Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif2model.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif2model.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif2model.F90	(revision 12101)
@@ -0,0 +1,89 @@
+#if defined key_agrif
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 4.0 , NEMO Consortium (2018)
+   !! $Id: agrif2model.F90 10068 2018-08-28 14:09:04Z nicolasmartin $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+SUBROUTINE Agrif2Model
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif2Model ***
+      !!--------------------------------------------- 
+END SUBROUTINE Agrif2model
+
+SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Set_numberofcells ***
+      !!--------------------------------------------- 
+   USE Agrif_Grids
+   IMPLICIT NONE
+
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+
+   IF ( ASSOCIATED(Agrif_Curgrid) )THEN
+#include "SetNumberofcells.h"
+   ENDIF
+
+END SUBROUTINE Agrif_Set_numberofcells
+
+SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Get_numberofcells ***
+      !!--------------------------------------------- 
+   USE Agrif_Grids
+   IMPLICIT NONE
+
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+
+   IF ( ASSOCIATED(Agrif_Curgrid) ) THEN
+#include "GetNumberofcells.h"
+   ENDIF
+
+END SUBROUTINE Agrif_Get_numberofcells
+
+SUBROUTINE Agrif_Allocationcalls(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Allocationscalls ***
+      !!--------------------------------------------- 
+   USE Agrif_Grids 
+#include "include_use_Alloc_agrif.h"
+   IMPLICIT NONE
+
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+
+#include "allocations_calls_agrif.h"
+
+END SUBROUTINE Agrif_Allocationcalls
+
+SUBROUTINE Agrif_probdim_modtype_def()
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_probdim_modtype_def ***
+      !!--------------------------------------------- 
+   USE Agrif_Types
+   IMPLICIT NONE
+
+#include "modtype_agrif.h"
+#include "probdim_agrif.h"
+#include "keys_agrif.h"
+
+   RETURN
+
+END SUBROUTINE Agrif_probdim_modtype_def
+
+SUBROUTINE Agrif_clustering_def()
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_clustering_def ***
+      !!--------------------------------------------- 
+   IMPLICIT NONE
+
+   RETURN
+
+END SUBROUTINE Agrif_clustering_def
+
+#else
+SUBROUTINE Agrif2Model
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif2Model ***
+      !!--------------------------------------------- 
+   WRITE(*,*) 'Impossible to bet here'
+END SUBROUTINE Agrif2model
+#endif
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_boundary_connections.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_boundary_connections.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_boundary_connections.F90	(revision 12101)
@@ -0,0 +1,351 @@
+#if defined key_agrif
+subroutine agrif_boundary_connections
+use agrif_profiles
+use agrif_parameters
+implicit none
+external connect_e3t_copy, connect_e3t_connect, connect_bottom_level,connect_e3u, connect_e3v
+if (agrif_root()) return
+
+call Agrif_connection()
+
+call Agrif_Bc_variable(bottom_level_id, procname = connect_bottom_level)
+
+call Agrif_Bc_variable(e3t_copy_id, procname = connect_e3t_copy)
+
+! Agrif_UseSpecialValue = .TRUE.
+! Agrif_SpecialValue = 0.
+! call Agrif_Bc_variable(e3t_connect_id, procname = connect_e3t_connect)
+! Agrif_UseSpecialValue = .FALSE.
+
+
+      Agrif_SpecialValue    = 0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+      !
+      CALL Agrif_Bc_variable( e3u_id, procname=connect_e3u )
+      CALL Agrif_Bc_variable( e3v_id, procname=connect_e3v )
+      !
+      Agrif_UseSpecialValue = .FALSE.
+      
+end subroutine agrif_boundary_connections
+
+
+    SUBROUTINE connect_e3t_copy( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir)
+    USE dom_oce
+    USE domzgr
+    USE agrif_parameters
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL, DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!---------------------------------------------------------------------- 
+      INTEGER :: ji,jj,jk      
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+      IF( before) THEN
+         ptab(i1:i2,j1:j2,k1:k2) = e3t_0(i1:i2,j1:j2,k1:k2)
+      ELSE
+         e3t_0(i1:i2,j1:j2,k1:k2) = ptab(i1:i2,j1:j2,k1:k2)
+      ENDIF
+      !
+   END SUBROUTINE connect_e3t_copy
+   
+    SUBROUTINE connect_bottom_level( ptab, i1, i2, j1, j2, before, nb,ndir)
+    USE dom_oce
+    USE domzgr
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2)    , INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!---------------------------------------------------------------------- 
+      INTEGER :: ji,jj     
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = mbkt(i1:i2,j1:j2)*ssmask(i1:i2,j1:j2)
+      ELSE
+         mbkt(i1:i2,j1:j2) = nint(ptab(i1:i2,j1:j2))
+         
+         WHERE (mbkt(i1:i2,j1:j2)==0)
+           ssmask(i1:i2,j1:j2) = 0.
+         END WHERE
+           
+      ENDIF
+      !
+   END SUBROUTINE connect_bottom_level
+   
+    SUBROUTINE connect_e3t_connect( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir)
+    USE dom_oce
+    USE domzgr
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL, DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!---------------------------------------------------------------------- 
+      INTEGER :: ji,jj,jk    
+      REAL,DIMENSION(i1:i2,j1:j2) :: bathy_local      
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+      IF( before) THEN
+         do jk=1,jpk
+         do jj=j1,j2
+         do ji=i1,i2
+          if (mbkt(ji,jj)>=jk) then
+            ptab(ji,jj,jk) = e3t_0(ji,jj,jk)
+          else
+            ptab(ji,jj,jk) = 0.
+          endif
+         enddo
+         enddo
+         enddo
+         
+         do jj=j1,j2
+         do ji=i1,i2
+           ptab(ji,jj,jpk+1) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj)
+         enddo
+         enddo
+
+      ELSE
+         do jj=j1,j2
+         do ji=i1,i2
+           bathy_local (ji,jj) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj)
+           print *,'ji = ',ji,jj,bathy_local(ji,jj),ptab(ji,jj,jpk+1)
+         enddo
+         enddo
+         
+         ! DO jk=1,jpk
+           ! DO jj=j1,j2
+             ! DO ji=i1,i2
+                 ! e3t_0(ji,jj,jk) = MAX(ptab(ji,jj,jk),MIN(e3zps_min, e3t_1d(jk)*e3zps_rat ))
+                 ! e3t_0(ji,jj,jk) = MIN(e3t_0(ji,jj,jk),e3t_1d(jk))
+             ! ENDDO
+           ! ENDDO
+         ! ENDDO
+      ENDIF
+      !
+   END SUBROUTINE connect_e3t_connect
+   
+   SUBROUTINE connect_e3u( ptab, i1, i2, j1, j2, k1, k2,before, nb, ndir )
+   USE dom_oce
+      !!----------------------------------------------------------------------
+      !!                  *** ROUTINE interpun ***
+      !!---------------------------------------------    
+      !!
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !!
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: zrhoy
+      ! vertical interpolation:
+      REAL(wp), DIMENSION(k1:k2) :: tabin, h_in
+      REAL(wp), DIMENSION(1:jpk) :: h_out
+      INTEGER  :: N_in, N_out, iref
+      REAL(wp) :: h_diff
+      LOGICAL  :: western_side, eastern_side
+      !!---------------------------------------------    
+      !
+      IF (before) THEN 
+         DO jk=1,jpk
+            DO jj=j1,j2
+               DO ji=i1,i2
+                 if (min(mbkt(ji,jj),mbkt(ji+1,jj))<jk) then
+                  ptab(ji,jj,jk) = 0.
+                 else
+                  ptab(ji,jj,jk) = e2u(ji,jj) * e3u_0(ji,jj,jk)
+                 endif
+# if defined key_vertical
+                  ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk))
+# endif
+               END DO
+            END DO
+         END DO
+      ELSE
+         zrhoy = Agrif_rhoy()
+# if defined key_vertical
+! VERTICAL REFINEMENT BEGIN
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+
+         DO ji=i1,i2
+            iref = ji
+            IF (western_side) iref = MAX(2,ji)
+            IF (eastern_side) iref = MIN(nlci-2,ji)
+            DO jj=j1,j2
+               N_in = 0
+               DO jk=k1,k2
+                  IF (ptab(ji,jj,jk,2) == 0) EXIT
+                  N_in = N_in + 1
+                  tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2)
+                  h_in(N_in) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy) 
+              ENDDO
+         
+              IF (N_in == 0) THEN
+                 ua(ji,jj,:) = 0._wp
+                 CYCLE
+              ENDIF
+         
+              N_out = 0
+              DO jk=1,jpk
+                 if (umask(iref,jj,jk) == 0) EXIT
+                 N_out = N_out + 1
+                 h_out(N_out) = e3u_a(iref,jj,jk)
+              ENDDO
+         
+              IF (N_out == 0) THEN
+                 ua(ji,jj,:) = 0._wp
+                 CYCLE
+              ENDIF
+         
+              IF (N_in * N_out > 0) THEN
+                 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
+! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly
+                 if (h_diff < -1.e4) then
+                    print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in))
+!                    stop
+                 endif
+              ENDIF
+              call reconstructandremap(tabin(1:N_in),h_in(1:N_in),ua(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)
+            ENDDO
+         ENDDO
+
+# else
+         DO jk = 1, jpkm1
+            DO jj=j1,j2
+            do ji=i1,i2
+              if (min(mbkt(ji+1,jj),mbkt(ji,jj))<jk) then
+                e3u_0(ji,jj,jk)=e3t_1d(jk)
+              else
+                e3u_0(ji,jj,jk) = MAX(ptab(ji,jj,jk) / ( zrhoy * e2u(ji,jj) ),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat))
+              endif
+            enddo
+               
+            END DO
+         END DO
+# endif
+
+      ENDIF
+      ! 
+   END SUBROUTINE connect_e3u
+   
+   SUBROUTINE connect_e3v( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
+   USE dom_oce
+      !!----------------------------------------------------------------------
+      !!                  *** ROUTINE interpvn ***
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: zrhox
+      ! vertical interpolation:
+      REAL(wp), DIMENSION(k1:k2) :: tabin, h_in
+      REAL(wp), DIMENSION(1:jpk) :: h_out
+      INTEGER  :: N_in, N_out, jref
+      REAL(wp) :: h_diff
+      LOGICAL  :: northern_side,southern_side
+      !!---------------------------------------------    
+      !      
+      IF (before) THEN          
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                 if (min(mbkt(ji,jj),mbkt(ji,jj+1))<jk) then
+                  ptab(ji,jj,jk) = 0.
+                 else
+                  ptab(ji,jj,jk) = (e1v(ji,jj) * e3v_0(ji,jj,jk))
+                 endif
+# if defined key_vertical
+                  ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk)
+# endif
+               END DO
+            END DO
+         END DO
+      ELSE       
+         zrhox = Agrif_rhox()
+# if defined key_vertical
+
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+         DO jj=j1,j2
+            jref = jj
+            IF (southern_side) jref = MAX(2,jj)
+            IF (northern_side) jref = MIN(nlcj-2,jj)
+            DO ji=i1,i2
+               N_in = 0
+               DO jk=k1,k2
+                  if (ptab(ji,jj,jk,2) == 0) EXIT
+                  N_in = N_in + 1
+                  tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2)
+                  h_in(N_in) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox)
+               END DO
+               IF (N_in == 0) THEN
+                  va(ji,jj,:) = 0._wp
+                  CYCLE
+               ENDIF
+         
+               N_out = 0
+               DO jk=1,jpk
+                  if (vmask(ji,jref,jk) == 0) EXIT
+                  N_out = N_out + 1
+                  h_out(N_out) = e3v_a(ji,jref,jk)
+               END DO
+               IF (N_out == 0) THEN
+                 va(ji,jj,:) = 0._wp
+                 CYCLE
+               ENDIF
+               call reconstructandremap(tabin(1:N_in),h_in(1:N_in),va(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)
+            END DO
+         END DO
+# else
+         DO jk = 1, jpkm1
+          DO jj=j1,j2
+          DO ji=i1,i2
+              if (min(mbkt(ji,jj),mbkt(ji,jj+1))<jk) then
+                e3v_0(ji,jj,jk)=e3t_1d(jk)
+              else
+                e3v_0(ji,jj,jk) = MAX(ptab(ji,jj,jk) / ( zrhox * e1v(ji,jj) ),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat))
+              endif
+          ENDDO
+          ENDDO
+         END DO
+# endif
+      ENDIF
+      !        
+   END SUBROUTINE connect_e3v
+
+#else
+subroutine agrif_boundary_connections_empty
+end subroutine agrif_boundary_connections_empty
+#endif
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_connection.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_connection.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_connection.F90	(revision 12101)
@@ -0,0 +1,72 @@
+#if defined key_agrif
+   SUBROUTINE Agrif_connection
+   use dom_oce
+   use agrif_parameters
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE  Agrif_Sponge ***
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, ind1, ind2
+      INTEGER  ::   ispongearea
+      REAL(wp) ::   z1_spongearea
+      !!----------------------------------------------------------------------
+      !
+         ! Define ramp from boundaries towards domain interior at T-points
+         ! Store it in ztabramp
+
+         ALLOCATE(ztabramp(jpi,jpj))
+         ispongearea  = 1 + npt_connect * Agrif_irhox()
+         z1_spongearea = 1._wp / REAL( ispongearea )
+         
+         ztabramp(:,:) = 0._wp
+
+         ! --- West --- !
+         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
+            ind1 = 1+nbghostcells
+            ind2 = 1+nbghostcells + ispongearea 
+            DO jj = 1, jpj
+               DO ji = ind1, ind2                
+                  ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1)
+               END DO
+            ENDDO
+         ENDIF
+
+         ! --- East --- !
+         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
+            ind1 = nlci - nbghostcells - ispongearea
+            ind2 = nlci - nbghostcells
+            DO jj = 1, jpj
+               DO ji = ind1, ind2
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind1 ) * z1_spongearea * umask(ind2-1,jj,1) )
+               ENDDO
+            ENDDO
+         ENDIF
+
+         ! --- South --- !
+         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
+            ind1 = 1+nbghostcells
+            ind2 = 1+nbghostcells + ispongearea
+            DO jj = ind1, ind2 
+               DO ji = 1, jpi
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) )
+               END DO
+            ENDDO
+         ENDIF
+
+         ! --- North --- !
+         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
+            ind1 = nlcj - nbghostcells - ispongearea
+            ind2 = nlcj - nbghostcells
+            DO jj = ind1, ind2
+               DO ji = 1, jpi
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind1 ) * z1_spongearea * vmask(ji,ind2-1,1) )
+               END DO
+            ENDDO
+         ENDIF
+      !
+      !
+   END SUBROUTINE Agrif_connection
+   
+#else
+subroutine agrif_connection_empty
+end subroutine agrif_connection_empty
+#endif
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_domzgr.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_domzgr.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_domzgr.F90	(revision 12101)
@@ -0,0 +1,40 @@
+#if defined key_agrif
+subroutine agrif_domzgr
+end subroutine agrif_domzgr
+
+subroutine agrif_create_bathy_meter
+use agrif_profiles
+external :: init_bathy
+
+call Agrif_Init_variable(bathy_id, procname = init_bathy)
+
+end subroutine agrif_create_bathy_meter
+
+    SUBROUTINE init_bathy( ptab, i1, i2, j1, j2, before, nb,ndir)
+    use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = bathy(i1:i2,j1:j2)
+      ELSE
+         bathy(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_bathy
+#else
+subroutine agrif_domzgr_empty
+end subroutine agrif_domzgr_empty
+#endif
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_parameters.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_parameters.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_parameters.F90	(revision 12101)
@@ -0,0 +1,19 @@
+#ifdef key_agrif
+module agrif_parameters
+USE par_kind
+
+INTEGER :: nn_cln_update
+LOGICAL :: ln_spc_dyn
+REAL(wp) :: rn_sponge_tra
+REAL(wp) :: rn_sponge_dyn
+LOGICAL :: ln_chk_bathy
+INTEGER :: npt_copy
+INTEGER :: npt_connect
+
+REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   ztabramp
+
+end module agrif_parameters
+#else
+subroutine agrif_parameters_empty
+end subroutine agrif_parameters_empty
+#endif
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_profiles.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_profiles.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_profiles.F90	(revision 12101)
@@ -0,0 +1,20 @@
+module agrif_profiles
+
+integer :: glamt_id, glamu_id, glamv_id,glamf_id
+integer :: gphit_id, gphiu_id, gphiv_id,gphif_id
+integer :: e1t_id, e1u_id, e1v_id, e1f_id
+integer :: e2t_id, e2u_id, e2v_id, e2f_id
+
+
+integer :: bathy_id
+
+! Vertical scale factors
+
+integer :: e3t_id
+integer :: e3t_copy_id
+integer :: e3t_connect_id
+integer :: e3u_id, e3v_id
+
+! Bottom level
+integer :: bottom_level_id
+end module agrif_profiles
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_recompute_scalefactors.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_recompute_scalefactors.f90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_recompute_scalefactors.f90	(revision 12101)
@@ -0,0 +1,88 @@
+#if defined key_agrif
+subroutine agrif_recompute_scalefactors
+   USE dom_oce
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp
+implicit none
+INTEGER :: ji,jj,jk,ikb,ikt
+
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+!         e3u_0 (:,:,jk) = e3t_1d(jk)
+!         e3v_0 (:,:,jk) = e3t_1d(jk)
+         e3uw_0(:,:,jk) = e3w_1d(jk)
+         e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+
+      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+!               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
+!               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
+               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
+               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
+            END DO
+         END DO
+      END DO
+      IF ( ln_isfcav ) THEN
+      ! (ISF) define e3uw (adapted for 2 cells in the water column)
+         DO jj = 2, jpjm1 
+            DO ji = 2, jpim1   ! vector opt. 
+               ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj))
+               ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj))
+               IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) &
+                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) )
+               ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1))
+               ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1))
+               IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) &
+                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) )
+            END DO
+         END DO
+      END IF
+
+      CALL lbc_lnk('toto', e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk('toto', e3uw_0, 'U', 1._wp )   ! lateral boundary conditions
+      CALL lbc_lnk( 'toto',e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk('toto', e3vw_0, 'V', 1._wp )
+      !
+
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk)
+         WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+      
+      ! Scale factor at F-point
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk('toto', e3f_0, 'F', 1._wp )       ! Lateral boundary conditions
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+!!gm  bug ? :  must be a do loop with mj0,mj1
+      ! 
+      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
+      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:) 
+      e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:) 
+      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:) 
+      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:) 
+
+      ! Control of the sign
+      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' )
+      IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' )
+      IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' )
+      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' )
+      
+end subroutine agrif_recompute_scalefactors
+#else
+subroutine agrif_recompute_scalefactors_empty
+end subroutine agrif_recompute_scalefactors_empty
+#endif
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_update.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_update.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_update.F90	(revision 12101)
@@ -0,0 +1,187 @@
+#if defined key_agrif
+subroutine agrif_update_all
+USE agrif_parameters
+USE agrif_profiles
+external update_bottom_level, update_e3t, update_e3u, update_e3v
+
+if (agrif_root()) return
+call agrif_update_variable(bottom_level_id,locupdate=(/npt_copy,0/),procname = update_bottom_level)
+
+      Agrif_UseSpecialValueInUpdate = .TRUE.
+      Agrif_SpecialValueFineGrid    = 0._wp
+      
+call agrif_update_variable(e3t_id,procname = update_e3t)
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+
+call agrif_update_variable(e3u_id,procname = update_e3u)
+call agrif_update_variable(e3v_id,procname = update_e3v)
+      
+end subroutine agrif_update_all
+
+    SUBROUTINE update_bottom_level( ptab, i1, i2, j1, j2, before, nb,ndir)
+    USE dom_oce
+    USE domzgr
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2)    , INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!---------------------------------------------------------------------- 
+      INTEGER :: ji,jj     
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = mbkt(i1:i2,j1:j2)*ssmask(i1:i2,j1:j2)
+      ELSE
+         mbkt(i1:i2,j1:j2) = nint(ptab(i1:i2,j1:j2))
+         
+         WHERE (mbkt(i1:i2,j1:j2)==0)
+           ssmask(i1:i2,j1:j2) = 0.
+         END WHERE
+           
+      ENDIF
+      !
+   END SUBROUTINE update_bottom_level
+   
+   SUBROUTINE update_e3t( tabres, i1, i2, j1, j2, k1, k2,  before )
+   USE dom_oce
+   implicit none
+      !!---------------------------------------------
+      !!           *** update_e3t updateT ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji,jj,jk
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                   if (mbkt(ji,jj) < jk) then
+                     tabres(ji,jj,jk) = e3t_0(ji,jj,jk)
+                   else
+                     tabres(ji,jj,jk) = 0.
+                   endif
+                  END DO
+               END DO
+            END DO
+      ELSE
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                   if (mbkt(ji,jj) < jk) then
+                     e3t_0(ji,jj,jk) = e3t_1d(jk)
+                   else
+                     e3t_0(ji,jj,jk) = MAX(tabres(ji,jj,jk),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat))
+                   endif
+                  END DO
+               END DO
+            END DO
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE update_e3t
+   
+   SUBROUTINE update_e3u( tabres, i1, i2, j1, j2, k1, k2, before )
+   USE dom_oce
+   implicit none
+      !!---------------------------------------------
+      !!           *** ROUTINE update_e3u ***
+      !!---------------------------------------------
+      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL                                     , INTENT(in   ) :: before
+      !
+      INTEGER  :: ji, jj, jk
+      REAL :: zrhoy
+      !!---------------------------------------------
+      ! 
+      IF( before ) THEN
+         zrhoy = Agrif_Rhoy()
+         DO jk = k1, k2
+          do jj=j1,j2
+          do ji=i1,i2
+           if (min(mbkt(ji,jj),mbkt(ji+1,jj))<jk) then
+            tabres(ji,jj,jk) = zrhoy * e2u(ji,jj) * MIN(e3zps_min,e3t_1d(jk)*e3zps_rat)
+           else
+            tabres(ji,jj,jk) = zrhoy * e2u(ji,jj) * e3u_0(ji,jj,jk)
+           endif
+          enddo
+          enddo
+         END DO
+      ELSE
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                 if (min(mbkt(ji,jj),mbkt(ji+1,jj))<jk) then
+                   e3u_0(ji,jj,jk)=e3t_1d(jk)
+                 else
+                   e3u_0(ji,jj,jk) = MAX(tabres(ji,jj,jk) / e2u(ji,jj),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat))
+                 endif
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE update_e3u
+   
+   SUBROUTINE update_e3v( tabres, i1, i2, j1, j2, k1, k2, before )
+   USE dom_oce
+   implicit none
+      !!---------------------------------------------
+      !!           *** ROUTINE update_e3v ***
+      !!---------------------------------------------
+      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL                                     , INTENT(in   ) :: before
+      !
+      INTEGER  :: ji, jj, jk
+      REAL :: zrhox
+      !!---------------------------------------------
+      ! 
+      IF( before ) THEN
+         zrhox = Agrif_Rhox()
+         DO jk = k1, k2
+          do jj=j1,j2
+          do ji=i1,i2
+           if (min(mbkt(ji,jj),mbkt(ji,jj+1))<jk) then
+            tabres(ji,jj,jk) = zrhox * e1v(ji,jj) * MIN(e3zps_min,e3t_1d(jk)*e3zps_rat)
+           else
+            tabres(ji,jj,jk) = zrhox * e1v(ji,jj) * e3v_0(ji,jj,jk)
+           endif
+          enddo
+          enddo
+         END DO
+      ELSE
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                 if (min(mbkt(ji,jj),mbkt(ji,jj+1))<jk) then
+                   e3v_0(ji,jj,jk)=e3t_1d(jk)
+                 else
+                   e3v_0(ji,jj,jk) = MAX(tabres(ji,jj,jk) / e1v(ji,jj),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat))
+                 endif
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE update_e3v
+   
+#else
+subroutine agrif_update_all_empty
+end subroutine agrif_update_all_empty
+#endif
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_user.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_user.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/agrif_user.F90	(revision 12101)
@@ -0,0 +1,811 @@
+#if defined key_agrif
+subroutine agrif_initworkspace()
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_InitWorkspace ***
+      !!----------------------------------------------------------------------
+end subroutine agrif_initworkspace
+SUBROUTINE Agrif_InitValues
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_InitValues ***
+      !!
+      !! ** Purpose :: Declaration of variables to be interpolated
+      !!----------------------------------------------------------------------
+   USE Agrif_Util
+   USE dom_oce
+   USE nemogcm
+   USE domain
+   !!
+   IMPLICIT NONE
+   
+ 
+   CALL nemo_init       !* Initializations of each fine grid
+
+   CALL dom_nam
+   CALL cfg_write         ! create the configuration file
+   
+END SUBROUTINE Agrif_InitValues
+
+SUBROUTINE Agrif_InitValues_cont
+
+use dom_oce
+    integer :: irafx, irafy
+    logical :: ln_perio
+    integer nx,ny
+
+irafx = agrif_irhox()
+irafy = agrif_irhoy()
+
+nx=nlci ; ny=nlcj
+
+   !       IF(jperio /=1 .AND. jperio/=4 .AND. jperio/=6 ) THEN
+   !          nx = (nbcellsx)+2*nbghostcellsfine+2
+   !          ny = (nbcellsy)+2*nbghostcellsfine+2
+   !          nbghostcellsfine_tot_x= nbghostcellsfine_x +1
+   !          nbghostcellsfine_tot_y= nbghostcellsfine_y +1
+   !       ELSE
+   !         nx = (nbcellsx)+2*nbghostcellsfine_x 
+   !         ny = (nbcellsy)+2*nbghostcellsfine+2
+   !         nbghostcellsfine_tot_x= 1
+   !         nbghostcellsfine_tot_y= nbghostcellsfine_y +1
+   !      ENDIF
+   !    ELSE
+   !       nbghostcellsfine = 0
+   !       nx = nbcellsx+irafx
+   !       ny = nbcellsy+irafy
+       
+  WRITE(*,*) ' '
+  WRITE(*,*)'Size of the High resolution grid: ',nx,' x ',ny
+  WRITE(*,*) ' '
+       
+       call agrif_init_lonlat()
+       ln_perio=.FALSE. 
+       if( jperio ==1 .OR. jperio==2 .OR. jperio==4) ln_perio=.TRUE.
+
+       where (glamt < -180) glamt = glamt +360.
+       if (ln_perio) then
+         glamt(1,:)=glamt(nx-1,:)
+         glamt(nx,:)=glamt(2,:)
+       endif
+ 
+       where (glamu < -180) glamu = glamu +360.
+       if (ln_perio) then
+         glamu(1,:)=glamu(nx-1,:)
+         glamu(nx,:)=glamu(2,:)
+       endif
+
+      where (glamv < -180) glamv = glamv +360.
+       if (ln_perio) then
+         glamv(1,:)=glamv(nx-1,:)
+         glamv(nx,:)=glamv(2,:)
+       endif
+
+      where (glamf < -180) glamf = glamf +360.
+       if (ln_perio) then
+         glamf(1,:)=glamf(nx-1,:)
+         glamf(nx,:)=glamf(2,:)
+       endif
+
+       call agrif_init_scales()
+
+        
+END SUBROUTINE Agrif_InitValues_cont  
+
+
+subroutine agrif_declare_var()
+use par_oce
+use dom_oce
+use agrif_profiles
+use agrif_parameters
+
+   IMPLICIT NONE
+   
+integer :: ind1, ind2, ind3
+integer nx,ny
+integer nbghostcellsfine_tot_x, nbghostcellsfine_tot_y
+INTEGER :: irafx
+!!----------------------------------------------------------------------
+
+   ! 1. Declaration of the type of variable which have to be interpolated
+   !---------------------------------------------------------------------
+ nx=nlci ; ny=nlcj
+
+!ind2 = nbghostcellsfine_tot_x + 1
+!ind3 = nbghostcellsfine_tot_y + 1
+ind2 = 2 + nbghostcells
+ind3 = ind2
+nbghostcellsfine_tot_x=nbghostcells+1
+nbghostcellsfine_tot_y=nbghostcells+1
+
+irafx = Agrif_irhox()
+
+CALL agrif_nemo_init  ! specific namelist part if needed
+
+CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),glamt_id)
+CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),glamu_id)
+CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),glamv_id)
+CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),glamf_id)
+
+CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),gphit_id)
+CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),gphiu_id)
+CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),gphiv_id)
+CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),gphif_id)
+
+! Horizontal scale factors
+
+CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),e1t_id)
+CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),e1u_id)
+CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),e1v_id)
+CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),e1f_id)
+
+CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),e2t_id)
+CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),e2u_id)
+CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),e2v_id)
+CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),e2f_id)
+
+! Bathymetry
+
+CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),bathy_id)
+
+! Vertical scale factors
+CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk/),e3t_id)
+CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk/),e3t_copy_id)
+CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk+1/),e3t_connect_id)
+
+CALL agrif_declare_variable((/1,2,0/),(/ind2-1,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk/),e3u_id)
+CALL agrif_declare_variable((/2,1,0/),(/ind2,ind3-1,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk/),e3v_id)
+
+! Bottom level
+
+CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),bottom_level_id)
+
+CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(glamt_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( glamt_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(glamu_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(glamu_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( glamu_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(glamv_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(glamv_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( glamv_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(glamf_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(glamf_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( glamf_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(gphit_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( gphit_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(gphiu_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(gphiu_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( gphiu_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(gphiv_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(gphiv_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( gphiv_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(gphif_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(gphif_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( gphif_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+!
+
+CALL Agrif_Set_bcinterp(e1t_id,interp=AGRIF_ppm)
+CALL Agrif_Set_interp(e1t_id,interp=AGRIF_ppm)
+CALL Agrif_Set_bc( e1t_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
+CALL Agrif_Set_interp(e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
+CALL Agrif_Set_bc( e1u_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e1v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
+CALL Agrif_Set_interp(e1v_id, interp1=AGRIF_ppm, interp2=Agrif_linear)
+CALL Agrif_Set_bc( e1v_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e1f_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(e1f_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( e1f_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e2t_id,interp=AGRIF_ppm)
+CALL Agrif_Set_interp(e2t_id,interp=AGRIF_ppm)
+CALL Agrif_Set_bc( e2t_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e2u_id,interp1=Agrif_linear, interp2=AGRIF_ppm)
+CALL Agrif_Set_interp(e2u_id,interp1=Agrif_linear, interp2=AGRIF_ppm)
+CALL Agrif_Set_bc( e2u_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
+CALL Agrif_Set_interp(e2v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
+CALL Agrif_Set_bc( e2v_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e2f_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(e2f_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( e2f_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(bathy_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(bathy_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( bathy_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+! Vertical scale factors
+CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_ppm)
+CALL Agrif_Set_interp(e3t_id,interp=AGRIF_ppm)
+CALL Agrif_Set_bc( e3t_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+CALL Agrif_Set_Updatetype( e3t_id, update = AGRIF_Update_Average)
+
+CALL Agrif_Set_bcinterp(e3t_copy_id,interp=AGRIF_constant)
+CALL Agrif_Set_interp(e3t_copy_id,interp=AGRIF_constant)
+CALL Agrif_Set_bc( e3t_copy_id, (/-npt_copy*irafx-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/))
+
+CALL Agrif_Set_bcinterp(e3t_connect_id,interp=AGRIF_ppm)
+CALL Agrif_Set_interp(e3t_connect_id,interp=AGRIF_ppm)
+CALL Agrif_Set_bc( e3t_connect_id, (/-(npt_copy+npt_connect)*irafx-1,-npt_copy*irafx-2/))
+
+CALL Agrif_Set_bcinterp(e3u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
+CALL Agrif_Set_interp(e3u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
+CALL Agrif_Set_bc( e3u_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+CALL Agrif_Set_Updatetype(e3u_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+
+CALL Agrif_Set_bcinterp(e3v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
+CALL Agrif_Set_interp(e3v_id, interp1=AGRIF_ppm, interp2=Agrif_linear)
+CALL Agrif_Set_bc( e3v_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+CALL Agrif_Set_Updatetype(e3v_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+   
+! Bottom level
+CALL Agrif_Set_bcinterp(bottom_level_id,interp=AGRIF_constant)
+CALL Agrif_Set_interp(bottom_level_id,interp=AGRIF_constant)
+CALL Agrif_Set_bc( bottom_level_id, (/-npt_copy*irafx-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/))
+CALL Agrif_Set_Updatetype( bottom_level_id, update = AGRIF_Update_Max)
+
+end subroutine agrif_declare_var
+
+
+subroutine agrif_init_lonlat()
+use agrif_profiles
+use agrif_util
+external :: init_glamt, init_glamu, init_glamv, init_glamf
+external :: init_gphit, init_gphiu, init_gphiv, init_gphif
+
+call Agrif_Init_variable(glamt_id, procname = init_glamt)
+call Agrif_Init_variable(glamu_id, procname = init_glamu)
+call Agrif_Init_variable(glamv_id, procname = init_glamv)
+call Agrif_Init_variable(glamf_id, procname = init_glamf)
+
+call Agrif_Init_variable(gphit_id, procname = init_gphit)
+call Agrif_Init_variable(gphiu_id, procname = init_gphiu)
+call Agrif_Init_variable(gphiv_id, procname = init_gphiv)
+call Agrif_Init_variable(gphif_id, procname = init_gphif)
+
+end subroutine agrif_init_lonlat
+
+subroutine agrif_init_scales()
+use agrif_profiles
+use agrif_util
+external :: init_e1t, init_e1u, init_e1v, init_e1f
+external :: init_e2t, init_e2u, init_e2v, init_e2f
+
+call Agrif_Init_variable(e1t_id, procname = init_e1t)
+call Agrif_Init_variable(e1u_id, procname = init_e1u)
+call Agrif_Init_variable(e1v_id, procname = init_e1v)
+call Agrif_Init_variable(e1f_id, procname = init_e1f)
+
+call Agrif_Init_variable(e2t_id, procname = init_e2t)
+call Agrif_Init_variable(e2u_id, procname = init_e2u)
+call Agrif_Init_variable(e2v_id, procname = init_e2v)
+call Agrif_Init_variable(e2f_id, procname = init_e2f)
+
+end subroutine agrif_init_scales
+
+
+
+   SUBROUTINE init_glamt( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = glamt(i1:i2,j1:j2)
+      ELSE
+         glamt(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_glamt
+
+    SUBROUTINE init_glamu( ptab, i1, i2, j1, j2, before, nb,ndir)
+    use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = glamu(i1:i2,j1:j2)
+      ELSE
+         glamu(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_glamu
+
+   SUBROUTINE init_glamv( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = glamv(i1:i2,j1:j2)
+      ELSE
+         glamv(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_glamv
+
+   SUBROUTINE init_glamf( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = glamf(i1:i2,j1:j2)
+      ELSE
+         glamf(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_glamf
+
+   SUBROUTINE init_gphit( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = gphit(i1:i2,j1:j2)
+      ELSE
+         gphit(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_gphit
+
+    SUBROUTINE init_gphiu( ptab, i1, i2, j1, j2, before, nb,ndir)
+    use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = gphiu(i1:i2,j1:j2)
+      ELSE
+         gphiu(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_gphiu
+
+    SUBROUTINE init_gphiv( ptab, i1, i2, j1, j2, before, nb,ndir)
+    use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = gphiv(i1:i2,j1:j2)
+      ELSE
+         gphiv(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_gphiv
+
+
+   SUBROUTINE init_gphif( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = gphif(i1:i2,j1:j2)
+      ELSE
+         gphif(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_gphif
+
+
+   SUBROUTINE init_e1t( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e1t(i1:i2,j1:j2)
+      ELSE
+         e1t(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e1t
+
+   SUBROUTINE init_e1u( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e1u(i1:i2,j1:j2)
+      ELSE
+         e1u(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e1u
+
+   SUBROUTINE init_e1v( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2)
+      ELSE
+         e1v(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e1v
+
+   SUBROUTINE init_e1f( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e1f(i1:i2,j1:j2)
+      ELSE
+         e1f(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e1f
+
+  SUBROUTINE init_e2t( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e2t(i1:i2,j1:j2)
+      ELSE
+         e2t(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e2t
+
+   SUBROUTINE init_e2u( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2)
+      ELSE
+         e2u(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e2u
+
+   SUBROUTINE init_e2v( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e2v(i1:i2,j1:j2)
+      ELSE
+         e2v(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e2v
+
+   SUBROUTINE init_e2f( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e2f(i1:i2,j1:j2)
+      ELSE
+         e2f(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e2f
+
+
+SUBROUTINE agrif_nemo_init
+USE agrif_parameters
+USE in_out_manager
+USE lib_mpp
+
+   
+   !!
+   IMPLICIT NONE
+   
+   INTEGER ::   ios
+   
+   NAMELIST/namagrif/ nn_cln_update,ln_spc_dyn,rn_sponge_tra,rn_sponge_dyn,ln_chk_bathy,npt_connect, npt_copy
+
+      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : nesting parameters
+      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : nesting parameters
+      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namagrif )
+
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'agrif_nemo_init : nesting'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namagrif : set nesting parameters'
+         WRITE(numout,*) '      npt_copy     = ', npt_copy
+         WRITE(numout,*) '      npt_connect  = ', npt_connect
+      ENDIF
+      
+END SUBROUTINE agrif_nemo_init
+   
+
+SUBROUTINE Agrif_detect( kg, ksizex )
+      !!----------------------------------------------------------------------
+      !!                      *** ROUTINE Agrif_detect ***
+      !!----------------------------------------------------------------------
+   INTEGER, DIMENSION(2) :: ksizex
+   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
+      !!----------------------------------------------------------------------
+   !
+   RETURN
+   !
+END SUBROUTINE Agrif_detect
+SUBROUTINE agrif_before_regridding
+END SUBROUTINE agrif_before_regridding
+
+SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
+      !!----------------------------------------------------------------------
+      !!                     *** ROUTINE Agrif_InvLoc ***
+      !!----------------------------------------------------------------------
+   USE dom_oce
+   !!
+   IMPLICIT NONE
+   !
+   INTEGER :: indglob, indloc, nprocloc, i
+      !!----------------------------------------------------------------------
+   !
+   SELECT CASE( i )
+   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
+   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
+   CASE DEFAULT
+      indglob = indloc
+   END SELECT
+   !
+END SUBROUTINE Agrif_InvLoc
+
+SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_get_proc_info ***
+      !!----------------------------------------------------------------------
+   USE par_oce
+   USE dom_oce 
+   !!
+   IMPLICIT NONE
+   !
+   INTEGER, INTENT(out) :: imin, imax
+   INTEGER, INTENT(out) :: jmin, jmax
+      !!----------------------------------------------------------------------
+   !
+   imin = nimppt(Agrif_Procrank+1)  ! ?????
+   jmin = njmppt(Agrif_Procrank+1)  ! ?????
+   imax = imin + jpi - 1
+   jmax = jmin + jpj - 1
+   ! 
+END SUBROUTINE Agrif_get_proc_info
+
+SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
+      !!----------------------------------------------------------------------
+   USE par_oce
+   !!
+   IMPLICIT NONE
+   !
+   INTEGER,  INTENT(in)  :: imin, imax
+   INTEGER,  INTENT(in)  :: jmin, jmax
+   INTEGER,  INTENT(in)  :: nbprocs
+   REAL(wp), INTENT(out) :: grid_cost
+      !!----------------------------------------------------------------------
+   !
+   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
+   !
+END SUBROUTINE Agrif_estimate_parallel_cost
+
+#endif
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/bdy_oce.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/bdy_oce.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/bdy_oce.F90	(revision 12101)
@@ -0,0 +1,169 @@
+MODULE bdy_oce
+   !!======================================================================
+   !!                       ***  MODULE bdy_oce   ***
+   !! Unstructured Open Boundary Cond. :   define related variables
+   !!======================================================================
+   !! History :  1.0  !  2001-05  (J. Chanut, A. Sellar)  Original code
+   !!            3.0  !  2008-04  (NEMO team)  add in the reference version     
+   !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions
+   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!            3.6  !  2014-01  (C. Rousset) add ice boundary conditions for new model
+   !!            4.0  !  2018     (C. Rousset) SI3 compatibility
+   !!----------------------------------------------------------------------
+   USE par_oce         ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   INTEGER, PUBLIC, PARAMETER ::   jp_bdy  = 10       !: Maximum number of bdy sets
+   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 3        !: Number of horizontal grid types used  (T, U, V)
+
+   TYPE, PUBLIC ::   OBC_INDEX    !: Indices and weights which define the open boundary
+      INTEGER ,          DIMENSION(jpbgrd) ::  nblen
+      INTEGER ,          DIMENSION(jpbgrd) ::  nblenrim
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbi
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbj
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbr
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbmap
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbw
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbd
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbdout
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagu
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagv
+   END TYPE OBC_INDEX
+
+   !! Logicals in OBC_DATA structure are true if the chosen algorithm requires this
+   !! field as external data. If true the data can come from external files
+   !! or model initial conditions. If false then no "external" data array
+   !! is required for this field. 
+
+   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data
+      INTEGER          , DIMENSION(2)   ::  nread
+      LOGICAL                           ::  ll_ssh
+      LOGICAL                           ::  ll_u2d
+      LOGICAL                           ::  ll_v2d
+      LOGICAL                           ::  ll_u3d
+      LOGICAL                           ::  ll_v3d
+      LOGICAL                           ::  ll_tem
+      LOGICAL                           ::  ll_sal
+      LOGICAL                           ::  ll_fvl
+      REAL(wp), POINTER, DIMENSION(:)   ::  ssh
+      REAL(wp), POINTER, DIMENSION(:)   ::  u2d
+      REAL(wp), POINTER, DIMENSION(:)   ::  v2d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  u3d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  v3d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  tem
+      REAL(wp), POINTER, DIMENSION(:,:) ::  sal
+#if defined key_si3
+      LOGICAL                           ::   ll_a_i
+      LOGICAL                           ::   ll_h_i
+      LOGICAL                           ::   ll_h_s
+      REAL(wp), POINTER, DIMENSION(:,:) ::   a_i    !: now ice leads fraction climatology
+      REAL(wp), POINTER, DIMENSION(:,:) ::   h_i    !: Now ice  thickness climatology
+      REAL(wp), POINTER, DIMENSION(:,:) ::   h_s    !: now snow thickness
+#endif
+#if defined key_top
+      CHARACTER(LEN=20)                   :: cn_obc  !: type of boundary condition to apply
+      REAL(wp)                            :: rn_fac  !: multiplicative scaling factor
+      REAL(wp), POINTER, DIMENSION(:,:)   :: trc     !: now field of the tracer
+      LOGICAL                             :: dmp     !: obc damping term
+#endif
+   END TYPE OBC_DATA
+
+   !!----------------------------------------------------------------------
+   !! Namelist variables
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC            ::   ln_bdy                   !: Unstructured Ocean Boundary Condition
+
+   CHARACTER(len=80), DIMENSION(jp_bdy) ::   cn_coords_file !: Name of bdy coordinates file
+   CHARACTER(len=80)                    ::   cn_mask_file   !: Name of bdy mask file
+   !
+   LOGICAL, DIMENSION(jp_bdy) ::   ln_coords_file           !: =T read bdy coordinates from file; 
+   !                                                        !: =F read bdy coordinates from namelist
+   LOGICAL                    ::   ln_mask_file             !: =T read bdymask from file
+   LOGICAL                    ::   ln_vol                   !: =T volume correction             
+   !
+   INTEGER                    ::   nb_bdy                   !: number of open boundary sets
+   INTEGER                    ::   nb_jpk_bdy               !: number of levels in the bdy data (set < 0 if consistent with planned run)
+   INTEGER, DIMENSION(jp_bdy) ::   nn_rimwidth              !: boundary rim width for Flow Relaxation Scheme
+   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P 
+   !                                                        !  = 1 the volume will be constant during all the integration.
+   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_dyn2d       ! Choice of boundary condition for barotropic variables (U,V,SSH)
+   INTEGER, DIMENSION(jp_bdy)           ::   nn_dyn2d_dta   !: = 0 use the initial state as bdy dta ; 
+                                                            !: = 1 read it in a NetCDF file
+                                                            !: = 2 read tidal harmonic forcing from a NetCDF file
+                                                            !: = 3 read external data AND tidal harmonic forcing from NetCDF files
+   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_dyn3d       ! Choice of boundary condition for baroclinic velocities 
+   INTEGER, DIMENSION(jp_bdy)           ::   nn_dyn3d_dta   !: = 0 use the initial state as bdy dta ; 
+                                                            !: = 1 read it in a NetCDF file
+   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_tra         ! Choice of boundary condition for active tracers (T and S)
+   INTEGER, DIMENSION(jp_bdy)           ::   nn_tra_dta     !: = 0 use the initial state as bdy dta ; 
+                                                            !: = 1 read it in a NetCDF file
+   LOGICAL , DIMENSION(jp_bdy) ::   ln_tra_dmp              !: =T Tracer damping
+   LOGICAL , DIMENSION(jp_bdy) ::   ln_dyn3d_dmp            !: =T Baroclinic velocity damping
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp             !: Damping time scale in days
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp_out         !: Damping time scale in days at radiation outflow points
+
+   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_ice         ! Choice of boundary condition for sea ice variables 
+   INTEGER , DIMENSION(jp_bdy)          ::   nn_ice_dta     !: = 0 use the initial state as bdy dta ; 
+                                                            !: = 1 read it in a NetCDF file
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_tem              !: choice of the temperature of incoming sea ice
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_sal              !: choice of the salinity    of incoming sea ice
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_age              !: choice of the age         of incoming sea ice
+   !
+   
+   !!----------------------------------------------------------------------
+   !! Global variables
+   !!----------------------------------------------------------------------
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdytmask   !: Mask defining computational domain at T-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyumask   !: Mask defining computational domain at U-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyvmask   !: Mask defining computational domain at V-points
+
+   REAL(wp)                                    ::   bdysurftot !: Lateral surface of unstructured open boundary
+
+   !!----------------------------------------------------------------------
+   !! open boundary data variables
+   !!----------------------------------------------------------------------
+
+   INTEGER,  DIMENSION(jp_bdy)                     ::   nn_dta            !: =0 => *all* data is set to initial conditions
+                                                                          !: =1 => some data to be read in from data files
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays (unstr.  bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_z      !: workspace for reading in global depth arrays (unstr.  bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_dz     !: workspace for reading in global depth arrays (unstr.  bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2       !: workspace for reading in global data arrays (struct. bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_z     !: workspace for reading in global depth arrays (struct. bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_dz    !: workspace for reading in global depth arrays (struct. bdy)
+!$AGRIF_DO_NOT_TREAT
+   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process)
+   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process)
+!$AGRIF_END_DO_NOT_TREAT
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: bdy_oce.F90 10425 2018-12-19 21:54:16Z smasson $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION bdy_oce_alloc()
+      !!----------------------------------------------------------------------
+      USE lib_mpp, ONLY: ctl_stop, mpp_sum
+      !
+      INTEGER :: bdy_oce_alloc
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),     &  
+         &      STAT=bdy_oce_alloc )
+      !
+      ! Initialize masks 
+      bdytmask(:,:) = 1._wp
+      bdyumask(:,:) = 1._wp
+      bdyvmask(:,:) = 1._wp
+      ! 
+      CALL mpp_sum ( 'bdy_oce', bdy_oce_alloc )
+      IF( bdy_oce_alloc /= 0 )   CALL ctl_stop( 'STOP', 'bdy_oce_alloc: failed to allocate arrays.' )
+      !
+   END FUNCTION bdy_oce_alloc
+
+   !!======================================================================
+END MODULE bdy_oce
+
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/bilinear_interp.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/bilinear_interp.f90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/bilinear_interp.f90	(revision 12101)
@@ -0,0 +1,3 @@
+MODULE bilinear_interp
+
+END MODULE
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/closea.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/closea.f90	(revision 12100)
+++ 	(revision )
@@ -1,223 +1,0 @@
-MODULE closea
-   !!======================================================================
-   !!                       ***  MODULE  closea  ***
-   !! Closed Seas  : specific treatments associated with closed seas
-   !!======================================================================
-   !! History :   8.2  !  00-05  (O. Marti)  Original code
-   !!             8.5  !  02-06  (E. Durand, G. Madec)  F90
-   !!             9.0  !  06-07  (G. Madec)  add clo_rnf, clo_ups, clo_bat
-   !!        NEMO 3.4  !  03-12  (P.G. Fogli) sbc_clo bug fix & mpp reproducibility
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dom_clo    : modification of the ocean domain for closed seas cases
-   !!   sbc_clo    : Special handling of closed seas
-   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf)
-   !!   clo_ups    : set mixed centered/upstream scheme in closed sea (see traadv_cen2)
-   !!   clo_bat    : set to zero a field over closed sea (see domzrg)
-   !!----------------------------------------------------------------------
-   USE oce             ! dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE in_out_manager  ! I/O manager
-   USE lib_fortran,    ONLY: glob_sum, DDPDD
-   USE lbclnk          ! lateral boundary condition - MPP exchanges
-   USE lib_mpp         ! MPP library
-   USE timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC dom_clo      ! routine called by domain module
-   PUBLIC clo_bat      ! routine called in domzgr module
-
-   INTEGER, PUBLIC, PARAMETER          ::   jpncs   = 4      !: number of closed sea
-   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncstt            !: Type of closed sea
-   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi1, ncsj1     !: south-west closed sea limits (i,j)
-   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi2, ncsj2     !: north-east closed sea limits (i,j)
-   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsnr            !: number of point where run-off pours
-   INTEGER, PUBLIC, DIMENSION(jpncs,4) ::   ncsir, ncsjr     !: Location of runoff
-
-   REAL(wp), DIMENSION (jpncs+1)       ::   surf             ! closed sea surface
-
-   !! * Substitutions
-   !!----------------------------------------------------------------------
-   !!                   ***  vectopt_loop_substitute  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
-   !!                allow unrolling of do-loop (useful with vector processors)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
-   !! Software governed by the CeCILL licence (./LICENSE)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: closea.F90 5836 2015-10-26 14:49:40Z cetlod $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dom_clo
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_clo  ***
-      !!        
-      !! ** Purpose :   Closed sea domain initialization
-      !!
-      !! ** Method  :   if a closed sea is located only in a model grid point
-      !!                just the thermodynamic processes are applied.
-      !!
-      !! ** Action  :   ncsi1(), ncsj1() : south-west closed sea limits (i,j)
-      !!                ncsi2(), ncsj2() : north-east Closed sea limits (i,j)
-      !!                ncsir(), ncsjr() : Location of runoff
-      !!                ncsnr            : number of point where run-off pours
-      !!                ncstt            : Type of closed sea
-      !!                                   =0 spread over the world ocean
-      !!                                   =2 put at location runoff
-      !!----------------------------------------------------------------------
-      INTEGER ::   jc      ! dummy loop indices
-      INTEGER ::   isrow   ! local index
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
-      IF(lwp) WRITE(numout,*)'~~~~~~~'
-      !
-      ! initial values
-      ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1
-      ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1
-      !
-      ! set the closed seas (in data domain indices)
-      ! -------------------
-      !
-      IF( cp_cfg == "orca" ) THEN
-         !
-         SELECT CASE ( jp_cfg )
-         !                                           ! =======================
-         CASE ( 1 )                                  ! ORCA_R1 configuration
-            !                                        ! =======================
-            ! This dirty section will be suppressed by simplification process:
-            ! all this will come back in input files
-            ! Currently these hard-wired indices relate to configuration with
-            ! extend grid (jpjglo=332)
-            isrow = 332 - jpjglo
-            !
-            ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea
-            ncsi1(1)   = 332  ; ncsj1(1)   = 243 - isrow
-            ncsi2(1)   = 344  ; ncsj2(1)   = 275 - isrow
-            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
-            !                                        
-            !                                        ! =======================
-         CASE ( 2 )                                  !  ORCA_R2 configuration
-            !                                        ! =======================
-            !                                            ! Caspian Sea
-            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe
-            ncsi1(1)   =  11  ;  ncsj1(1)   = 103
-            ncsi2(1)   =  17  ;  ncsj2(1)   = 112
-            ncsir(1,1) =   1  ;  ncsjr(1,1) =   1 
-            !                                            ! Great North American Lakes
-            ncsnr(2)   =   1  ;  ncstt(2)   =   2           ! put at St Laurent mouth
-            ncsi1(2)   =  97  ;  ncsj1(2)   = 107
-            ncsi2(2)   = 103  ;  ncsj2(2)   = 111
-            ncsir(2,1) = 110  ;  ncsjr(2,1) = 111           
-            !                                            ! Black Sea (crossed by the cyclic boundary condition)
-            ncsnr(3:4) =   4  ;  ncstt(3:4) =   2           ! put in Med Sea (north of Aegean Sea)
-            ncsir(3:4,1) = 171;  ncsjr(3:4,1) = 106         !
-            ncsir(3:4,2) = 170;  ncsjr(3:4,2) = 106 
-            ncsir(3:4,3) = 171;  ncsjr(3:4,3) = 105 
-            ncsir(3:4,4) = 170;  ncsjr(3:4,4) = 105 
-            ncsi1(3)   = 174  ;  ncsj1(3)   = 107           ! 1 : west part of the Black Sea      
-            ncsi2(3)   = 181  ;  ncsj2(3)   = 112           !            (ie west of the cyclic b.c.)
-            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! 2 : east part of the Black Sea 
-            ncsi2(4)   =   6  ;  ncsj2(4)   = 112           !           (ie east of the cyclic b.c.)
-             
-          
-
-            !                                        ! =======================
-         CASE ( 4 )                                  !  ORCA_R4 configuration
-            !                                        ! =======================
-            !                                            ! Caspian Sea
-            ncsnr(1)   =  1  ;  ncstt(1)   =  0  
-            ncsi1(1)   =  4  ;  ncsj1(1)   = 53 
-            ncsi2(1)   =  4  ;  ncsj2(1)   = 56
-            ncsir(1,1) =  1  ;  ncsjr(1,1) =  1
-            !                                            ! Great North American Lakes
-            ncsnr(2)   =  1  ;  ncstt(2)   =  2 
-            ncsi1(2)   = 49  ;  ncsj1(2)   = 55
-            ncsi2(2)   = 51  ;  ncsj2(2)   = 56
-            ncsir(2,1) = 57  ;  ncsjr(2,1) = 55
-            !                                            ! Black Sea
-            ncsnr(3)   =  4  ;  ncstt(3)   =  2  
-            ncsi1(3)   = 88  ;  ncsj1(3)   = 55 
-            ncsi2(3)   = 91  ;  ncsj2(3)   = 56
-            ncsir(3,1) = 86  ;  ncsjr(3,1) = 53
-            ncsir(3,2) = 87  ;  ncsjr(3,2) = 53 
-            ncsir(3,3) = 86  ;  ncsjr(3,3) = 52 
-            ncsir(3,4) = 87  ;  ncsjr(3,4) = 52
-            !                                            ! Baltic Sea
-            ncsnr(4)   =  1  ;  ncstt(4)   =  2
-            ncsi1(4)   = 75  ;  ncsj1(4)   = 59
-            ncsi2(4)   = 76  ;  ncsj2(4)   = 61
-            ncsir(4,1) = 84  ;  ncsjr(4,1) = 59 
-            !                                        ! =======================
-         CASE ( 025 )                                ! ORCA_R025 configuration
-            !                                        ! =======================
-            ncsnr(1)   = 1    ; ncstt(1)   = 0               ! Caspian + Aral sea
-            ncsi1(1)   = 1330 ; ncsj1(1)   = 645
-            ncsi2(1)   = 1400 ; ncsj2(1)   = 795
-            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
-            !                                        
-            ncsnr(2)   = 1    ; ncstt(2)   = 0               ! Azov Sea 
-            ncsi1(2)   = 1284 ; ncsj1(2)   = 722
-            ncsi2(2)   = 1304 ; ncsj2(2)   = 747
-            ncsir(2,1) = 1    ; ncsjr(2,1) = 1
-            !
-         END SELECT
-         !
-      ENDIF
-
-      ! convert the position in local domain indices
-      ! --------------------------------------------
-      DO jc = 1, jpncs
-         ncsi1(jc)   = mi0( ncsi1(jc) )
-         ncsj1(jc)   = mj0( ncsj1(jc) )
-
-         ncsi2(jc)   = mi1( ncsi2(jc) )   
-         ncsj2(jc)   = mj1( ncsj2(jc) )  
-      END DO
-      !
-   END SUBROUTINE dom_clo
-
-
-   SUBROUTINE clo_bat( pbat, kbat )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE clo_bat  ***
-      !!                    
-      !! ** Purpose :   suppress closed sea from the domain
-      !!
-      !! ** Method  :   set to 0 the meter and level bathymetry (given in 
-      !!                arguments) over the closed seas.
-      !!
-      !! ** Action  :   set pbat=0 and kbat=0 over closed seas
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pbat   ! bathymetry in meters (bathy array)
-      INTEGER , DIMENSION(jpi,jpj), INTENT(inout) ::   kbat   ! bathymetry in levels (mbathy array)
-      !
-      INTEGER  ::   jc, ji, jj      ! dummy loop indices
-      !!----------------------------------------------------------------------
-      !
-      DO jc = 1, jpncs
-         DO jj = ncsj1(jc), ncsj2(jc)
-            DO ji = ncsi1(jc), ncsi2(jc)
-               pbat(ji,jj) = 0._wp   
-               kbat(ji,jj) = 0   
-            END DO 
-         END DO 
-       END DO 
-       !
-   END SUBROUTINE clo_bat
-
-   !!======================================================================
-END MODULE closea
-
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/daymod.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/daymod.f90	(revision 12100)
+++ 	(revision )
@@ -1,287 +1,0 @@
-MODULE daymod
-   !!======================================================================
-   !!                       ***  MODULE  daymod  ***
-   !! Ocean        :  calendar
-   !!=====================================================================
-   !! History :  OPA  ! 1994-09  (M. Pontaud M. Imbard)  Original code
-   !!                 ! 1997-03  (O. Marti)
-   !!                 ! 1997-05  (G. Madec)
-   !!                 ! 1997-08  (M. Imbard)
-   !!   NEMO     1.0  ! 2003-09  (G. Madec)  F90 + nyear, nmonth, nday
-   !!                 ! 2004-01  (A.M. Treguier) new calculation based on adatrj
-   !!                 ! 2006-08  (G. Madec)  surface module major update
-   !!                 ! 2015-11  (D. Lea) Allow non-zero initial time of day
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   day        : calendar
-   !!
-   !!           -------------------------------
-   !!           ----------- WARNING -----------
-   !!
-   !!   we suppose that the time step is deviding the number of second of in a day
-   !!             ---> MOD( rday, rdt ) == 0
-   !!
-   !!           ----------- WARNING -----------
-   !!           -------------------------------
-   !!
-   !!----------------------------------------------------------------------
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants
-   USE in_out_manager ! I/O manager
-   USE iom            !
-   USE ioipsl  , ONLY :   ymds2ju   ! for calendar
-   USE prtctl         ! Print control
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   day        ! called by step.F90
-   PUBLIC   day_init   ! called by istate.F90
-   PUBLIC   day_mth    ! Needed by TAM
-
-   INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05   !: (PUBLIC for TAM)
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: daymod.F90 6140 2015-12-21 11:35:23Z timgraham $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE day_init
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE day_init  ***
-      !!
-      !! ** Purpose :   Initialization of the calendar values to their values 1 time step before nit000
-      !!                because day will be called at the beginning of step
-      !!
-      !! ** Action  : - nyear        : current year
-      !!              - nmonth       : current month of the year nyear
-      !!              - nday         : current day of the month nmonth
-      !!              - nday_year    : current day of the year nyear
-      !!              - nsec_year    : current time step counted in second since 00h jan 1st of the current year
-      !!              - nsec_month   : current time step counted in second since 00h 1st day of the current month
-      !!              - nsec_day     : current time step counted in second since 00h of the current day
-      !!              - nsec1jan000  : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year
-      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth
-      !!----------------------------------------------------------------------
-      INTEGER  ::   inbday, idweek
-      REAL(wp) ::   zjul
-      !!----------------------------------------------------------------------
-      !
-      ! max number of seconds between each restart
-      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
-         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
-            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
-      ENDIF
-      ! all calendar staff is based on the fact that MOD( rday, rdt ) == 0
-      IF( MOD( rday     , rdt   ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
-      IF( MOD( rday     , 2.    ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
-      IF( MOD( rdt      , 2.    ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
-      nsecd   = NINT(rday       )
-      nsecd05 = NINT(0.5 * rday )
-      ndt     = NINT(      rdt  )
-      ndt05   = NINT(0.5 * rdt  )
-
-
-      ! set the calandar from ndastp (read in restart file and namelist)
-
-      nyear   =   ndastp / 10000
-      nmonth  = ( ndastp - (nyear * 10000) ) / 100
-      nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 )
-
-      nhour   =   nn_time0 / 100
-      nminute = ( nn_time0 - nhour * 100 )
-
-      CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday )  
-      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
-      IF( nn_time0*3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1.                    ! move back to the day at nit000 (and not at nit000 - 1)
-
-      nsec1jan000 = 0
-      CALL day_mth
-
-      IF ( nday == 0 ) THEN     !   for ex if ndastp = ndate0 - 1
-         nmonth = nmonth - 1
-         nday = nmonth_len(nmonth)
-      ENDIF
-      IF ( nmonth == 0 ) THEN   ! go at the end of previous year
-         nmonth = 12
-         nyear = nyear - 1
-         nsec1jan000 = nsec1jan000 - nsecd * nyear_len(0)
-         IF( nleapy == 1 )   CALL day_mth
-      ENDIF
-
-      ! day since january 1st
-      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
-
-      !compute number of days between last monday and today
-      CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (our reference that was a Monday)
-      inbday = FLOOR(fjulday - zjul)            ! compute nb day between  01.01.1900 and start of current day
-      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day
-      IF (idweek .lt. 0) idweek=idweek+7       ! Avoid negative values for dates before 01.01.1900
-
-      ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step
-      IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN
-         ! 1 timestep before current middle of first time step is still the same day
-         nsec_year  = (nday_year-1) * nsecd + nhour*3600+nminute*60 - ndt05 
-         nsec_month = (nday-1)      * nsecd + nhour*3600+nminute*60 - ndt05    
-      ELSE
-         ! 1 time step before the middle of the first time step is the previous day 
-         nsec_year  = nday_year * nsecd + nhour*3600+nminute*60 - ndt05 
-         nsec_month = nday      * nsecd + nhour*3600+nminute*60 - ndt05   
-      ENDIF
-      nsec_week  = idweek    * nsecd + nhour*3600+nminute*60 - ndt05
-      nsec_day   =             nhour*3600+nminute*60 - ndt05 
-      IF( nsec_day .lt. 0 ) nsec_day = nsec_day + nsecd
-      IF( nsec_week .lt. 0 ) nsec_week = nsec_week + nsecd*7
-
-      ! control print
-      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
-           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week, '  &
-           &                   nsec_month:', nsec_month , '  nsec_year:' , nsec_year
-
-      ! Up to now, calendar parameters are related to the end of previous run (nit000-1)
-      ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init
-      CALL day( nit000 )
-      !
-   END SUBROUTINE day_init
-
-
-   SUBROUTINE day_mth
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE day_init  ***
-      !!
-      !! ** Purpose :   calendar values related to the months
-      !!
-      !! ** Action  : - nmonth_len    : length in days of the months of the current year
-      !!              - nyear_len     : length in days of the previous/current year
-      !!              - nmonth_half   : second since the beginning of the year and the halft of the months
-      !!              - nmonth_end    : second since the beginning of the year and the end of the months
-      !!----------------------------------------------------------------------
-      INTEGER  ::   jm               ! dummy loop indice
-      !!----------------------------------------------------------------------
-
-      ! length of the month of the current year (from nleapy, read in namelist)
-      IF ( nleapy < 2 ) THEN
-         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /)
-         nyear_len(:) = 365
-         IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years
-            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN
-               nyear_len(0)  = 366
-            ENDIF
-            IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN
-               nmonth_len(2) = 29
-               nyear_len(1)  = 366
-            ENDIF
-            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN
-               nyear_len(2)  = 366
-            ENDIF
-         ENDIF
-      ELSE
-         nmonth_len(:) = nleapy   ! all months with nleapy days per year
-         nyear_len(:) = 12 * nleapy
-      ENDIF
-
-      ! half month in second since the begining of the year:
-      ! time since Jan 1st   0     1     2    ...    11    12    13
-      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|--------------------------------------
-      !                 <---> <---> <--->  ...  <---> <---> <--->
-      ! month number      0     1     2    ...    11    12    13
-      !
-      ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) )
-      nmonth_half(0) = - nsecd05 * nmonth_len(0)
-      DO jm = 1, 13
-         nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) )
-      END DO
-
-      nmonth_end(0) = 0
-      DO jm = 1, 13
-         nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm)
-      END DO
-      !
-   END SUBROUTINE
-
-
-   SUBROUTINE day( kt )
-      !!----------------------------------------------------------------------
-      !!                      ***  ROUTINE day  ***
-      !!
-      !! ** Purpose :   Compute the date with a day iteration IF necessary.
-      !!
-      !! ** Method  : - ???
-      !!
-      !! ** Action  : - nyear     : current year
-      !!              - nmonth    : current month of the year nyear
-      !!              - nday      : current day of the month nmonth
-      !!              - nday_year : current day of the year nyear
-      !!              - ndastp    : = nyear*10000 + nmonth*100 + nday
-      !!              - adatrj    : date in days since the beginning of the run
-      !!              - nsec_year : current time of the year (in second since 00h, jan 1st)
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices
-      !
-      CHARACTER (len=25) ::   charout
-      REAL(wp)           ::   zprec      ! fraction of day corresponding to 0.1 second
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('day')
-      !
-      zprec = 0.1 / rday
-      !                                                 ! New time-step
-      nsec_year  = nsec_year  + ndt
-      nsec_month = nsec_month + ndt
-      nsec_week  = nsec_week  + ndt
-      nsec_day   = nsec_day   + ndt
-      adatrj  = adatrj  + rdt / rday
-      fjulday = fjulday + rdt / rday
-      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
-      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
-
-      IF( nsec_day > nsecd ) THEN                       ! New day
-         !
-         nday      = nday + 1
-         nday_year = nday_year + 1
-         nsec_day  = ndt05
-         !
-         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! New month
-            nday   = 1
-            nmonth = nmonth + 1
-            nsec_month = ndt05
-            IF( nmonth == 13 ) THEN                     ! New year
-               nyear     = nyear + 1
-               nmonth    = 1
-               nday_year = 1
-               nsec_year = ndt05
-               nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
-               IF( nleapy == 1 )   CALL day_mth
-            ENDIF
-         ENDIF
-         !
-         ndastp = nyear * 10000 + nmonth * 100 + nday   ! New date
-         !
-         !compute first day of the year in julian days
-         CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear )
-         !
-         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   &
-              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year
-         IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   &
-              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_week = ', nsec_week
-      ENDIF
-
-      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week
-
-      IF(ln_ctl) THEN
-         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
-         CALL prt_ctl_info(charout)
-      ENDIF
-
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('day')
-      !
-   END SUBROUTINE day
-
-
-   !!======================================================================
-END MODULE daymod
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dom_oce.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dom_oce.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dom_oce.F90	(revision 12101)
@@ -0,0 +1,360 @@
+MODULE dom_oce
+   !!======================================================================
+   !!                       ***  MODULE dom_oce  ***
+   !!       
+   !! ** Purpose :   Define in memory all the ocean space domain variables
+   !!======================================================================
+   !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate 
+   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
+   !!            3.4  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Add arrays associated
+   !!                             to the optimization of BDY communications
+   !!            3.7  ! 2015-11  (G. Madec) introduce surface and scale factor ratio
+   !!             -   ! 2015-11  (G. Madec, A. Coward)  time varying zgr by default
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   Agrif_Root    : dummy function used when lk_agrif=F
+   !!   Agrif_CFixed  : dummy function used when lk_agrif=F
+   !!   dom_oce_alloc : dynamical allocation of dom_oce arrays
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC             ! allows the acces to par_oce when dom_oce is used (exception to coding rules)
+
+   PUBLIC dom_oce_alloc  ! Called from nemogcm.F90
+
+  !! time & space domain namelist
+   !! ----------------------------
+   INTEGER , PUBLIC ::   nmsh            !: = 1 create a mesh-mask file
+   !                                    !!* Namelist namdom : time & space domain *
+   INTEGER , PUBLIC ::   nn_bathy        !: = 0/1/2 ,compute/read the bathymetry file
+   REAL(wp), PUBLIC ::   rn_bathy        !: depth of flat bottom (active if nn_bathy=0; if =0 depth=jpkm1)
+   REAL(wp), PUBLIC ::   rn_hmin         !: minimum ocean depth (>0) or minimum number of ocean levels (<0)
+   REAL(wp), PUBLIC ::   rn_e3zps_min    !: miminum thickness for partial steps (meters)
+   REAL(wp), PUBLIC ::   rn_e3zps_rat    !: minimum thickness ration for partial steps
+   INTEGER , PUBLIC ::   nn_msh          !: = 1 create a mesh-mask file
+
+   INTEGER , PUBLIC ::   ntopo           !: = 0/1 ,compute/read the bathymetry file
+   INTEGER, PUBLIC  ::   nperio          !: type of lateral boundary condition
+   REAL(wp), PUBLIC ::   e3zps_min       !: miminum thickness for partial steps (meters)
+   REAL(wp), PUBLIC ::   e3zps_rat       !: minimum thickness ration for partial steps
+
+   INTEGER, PUBLIC :: nn_interp
+   CHARACTER(LEN=132), PUBLIC :: cn_topo
+   CHARACTER(LEN=132), PUBLIC :: cn_bath
+   CHARACTER(LEN=132), PUBLIC :: cn_lon
+   CHARACTER(LEN=132), PUBLIC :: cn_lat
+
+   LOGICAL, PUBLIC ::   lzoom      =  .FALSE.   !: zoom flag
+   LOGICAL, PUBLIC ::   lzoom_e    =  .FALSE.   !: East  zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_w    =  .FALSE.   !: West  zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_s    =  .FALSE.   !: South zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_n    =  .FALSE.   !: North zoom type flag
+
+   LOGICAL, PUBLIC ::   ln_domclo  =  .FALSE.
+
+   INTEGER       ::   jphgr_msh          !: type of horizontal mesh
+   !                                       !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+   !                                       !  = 1 geographical mesh on the sphere with regular grid-spacing
+   !                                       !  = 2 f-plane with regular grid-spacing
+   !                                       !  = 3 beta-plane with regular grid-spacing
+   !                                       !  = 4 Mercator grid with T/U point at the equator
+
+   REAL(wp)      ::   ppglam0            !: longitude of first raw and column T-point (jphgr_msh = 1)
+   REAL(wp)      ::   ppgphi0            !: latitude  of first raw and column T-point (jphgr_msh = 1)
+   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3)
+   REAL(wp)      ::   ppe1_deg           !: zonal      grid-spacing (degrees)
+   REAL(wp)      ::   ppe2_deg           !: meridional grid-spacing (degrees)
+   REAL(wp)      ::   ppe1_m             !: zonal      grid-spacing (degrees)
+   REAL(wp)      ::   ppe2_m             !: meridional grid-spacing (degrees)
+
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   REAL(wp)      ::   ppsur              !: ORCA r4, r2 and r05 coefficients
+   REAL(wp)      ::   ppa0               !: (default coefficients)
+   REAL(wp)      ::   ppa1               !:
+   REAL(wp)      ::   ppkth              !:
+   REAL(wp)      ::   ppacr              !:
+   !
+   !  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   REAL(wp)      ::   ppdzmin            !: Minimum vertical spacing
+   REAL(wp)      ::   pphmax             !: Maximum depth
+   !
+   LOGICAL       ::   ldbletanh          !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp)      ::   ppa2               !: Double tanh function parameters
+   REAL(wp)      ::   ppkth2             !:
+   REAL(wp)      ::   ppacr2             !:
+
+   !!----------------------------------------------------------------------
+   !! time & space domain namelist
+   !! ----------------------------
+   !                                   !!* Namelist namdom : time & space domain *
+   LOGICAL , PUBLIC ::   ln_linssh      !: =T  linear free surface ==>> model level are fixed in time
+   LOGICAL , PUBLIC ::   ln_meshmask    !: =T  create a mesh-mask file (mesh_mask.nc)
+   REAL(wp), PUBLIC ::   rn_isfhmin     !: threshold to discriminate grounded ice to floating ice
+   REAL(wp), PUBLIC ::   rn_rdt         !: time step for the dynamics and tracer
+   REAL(wp), PUBLIC ::   rn_atfp        !: asselin time filter parameter
+   INTEGER , PUBLIC ::   nn_euler       !: =0 start with forward time step or not (=1)
+   LOGICAL , PUBLIC ::   ln_iscpl       !: coupling with ice sheet
+   LOGICAL , PUBLIC ::   ln_crs         !: Apply grid coarsening to dynamical model output or online passive tracers
+
+   !! Free surface parameters
+   !! =======================
+   LOGICAL , PUBLIC :: ln_dynspg_exp    !: Explicit free surface flag
+   LOGICAL , PUBLIC :: ln_dynspg_ts     !: Split-Explicit free surface flag
+
+   !! Time splitting parameters
+   !! =========================
+   LOGICAL,  PUBLIC :: ln_bt_fw         !: Forward integration of barotropic sub-stepping
+   LOGICAL,  PUBLIC :: ln_bt_av         !: Time averaging of barotropic variables
+   LOGICAL,  PUBLIC :: ln_bt_auto       !: Set number of barotropic iterations automatically
+   INTEGER,  PUBLIC :: nn_bt_flt        !: Filter choice
+   INTEGER,  PUBLIC :: nn_baro          !: Number of barotropic iterations during one baroclinic step (rdt)
+   REAL(wp), PUBLIC :: rn_bt_cmax       !: Maximum allowed courant number (used if ln_bt_auto=T)
+   REAL(wp), PUBLIC :: rn_bt_alpha      !: Time stepping diffusion parameter
+
+
+   !                                   !! old non-DOCTOR names still used in the model
+   REAL(wp), PUBLIC ::   atfp           !: asselin time filter parameter
+   REAL(wp), PUBLIC ::   rdt            !: time step for the dynamics and tracer
+
+   !                                   !!! associated variables
+   INTEGER , PUBLIC ::   neuler         !: restart euler forward option (0=Euler)
+   REAL(wp), PUBLIC ::   r2dt           !: = 2*rdt except at nit000 (=rdt) if neuler=0
+
+   !!----------------------------------------------------------------------
+   !! space domain parameters
+   !!----------------------------------------------------------------------
+   INTEGER, PUBLIC ::   jperio   !: Global domain lateral boundary type (between 0 and 7)
+   !                                !  = 0 closed                 ;   = 1 cyclic East-West
+   !                                !  = 2 cyclic North-South     ;   = 3 North fold T-point pivot
+   !                                !  = 4 cyclic East-West AND North fold T-point pivot
+   !                                !  = 5 North fold F-point pivot
+   !                                !  = 6 cyclic East-West AND North fold F-point pivot
+   !                                !  = 7 bi-cyclic East-West AND North-South
+   LOGICAL, PUBLIC ::   l_Iperio, l_Jperio   !   should we explicitely take care I/J periodicity 
+
+   !                                 !  domain MPP decomposition parameters
+   INTEGER             , PUBLIC ::   nimpp, njmpp     !: i- & j-indexes for mpp-subdomain left bottom
+   INTEGER             , PUBLIC ::   nreci, nrecj     !: overlap region in i and j
+   INTEGER             , PUBLIC ::   nproc            !: number for local processor
+   INTEGER             , PUBLIC ::   narea            !: number for local area
+   INTEGER             , PUBLIC ::   nbondi, nbondj   !: mark of i- and j-direction local boundaries
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy(:)    !: mark i-direction local boundaries for BDY open boundaries
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy(:)    !: mark j-direction local boundaries for BDY open boundaries
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries  
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries  
+
+   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4)
+   INTEGER, PUBLIC ::   nlci, nldi, nlei  !: i-dimensions of the local subdomain and its first and last indoor indices
+   INTEGER, PUBLIC ::   nlcj, nldj, nlej  !: i-dimensions of the local subdomain and its first and last indoor indices
+   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in
+   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions
+   INTEGER, PUBLIC ::   nidom             !: ???
+
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig        !: local  ==> global domain i-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg        !: local  ==> global domain j-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mi0, mi1   !: global ==> local  domain i-index (mi0=1 and mi1=0 if the global index
+   !                                                                !                                             is not in the local domain)
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mj0, mj1   !: global ==> local  domain j-index (mj0=1 and mj1=0 if the global index
+   !                                                                !                                             is not in the local domain)
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcit , nlcjt    !: dimensions of every subdomain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfiimpp, nfipproc, nfilcit
+
+   !!----------------------------------------------------------------------
+   !! horizontal curvilinear coordinate and scale factors
+   !! ---------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1t   , e2t  , r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1u   , e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1v   , e2v  , r1_e1v, r1_e2v   !: horizontal scale factors at v-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   ff_f  , ff_t                    !: Coriolis factor at f- & t-points  [1/s]
+
+   !! s-coordinate and hybrid z-s-coordinate
+   !! =----------------======---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gsigt, gsigw       !: model level depth coefficient at t-, w-levels (analytic)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gsi3w              !: model level depth coefficient at w-level (sum of gsigw)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   esigt, esigw       !: vertical scale factor coef. at t-, w-levels
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf      !: ocean depth at the vertical of  v--f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu      !:                                 t--u points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   scosrf, scobot     !: ocean surface and bottom topographies
+   !                                                                           !  (if deviating from coordinate surfaces in HYBRID)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff       !: interface depth between stretching at v--f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m)
+!!gm end
+
+   !!----------------------------------------------------------------------
+   !! vertical coordinate and scale factors
+   !! ---------------------------------------------------------------------
+   LOGICAL, PUBLIC ::   ln_zco       !: z-coordinate - full step
+   LOGICAL, PUBLIC ::   ln_zps       !: z-coordinate - partial step
+   LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate
+   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF 
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  e3t_0, e3u_0 , e3v_0 , e3f_0 !: t-,u-,v-,f-vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  e3w_0, e3uw_0, e3vw_0        !: w-,uw-,vw-vert. scale factor [m]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0 !: t- depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0 !: w- depth              [m]
+   !
+   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1)
+   INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1) 
+   !
+   !! 1D reference  vertical coordinate
+   !! =-----------------====------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gdept_1d, gdepw_1d !: reference depth of t- and w-points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_1d  , e3w_1d   !: reference vertical scale factors at T- and W-pts (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3tp    , e3wp     !: ocean bottom level thickness at T and W points
+
+   !!----------------------------------------------------------------------
+   !! masks, top and bottom ocean point position
+   !! ---------------------------------------------------------------------
+!!gm Proposition of new name for top/bottom vertical indices
+!   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mtk_t, mtk_u, mtk_v   !: top first wet T-, U-, V-, F-level (ISF)
+!   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbk_t, mbk_u, mbk_v   !: bottom last wet T-, U- and V-level
+!!gm
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy             !: number of ocean level (=0, 1, ... , jpk-1)
+   REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy             !: number of ocean level (=0, 1, ... , jpk-1)
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt, mbku, mbkv   !: bottom last wet T-, U- and V-level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i            !: interior domain T-point mask
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book)
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level             (ISF)
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: top first wet T-, U-, V-, F-level (ISF)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                    (ISF)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask             !: surface mask at T-,U-, V- and F-pts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask                        !: land/ocean mask at W- pts               
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_opnsea  , msk_csundef                !: open ocean mask, closed sea mask (all of them)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_csglo   , msk_csrnf   , msk_csemp    !: closed sea masks
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_csgrpglo, msk_csgrprnf, msk_csgrpemp !: closed sea masks
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
+
+   !!----------------------------------------------------------------------
+   !! calendar variables
+   !! ---------------------------------------------------------------------
+   INTEGER , PUBLIC ::   nyear         !: current year
+   INTEGER , PUBLIC ::   nmonth        !: current month
+   INTEGER , PUBLIC ::   nday          !: current day of the month
+   INTEGER , PUBLIC ::   nhour         !: current hour
+   INTEGER , PUBLIC ::   nminute       !: current minute
+   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format
+   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year
+   INTEGER , PUBLIC ::   nsec_year     !: current time step counted in second since 00h jan 1st of the current year
+   INTEGER , PUBLIC ::   nsec_month    !: current time step counted in second since 00h 1st day of the current month
+   INTEGER , PUBLIC ::   nsec_week     !: current time step counted in second since 00h of last monday
+   INTEGER , PUBLIC ::   nsec_day      !: current time step counted in second since 00h of the current day
+   REAL(wp), PUBLIC ::   fjulday       !: current julian day 
+   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days
+   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation
+   !                                   !: (cumulative duration of previous runs that may have used different time-step size)
+   INTEGER , PUBLIC, DIMENSION(0: 2) ::   nyear_len     !: length in days of the previous/current/next year
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_half   !: second since Jan 1st 0h of the current year and the half of the months
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_end    !: second since Jan 1st 0h of the current year and the end of the months
+   INTEGER , PUBLIC                  ::   nsec1jan000   !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year
+
+   !!----------------------------------------------------------------------
+   !! agrif domain
+   !!----------------------------------------------------------------------
+#if defined key_agrif
+   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .TRUE.    !: agrif flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .FALSE.   !: agrif flag
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: dom_oce.F90 10068 2018-08-28 14:09:04Z nicolasmartin $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if ! defined key_agrif
+   !!----------------------------------------------------------------------
+   !! NOT 'key_agrif'      dummy function                     No AGRIF zoom
+   !!----------------------------------------------------------------------
+   LOGICAL FUNCTION Agrif_Root()
+      Agrif_Root = .TRUE.
+   END FUNCTION Agrif_Root
+
+   CHARACTER(len=3) FUNCTION Agrif_CFixed()
+      Agrif_CFixed = '0' 
+   END FUNCTION Agrif_CFixed
+#endif
+
+   INTEGER FUNCTION dom_oce_alloc()
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(11) :: ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(1) )
+         !
+      ALLOCATE( mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     &
+         &      tpol(jpiglo)  , fpol(jpiglo)                                , STAT=ierr(2) )
+         !
+      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     &
+         &      gphit(jpi,jpj) ,    gphiu(jpi,jpj) ,  gphiv(jpi,jpj) ,  gphif(jpi,jpj) ,     &
+         &       e1t (jpi,jpj) ,     e2t (jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,     &
+         &       e1u (jpi,jpj) ,     e2u (jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,     &
+         &       e1v (jpi,jpj) ,     e2v (jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,     &
+         &       e1f (jpi,jpj) ,     e2f (jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,     &
+         &      e1e2t(jpi,jpj) , r1_e1e2t(jpi,jpj)                                     ,     &
+         &      e1e2u(jpi,jpj) , r1_e1e2u(jpi,jpj) , e2_e1u(jpi,jpj)                   ,     &
+         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     &
+         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     &
+         &      ff_f (jpi,jpj) ,    ff_t (jpi,jpj)                                     , STAT=ierr(3) )
+         !
+      ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , STAT=ierr(4) )
+         !
+      ALLOCATE( e3t_0 (jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) ,   &
+         &      e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , STAT=ierr(5) )                       
+         !
+      ALLOCATE( gdept_1d(jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) ,gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(6) )
+         !
+      ALLOCATE( bathy(jpi,jpj),mbathy(jpi,jpj), tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                        & 
+         &      ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) ,     &
+         &      mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(7) )
+         !
+      ALLOCATE( misfdep(jpi,jpj) , mikt(jpi,jpj) , miku(jpi,jpj) ,     &
+         &      risfdep(jpi,jpj) , mikv(jpi,jpj) , mikf(jpi,jpj) , STAT=ierr(8) )
+         !
+      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) ,     & 
+         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , wmask(jpi,jpj,jpk) , STAT=ierr(9) )
+         !
+      ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     &
+         &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     &
+         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     &
+         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     &
+         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , STAT=ierr(10) )
+
+      ALLOCATE( msk_opnsea  (jpi,jpj), msk_csundef (jpi,jpj),                        &
+         &      msk_csglo   (jpi,jpj), msk_csrnf   (jpi,jpj), msk_csemp   (jpi,jpj), &
+         &      msk_csgrpglo(jpi,jpj), msk_csgrprnf(jpi,jpj), msk_csgrpemp(jpi,jpj), STAT=ierr(11) )
+      !
+      dom_oce_alloc = MAXVAL(ierr)
+      !
+   END FUNCTION dom_oce_alloc
+
+   !!======================================================================
+END MODULE dom_oce
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dom_oce.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dom_oce.f90	(revision 12100)
+++ 	(revision )
@@ -1,385 +1,0 @@
-MODULE dom_oce
-   !!======================================================================
-   !!                       ***  MODULE dom_oce  ***
-   !!       
-   !! ** Purpose :   Define in memory all the ocean space domain variables
-   !!======================================================================
-   !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate 
-   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
-   !!            3.4  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
-   !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Add arrays associated
-   !!                             to the optimization of BDY communications
-   !!            3.7  ! 2015-11  (G. Madec) introduce surface and scale factor ratio
-   !!             -   ! 2015-11  (G. Madec, A. Coward)  time varying zgr by default
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   Agrif_Root    : dummy function used when lk_agrif=F
-   !!   Agrif_CFixed  : dummy function used when lk_agrif=F
-   !!   dom_oce_alloc : dynamical allocation of dom_oce arrays
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-
-   IMPLICIT NONE
-   PUBLIC             ! allows the acces to par_oce when dom_oce is used (exception to coding rules)
-
-   PUBLIC dom_oce_alloc  ! Called from nemogcm.F90
-
-   !!----------------------------------------------------------------------
-   !! time & space domain namelist
-   !! ----------------------------
-   !                                    !!* Namelist namdom : time & space domain *
-   INTEGER , PUBLIC ::   nn_bathy        !: = 0/1 ,compute/read the bathymetry file
-   REAL(wp), PUBLIC ::   rn_bathy        !: depth of flat bottom (active if nn_bathy=0; if =0 depth=jpkm1)
-   REAL(wp), PUBLIC ::   rn_hmin         !: minimum ocean depth (>0) or minimum number of ocean levels (<0)
-   REAL(wp), PUBLIC ::   rn_isfhmin      !: threshold to discriminate grounded ice to floating ice
-   REAL(wp), PUBLIC ::   rn_e3zps_min    !: miminum thickness for partial steps (meters)
-   REAL(wp), PUBLIC ::   rn_e3zps_rat    !: minimum thickness ration for partial steps
-   INTEGER , PUBLIC ::   nn_msh          !: = 1 create a mesh-mask file
-   REAL(wp), PUBLIC ::   rn_atfp         !: asselin time filter parameter
-   REAL(wp), PUBLIC ::   rn_rdt          !: time step for the dynamics and tracer
-   INTEGER , PUBLIC ::   nn_closea       !: =0 suppress closed sea/lake from the ORCA domain or not (=1)
-   INTEGER , PUBLIC ::   nn_euler        !: =0 start with forward time step or not (=1)
-   LOGICAL , PUBLIC ::   ln_iscpl       !: coupling with ice sheet
-   LOGICAL , PUBLIC ::   ln_crs          !: Apply grid coarsening to dynamical model output or online passive tracers
-
-   !! Free surface parameters
-   !! =======================
-   LOGICAL , PUBLIC :: ln_dynspg_exp     !: Explicit free surface flag
-   LOGICAL , PUBLIC :: ln_dynspg_ts      !: Split-Explicit free surface flag
-
-   !! Time splitting parameters
-   !! =========================
-   LOGICAL,  PUBLIC :: ln_bt_fw          !: Forward integration of barotropic sub-stepping
-   LOGICAL,  PUBLIC :: ln_bt_av          !: Time averaging of barotropic variables
-   LOGICAL,  PUBLIC :: ln_bt_auto        !: Set number of barotropic iterations automatically
-   INTEGER,  PUBLIC :: nn_bt_flt         !: Filter choice
-   INTEGER,  PUBLIC :: nn_baro           !: Number of barotropic iterations during one baroclinic step (rdt)
-   REAL(wp), PUBLIC :: rn_bt_cmax        !: Maximum allowed courant number (used if ln_bt_auto=T)
-
-   !! Horizontal grid parameters for domhgr
-   !! =====================================
-   INTEGER       ::   jphgr_msh          !: type of horizontal mesh
-   !                                       !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
-   !                                       !  = 1 geographical mesh on the sphere with regular grid-spacing
-   !                                       !  = 2 f-plane with regular grid-spacing
-   !                                       !  = 3 beta-plane with regular grid-spacing
-   !                                       !  = 4 Mercator grid with T/U point at the equator
-
-   REAL(wp)      ::   ppglam0            !: longitude of first raw and column T-point (jphgr_msh = 1)
-   REAL(wp)      ::   ppgphi0            !: latitude  of first raw and column T-point (jphgr_msh = 1)
-   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3)
-   REAL(wp)      ::   ppe1_deg           !: zonal      grid-spacing (degrees)
-   REAL(wp)      ::   ppe2_deg           !: meridional grid-spacing (degrees)
-   REAL(wp)      ::   ppe1_m             !: zonal      grid-spacing (degrees)
-   REAL(wp)      ::   ppe2_m             !: meridional grid-spacing (degrees)
-
-   !! Vertical grid parameter for domzgr
-   !! ==================================
-   REAL(wp)      ::   ppsur              !: ORCA r4, r2 and r05 coefficients
-   REAL(wp)      ::   ppa0               !: (default coefficients)
-   REAL(wp)      ::   ppa1               !:
-   REAL(wp)      ::   ppkth              !:
-   REAL(wp)      ::   ppacr              !:
-   !
-   !  If both ppa0 ppa1 and ppsur are specified to 0, then
-   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-   REAL(wp)      ::   ppdzmin            !: Minimum vertical spacing
-   REAL(wp)      ::   pphmax             !: Maximum depth
-   !
-   LOGICAL       ::   ldbletanh          !: Use/do not use double tanf function for vertical coordinates
-   REAL(wp)      ::   ppa2               !: Double tanh function parameters
-   REAL(wp)      ::   ppkth2             !:
-   REAL(wp)      ::   ppacr2             !:
-
-   !                                    !! old non-DOCTOR names still used in the model
-   INTEGER , PUBLIC ::   ntopo           !: = 0/1 ,compute/read the bathymetry file
-   REAL(wp), PUBLIC ::   e3zps_min       !: miminum thickness for partial steps (meters)
-   REAL(wp), PUBLIC ::   e3zps_rat       !: minimum thickness ration for partial steps
-   INTEGER , PUBLIC ::   nmsh            !: = 1 create a mesh-mask file
-   REAL(wp), PUBLIC ::   atfp            !: asselin time filter parameter
-   REAL(wp), PUBLIC ::   rdt             !: time step for the dynamics and tracer
-
-   !                                                  !!! associated variables
-   INTEGER , PUBLIC                 ::   neuler        !: restart euler forward option (0=Euler)
-   REAL(wp), PUBLIC                 ::   atfp1         !: asselin time filter coeff. (atfp1= 1-2*atfp)
-   REAL(wp), PUBLIC                 ::   r2dt          !: = 2*rdt except at nit000 (=rdt) if neuler=0
-
-   !!----------------------------------------------------------------------
-   !! space domain parameters
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC ::   lzoom      =  .FALSE.   !: zoom flag
-   LOGICAL, PUBLIC ::   lzoom_e    =  .FALSE.   !: East  zoom type flag
-   LOGICAL, PUBLIC ::   lzoom_w    =  .FALSE.   !: West  zoom type flag
-   LOGICAL, PUBLIC ::   lzoom_s    =  .FALSE.   !: South zoom type flag
-   LOGICAL, PUBLIC ::   lzoom_n    =  .FALSE.   !: North zoom type flag
-
-   !                                     !!! domain parameters linked to mpp
-   INTEGER, PUBLIC ::   nperio            !: type of lateral boundary condition
-   INTEGER, PUBLIC ::   nimpp, njmpp      !: i- & j-indexes for mpp-subdomain left bottom
-   INTEGER, PUBLIC ::   nreci, nrecj      !: overlap region in i and j
-   INTEGER, PUBLIC ::   nproc             !: number for local processor
-   INTEGER, PUBLIC ::   narea             !: number for local area
-   INTEGER, PUBLIC ::   nbondi, nbondj    !: mark of i- and j-direction local boundaries
-   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy(:)    !: mark i-direction local boundaries for BDY open boundaries
-   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy(:)    !: mark j-direction local boundaries for BDY open boundaries
-   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries  
-   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries  
-
-   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4)
-   INTEGER, PUBLIC ::   nlci, nldi, nlei  !: i-dimensions of the local subdomain and its first and last indoor indices
-   INTEGER, PUBLIC ::   nlcj, nldj, nlej  !: i-dimensions of the local subdomain and its first and last indoor indices
-   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in
-   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions
-   INTEGER, PUBLIC ::   npne, npnw        !: index of north east and north west processor
-   INTEGER, PUBLIC ::   npse, npsw        !: index of south east and south west processor
-   INTEGER, PUBLIC ::   nbne, nbnw        !: logical of north east & north west processor
-   INTEGER, PUBLIC ::   nbse, nbsw        !: logical of south east & south west processor
-   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    !!bug ==> other solution?
-   !                                                  ! (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     !!bug ==> other solution?
-   !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain)
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcit , nlcjt    !: dimensions of every subdomain
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfiimpp, nfipproc, nfilcit
-
-   !!----------------------------------------------------------------------
-   !! horizontal curvilinear coordinate and scale factors
-   !! ---------------------------------------------------------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1t   , e2t  , r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1u   , e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1v   , e2v  , r1_e1v, r1_e2v   !: horizontal scale factors at v-point [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m]
-   !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point
-   !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff_f, ff_t                      !: coriolis factor                   [1/s]
-
-   !!----------------------------------------------------------------------
-   !! vertical coordinate and scale factors
-   !! ---------------------------------------------------------------------
-   !                                !!* Namelist namzgr : vertical coordinate *
-   LOGICAL, PUBLIC ::   ln_zco       !: z-coordinate - full step
-   LOGICAL, PUBLIC ::   ln_zps       !: z-coordinate - partial step
-   LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate
-   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF 
-   LOGICAL, PUBLIC ::   ln_linssh    !: variable grid flag
-
-   !                                                        !  ref.   ! before  !   now   ! after  !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0 ,   e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3u_0 ,   e3u_b ,   e3u_n ,  e3u_a   !: u- vert. scale factor [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3f_0           ,   e3f_n            !: f- vert. scale factor [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3w_0 ,   e3w_b ,   e3w_n            !: w- vert. scale factor [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m]
-
-   !                                                        !  ref.   ! before  !   now   !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0 , gdept_b , gdept_n   !: t- depth              [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0 , gdepw_b , gdepw_n   !: w- depth              [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0           , gde3w_n   !: w- depth (sum of e3w) [m]
-   
-   !                                                      !  ref. ! before  !   now   !  after  !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0            ,    ht_n             !: t-depth              [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0  ,    hu_b ,    hu_n ,    hu_a   !: u-depth              [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hv_0  ,    hv_b ,    hv_n ,    hv_a   !: u-depth              [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hu_b , r1_hu_n , r1_hu_a   !: inverse of u-depth [1/m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hv_b , r1_hv_n , r1_hv_a   !: inverse of v-depth [1/m]
-
-
-   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1)
-   INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1) 
-
-   !! 1D reference  vertical coordinate
-   !! =-----------------====------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gdept_1d, gdepw_1d !: reference depth of t- and w-points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_1d  , e3w_1d   !: reference vertical scale factors at T- and W-pts (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3tp    , e3wp     !: ocean bottom level thickness at T and W points
-
-!!gm  This should be removed from here....  ==>>> only used in domzgr at initialization phase
-   !! s-coordinate and hybrid z-s-coordinate
-   !! =----------------======---------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gsigt, gsigw       !: model level depth coefficient at t-, w-levels (analytic)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gsi3w              !: model level depth coefficient at w-level (sum of gsigw)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   esigt, esigw       !: vertical scale factor coef. at t-, w-levels
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf      !: ocean depth at the vertical of  v--f
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu      !:                                 t--u points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   scosrf, scobot     !: ocean surface and bottom topographies 
-   !                                                                           !  (if deviating from coordinate surfaces in HYBRID)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff       !: interface depth between stretching at v--f
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m)
-!!gm end
-
-   !!----------------------------------------------------------------------
-   !! masks, bathymetry
-   !! ---------------------------------------------------------------------
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy             !: number of ocean level (=0, 1, ... , jpk-1)
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt               !: vertical index of the bottom last T- ocean level
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku, mbkv         !: vertical index of the bottom last U- and W- ocean level
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy              !: ocean depth (meters)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i            !: interior domain T-point mask
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book)
-
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level                (ISF)
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: first wet T-, U-, V-, F- ocean level (ISF)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                       (ISF)
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask, ssfmask    !: surface mask at T-,U-, V- and F-pts
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
-
-   !!----------------------------------------------------------------------
-   !! calendar variables
-   !! ---------------------------------------------------------------------
-   INTEGER , PUBLIC ::   nyear         !: current year
-   INTEGER , PUBLIC ::   nmonth        !: current month
-   INTEGER , PUBLIC ::   nday          !: current day of the month
-   INTEGER , PUBLIC ::   nhour         !: current hour
-   INTEGER , PUBLIC ::   nminute       !: current minute
-   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format
-   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year
-   INTEGER , PUBLIC ::   nsec_year     !: current time step counted in second since 00h jan 1st of the current year
-   INTEGER , PUBLIC ::   nsec_month    !: current time step counted in second since 00h 1st day of the current month
-   INTEGER , PUBLIC ::   nsec_week     !: current time step counted in second since 00h of last monday
-   INTEGER , PUBLIC ::   nsec_day      !: current time step counted in second since 00h of the current day
-   REAL(wp), PUBLIC ::   fjulday       !: current julian day 
-   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days
-   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation
-   !                                   !: (cumulative duration of previous runs that may have used different time-step size)
-   INTEGER , PUBLIC, DIMENSION(0: 2) ::   nyear_len     !: length in days of the previous/current/next year
-   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year
-   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_half   !: second since Jan 1st 0h of the current year and the half of the months
-   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_end    !: second since Jan 1st 0h of the current year and the end of the months
-   INTEGER , PUBLIC                  ::   nsec1jan000   !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year
-
-   !!----------------------------------------------------------------------
-   !! mpp reproducibility
-   !!----------------------------------------------------------------------
-
-
-
-   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp_rep = .FALSE.   !: agrif flag
-
-
-   !!----------------------------------------------------------------------
-   !! agrif domain
-   !!----------------------------------------------------------------------
-
-
-
-   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .FALSE.   !: agrif flag
-
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id: dom_oce.F90 6140 2015-12-21 11:35:23Z timgraham $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-
-   !!----------------------------------------------------------------------
-   !! NOT 'key_agrif'      dummy function                     No AGRIF zoom
-   !!----------------------------------------------------------------------
-   LOGICAL FUNCTION Agrif_Root()
-      Agrif_Root = .TRUE.
-   END FUNCTION Agrif_Root
-
-   CHARACTER(len=3) FUNCTION Agrif_CFixed()
-      Agrif_CFixed = '0' 
-   END FUNCTION Agrif_CFixed
-
-
-   INTEGER FUNCTION dom_oce_alloc()
-      !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(13) :: ierr
-      !!----------------------------------------------------------------------
-      ierr(:) = 0
-      !
-      ALLOCATE( mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj),  &
-         &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) )
-         !
-      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     &
-         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     &
-         &                                      nleit(jpnij) , nlejt(jpnij) ,     &
-         &      mi0(jpidta)   , mi1 (jpidta),  mj0(jpjdta)   , mj1 (jpjdta),      &
-         &      tpol(jpiglo)  , fpol(jpiglo)                               , STAT=ierr(2) )
-         !
-      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     &
-         &      gphit(jpi,jpj) ,    gphiu(jpi,jpj) ,  gphiv(jpi,jpj) ,  gphif(jpi,jpj) ,     &
-         &       e1t (jpi,jpj) ,     e2t (jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,     &
-         &       e1u (jpi,jpj) ,     e2u (jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,     &
-         &       e1v (jpi,jpj) ,     e2v (jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,     &
-         &       e1f (jpi,jpj) ,     e2f (jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,     &
-         &      e1e2t(jpi,jpj) , r1_e1e2t(jpi,jpj)                                     ,     &
-         &      e1e2u(jpi,jpj) , r1_e1e2u(jpi,jpj) , e2_e1u(jpi,jpj)                   ,     &
-         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     &
-         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     &
-         &       ff_f(jpi,jpj) ,     ff_t(jpi,jpj)                                     , STAT=ierr(3) )
-         !
-      ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) ,     &
-         &      gdept_b(jpi,jpj,jpk) , gdepw_b(jpi,jpj,jpk) ,                             &
-         &      gdept_n(jpi,jpj,jpk) , gdepw_n(jpi,jpj,jpk) , gde3w_n(jpi,jpj,jpk) , STAT=ierr(4) )
-         !
-      ALLOCATE( e3t_0(jpi,jpj,jpk) , e3u_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) ,   &
-         &      e3t_b(jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk) ,                      e3w_b(jpi,jpj,jpk) ,   & 
-         &      e3t_n(jpi,jpj,jpk) , e3u_n(jpi,jpj,jpk) , e3v_n(jpi,jpj,jpk) , e3f_n(jpi,jpj,jpk) , e3w_n(jpi,jpj,jpk) ,   & 
-         &      e3t_a(jpi,jpj,jpk) , e3u_a(jpi,jpj,jpk) , e3v_a(jpi,jpj,jpk) ,                                             &
-         !                                                          !
-         &      e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) ,         &
-         &      e3uw_b(jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) ,         &               
-         &      e3uw_n(jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) ,     STAT=ierr(5) )                       
-         !
-      ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) ,                                           &
-         &                      hu_b(jpi,jpj) , hv_b(jpi,jpj) , r1_hu_b(jpi,jpj) , r1_hv_b(jpi,jpj) ,     &
-         &      ht_n(jpi,jpj) , hu_n(jpi,jpj) , hv_n(jpi,jpj) , r1_hu_n(jpi,jpj) , r1_hv_n(jpi,jpj) ,     &
-         &                      hu_a(jpi,jpj) , hv_a(jpi,jpj) , r1_hu_a(jpi,jpj) , r1_hv_a(jpi,jpj) , STAT=ierr(6)  )
-         !
-         !
-      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) ,                                     &
-         &      e3t_1d  (jpk) , e3w_1d  (jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) ,     &
-         &      gsigt   (jpk) , gsigw   (jpk) , gsi3w(jpk)    ,                     &
-         &      esigt   (jpk) , esigw   (jpk)                                 , STAT=ierr(7) )
-         !
-      ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     &
-         &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     &
-         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     &
-         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     &
-         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , STAT=ierr(8) )
-
-      ALLOCATE( mbathy(jpi,jpj) , bathy  (jpi,jpj) ,                                       &
-         &     tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                                       & 
-         &     ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , &
-         &     mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) )
-
-! (ISF) Allocation of basic array   
-      ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),     &
-         &     mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           &
-         &     mikf(jpi,jpj), STAT=ierr(10) )
-
-      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     & 
-         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(11) )
-
-      ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) )
-      !
-      dom_oce_alloc = MAXVAL(ierr)
-      !
-   END FUNCTION dom_oce_alloc
-
-   !!======================================================================
-END MODULE dom_oce
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domain.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domain.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domain.F90	(revision 12101)
@@ -0,0 +1,440 @@
+MODULE domain
+   !!==============================================================================
+   !!                       ***  MODULE domain   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
+   !!                 !  1992-01  (M. Imbard) insert time step initialization
+   !!                 !  1996-06  (G. Madec) generalized vertical coordinate 
+   !!                 !  1997-02  (G. Madec) creation of domwri.F
+   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
+   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   dom_init       : initialize the space and time domain
+   !!   dom_nam        : read and contral domain namelists
+   !!   dom_ctl        : control print for the ocean domain
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! domain: ocean
+   USE phycst          ! physical constants
+   USE domhgr          ! domain: set the horizontal mesh
+   USE domzgr          ! domain: set the vertical mesh
+   USE dommsk          ! domain: set the mask system
+   USE domclo          ! domain: set closed sea mask
+   !
+   USE lib_mpp         !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_init   ! called by opa.F90
+   PUBLIC   dom_nam  ! called by opa.F90
+   PUBLIC   cfg_write   ! called by opa.F90
+
+   !!-------------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: domain.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence        (./LICENSE)
+   !!-------------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_init  ***
+      !!                    
+      !! ** Purpose :   Domain initialization. Call the routines that are 
+      !!              required to create the arrays which define the space 
+      !!              and time domain of the ocean model.
+      !!
+      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
+      !!              - dom_hgr: compute or read the horizontal grid-point position
+      !!                         and scale factors, and the coriolis factor
+      !!              - dom_zgr: define the vertical coordinate and the bathymetry
+      !!              - dom_stp: defined the model time step
+      !!              - dom_wri: create the meshmask file if nmsh=1
+      !!              - 1D configuration, move Coriolis, u and v at T-point
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+      !
+      !                       !==  Reference coordinate system  ==!
+      !
+      CALL dom_nam                  ! read namelist ( namrun, namdom )
+      !
+      CALL dom_hgr                  ! Horizontal mesh
+      !
+      CALL dom_zgr                  ! Vertical mesh and bathymetry
+      !
+      CALL dom_msk                  ! compute mask (needed by write_cfg)
+      !
+      IF ( ln_domclo ) CALL dom_clo ! Closed seas and lake
+      !
+      CALL dom_ctl                  ! print extrema of masked scale factors
+      ! 
+      CALL cfg_write                ! create the configuration file
+      !
+   END SUBROUTINE dom_init
+
+   SUBROUTINE dom_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read domaine namelists and print the variables.
+      !!
+      !! ** input   : - namrun namelist
+      !!              - namdom namelist
+      !!              - namnc4 namelist   ! "key_netcdf4" only
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
+                       nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
+         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
+         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
+         &             ln_cfmeta, ln_iscpl
+      NAMELIST/namdom/ nn_bathy, cn_topo, cn_bath, cn_lon, cn_lat, nn_interp,                        &
+         &             rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,                       &
+         &             rn_atfp , rn_rdt   , ln_crs      , jphgr_msh ,                                &
+         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m,                         &
+         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh,                  &
+         &             ppa2, ppkth2, ppacr2
+
+
+
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
+      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namrun )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namrun'
+         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
+         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
+         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
+         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
+         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+      ENDIF
+
+      cexper = cn_exp
+      nrstdt = nn_rstctl
+      nit000 = nn_it000
+      nitend = nn_itend
+      ndate0 = nn_date0
+      nleapy = nn_leapy
+      ninist = nn_istate
+      nstock = nn_stock
+      nstocklist = nn_stocklist
+      nwrite = nn_write
+      neuler = nn_euler
+      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
+         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
+         CALL ctl_warn( ctmp1 )
+         neuler = 0
+      ENDIF
+
+      !                             ! control of output frequency
+      IF ( nstock == 0 .OR. nstock > nitend ) THEN
+         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nstock = nitend
+      ENDIF
+      IF ( nwrite == 0 ) THEN
+         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nwrite = nitend
+      ENDIF
+
+
+
+
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE (  1 ) 
+         CALL ioconf_calendar('gregorian')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
+      CASE (  0 )
+         CALL ioconf_calendar('noleap')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
+      CASE ( 30 )
+         CALL ioconf_calendar('360d')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
+      END SELECT
+
+
+
+
+      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
+  
+      !
+      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdom )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namdom : space & time domain'
+         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
+         IF( nn_bathy == 2 ) THEN
+            WRITE(numout,*) '      compute bathymetry from file      cn_topo      = ', cn_topo
+         ENDIF   
+         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
+         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
+         WRITE(numout,*) '      min number of ocean level (<0)       '
+         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
+         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
+         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
+         WRITE(numout,*) '           = 0   no file created           '
+         WRITE(numout,*) '           = 1   mesh_mask                 '
+         WRITE(numout,*) '           = 2   mesh and mask             '
+         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
+         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
+         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
+         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
+         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
+         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
+         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
+         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
+         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
+         WRITE(numout,*) '                                        ppa0            = ', ppa0
+         WRITE(numout,*) '                                        ppa1            = ', ppa1
+         WRITE(numout,*) '                                        ppkth           = ', ppkth
+         WRITE(numout,*) '                                        ppacr           = ', ppacr
+         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
+         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
+         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
+         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
+         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
+         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
+      ENDIF
+      !
+      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
+      e3zps_min = rn_e3zps_min
+      e3zps_rat = rn_e3zps_rat
+      nmsh      = nn_msh
+      atfp      = rn_atfp
+      rdt       = rn_rdt
+
+      snc4set%luse = .FALSE.        ! No NetCDF 4 case
+      !
+   END SUBROUTINE dom_nam
+
+
+   SUBROUTINE dom_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_ctl  ***
+      !!
+      !! ** Purpose :   Domain control.
+      !!
+      !! ** Method  :   compute and print extrema of masked scale factors
+      !!----------------------------------------------------------------------
+      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
+      INTEGER, DIMENSION(2) ::   iloc   ! 
+      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
+      !!----------------------------------------------------------------------
+      !
+      IF(lk_mpp) THEN
+         CALL mpp_minloc( 'dom_ctl', e1t(:,:), tmask_i(:,:), ze1min, iloc )
+         iimi1 = iloc(1) ; ijmi1 = iloc(2)
+         CALL mpp_minloc( 'dom_ctl', e2t(:,:), tmask_i(:,:), ze2min, iloc )
+         iimi2 = iloc(1) ; ijmi2 = iloc(2)
+         CALL mpp_maxloc( 'dom_ctl', e1t(:,:), tmask_i(:,:), ze1max, iloc )
+         iima1 = iloc(1) ; ijma1 = iloc(2)
+         CALL mpp_maxloc( 'dom_ctl', e2t(:,:), tmask_i(:,:), ze2max, iloc )
+         iima2 = iloc(1) ; ijma2 = iloc(2)
+      ELSE
+         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )    
+
+         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iimi1 = iloc(1) + nimpp - 1
+         ijmi1 = iloc(2) + njmpp - 1
+         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iimi2 = iloc(1) + nimpp - 1
+         ijmi2 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iima1 = iloc(1) + nimpp - 1
+         ijma1 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iima2 = iloc(1) + nimpp - 1
+         ijma2 = iloc(2) + njmpp - 1
+      ENDIF
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
+         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
+         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
+         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
+      ENDIF
+      !
+   END SUBROUTINE dom_ctl
+
+
+   SUBROUTINE cfg_write
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE cfg_write  ***
+      !!                   
+      !! ** Purpose :   Create the "domain_cfg" file, a NetCDF file which 
+      !!              contains all the ocean domain informations required to 
+      !!              define an ocean configuration.
+      !!
+      !! ** Method  :   Write in a file all the arrays required to set up an
+      !!              ocean configuration.
+      !!
+      !! ** output file :   domain_cfg.nc : domain size, characteristics,horizontal mesh,
+      !!                              Coriolis parameter, and vertical scale factors
+      !!                              NB: also contains ORCA family information (if cp_cfg = "ORCA")
+      !!                              and depths (ln_e3_dep=F) 
+      !!----------------------------------------------------------------------
+      INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      INTEGER           ::   izco, izps, isco, icav
+      INTEGER           ::   inum     ! temprary units for 'domain_cfg.nc' file
+      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cfg_write : create the "domain_cfg.nc" file containing all required configuration information'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+      !
+      !                       ! ============================= !
+      !                       !  create 'domain_cfg.nc' file  !
+      !                       ! ============================= !
+      !         
+      clnam = 'domain_cfg'  ! filename (configuration information)
+      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE.)!, kiolib = jprstlib )
+      
+      !
+      !                             !==  ORCA family specificities  ==!
+      IF( cp_cfg == "ORCA" ) THEN
+         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( jp_cfg, wp), ktype = jp_i4 )         
+      ENDIF
+      !                             !==  global domain size  ==!
+      !
+      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
+      !
+      !                             !==  domain characteristics  ==!
+      !
+      !                                   ! lateral boundary of the global
+      !                                   domain
+      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
+      !
+      !                                   ! type of vertical coordinate
+      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
+      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
+      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
+      !
+      !                                   ! ocean cavities under iceshelves
+      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
+      !
+      !                             !==  horizontal mesh  !
+      !
+      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
+      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
+      !                                
+      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
+      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
+      !                                
+      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
+      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
+      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
+      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
+      !
+      !                             !==  vertical mesh  ==!
+      !                                                     
+      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d  , ktype = jp_r8 )   !  reference 1D-coordinate
+      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0   , ktype = jp_r8 )   !  vertical scale factors (e
+      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0   , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0   , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0   , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0   , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0  , ktype = jp_r8 )
+      !
+      IF(.NOT.ln_e3_dep ) THEN                                             !  depth (t- & w-points)
+         CALL iom_rstput( 0, 0, inum, 'gdept_1d', gdept_1d, ktype = jp_r8 )   ! required only with  
+         CALL iom_rstput( 0, 0, inum, 'gdepw_1d', gdepw_1d, ktype = jp_r8 )   ! the old e3. definition
+         CALL iom_rstput( 0, 0, inum, 'gdept_0' , gdept_0 , ktype = jp_r8 )
+         CALL iom_rstput( 0, 0, inum, 'gdepw_0' , gdepw_0 , ktype = jp_r8 )
+      ENDIF
+      !                                         
+      !                             !==  ocean top and bottom level  ==!
+      !
+      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
+      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
+      CALL iom_rstput( 0, 0, inum, 'isf_draft'    , risfdep , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'bathy_metry'  , bathy   , ktype = jp_r8 )
+      !
+      !                              !== closed sea ==!
+      IF (ln_domclo) THEN
+         ! mask for the open sea
+         CALL iom_rstput( 0, 0, inum, 'mask_opensea' , msk_opnsea  , ktype = jp_i4 )
+         ! mask for all the under closed sea
+         CALL iom_rstput( 0, 0, inum, 'mask_csundef' , msk_csundef , ktype = jp_i4 )
+         ! mask for global, local net precip, local net precip and evaporation correction
+         CALL iom_rstput( 0, 0, inum, 'mask_csglo'   , msk_csglo   , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csemp'   , msk_csemp   , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csrnf'   , msk_csrnf   , ktype = jp_i4 )
+         ! mask for the various river mouth (in case multiple lake in the same outlet)
+         CALL iom_rstput( 0, 0, inum, 'mask_csgrpglo', msk_csgrpglo, ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csgrpemp', msk_csgrpemp, ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csgrprnf', msk_csgrprnf, ktype = jp_i4 )
+      END IF
+      !
+      !                                ! ============================
+      !                                !        close the files 
+      !                                ! ============================
+      CALL iom_close( inum )
+      !
+   END SUBROUTINE cfg_write
+
+
+
+   !!======================================================================
+END MODULE domain
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dombat.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dombat.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dombat.F90	(revision 12101)
@@ -0,0 +1,243 @@
+MODULE dombat
+
+   USE dom_oce           ! ocean domain
+!   USE closea            ! closed seas
+   !
+   USE in_out_manager    ! I/O manager
+   USE iom               ! I/O library
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp           ! distributed memory computing library
+   USE agrif_modutil
+   USE bilinear_interp
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_bat        ! called by dom_zgr.F90
+
+CONTAINS
+
+   SUBROUTINE dom_bat
+
+      INTEGER :: inum, isize, jsize, id, ji, jj
+      INTEGER :: tabdim1, tabdim2, nxhr, nyhr, nxyhr
+      INTEGER, DIMENSION(2) :: ddims
+      INTEGER, DIMENSION(3) :: status
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: trouble_points ,  vardep,mask_oce
+      INTEGER :: iimin,iimax,jjmin,jjmax
+      INTEGER, DIMENSION(1) :: i_min,i_max
+      INTEGER, DIMENSION(1) ::j_min,j_max
+      REAL(wp), DIMENSION(jpi,jpj) :: myglamf
+      INTEGER,DIMENSION(:)  ,POINTER     ::   src_add,dst_add => NULL()
+      REAL(wp), DIMENSION(:)  ,ALLOCATABLE ::   vardep1d, lon_new1D,lat_new1D 
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: bathy_new, lat_new, lon_new, bathy_test
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: coarselon, coarselat, coarsebathy
+      REAL(wp) :: Cell_lonmin, Cell_lonmax, Cell_latmin, Cell_latmax
+      LOGICAL :: identical_grids
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE     ::   masksrc
+      REAL*8, DIMENSION(:,:),POINTER     ::   matrix,interpdata => NULL() 
+      LOGICAL :: lonlat_2D
+
+      CHARACTER(32) :: bathyfile, bathyname, lonname,latname       
+
+     lonlat_2D=.false.
+
+      bathyfile=TRIM(cn_topo)
+      bathyname=TRIM(cn_bath)
+      lonname=TRIM(cn_lon)
+      latname=TRIM(cn_lat)
+   
+      CALL iom_open( bathyfile, inum, lagrif=.FALSE. )
+      id = iom_varid( inum, bathyname, ddims )
+      
+      status=-1
+      ALLOCATE(lon_new  (ddims(1),ddims(2)), STAT=status(1)) 
+      ALLOCATE(lat_new  (ddims(1),ddims(2)), STAT=status(2)) 
+      ALLOCATE(bathy_new(ddims(1),ddims(2)), STAT=status(3)) 
+      IF( sum(status) /= 0 )   CALL ctl_stop( 'STOP', 'dom_bat : unable to allocate arrays' )
+
+      IF (lonlat_2D) THEN
+        CALL iom_get  ( inum, jpdom_unknown, lonname, lon_new )
+        CALL iom_get  ( inum, jpdom_unknown, latname, lat_new )
+      ELSE
+        ALLOCATE(lon_new1D(ddims(1)), lat_new1D(ddims(2)))
+        CALL iom_get  ( inum, jpdom_unknown, lonname, lon_new1D )
+        CALL iom_get  ( inum, jpdom_unknown, latname, lat_new1D )
+        DO ji=1, ddims(1)
+           lon_new(ji,:)=lon_new1D(ji)
+        ENDDO              
+        DO ji=1, ddims(2)
+           lat_new(:,ji)=lat_new1D(ji)
+        ENDDO              
+      ENDIF  
+      CALL iom_get  ( inum, jpdom_unknown, bathyname, bathy_new )
+      CALL iom_close (inum)
+      WHERE (bathy_new > 0.)        
+        bathy_new=0.
+      ENDWHERE 
+      bathy_new=-bathy_new 
+
+       ! Eventually add here a pre-selection of the area (coarselon/lat)
+       i_min=10  ; j_min=10
+       i_max= ddims(1)-10 ; j_max=ddims(2)-10 
+
+       tabdim1 = i_max(1) -  i_min(1) + 1 
+       tabdim2 = j_max(1) - j_min(1) + 1
+       !
+
+       ALLOCATE(coarselon(tabdim1,tabdim2))
+       ALLOCATE(coarselat(tabdim1,tabdim2))
+       ALLOCATE(coarsebathy(tabdim1,tabdim2))          
+       !
+       WHERE( lon_new < 0. )   lon_new = lon_new + 360.
+       myglamf=glamf
+       WHERE( myglamf < 0. )   myglamf = myglamf + 360.
+
+       coarselat(:,:)   =  lat_new  (i_min(1):i_max(1), j_min(1):j_max(1))
+       coarselon  (:,:) =  lon_new  (i_min(1):i_max(1), j_min(1):j_max(1))
+       coarsebathy(:,:) =  bathy_new(i_min(1):i_max(1), j_min(1):j_max(1))
+
+       IF( nn_interp == 0 .OR. nn_interp == 1 ) THEN   ! arithmetic or median averages
+        !                                                            ! ----------------------------- 
+        ALLOCATE(trouble_points(jpi,jpj))
+        trouble_points(:,:) = 0
+        !                       
+        DO jj = 2, jpj
+           DO ji = 2, jpi
+              !       
+              ! fine grid cell extension               
+              Cell_lonmin = MIN(myglamf(ji-1,jj-1),myglamf(ji,jj-1),myglamf(ji,jj),myglamf(ji-1,jj))
+              Cell_lonmax = MAX(myglamf(ji-1,jj-1),myglamf(ji,jj-1),myglamf(ji,jj),myglamf(ji-1,jj))
+              Cell_latmin = MIN(gphif(ji-1,jj-1),gphif(ji,jj-1),gphif(ji,jj),gphif(ji-1,jj))
+              Cell_latmax = MAX(gphif(ji-1,jj-1),gphif(ji,jj-1),gphif(ji,jj),gphif(ji-1,jj)) 
+              !               
+              ! look for points in G0 (bathy dataset) contained in the fine grid cells  
+              iimin = 1
+              DO WHILE( coarselon(iimin,1) < Cell_lonmin ) 
+                 iimin = iimin + 1
+              ENDDO
+              !               
+              jjmin = 1
+              DO WHILE( coarselat(iimin,jjmin) < Cell_latmin ) 
+                 jjmin = jjmin + 1
+              ENDDO
+             !                
+              iimax = iimin 
+              DO WHILE( coarselon(iimax,1) <= Cell_lonmax ) 
+                 iimax = iimax + 1
+                 iimax = MIN( iimax,SIZE(coarsebathy,1))
+              ENDDO
+              !                               
+              jjmax = jjmin 
+              DO WHILE( coarselat(iimax,jjmax) <= Cell_latmax ) 
+                 jjmax = jjmax + 1
+                 jjmax = MIN( jjmax,SIZE(coarsebathy,2))
+              ENDDO
+              !
+              IF( .NOT. Agrif_Root() ) THEN
+                 iimax = iimax-1
+                 jjmax = jjmax-1
+              ELSE
+                 iimax = MAX(iimin,iimax-1)
+                 jjmax = MAX(jjmin,jjmax-1)
+              ENDIF
+              !               
+              iimin = MAX( iimin,1 )
+              jjmin = MAX( jjmin,1 )
+              iimax = MIN( iimax,SIZE(coarsebathy,1))
+              jjmax = MIN( jjmax,SIZE(coarsebathy,2))
+
+              nxhr = iimax - iimin + 1
+              nyhr = jjmax - jjmin + 1                    
+
+                
+              IF( nxhr == 0 .OR. nyhr == 0 ) THEN
+                 !
+                 trouble_points(ji,jj) = 1
+                 !
+              ELSE
+                 !
+                 ALLOCATE( vardep(nxhr,nyhr), mask_oce(nxhr,nyhr) )
+                 vardep(:,:) = coarsebathy(iimin:iimax,jjmin:jjmax)
+                 !
+                 WHERE( vardep(:,:) .GT. 0. )   ;   mask_oce = 1 ;
+                 ELSEWHERE                      ;   mask_oce = 0 ;
+                 ENDWHERE
+                 !
+                 nxyhr = nxhr*nyhr
+                 IF( SUM(mask_oce) < 0.5*(nxyhr) ) THEN ! if more than half of the points are on land then bathy fine = 0
+                    bathy(ji,jj) = 0.
+                 ELSE
+                    IF( nn_interp == 0 ) THEN     ! Arithmetic average
+                      bathy(ji,jj) = SUM( vardep(:,:) * mask_oce(:,:) ) / SUM( mask_oce(:,:) )
+                    ELSE                                  ! Median average
+                       ALLOCATE(vardep1d(nxyhr))
+                       vardep1d = RESHAPE(vardep,(/ nxyhr /) )
+                       !!CALL ssort(vardep1d,nxyhr)
+                       CALL quicksort(vardep1d,1,nxyhr)
+                       !
+                       ! Calculate median
+                       IF (MOD(nxyhr,2) .NE. 0) THEN
+                          bathy(ji,jj) = vardep1d( nxyhr/2 + 1 )
+                       ELSE
+                          bathy(ji,jj) = 0.5 * ( vardep1d(nxyhr/2) + vardep1d(nxyhr/2+1) )
+                       END IF
+                       DEALLOCATE(vardep1d)   
+                    ENDIF
+                 ENDIF
+                 DEALLOCATE (mask_oce,vardep)
+                 !
+              ENDIF
+           ENDDO
+        ENDDO
+
+        IF( SUM( trouble_points ) > 0 ) THEN
+           PRINT*,'too much empty cells, proceed to bilinear interpolation'
+           nn_interp = 2
+           stop
+        ENDIF           
+     ENDIF
+
+#undef MYTEST
+#ifdef MYTEST
+         IF( nn_interp == 2) THEN                        ! Bilinear interpolation
+        !                                                    ! ----------------------------- 
+        identical_grids = .FALSE.
+
+        IF( SIZE(coarselat,1) == jpi .AND. SIZE(coarselat,2) == jpj  .AND.   &
+            SIZE(coarselon,1) == jpj .AND. SIZE(coarselon,2) == jpj ) THEN
+           IF( MAXVAL( ABS(coarselat(:,:)- gphit(:,:)) ) < 0.0001 .AND.   &
+               MAXVAL( ABS(coarselon(:,:)- glamt(:,:)) ) < 0.0001 ) THEN
+              PRINT*,'same grid between ', cn_topo,' and child domain'    
+              bathy = bathy_new
+              identical_grids = .TRUE.                          
+           ENDIF
+        ENDIF
+
+        IF( .NOT. identical_grids ) THEN 
+
+           ALLOCATE(masksrc(SIZE(bathy_new,1),SIZE(bathy_new,2)))
+           ALLOCATE(bathy_test(jpi,jpj))
+           !
+           !Where(G0%bathy_meter.le.0.00001) 
+           !  masksrc = .false.
+           !ElseWhere
+              masksrc = .TRUE.
+           !End where                       
+           !            
+           ! compute remapping matrix thanks to SCRIP package            
+           CALL get_remap_matrix(coarselat,gphit,coarselon,glamt,masksrc,matrix,src_add,dst_add)
+           CALL make_remap(bathy_new,bathy_test,jpi,jpj,matrix,src_add,dst_add)  
+           !                                  
+           bathy = bathy_test               
+           !            
+           DEALLOCATE(masksrc)
+           DEALLOCATE(bathy_test) 
+
+        ENDIF
+        !            
+     ENDIF
+#endif 
+   END SUBROUTINE dom_bat
+
+END MODULE dombat
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dombat_util.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dombat_util.f90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dombat_util.f90	(revision 12101)
@@ -0,0 +1,472 @@
+!
+MODULE agrif_modutil
+  !
+CONTAINS
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  AGRIF_MODUTIL							*
+  !									*
+  ! module containing subroutine used for : 				*
+  !   - unrolling 2D arrays to 1D arrays (required for SCRIP package use)	*
+  !   - convert 1D arrays to 2D arrays (required for SCRIP package use)	*
+  !   - remapping process (use SCRIP remapping matrix)			*
+  !									*
+  !************************************************************************
+  ! 
+  !***********************************************************    
+  SUBROUTINE ssort (x, nb)
+    !***********************************************************
+    !
+    IMPLICIT NONE
+
+    INTEGER :: nb
+    REAL*8, DIMENSION(:) :: x
+    REAL*8 :: temp
+    INTEGER ji,jj,jmax,itemp
+    !      
+    jmax=nb-1
+    !
+    !
+    DO ji=1,nb-1
+       temp=HUGE(1)
+
+       DO jj=1,jmax
+
+          IF(X(jj).LE.X(jj+1)) THEN 
+             temp=X(jj)
+             X(jj)=X(jj+1)
+             X(jj+1)=temp
+          ENDIF
+
+       ENDDO
+
+       IF(temp.EQ.HUGE(1)) RETURN
+       jmax=jmax-1
+    ENDDO
+
+    RETURN
+  END SUBROUTINE ssort
+  !
+  !***********************************************************
+  !                    --- quicksort ---
+  ! Author: t-nissie
+  ! License: GPLv3
+  ! Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
+  !***********************************************************
+  RECURSIVE SUBROUTINE quicksort(var, first, last)
+     IMPLICIT NONE
+
+     REAL*8, DIMENSION(:), INTENT(inout) :: var
+     INTEGER,              INTENT(in)    :: first, last
+     REAL*8  :: x, t
+     INTEGER :: ji, jj
+     
+     x = var( (first+last) / 2 )
+     ji = first
+     jj = last
+     DO
+        DO WHILE (var(ji) < x)
+           ji=ji+1
+        END DO
+        DO WHILE (x < var(jj))
+           jj=jj-1
+        END DO
+        IF (ji >= jj) EXIT
+        t = var(ji);  var(ji) = var(jj);  var(jj) = t
+        ji=ji+1
+        jj=jj-1
+     END DO
+     IF (first < ji-1) CALL quicksort(var, first, ji-1)
+     IF (jj+1 < last)  CALL quicksort(var, jj+1, last)
+  END SUBROUTINE quicksort
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE 1Dto2D
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE tab1Dto2D(tab1D,tab2D,nx,ny)
+    !
+    IMPLICIT NONE   
+    !
+    REAL*8,DIMENSION(:) :: tab1D
+    REAL*8,DIMENSION(:,:) :: tab2D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny   
+    INTEGER :: i      
+    !      
+    xpos=0
+    ypos=1
+    !      
+    DO i=1,nx*ny
+       xpos=xpos+1
+       IF(xpos.GT.nx) THEN
+          xpos=1
+          ypos=ypos+1
+       ENDIF
+       tab2D(ypos,xpos)=tab1D(i)
+    END DO
+    !
+  END SUBROUTINE tab1Dto2D
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE tab2Dto1D
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE tab2Dto1D(tab2D,tab1D)
+    !
+    IMPLICIT NONE 
+    !       
+    REAL*8,DIMENSION(:,:) :: tab2D
+    REAL*8,DIMENSION(:) :: tab1D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny
+    INTEGER :: i
+    !
+    nx = SIZE(tab2D,2)
+    ny = SIZE(tab2D,1)
+    !      
+    xpos = 0
+    ypos = 1
+    DO i = 1,nx*ny
+       xpos = xpos + 1
+       IF(xpos.GT.nx) THEN
+          xpos = 1
+          ypos = ypos + 1
+       END IF
+       tab1D(i) = tab2D(ypos,xpos)
+    END DO
+    !
+  END SUBROUTINE tab2Dto1D
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE tab2Dto1D logical
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE logtab2Dto1D(tab2D,tab1D)
+    !
+    IMPLICIT NONE 
+    !       
+    LOGICAL,DIMENSION(:,:) :: tab2D
+    LOGICAL,DIMENSION(:) :: tab1D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny
+    INTEGER :: i
+    !
+    nx = SIZE(tab2D,2)
+    ny = SIZE(tab2D,1)
+    !      
+    xpos = 0
+    ypos = 1
+    DO i = 1,nx*ny
+       xpos = xpos + 1
+       IF(xpos.GT.nx) THEN
+          xpos = 1
+          ypos = ypos + 1
+       END IF
+       tab1D(i) = tab2D(ypos,xpos)
+    END DO
+    !
+  END SUBROUTINE logtab2Dto1D
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE 1Dto2D
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE logtab1Dto2D(tab1D,tab2D,nx,ny)
+    !
+    IMPLICIT NONE   
+    !
+    LOGICAL,DIMENSION(:) :: tab1D
+    LOGICAL,DIMENSION(:,:) :: tab2D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny   
+    INTEGER :: i      
+    !      
+    xpos=0
+    ypos=1
+    !      
+    DO i=1,nx*ny
+       xpos=xpos+1
+       IF(xpos.GT.nx) THEN
+          xpos=1
+          ypos=ypos+1
+       ENDIF
+       tab2D(ypos,xpos)=tab1D(i)
+    END DO
+    !
+  END SUBROUTINE logtab1Dto2D
+
+  !**************************************************************
+  !   subroutine make_remap
+  !**************************************************************            
+  !
+  SUBROUTINE make_remap(tabin,tabout,nxfin,nyfin,matrix,src_add,dst_add) 
+    !      
+    IMPLICIT NONE
+    !      
+    REAL*8, DIMENSION(:,:)  :: tabin 
+    REAL*8, DIMENSION(:,:) :: tabout 
+    REAL*8, POINTER, DIMENSION(:,:) :: tabtemp    
+    INTEGER,DIMENSION(:) :: src_add,dst_add
+    INTEGER :: nxfin,nyfin      
+    REAL*8, POINTER, DIMENSION(:) :: var1D,var_interp1D
+    REAL*8,DIMENSION(:,:) :: matrix 
+    INTEGER :: num_links,i
+    ! 
+    ALLOCATE(var1D(SIZE(tabin,1)*SIZE(tabin,2)))     
+    CALL tab2Dto1D(tabin,var1D)
+    !      
+    ALLOCATE(var_interp1D(nxfin*nyfin))
+    var_interp1D = 0.0
+    num_links = SIZE(dst_add)
+    !
+    DO i = 1,num_links
+       var_interp1D(dst_add(i)) = var_interp1D(dst_add(i)) &
+            + matrix(1,i)*var1D(src_add(i))
+    END DO
+    !
+    ALLOCATE(tabtemp(SIZE(tabout,1),SIZE(tabout,2)))
+    !
+    CALL tab1Dto2D(var_interp1D,tabtemp,nyfin,nxfin)
+    !
+    tabout = tabtemp
+    !
+    DEALLOCATE(var_interp1D,var1D,tabtemp)  
+    ! 
+  END SUBROUTINE make_remap
+  !          
+  !
+  !**************************************************************
+  !   end subroutine make_remap
+  !**************************************************************          
+  !
+  !
+  !**************************************************************
+  !   subroutine make_bicubic_remap
+  !**************************************************************            
+  !
+  SUBROUTINE make_bicubic_remap(tabin,masksrc,tabout,nxfin,nyfin,matrix,src_add,dst_add) 
+    !      
+    IMPLICIT NONE
+    !      
+    REAL*8, DIMENSION(:,:)  :: tabin
+    LOGICAL, DIMENSION(:,:)  :: masksrc
+    LOGICAL, POINTER, DIMENSION(:)  :: grid1_mask
+    REAL*8, DIMENSION(:,:) :: tabout     
+    INTEGER,DIMENSION(:) :: src_add,dst_add
+    INTEGER :: nxfin,nyfin      
+    REAL*8, POINTER, DIMENSION(:) :: var1D,var_interp1D,gradi,gradj,gradij,deriv1,deriv2
+    REAL*8,DIMENSION(:,:) :: matrix 
+    INTEGER :: num_links,i,j,nx,ny,n,ip1,im1,jp1,jm1
+    INTEGER :: in_x,is,ie,iw,ine,inw,ise,isw
+    REAL*8 :: delew,delns
+    !
+    nx = SIZE(tabin,1)
+    ny = SIZE(tabin,2)
+    ALLOCATE(gradi(nx*ny),gradj(nx*ny),gradij(nx*ny),deriv1(nx*ny),deriv2(nx*ny))
+    ALLOCATE(var1D(nx*ny),grid1_mask(nx*ny))
+    !           
+    CALL tab2Dto1D(tabin,var1D)
+    CALL logtab2Dto1D(masksrc,grid1_mask)     
+    !
+    gradi  = 0.0
+    gradj  = 0.0
+    gradij = 0.0
+    !
+    DO n = 1,nx*ny
+
+       IF( grid1_mask(n) ) THEN                        
+          !                     
+          delew = 0.5      
+          delns = 0.5
+
+          j = (n-1)/ny + 1
+          i = n - (j-1)*ny
+          !
+          ip1 = i+1
+          im1 = i-1
+          jp1 = j+1
+          jm1 = j-1      
+          !
+          IF (ip1 > ny) ip1 = ip1 - ny
+
+          IF (im1 < 1 ) im1 = ny
+
+          IF (jp1 > nx) THEN
+             jp1 = j
+             delns = 1.
+          ENDIF
+
+          IF (jm1 < 1 ) THEN
+             jm1 = j
+             delns = 1.
+          ENDIF
+          !
+          in_x  = (jp1-1)*ny + i
+          is  = (jm1-1)*ny + i
+          ie  = (j  -1)*ny + ip1
+          iw  = (j  -1)*ny + im1
+          !
+          ine = (jp1-1)*ny + ip1
+          inw = (jp1-1)*ny + im1
+          ise = (jm1-1)*ny + ip1
+          isw = (jm1-1)*ny + im1
+          !
+          !*** compute i-gradient
+
+          IF (.NOT. grid1_mask(ie)) THEN
+             ie = n
+             delew = 1.
+          ENDIF
+          !            
+          IF (.NOT. grid1_mask(iw)) THEN
+             iw = n
+             delew = 1.
+          ENDIF
+          !
+          gradi(n) = delew*(var1D(ie) - var1D(iw))
+          !
+          !*** compute j-gradient
+
+          IF (.NOT. grid1_mask(in_x)) THEN
+             in_x = n
+             delns = 1.
+          ENDIF
+          !                      
+          IF (.NOT. grid1_mask(is)) THEN
+             is = n
+             delns = 1.
+          ENDIF
+          !
+          gradj(n) = delns*(var1D(in_x) - var1D(is))                    
+          !
+          !*** compute ij-gradient
+
+          delew = 0.5
+
+          IF (jp1 == j .OR. jm1 == j) THEN
+             delns = 1.
+          ELSE 
+             delns = 0.5
+          ENDIF
+          !
+          IF (.NOT. grid1_mask(ine)) THEN
+             IF (in_x /= n) THEN
+                ine = in_x
+                delew = 1.
+             ELSE IF (ie /= n) THEN
+                ine = ie
+                inw = iw
+                IF (inw == n) delew = 1.
+                delns = 1.
+             ELSE
+                ine = n
+                inw = iw
+                delew = 1
+                delns = 1
+             ENDIF
+          ENDIF
+          !
+          IF (.NOT. grid1_mask(inw)) THEN
+             IF (in_x /= n) THEN
+                inw = in_x
+                delew = 1.
+             ELSE IF (iw /= n) THEN
+                inw = iw
+                ine = ie
+                IF (ie == n) delew = 1.
+                delns = 1.
+             ELSE
+                inw = n
+                ine = ie
+                delew = 1.
+                delns = 1.
+             ENDIF
+          ENDIF
+          !
+          deriv1(n) = delew*(var1D(ine)-var1D(inw))                    
+          !
+          IF (.NOT. grid1_mask(ise)) THEN
+             IF (is /= n) THEN
+                ise = is
+                delew = 1.
+             ELSE IF (ie /= n) THEN
+                ise = ie
+                isw = iw
+                IF (isw == n) delew = 1.
+                delns = 1.
+             ELSE
+                ise = n
+                isw = iw
+                delew = 1.
+                delns = 1.
+             ENDIF
+          ENDIF
+          !
+          IF (.NOT. grid1_mask(isw)) THEN
+             IF (is /= n) THEN
+                isw = is
+                delew = 1.
+             ELSE IF (iw /= n) THEN
+                isw = iw
+                ise = ie
+                IF (ie == n) delew = 1.
+                delns = 1.
+             ELSE
+                isw = n
+                ise = ie
+                delew = 1.
+                delns = 1.
+             ENDIF
+          ENDIF
+
+          deriv2(n) = delew*(var1D(ise) - var1D(isw))
+          gradij(n) = delns*(deriv1(n) - deriv2(n))
+       ENDIF
+    END DO
+    !
+    DEALLOCATE(deriv1,deriv2,grid1_mask)
+
+    !       
+    ALLOCATE(var_interp1D(nxfin*nyfin))
+    var_interp1D = 0.0
+    num_links = SIZE(dst_add)
+    !      
+    DO i = 1,num_links
+       !        
+       var_interp1D(dst_add(i)) = var_interp1D(dst_add(i))        +      &
+            matrix(1,i)*var1D(src_add(i))   +      &
+            matrix(2,i)*gradi(src_add(i))   +      &
+            matrix(3,i)*gradj(src_add(i))   +      & 
+            matrix(4,i)*gradij(src_add(i))
+    END DO
+    !
+    DEALLOCATE(gradi,gradj,gradij,var1D)
+    !
+    CALL tab1Dto2D(var_interp1D,tabout,nyfin,nxfin)
+    !      
+    DEALLOCATE(var_interp1D)       
+    ! 
+  END SUBROUTINE make_bicubic_remap
+  !          
+  !
+  !**************************************************************
+  !   end subroutine make_bicubic_remap
+  !**************************************************************          
+  !
+  !
+END MODULE agrif_modutil
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domcfg.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domcfg.f90	(revision 12100)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domcfg.f90	(revision 12101)
@@ -15,5 +15,4 @@
    USE in_out_manager  ! I/O manager
    USE lib_mpp         ! distributed memory computing library
-   USE timing          ! Timing
 
    IMPLICIT NONE
@@ -36,6 +35,4 @@
       !!
       !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_cfg')
       !
       IF(lwp) THEN                   ! Control print
@@ -60,8 +57,5 @@
       CALL dom_glo                   ! global domain versus zoom and/or local domain
       !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_cfg')
-      !
    END SUBROUTINE dom_cfg
-
 
    SUBROUTINE dom_glo
@@ -69,131 +63,64 @@
       !!                     ***  ROUTINE dom_glo  ***
       !!
-      !! ** Purpose :   initialization for global domain, zoom and local domain
+      !! ** Purpose :   initialization of global domain <--> local domain indices
       !!
       !! ** Method  :   
       !!
-      !! ** Action  : - mig  , mjg : 
-      !!              - mi0  , mi1   :
-      !!              - mj0, , mj1   :
+      !! ** 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
       !!----------------------------------------------------------------------
-      !                              ! recalculate jpizoom/jpjzoom given lat/lon
       !
-      !                        ! ============== !
-      !                        !  Local domain  ! 
-      !                        ! ============== !
-      DO ji = 1, jpi                 ! local domain indices ==> data domain indices
-        mig(ji) = ji + jpizoom - 1 + nimpp - 1
+      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
+        mig(ji) = ji + nimpp - 1
       END DO
       DO jj = 1, jpj
-        mjg(jj) = jj + jpjzoom - 1 + njmpp - 1
+        mjg(jj) = jj + njmpp - 1
       END DO
-      !
-      !                              ! data domain indices ==> local domain indices
+      !                              ! 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, jpidta
-        mi0(ji) = MAX( 1, MIN( ji - jpizoom + 1 - nimpp + 1, jpi+1 ) )
-        mi1(ji) = MAX( 0, MIN( ji - jpizoom + 1 - nimpp + 1, jpi   ) )
+      !                                   ! 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, jpjdta
-        mj0(jj) = MAX( 1, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj+1 ) )
-        mj1(jj) = MAX( 0, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj   ) )
+      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: data / local '
+         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
          WRITE(numout,*) '~~~~~~~ '
-         WRITE(numout,*) '          data input domain    : jpidta = ', jpidta,   &
-            &                                            ' jpjdta = ', jpjdta, ' jpkdta = ', jpkdta
-         WRITE(numout,*) '          global or zoom domain: jpiglo = ', jpiglo,   &
-            &                                            ' jpjglo = ', jpjglo, ' jpk    = ', jpk
-         WRITE(numout,*) '          local domain         : jpi    = ', jpi   ,   &
-            &                                            ' jpj    = ', jpj   , ' jpk    = ', jpk
+         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
+         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
          WRITE(numout,*)
-         WRITE(numout,*) '          south-west indices    jpizoom = ', jpizoom,   &
-            &                                           ' jpjzoom = ', jpjzoom
+         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
          IF( nn_print >= 1 ) THEN
             WRITE(numout,*)
-            WRITE(numout,*) '          conversion local  ==> data i-index domain'
+            WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)'
             WRITE(numout,25)              (mig(ji),ji = 1,jpi)
             WRITE(numout,*)
-            WRITE(numout,*) '          conversion data   ==> local  i-index domain'
-            WRITE(numout,*) '             starting index'
-            WRITE(numout,25)              (mi0(ji),ji = 1,jpidta)
-            WRITE(numout,*) '             ending index'
-            WRITE(numout,25)              (mi1(ji),ji = 1,jpidta)
+            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  ==> data j-index domain'
+            WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)'
             WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
             WRITE(numout,*)
-            WRITE(numout,*) '          conversion data  ==> local j-index domain'
-            WRITE(numout,*) '             starting index'
-            WRITE(numout,25)              (mj0(jj),jj = 1,jpjdta)
-            WRITE(numout,*) '             ending index'
-            WRITE(numout,25)              (mj1(jj),jj = 1,jpjdta)
+            WRITE(numout,*) '          conversion global ==> local  j-index domain'
+            WRITE(numout,*) '             starting index (mj0)'
+            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
+            WRITE(numout,*) '             ending index (mj1)'
+            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
          ENDIF
       ENDIF
  25   FORMAT( 100(10x,19i4,/) )
-
-      !                        ! ============== !
-      !                        !  Zoom domain   !
-      !                        ! ============== !
-      !                              ! zoom control
-      IF( jpiglo + jpizoom - 1  >  jpidta .OR.   &
-          jpjglo + jpjzoom - 1  >  jpjdta      ) &
-          &   CALL ctl_stop( ' global or zoom domain exceed the data domain ! ' )
-
-      !                              ! set zoom flag
-      IF( jpiglo < jpidta .OR. jpjglo < jpjdta )   lzoom = .TRUE.
-
-      !                              ! set zoom type flags
-      IF( lzoom .AND. jpizoom /= 1 )   lzoom_w = .TRUE.                     ! 
-      IF( lzoom .AND. jpjzoom /= 1 )   lzoom_s = .TRUE.
-      IF( lzoom .AND. jpiglo + jpizoom -1 /= jpidta )   lzoom_e = .TRUE.
-      IF( lzoom .AND. jpjglo + jpjzoom -1 /= jpjdta )   lzoom_n = .TRUE.
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '          zoom flags : '
-         WRITE(numout,*) '             lzoom   = ', lzoom  , ' (T = zoom, F = global )'
-         WRITE(numout,*) '             lzoom_e = ', lzoom_e, ' (T = forced closed east  boundary)'
-         WRITE(numout,*) '             lzoom_w = ', lzoom_w, ' (T = forced closed west  boundary)'
-         WRITE(numout,*) '             lzoom_s = ', lzoom_s, ' (T = forced closed South boundary)'
-         WRITE(numout,*) '             lzoom_n = ', lzoom_n, ' (T = forced closed North boundary)'
-      ENDIF
-      IF(  ( lzoom_e .OR. lzoom_w )  .AND.  ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 )  )   &
-           &   CALL ctl_stop( ' Your zoom choice is inconsistent with east-west cyclic boundary condition' )
-      IF(  lzoom_n  .AND.  ( 3 <= jperio .AND. jperio <= 6 )  )   &
-           &   CALL ctl_stop( ' Your zoom choice is inconsistent with North fold boundary condition' )
-
-      !                              ! Pre-defined arctic/antarctic zoom of ORCA configuration flag
-      IF( cp_cfg == "orca" ) THEN
-         SELECT CASE ( jp_cfg )
-         CASE ( 2 )                               !  ORCA_R2 configuration
-            IF(  cp_cfz == "arctic"    .AND. jpiglo  == 142    .AND. jpjglo  ==  53 .AND.   &
-               & jpizoom ==  21    .AND. jpjzoom ==  97         )   THEN
-              IF(lwp) WRITE(numout,*) '          ORCA configuration: arctic zoom '
-            ENDIF
-            IF(  cp_cfz == "antarctic" .AND. jpiglo  == jpidta .AND. jpjglo  ==  50 .AND.   &
-               & jpizoom ==   1    .AND. jpjzoom ==   1         )   THEN
-              IF(lwp) WRITE(numout,*) '          ORCA configuration: antarctic zoom '
-            ENDIF
-            !                             
-         CASE ( 05 )                              !  ORCA_R05 configuration
-            IF(    cp_cfz == "arctic"    .AND. jpiglo  == 562    .AND. jpjglo  == 202 .AND.   &
-               & jpizoom ==  81    .AND. jpjzoom == 301         )   THEN
-              IF(lwp) WRITE(numout,*) '          ORCA configuration: arctic zoom '
-            ENDIF
-            IF(    cp_cfz == "antarctic" .AND. jpiglo  == jpidta .AND. jpjglo  == 187 .AND.   &
-               & jpizoom ==   1    .AND. jpjzoom ==   1         )   THEN
-              IF(lwp) WRITE(numout,*) '          ORCA configuration: antarctic zoom '
-            ENDIF
-         END SELECT
-         !
-      ENDIF
       !
    END SUBROUTINE dom_glo
-
    !!======================================================================
 END MODULE domcfg
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domclo.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domclo.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domclo.F90	(revision 12101)
@@ -0,0 +1,329 @@
+MODULE domclo
+   !!======================================================================
+   !!                       ***  MODULE  domclo  ***
+   !! domclo : definition of closed sea mask needed by NEMO
+   !!======================================================================
+   !! History : NEMO 4.0 ! 07-2019 (P. Mathiot) original version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   dom_clo    : definition of closed sea mask needed by NEMO
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE domngb          ! closest point algorithm
+   USE phycst          ! rpi, rad, ra
+   USE domutil         ! flood filling algorithm (fill_pool)
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! lateral boundary condition - MPP exchanges
+   USE lib_mpp
+   USE lib_fortran
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dom_clo      ! routine called by domain module
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: closea.F90 7213 2016-11-09 09:07:42Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_clo
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_clo  ***
+      !!        
+      !! ** Purpose :   Closed sea mask definition
+      !!
+      !! ** Method  :   A flood filling algorithm is used to detect lake and open ocean
+      !!                Namelist provide seed for each lake and condition on how to
+      !!                manage net evap/runoff.
+      !!
+      !! ** Action  :  - compute open ocean mask 
+      !!               - loop over all the lake in namelist 
+      !!               - define lake msk (msk_csglo/emp/rnf)
+      !!               - define river mouth mask for each lake or group of lake with the same river mouth
+      !!                 (msk_csgrpglo/emp/rnf) 
+      !!               
+      !!----------------------------------------------------------------------
+
+      TYPE closea 
+         CHARACTER(256) :: cname                       ! name
+         REAL(wp)       :: rlonsrc                     ! seed src location (lon)
+         REAL(wp)       :: rlatsrc                     ! seed src location (lat)
+         REAL(wp)       :: rlontrg                     ! seed trg location (lon)
+         REAL(wp)       :: rlattrg                     ! seed trg location (lat)
+         CHARACTER(256) :: cloctrg                     ! where water is spread
+         CHARACTER(256) :: cschtrg                     ! how   water is spread
+         REAL(wp)       :: radtrg                      ! radius of closed sea river mouth (used if cschtrg is rnf or emp)
+         INTEGER        :: idtrg                       ! target id in case multiple lakes for the same river mouth
+      END TYPE
+         
+      INTEGER, PARAMETER :: jp_closea = 98 ! number maximal of closea
+      INTEGER :: ji, jj, jcs, jsch  ! loop indexes
+      INTEGER :: jglo, jemp, jrnf   ! closed sea indexes for global, emp, rnf spreading
+      INTEGER :: jiseed, jjseed     ! seed indexes
+      INTEGER :: jglo, jloc, jcoast ! counter
+      INTEGER :: ios
+      INTEGER :: nn_closea          ! number of closed seas
+
+      REAL(wp) :: zdistseed                         ! distance to seed
+      REAL(wp) :: zarea                             ! river mouth area
+      REAL(wp) :: rn_lon_opnsea, rn_lat_opnsea      ! open sea seed
+      REAL(wp), DIMENSION(1)       :: zchk, zradtrg !
+      REAL(wp), DIMENSION(jpi,jpj) :: zdist         ! distance to seed trg location
+      REAL(wp), DIMENSION(jpi,jpj) :: zmsksrc, zmsktrg, zmsk_coastline ! various mask
+
+      CHARACTER(256) :: csch, cloc                       ! scheme name for water spreading (glo, rnf, emp)
+      TYPE(closea)  , DIMENSION(jp_closea)   :: sn_lake  ! lake properties
+
+      LOGICAL :: lskip     ! flag in case lake seed on land or already filled (...)
+
+      !!----------------------------------------------------------------------
+      !! 0 : Read namelist for closed sea definition
+      !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
+      IF(lwp) WRITE(numout,*)'~~~~~~~'
+
+      NAMELIST/namclo/ rn_lon_opnsea, rn_lat_opnsea, nn_closea, sn_lake
+      !!---------------------------------------------------------------------
+      
+      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
+      READ  ( numnam_ref, namclo, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namclo in reference namelist', lwp )
+      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition
+      READ  ( numnam_cfg, namclo, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namclo in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namclo )
+
+      !!----------------------------------------------------------------------
+      !! 1 : Define open ocean and closed sea masks
+      !!----------------------------------------------------------------------
+
+      !! 1.1 get closest point to the lat/lon seed
+      msk_opnsea(:,:) = ssmask(:,:)
+      CALL dom_ngb(rn_lon_opnsea, rn_lat_opnsea, jiseed, jjseed, zdistseed, 'T')
+
+      !! 1.2 fill connected cell to -1
+      CALL fill_pool( jiseed, jjseed, msk_opnsea, -1._wp )
+
+      !! sanity check on the msk value (closea mask should be 99 otherwise, lake already processed)
+      !! check if some lake are not connected
+      zchk = 0._wp
+      IF (mi0(jiseed) == mi1(jiseed) .AND. mj0(jjseed) == mj1(jjseed)) zchk = ssmask(mi0(jiseed),mj0(jjseed))
+      CALL mpp_max('domclo',zchk)
+      IF (zchk(1) == 0._wp) CALL ctl_stop( 'STOP', 'open sea seed is on land, please update namelist (rn_lon_opnsea,rn_lat_opnsea)' ) 
+
+      !! print
+      IF (lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'open ocean: '
+         WRITE(numout,'(a,2f7.2)')'    lon/lat seed to detect main ocean is: ', rn_lon_opnsea, rn_lat_opnsea
+         WRITE(numout,'(a,2i7)'  )'    i/j     seed to detect main ocean is: ', jiseed, jjseed
+         WRITE(numout,'(a,f8.0)' )'    distance (m) between namelist seed location and model seed location: ', zdistseed
+         WRITE(numout,*)
+      END IF
+      
+      !! 1.3 set to 0 everything >0 and revert mask
+      WHERE (msk_opnsea(:,:) > 0._wp) msk_opnsea(:,:) = 0._wp ! mask all closed seas
+      WHERE (msk_opnsea(:,:) < 0._wp) msk_opnsea(:,:) = 1._wp ! restore mask value
+
+      !! 1.4 Define closed sea mask (all of them, ie defined in the namelist or not)
+      !! needed to remove the undefined closed seas at the end
+      msk_csundef(:,:) = ( ssmask(:,:) - msk_opnsea(:,:) ) * 99._wp
+
+      !!----------------------------------------------------------------------
+      !! 2 : compute closed sea mask for global, rnf and emp cases
+      !!----------------------------------------------------------------------
+
+      !! 2.1 : initialisation of masks and lake indexes
+      jglo = 1 ; jrnf = 1 ; jemp = 1
+      !! mask used to group lake by net evap/precip distribution technics
+      msk_csglo(:,:) = msk_csundef(:,:)
+      msk_csrnf(:,:) = msk_csundef(:,:)
+      msk_csemp(:,:) = msk_csundef(:,:)
+
+      !! mask used to define group of lake sharing the same river mouth
+      msk_csgrpglo(:,:) = 0.0_wp
+      msk_csgrprnf(:,:) = 0.0_wp
+      msk_csgrpemp(:,:) = 0.0_wp
+
+      IF (lwp) WRITE(numout,*)'closed seas: '
+ 
+      DO jcs = 1,nn_closea
+
+         !! how the excess of the closed seas is spread out:
+         cloc = sn_lake(jcs)%cloctrg
+         csch = sn_lake(jcs)%cschtrg
+
+         !! set up indexes and mask
+         SELECT CASE (csch)
+         CASE('glo')
+            jsch = jglo
+            zmsksrc(:,:) = msk_csglo(:,:)
+            zmsktrg(:,:) = msk_csgrpglo(:,:)
+         CASE('rnf') 
+            jsch = jrnf
+            zmsksrc(:,:) = msk_csrnf(:,:)
+            zmsktrg(:,:) = msk_csgrprnf(:,:)
+         CASE('emp')
+            jsch = jemp 
+            zmsksrc(:,:) = msk_csemp(:,:)
+            zmsktrg(:,:) = msk_csgrpemp(:,:)
+         CASE DEFAULT
+            CALL ctl_stop( 'STOP', 'domclo: ',TRIM(csch),' is an unknown target type for lake (should be glo, emp, rnf)' )
+         END SELECT
+
+         !! 2.2 : print out and sanity check
+         !! flag changed in sanity checks
+         lskip = .FALSE.
+
+         !! define seed to extract the closed sea jcs
+         CALL dom_ngb(sn_lake(jcs)%rlonsrc, sn_lake(jcs)%rlatsrc, jiseed, jjseed, zdistseed, 'T')
+
+         !! sanity check on the msk value (closea mask should be 99 otherwise, lake already processed)
+         !! check if seed on land or lake already processed
+         zchk = 0._wp
+         IF (mi0(jiseed) == mi1(jiseed) .AND. mj0(jjseed) == mj1(jjseed)) zchk = msk_csundef(mi0(jiseed),mj0(jjseed))
+         CALL mpp_max('domclo',zchk)
+         
+         IF (zchk(1) /= 99._wp) THEN
+            IF (lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*)'W A R N I N G: lake ',TRIM(sn_lake(jcs)%cname),' already processed or seed on land, we skip it.'
+               WRITE(numout,*)'It is possible this lake is connected to another one already processed.'
+               WRITE(numout,*)'It is possible the seed is on land because the lake is not present in the bathymetry file'
+               WRITE(numout,*)'If concerned about it, check input file and namelist definition of this lake.'
+            END IF
+            lskip = .TRUE.
+         END IF
+ 
+         !! 2.3 : compute mask for global, rnf, emp case
+         IF (.NOT. lskip) THEN
+
+            IF (lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,'(a,a10,a,2f7.2,a,2i6,a,f7.2,a)')                               &
+                    &         '    processing lake ',TRIM(sn_lake(jcs)%cname)               &
+                    &        ,' ( lat/lon : ',sn_lake(jcs)%rlatsrc, sn_lake(jcs)%rlonsrc    &
+                    &        ,' , i/j     : ',jiseed,jjseed                                 &
+                    &        ,' , distance to seed : ',zdistseed,'m )'
+            END IF
+
+            !! fill close sea mask with counter value
+            !! and update undefined closed sea mask
+            CALL fill_pool( jiseed, jjseed, zmsksrc, REAL(jsch  ,8))
+            WHERE (zmsksrc(:,:) == REAL(jsch,8))
+               msk_csundef = 0._wp
+               zmsktrg    = sn_lake(jcs)%idtrg
+            END WHERE
+
+            !! compute location of river mouth and distance to river mouth
+            IF (cloc /= 'global') THEN
+
+               !! set value for radius of the river influence
+               zradtrg = 0._wp
+               IF (mi0(jiseed) == mi1(jiseed) .AND. mj0(jjseed) == mj1(jjseed)) THEN
+                  zradtrg(1) = MAX( sn_lake(jcs)%radtrg, e1t( mi0(jiseed), mj0(jjseed) ), e2t( mi0(jiseed), mj0(jjseed) ) )
+               END IF
+               CALL mpp_max('domclo',zradtrg)
+              
+               !! compute seed location for print 
+               CALL dom_ngb(sn_lake(jcs)%rlontrg, sn_lake(jcs)%rlattrg, jiseed, jjseed, zdistseed, 'T')
+
+               !! compute distance to river mouth
+               zdist(:,:) = dist(sn_lake(jcs)%rlontrg, sn_lake(jcs)%rlattrg, glamt, gphit)
+
+            END IF
+
+            !! define estuary
+            !! deal with global/local/coastal cases
+            SELECT CASE (cloc)
+            CASE ('global')
+               WHERE (msk_opnsea(:,:) == 1._wp) zmsktrg = sn_lake(jcs)%idtrg
+
+            CASE ('local')
+               !! compute mask
+               WHERE (zdist(:,:) < zradtrg(1) .AND. msk_opnsea(:,:) == 1 ) zmsktrg = sn_lake(jcs)%idtrg
+
+               !! print
+               IF (lwp) WRITE(numout,'(a,f7.0,a,2f7.2,a,2i7,a,f7.0,a)')                                            &
+                             &         '         river mouth area is defined by         points within ',zradtrg(1) &
+                             &        ,' m of lat/lon ', sn_lake(jcs)%rlontrg, sn_lake(jcs)%rlattrg                &
+                             &        ,' (closest wet point is i/j ',jiseed, jjseed,' at ',zdistseed,' m )'
+            CASE ('coast')
+               !! define coastline mask
+               zmsk_coastline = 0._wp
+               DO jj=2,jpj-1
+                  DO ji=2,jpi-1
+                     IF ( ssmask(ji,jj) == 1._wp .AND. SUM(ssmask(ji-1:ji+1,jj-1:jj+1)) < 9 ) zmsk_coastline(ji,jj) = 1._wp
+                  END DO
+               END DO
+               CALL lbc_lnk('domclo', zmsk_coastline,'T',1._wp)
+   
+               !! compute mask
+               WHERE ( zdist(:,:) < zradtrg(1) .AND. zmsk_coastline(:,:) == 1 .AND. msk_opnsea(:,:) == 1 ) zmsktrg = sn_lake(jcs)%idtrg
+
+               !! print
+               IF (lwp) WRITE(numout,'(a,f7.0,a,2f7.2,a,2i7,a,f7.0,a)')                                            &
+                             &         '         river mouth area is defined by coastal points within ',zradtrg(1) &
+                             &        ,' m of lat/lon ', sn_lake(jcs)%rlontrg, sn_lake(jcs)%rlattrg                &
+                             &        ,' (closest wet point is i/j ',jiseed, jjseed,' at ',zdistseed,' m )'
+
+            CASE DEFAULT
+               CALL ctl_stop( 'STOP', 'domclo: unknown target type for lake (should be global, coast or local)' )
+
+            END SELECT
+   
+            !! sanity check
+            zarea = glob_sum('domclo',zmsktrg * msk_opnsea)
+            IF (zarea == 0._wp) CALL ctl_stop( 'STOP', 'river mouth area is 0, tune lon/lat trg or radtrg for this lake') 
+            !
+            zarea = glob_sum('domclo',zmsksrc * msk_opnsea)
+            IF (zarea > 0._wp) CALL ctl_stop( 'STOP', 'closed seas and open ocean have common points, '                           &
+               &                                    , 'tune lon/lat src or check if your lake is really closed on the model grid')
+
+            !! set up indexes and mask 
+            SELECT CASE (csch)
+            CASE ('glo')
+               jglo = jglo + 1
+               msk_csglo(:,:)    = zmsksrc(:,:)
+               msk_csgrpglo(:,:) = zmsktrg(:,:)
+               IF (lwp) WRITE(numout,*)'        net evap/precip will be spread globally (glo)'
+            CASE ('rnf')
+               jrnf = jrnf + 1
+               msk_csrnf(:,:)    = zmsksrc(:,:)
+               msk_csgrprnf(:,:) = zmsktrg(:,:)
+               IF (lwp) WRITE(numout,*)'        net precip will be spread locally and net evap globally (rnf)'
+            CASE ('emp')
+               jemp = jemp + 1
+               msk_csemp(:,:)    = zmsksrc(:,:)
+               msk_csgrpemp(:,:) = zmsktrg(:,:)
+               IF (lwp) WRITE(numout,*)'        net evap/precip will be spread locally (emp)'
+            END SELECT
+
+         END IF ! lskip
+
+      END DO ! nn_closea
+
+      !!----------------------------------------------------------------------
+      !! 3 : clean the masks of possible remaining undefined closed seas
+      !!----------------------------------------------------------------------
+
+      !! mask all the cells not defined as closed sea
+      WHERE ( msk_csglo(:,:) == 99._wp )  msk_csglo = 0._wp
+      WHERE ( msk_csrnf(:,:) == 99._wp )  msk_csrnf = 0._wp
+      WHERE ( msk_csemp(:,:) == 99._wp )  msk_csemp = 0._wp
+
+      !!  non defined closed sea
+      WHERE ( msk_csundef(:,:) > 0._wp ) msk_csundef = 1._wp
+
+   END SUBROUTINE dom_clo
+
+   !!======================================================================
+
+END MODULE domclo
+
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domhgr.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domhgr.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domhgr.F90	(revision 12101)
@@ -0,0 +1,501 @@
+MODULE domhgr
+   !!==============================================================================
+   !!                       ***  MODULE domhgr   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! History :  OPA  ! 1988-03  (G. Madec) Original code
+   !!            7.0  ! 1996-01  (G. Madec)  terrain following coordinates
+   !!            8.0  ! 1997-02  (G. Madec)  print mesh informations
+   !!            8.1  ! 1999-11  (M. Imbard) NetCDF format with IO-IPSL
+   !!            8.2  ! 2000-08  (D. Ludicone) Reduced section at Bab el Mandeb
+   !!             -   ! 2001-09  (M. Levy)  eel config: grid in km, beta-plane
+   !!  NEMO      1.0  ! 2002-08  (G. Madec)  F90: Free form and module, namelist
+   !!             -   ! 2004-01  (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh)
+   !!                            use of parameters in par_CONFIG-Rxx.h90, not in namelist
+   !!             -   ! 2004-05  (A. Koch-Larrouy) Add Gyre configuration 
+   !!            3.7  ! 2015-09  (G. Madec, S. Flavoni) add cell surface and their inverse
+   !!                                       add optional read of e1e2u & e1e2v
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_hgr       : initialize the horizontal mesh 
+   !!   hgr_read      : read "coordinate" NetCDF file 
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE domwri         ! write 'meshmask.nc' & 'coordinate_e1e2u_v.nc' files
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   REAL(wp) ::   glam0, gphi0   ! variables corresponding to parameters ppglam0 ppgphi0 set in par_oce
+
+   PUBLIC   dom_hgr   ! called by domain.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: domhgr.F90 6140 2015-12-21 11:35:23Z timgraham $ 
+   !! Software governed by the CeCILL licence     (./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_hgr
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_hgr  ***
+      !!
+      !! ** Purpose :   Compute the geographical position (in degre) of the 
+      !!      model grid-points,  the horizontal scale factors (in meters) and 
+      !!      the Coriolis factor (in s-1).
+      !!
+      !! ** Method  :   The geographical position of the model grid-points is
+      !!      defined from analytical functions, fslam and fsphi, the deriva-
+      !!      tives of which gives the horizontal scale factors e1,e2.
+      !!      Defining two function fslam and fsphi and their derivatives in 
+      !!      the two horizontal directions (fse1 and fse2), the model grid-
+      !!      point position and scale factors are given by:
+      !!         t-point:
+      !!      glamt(i,j) = fslam(i    ,j    )   e1t(i,j) = fse1(i    ,j    )
+      !!      gphit(i,j) = fsphi(i    ,j    )   e2t(i,j) = fse2(i    ,j    )
+      !!         u-point:
+      !!      glamu(i,j) = fslam(i+1/2,j    )   e1u(i,j) = fse1(i+1/2,j    )
+      !!      gphiu(i,j) = fsphi(i+1/2,j    )   e2u(i,j) = fse2(i+1/2,j    )
+      !!         v-point:
+      !!      glamv(i,j) = fslam(i    ,j+1/2)   e1v(i,j) = fse1(i    ,j+1/2)
+      !!      gphiv(i,j) = fsphi(i    ,j+1/2)   e2v(i,j) = fse2(i    ,j+1/2)
+      !!            f-point:
+      !!      glamf(i,j) = fslam(i+1/2,j+1/2)   e1f(i,j) = fse1(i+1/2,j+1/2)
+      !!      gphif(i,j) = fsphi(i+1/2,j+1/2)   e2f(i,j) = fse2(i+1/2,j+1/2)
+      !!      Where fse1 and fse2 are defined by:
+      !!         fse1(i,j) = ra * rad * SQRT( (cos(phi) di(fslam))**2
+      !!                                     +          di(fsphi) **2 )(i,j)
+      !!         fse2(i,j) = ra * rad * SQRT( (cos(phi) dj(fslam))**2
+      !!                                     +          dj(fsphi) **2 )(i,j)
+      !!
+      !!        The coriolis factor is given at z-point by:
+      !!                     ff = 2.*omega*sin(gphif)      (in s-1)
+      !!
+      !!        This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model grid-point position and
+      !!      horizontal scale factors must be respected in order to insure
+      !!      second order accuracy schemes.
+      !!
+      !! N.B. If the domain is periodic, verify that scale factors are also
+      !!      periodic, and the coriolis term again.
+      !!
+      !! ** Action  : - define  glamt, glamu, glamv, glamf: longitude of t-, 
+      !!                u-, v- and f-points (in degre)
+      !!              - define  gphit, gphiu, gphiv, gphit: latitude  of t-,
+      !!               u-, v-  and f-points (in degre)
+      !!        define e1t, e2t, e1u, e2u, e1v, e2v, e1f, e2f: horizontal
+      !!      scale factors (in meters) at t-, u-, v-, and f-points.
+      !!        define ff: coriolis factor at f-point
+      !!
+      !! References :   Marti, Madec and Delecluse, 1992, JGR
+      !!                Madec, Imbard, 1996, Clim. Dyn.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers
+      INTEGER  ::   ijeq                 ! index of equator T point (used in case 4)
+      REAL(wp) ::   zti, zui, zvi, zfi   ! local scalars
+      REAL(wp) ::   ztj, zuj, zvj, zfj   !   -      -
+      REAL(wp) ::   zphi0, zbeta, znorme !
+      REAL(wp) ::   zarg, zf0, zminff, zmaxff
+      REAL(wp) ::   zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg
+      REAL(wp) ::   zphi1, zsin_alpha, zim05, zjm05
+      INTEGER  ::   isrow                ! index for ORCA1 starting row
+      INTEGER  ::   ie1e2u_v             ! fag for u- & v-surface read in coordinate file or not
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_hgr : define the horizontal mesh from ithe following par_oce parameters '
+         WRITE(numout,*) '~~~~~~~      type of horizontal mesh           jphgr_msh = ', jphgr_msh
+         WRITE(numout,*) '             position of the first row and     ppglam0  = ', ppglam0
+         WRITE(numout,*) '             column grid-point (degrees)       ppgphi0  = ', ppgphi0
+         WRITE(numout,*) '             zonal      grid-spacing (degrees) ppe1_deg = ', ppe1_deg
+         WRITE(numout,*) '             meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg
+         WRITE(numout,*) '             zonal      grid-spacing (meters)  ppe1_m   = ', ppe1_m  
+         WRITE(numout,*) '             meridional grid-spacing (meters)  ppe2_m   = ', ppe2_m  
+      ENDIF
+      !
+      !
+      SELECT CASE( jphgr_msh )   !  type of horizontal mesh  
+      !
+      CASE ( 0 )                     !==  read in coordinate.nc file  ==!
+         !
+#if defined key_agrif
+         IF (agrif_root()) THEN
+#endif
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file'
+         !
+         ie1e2u_v = 0                  ! set to unread e1e2u and e1e2v
+         !
+         CALL hgr_read( ie1e2u_v )     ! read the coordinate.nc file
+         !
+         IF( ie1e2u_v == 0 ) THEN      ! e1e2u and e1e2v have not been read: compute them
+            !                          ! e2u and e1v does not include a reduction in some strait: apply reduction
+            e1e2u (:,:) = e1u(:,:) * e2u(:,:)   
+            e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
+         ENDIF
+#if defined key_agrif
+         ELSE
+           CALL Agrif_InitValues_cont()
+         ENDIF
+#endif
+         !
+      CASE ( 1 )                     !==  geographical mesh on the sphere with regular (in degree) grid-spacing  ==!
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing'
+         IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg' 
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - 1 + njmpp - 1 )
+               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - 1 + njmpp - 1 )
+               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - 1 + njmpp - 1 ) + 0.5
+               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - 1 + njmpp - 1 ) + 0.5
+         ! Longitude
+               glamt(ji,jj) = ppglam0 + ppe1_deg * zti
+               glamu(ji,jj) = ppglam0 + ppe1_deg * zui
+               glamv(ji,jj) = ppglam0 + ppe1_deg * zvi
+               glamf(ji,jj) = ppglam0 + ppe1_deg * zfi
+         ! Latitude
+               gphit(ji,jj) = ppgphi0 + ppe2_deg * ztj
+               gphiu(ji,jj) = ppgphi0 + ppe2_deg * zuj
+               gphiv(ji,jj) = ppgphi0 + ppe2_deg * zvj
+               gphif(ji,jj) = ppgphi0 + ppe2_deg * zfj
+         ! e1
+               e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
+               e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
+               e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
+               e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
+         ! e2
+               e2t(ji,jj) = ra * rad * ppe2_deg
+               e2u(ji,jj) = ra * rad * ppe2_deg
+               e2v(ji,jj) = ra * rad * ppe2_deg
+               e2f(ji,jj) = ra * rad * ppe2_deg
+            END DO
+         END DO
+         !
+      CASE ( 2:3 )                   !==  f- or beta-plane with regular grid-spacing  ==!
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          f- or beta-plane with regular grid-spacing'
+         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m' 
+         !
+         ! Position coordinates (in kilometers)
+         !                          ==========
+         glam0 = 0._wp
+         gphi0 = - ppe2_m * 1.e-3
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 )       )
+               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) + 0.5 )
+               glamv(ji,jj) = glamt(ji,jj)
+               glamf(ji,jj) = glamu(ji,jj)
+               !
+               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 )       )
+               gphiu(ji,jj) = gphit(ji,jj)
+               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) + 0.5 )
+               gphif(ji,jj) = gphiv(ji,jj)
+            END DO
+         END DO
+         !
+         ! Horizontal scale factors (in meters)
+         !                              ======
+         e1t(:,:) = ppe1_m      ;      e2t(:,:) = ppe2_m
+         e1u(:,:) = ppe1_m      ;      e2u(:,:) = ppe2_m
+         e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m
+         e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m
+         !
+      CASE ( 4 )                     !==  geographical mesh on the sphere, isotropic MERCATOR type  ==!
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type'
+         IF(lwp) WRITE(numout,*) '          longitudinal/latitudinal spacing given by ppe1_deg'
+         IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' )
+         !
+         !  Find index corresponding to the equator, given the grid spacing e1_deg
+         !  and the (approximate) southern latitude ppgphi0.
+         !  This way we ensure that the equator is at a "T / U" point, when in the domain.
+         !  The formula should work even if the equator is outside the domain.
+         zarg = rpi / 4. - rpi / 180. * ppgphi0 / 2.
+         ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg )
+         IF(  ppgphi0 > 0 )  ijeq = -ijeq
+         !
+         IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', ijeq
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - ijeq + njmpp - 1 )
+               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - ijeq + njmpp - 1 )
+               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - ijeq + njmpp - 1 ) + 0.5
+               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - ijeq + njmpp - 1 ) + 0.5
+         ! Longitude
+               glamt(ji,jj) = ppglam0 + ppe1_deg * zti
+               glamu(ji,jj) = ppglam0 + ppe1_deg * zui
+               glamv(ji,jj) = ppglam0 + ppe1_deg * zvi
+               glamf(ji,jj) = ppglam0 + ppe1_deg * zfi
+         ! Latitude
+               gphit(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* ztj ) )
+               gphiu(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zuj ) )
+               gphiv(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zvj ) )
+               gphif(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zfj ) )
+         ! e1
+               e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
+               e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
+               e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
+               e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
+         ! e2
+               e2t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
+               e2u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
+               e2v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
+               e2f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
+            END DO
+         END DO
+         !
+      CASE ( 5 )                   !==  beta-plane with regular grid-spacing and rotated domain ==! (GYRE configuration)
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          beta-plane with regular grid-spacing and rotated domain (GYRE configuration)'
+         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m'
+         !
+         ! Position coordinates (in kilometers)
+         !                          ==========
+         !
+         ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN
+         zlam1 = -85._wp
+         zphi1 =  29._wp
+         ! resolution in meters
+         ze1 = 106000. / REAL( jp_cfg , wp )            
+         ! benchmark: forced the resolution to be about 100 km
+       !  IF( nbench /= 0 )   ze1 = 106000._wp     
+         zsin_alpha = - SQRT( 2._wp ) * 0.5_wp
+         zcos_alpha =   SQRT( 2._wp ) * 0.5_wp
+         ze1deg = ze1 / (ra * rad)
+       !  IF( nbench /= 0 )   ze1deg = ze1deg / REAL( jp_cfg , wp )   ! benchmark: keep the lat/+lon
+         !                                                           ! at the right jp_cfg resolution
+         glam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp )
+         gphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp )
+         !
+         IF( nprint==1 .AND. lwp )   THEN
+            WRITE(numout,*) '          ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha
+            WRITE(numout,*) '          ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0
+         ENDIF
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5
+               zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5
+               !
+               glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+               gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+               !
+               glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+               gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+               !
+               glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+               gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+               !
+               glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+               gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+            END DO
+         END DO
+         !
+         ! Horizontal scale factors (in meters)
+         !                              ======
+         e1t(:,:) =  ze1     ;      e2t(:,:) = ze1
+         e1u(:,:) =  ze1     ;      e2u(:,:) = ze1
+         e1v(:,:) =  ze1     ;      e2v(:,:) = ze1
+         e1f(:,:) =  ze1     ;      e2f(:,:) = ze1
+         !
+      CASE DEFAULT
+         WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh
+         CALL ctl_stop( ctmp1 )
+         !
+      END SELECT
+      
+      ! associated horizontal metrics
+      ! -----------------------------
+      !
+      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:)
+      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:)
+      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:)
+      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:)
+      !
+      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:)
+      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:)
+      IF( jphgr_msh /= 0 ) THEN               ! e1e2u and e1e2v have not been set: compute them
+         e1e2u (:,:) = e1u(:,:) * e2u(:,:)   
+         e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
+      ENDIF
+      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in both cases
+      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:)
+      !   
+      e2_e1u(:,:) = e2u(:,:) / e1u(:,:)
+      e1_e2v(:,:) = e1v(:,:) / e2v(:,:)
+
+      IF( lwp .AND. nn_print >=1 .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart)
+         WRITE(numout,*)
+         WRITE(numout,*) '          longitude and e1 scale factors'
+         WRITE(numout,*) '          ------------------------------'
+         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
+            glamv(ji,1), glamf(ji,1),   &
+            e1t(ji,1), e1u(ji,1),   &
+            e1v(ji,1), e1f(ji,1), ji = 1, jpi,10)
+9300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
+            f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 )
+            !
+         WRITE(numout,*)
+         WRITE(numout,*) '          latitude and e2 scale factors'
+         WRITE(numout,*) '          -----------------------------'
+         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   &
+            &                     gphiv(1,jj), gphif(1,jj),   &
+            &                     e2t  (1,jj), e2u  (1,jj),   &
+            &                     e2v  (1,jj), e2f  (1,jj), jj = 1, jpj, 10 )
+      ENDIF
+
+
+      ! ================= !
+      !  Coriolis factor  !
+      ! ================= !
+
+      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
+      !
+      CASE ( 0, 1, 4 )               ! mesh on the sphere
+         !
+         ff_f(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 
+         ff_t(:,:) = 2. * omega * SIN( rad * gphit(:,:) )     !    -        -       - at t-point
+         !
+      CASE ( 2 )                     ! f-plane at ppgphi0 
+         !
+         ff_f(:,:) = 2. * omega * SIN( rad * ppgphi0 )
+         ff_t(:,:) = 2. * omega * SIN( rad * ppgphi0 )
+         !
+         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff_f(1,1)
+         !
+      CASE ( 3 )                     ! beta-plane
+         !
+         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                       ! beta at latitude ppgphi0
+         zphi0   = ppgphi0 - REAL( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points
+         !
+         zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south
+         !
+         ff_f(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south)
+         ff_t(:,:) = ( zf0  + zbeta * gphit(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south)
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff_f(nldi,nldj)
+            WRITE(numout,*) '          Coriolis parameter varies from ', ff_f(nldi,nldj),' to ', ff_f(nldi,nlej)
+         ENDIF
+         IF( lk_mpp ) THEN 
+            zminff=ff_f(nldi,nldj)
+            zmaxff=ff_f(nldi,nlej)
+            CALL mpp_min( 'toto',zminff )   ! min over the global domain
+            CALL mpp_max( 'toto',zmaxff )   ! max over the global domain
+            IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff
+         END IF
+         !
+      CASE ( 5 )                     ! beta-plane and rotated domain (gyre configuration)
+         !
+         zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
+         zphi0 = 15._wp                                                     ! latitude of the first row F-points
+         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
+         !
+         ff_f(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
+         ff_t(:,:) = ( zf0 + zbeta * ABS( gphit(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) '          Beta-plane and rotated domain : '
+            WRITE(numout,*) '          Coriolis parameter varies in this processor from ', ff_f(nldi,nldj),' to ', ff_f(nldi,nlej)
+         ENDIF
+         !
+         IF( lk_mpp ) THEN 
+            zminff=ff_f(nldi,nldj)
+            zmaxff=ff_f(nldi,nlej)
+            CALL mpp_min('toto', zminff )   ! min over the global domain
+            CALL mpp_max( 'toto',zmaxff )   ! max over the global domain
+            IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff
+         END IF
+         !
+      END SELECT
+
+
+      ! Control of domain for symetrical condition
+      ! ------------------------------------------
+      ! The equator line must be the latitude coordinate axe
+! (PM) be carefull with nperio/jperio 
+      IF( jperio == 2 ) THEN
+         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi )
+         IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' )
+      ENDIF
+      !
+   END SUBROUTINE dom_hgr
+
+
+   SUBROUTINE hgr_read( ke1e2u_v )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE hgr_read  ***
+      !!
+      !! ** Purpose :   Read a coordinate file in NetCDF format using IOM
+      !!
+      !!----------------------------------------------------------------------
+      USE iom
+      !!
+      INTEGER, INTENT( inout ) ::   ke1e2u_v   ! fag: e1e2u & e1e2v read in coordinate file (=1) or not (=0)
+      !
+      INTEGER ::   inum   ! temporary logical unit
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'hgr_read : read the horizontal coordinates'
+         WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk
+      ENDIF
+      !
+      CALL iom_open( 'coordinates', inum )
+      !
+      CALL iom_get( inum, jpdom_data, 'glamt', glamt, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamu', glamu, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamv', glamv, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamf', glamf, lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'gphit', gphit, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphiu', gphiu, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphiv', gphiv, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphif', gphif, lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'e1t'  , e1t  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1u'  , e1u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1v'  , e1v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1f'  , e1f  , lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'e2t'  , e2t  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2u'  , e2u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2v'  , e2v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2f'  , e2f  , lrowattr=ln_use_jattr )
+      !
+      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN
+         IF(lwp) WRITE(numout,*) 'hgr_read : e1e2u & e1e2v read in coordinates file'
+         CALL iom_get( inum, jpdom_data, 'e1e2u'  , e1e2u  , lrowattr=ln_use_jattr )
+         CALL iom_get( inum, jpdom_data, 'e1e2v'  , e1e2v  , lrowattr=ln_use_jattr )
+         ke1e2u_v = 1
+      ELSE
+         ke1e2u_v = 0
+      ENDIF
+      !
+      CALL iom_close( inum )
+      
+    END SUBROUTINE hgr_read
+    
+   !!======================================================================
+END MODULE domhgr
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domhgr.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domhgr.f90	(revision 12100)
+++ 	(revision )
@@ -1,498 +1,0 @@
-MODULE domhgr
-   !!==============================================================================
-   !!                       ***  MODULE domhgr   ***
-   !! Ocean initialization : domain initialization
-   !!==============================================================================
-   !! History :  OPA  ! 1988-03  (G. Madec) Original code
-   !!            7.0  ! 1996-01  (G. Madec)  terrain following coordinates
-   !!            8.0  ! 1997-02  (G. Madec)  print mesh informations
-   !!            8.1  ! 1999-11  (M. Imbard) NetCDF format with IO-IPSL
-   !!            8.2  ! 2000-08  (D. Ludicone) Reduced section at Bab el Mandeb
-   !!             -   ! 2001-09  (M. Levy)  eel config: grid in km, beta-plane
-   !!  NEMO      1.0  ! 2002-08  (G. Madec)  F90: Free form and module, namelist
-   !!             -   ! 2004-01  (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh)
-   !!                            use of parameters in par_CONFIG-Rxx.h90, not in namelist
-   !!             -   ! 2004-05  (A. Koch-Larrouy) Add Gyre configuration 
-   !!            3.7  ! 2015-09  (G. Madec, S. Flavoni) add cell surface and their inverse
-   !!                                       add optional read of e1e2u & e1e2v
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dom_hgr       : initialize the horizontal mesh 
-   !!   hgr_read      : read "coordinate" NetCDF file 
-   !!----------------------------------------------------------------------
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants
-   USE domwri         ! write 'meshmask.nc' & 'coordinate_e1e2u_v.nc' files
-   !
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   REAL(wp) ::   glam0, gphi0   ! variables corresponding to parameters ppglam0 ppgphi0 set in par_oce
-
-   PUBLIC   dom_hgr   ! called by domain.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: domhgr.F90 6140 2015-12-21 11:35:23Z timgraham $ 
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dom_hgr
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_hgr  ***
-      !!
-      !! ** Purpose :   Compute the geographical position (in degre) of the 
-      !!      model grid-points,  the horizontal scale factors (in meters) and 
-      !!      the Coriolis factor (in s-1).
-      !!
-      !! ** Method  :   The geographical position of the model grid-points is
-      !!      defined from analytical functions, fslam and fsphi, the deriva-
-      !!      tives of which gives the horizontal scale factors e1,e2.
-      !!      Defining two function fslam and fsphi and their derivatives in 
-      !!      the two horizontal directions (fse1 and fse2), the model grid-
-      !!      point position and scale factors are given by:
-      !!         t-point:
-      !!      glamt(i,j) = fslam(i    ,j    )   e1t(i,j) = fse1(i    ,j    )
-      !!      gphit(i,j) = fsphi(i    ,j    )   e2t(i,j) = fse2(i    ,j    )
-      !!         u-point:
-      !!      glamu(i,j) = fslam(i+1/2,j    )   e1u(i,j) = fse1(i+1/2,j    )
-      !!      gphiu(i,j) = fsphi(i+1/2,j    )   e2u(i,j) = fse2(i+1/2,j    )
-      !!         v-point:
-      !!      glamv(i,j) = fslam(i    ,j+1/2)   e1v(i,j) = fse1(i    ,j+1/2)
-      !!      gphiv(i,j) = fsphi(i    ,j+1/2)   e2v(i,j) = fse2(i    ,j+1/2)
-      !!            f-point:
-      !!      glamf(i,j) = fslam(i+1/2,j+1/2)   e1f(i,j) = fse1(i+1/2,j+1/2)
-      !!      gphif(i,j) = fsphi(i+1/2,j+1/2)   e2f(i,j) = fse2(i+1/2,j+1/2)
-      !!      Where fse1 and fse2 are defined by:
-      !!         fse1(i,j) = ra * rad * SQRT( (cos(phi) di(fslam))**2
-      !!                                     +          di(fsphi) **2 )(i,j)
-      !!         fse2(i,j) = ra * rad * SQRT( (cos(phi) dj(fslam))**2
-      !!                                     +          dj(fsphi) **2 )(i,j)
-      !!
-      !!        The coriolis factor is given at z-point by:
-      !!                     ff = 2.*omega*sin(gphif)      (in s-1)
-      !!
-      !!        This routine is given as an example, it must be modified
-      !!      following the user s desiderata. nevertheless, the output as
-      !!      well as the way to compute the model grid-point position and
-      !!      horizontal scale factors must be respected in order to insure
-      !!      second order accuracy schemes.
-      !!
-      !! N.B. If the domain is periodic, verify that scale factors are also
-      !!      periodic, and the coriolis term again.
-      !!
-      !! ** Action  : - define  glamt, glamu, glamv, glamf: longitude of t-, 
-      !!                u-, v- and f-points (in degre)
-      !!              - define  gphit, gphiu, gphiv, gphit: latitude  of t-,
-      !!               u-, v-  and f-points (in degre)
-      !!        define e1t, e2t, e1u, e2u, e1v, e2v, e1f, e2f: horizontal
-      !!      scale factors (in meters) at t-, u-, v-, and f-points.
-      !!        define ff: coriolis factor at f-point
-      !!
-      !! References :   Marti, Madec and Delecluse, 1992, JGR
-      !!                Madec, Imbard, 1996, Clim. Dyn.
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj               ! dummy loop indices
-      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers
-      INTEGER  ::   ijeq                 ! index of equator T point (used in case 4)
-      REAL(wp) ::   zti, zui, zvi, zfi   ! local scalars
-      REAL(wp) ::   ztj, zuj, zvj, zfj   !   -      -
-      REAL(wp) ::   zphi0, zbeta, znorme !
-      REAL(wp) ::   zarg, zf0, zminff, zmaxff
-      REAL(wp) ::   zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg
-      REAL(wp) ::   zphi1, zsin_alpha, zim05, zjm05
-      INTEGER  ::   isrow                ! index for ORCA1 starting row
-      INTEGER  ::   ie1e2u_v             ! fag for u- & v-surface read in coordinate file or not
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_hgr')
-      !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_hgr : define the horizontal mesh from ithe following par_oce parameters '
-         WRITE(numout,*) '~~~~~~~      type of horizontal mesh           jphgr_msh = ', jphgr_msh
-         WRITE(numout,*) '             position of the first row and     ppglam0  = ', ppglam0
-         WRITE(numout,*) '             column grid-point (degrees)       ppgphi0  = ', ppgphi0
-         WRITE(numout,*) '             zonal      grid-spacing (degrees) ppe1_deg = ', ppe1_deg
-         WRITE(numout,*) '             meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg
-         WRITE(numout,*) '             zonal      grid-spacing (meters)  ppe1_m   = ', ppe1_m  
-         WRITE(numout,*) '             meridional grid-spacing (meters)  ppe2_m   = ', ppe2_m  
-      ENDIF
-      !
-      !
-      SELECT CASE( jphgr_msh )   !  type of horizontal mesh  
-      !
-      CASE ( 0 )                     !==  read in coordinate.nc file  ==!
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file'
-         !
-         ie1e2u_v = 0                  ! set to unread e1e2u and e1e2v
-         !
-         CALL hgr_read( ie1e2u_v )     ! read the coordinate.nc file
-         !
-         IF( ie1e2u_v == 0 ) THEN      ! e1e2u and e1e2v have not been read: compute them
-            !                          ! e2u and e1v does not include a reduction in some strait: apply reduction
-            e1e2u (:,:) = e1u(:,:) * e2u(:,:)   
-            e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
-         ENDIF
-         !
-      CASE ( 1 )                     !==  geographical mesh on the sphere with regular (in degree) grid-spacing  ==!
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing'
-         IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg' 
-         !
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - 1 + njmpp - 1 )
-               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - 1 + njmpp - 1 )
-               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - 1 + njmpp - 1 ) + 0.5
-               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - 1 + njmpp - 1 ) + 0.5
-         ! Longitude
-               glamt(ji,jj) = ppglam0 + ppe1_deg * zti
-               glamu(ji,jj) = ppglam0 + ppe1_deg * zui
-               glamv(ji,jj) = ppglam0 + ppe1_deg * zvi
-               glamf(ji,jj) = ppglam0 + ppe1_deg * zfi
-         ! Latitude
-               gphit(ji,jj) = ppgphi0 + ppe2_deg * ztj
-               gphiu(ji,jj) = ppgphi0 + ppe2_deg * zuj
-               gphiv(ji,jj) = ppgphi0 + ppe2_deg * zvj
-               gphif(ji,jj) = ppgphi0 + ppe2_deg * zfj
-         ! e1
-               e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
-               e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
-               e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
-               e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
-         ! e2
-               e2t(ji,jj) = ra * rad * ppe2_deg
-               e2u(ji,jj) = ra * rad * ppe2_deg
-               e2v(ji,jj) = ra * rad * ppe2_deg
-               e2f(ji,jj) = ra * rad * ppe2_deg
-            END DO
-         END DO
-         !
-      CASE ( 2:3 )                   !==  f- or beta-plane with regular grid-spacing  ==!
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          f- or beta-plane with regular grid-spacing'
-         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m' 
-         !
-         ! Position coordinates (in kilometers)
-         !                          ==========
-         glam0 = 0._wp
-         gphi0 = - ppe2_m * 1.e-3
-         !
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 )       )
-               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) + 0.5 )
-               glamv(ji,jj) = glamt(ji,jj)
-               glamf(ji,jj) = glamu(ji,jj)
-               !
-               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 )       )
-               gphiu(ji,jj) = gphit(ji,jj)
-               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) + 0.5 )
-               gphif(ji,jj) = gphiv(ji,jj)
-            END DO
-         END DO
-         !
-         ! Horizontal scale factors (in meters)
-         !                              ======
-         e1t(:,:) = ppe1_m      ;      e2t(:,:) = ppe2_m
-         e1u(:,:) = ppe1_m      ;      e2u(:,:) = ppe2_m
-         e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m
-         e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m
-         !
-      CASE ( 4 )                     !==  geographical mesh on the sphere, isotropic MERCATOR type  ==!
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type'
-         IF(lwp) WRITE(numout,*) '          longitudinal/latitudinal spacing given by ppe1_deg'
-         IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' )
-         !
-         !  Find index corresponding to the equator, given the grid spacing e1_deg
-         !  and the (approximate) southern latitude ppgphi0.
-         !  This way we ensure that the equator is at a "T / U" point, when in the domain.
-         !  The formula should work even if the equator is outside the domain.
-         zarg = rpi / 4. - rpi / 180. * ppgphi0 / 2.
-         ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg )
-         IF(  ppgphi0 > 0 )  ijeq = -ijeq
-         !
-         IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', ijeq
-         !
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - ijeq + njmpp - 1 )
-               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - ijeq + njmpp - 1 )
-               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - ijeq + njmpp - 1 ) + 0.5
-               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - ijeq + njmpp - 1 ) + 0.5
-         ! Longitude
-               glamt(ji,jj) = ppglam0 + ppe1_deg * zti
-               glamu(ji,jj) = ppglam0 + ppe1_deg * zui
-               glamv(ji,jj) = ppglam0 + ppe1_deg * zvi
-               glamf(ji,jj) = ppglam0 + ppe1_deg * zfi
-         ! Latitude
-               gphit(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* ztj ) )
-               gphiu(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zuj ) )
-               gphiv(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zvj ) )
-               gphif(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zfj ) )
-         ! e1
-               e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
-               e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
-               e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
-               e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
-         ! e2
-               e2t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
-               e2u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
-               e2v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
-               e2f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
-            END DO
-         END DO
-         !
-      CASE ( 5 )                   !==  beta-plane with regular grid-spacing and rotated domain ==! (GYRE configuration)
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          beta-plane with regular grid-spacing and rotated domain (GYRE configuration)'
-         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m'
-         !
-         ! Position coordinates (in kilometers)
-         !                          ==========
-         !
-         ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN
-         zlam1 = -85._wp
-         zphi1 =  29._wp
-         ! resolution in meters
-         ze1 = 106000. / REAL( jp_cfg , wp )            
-         ! benchmark: forced the resolution to be about 100 km
-         IF( nbench /= 0 )   ze1 = 106000._wp     
-         zsin_alpha = - SQRT( 2._wp ) * 0.5_wp
-         zcos_alpha =   SQRT( 2._wp ) * 0.5_wp
-         ze1deg = ze1 / (ra * rad)
-         IF( nbench /= 0 )   ze1deg = ze1deg / REAL( jp_cfg , wp )   ! benchmark: keep the lat/+lon
-         !                                                           ! at the right jp_cfg resolution
-         glam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp )
-         gphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp )
-         !
-         IF( nprint==1 .AND. lwp )   THEN
-            WRITE(numout,*) '          ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha
-            WRITE(numout,*) '          ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0
-         ENDIF
-         !
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5
-               zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5
-               !
-               glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
-               gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
-               !
-               glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
-               gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
-               !
-               glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
-               gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
-               !
-               glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
-               gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
-            END DO
-         END DO
-         !
-         ! Horizontal scale factors (in meters)
-         !                              ======
-         e1t(:,:) =  ze1     ;      e2t(:,:) = ze1
-         e1u(:,:) =  ze1     ;      e2u(:,:) = ze1
-         e1v(:,:) =  ze1     ;      e2v(:,:) = ze1
-         e1f(:,:) =  ze1     ;      e2f(:,:) = ze1
-         !
-      CASE DEFAULT
-         WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh
-         CALL ctl_stop( ctmp1 )
-         !
-      END SELECT
-      
-      ! associated horizontal metrics
-      ! -----------------------------
-      !
-      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:)
-      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:)
-      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:)
-      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:)
-      !
-      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:)
-      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:)
-      IF( jphgr_msh /= 0 ) THEN               ! e1e2u and e1e2v have not been set: compute them
-         e1e2u (:,:) = e1u(:,:) * e2u(:,:)   
-         e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
-      ENDIF
-      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in both cases
-      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:)
-      !   
-      e2_e1u(:,:) = e2u(:,:) / e1u(:,:)
-      e1_e2v(:,:) = e1v(:,:) / e2v(:,:)
-
-      IF( lwp .AND. nn_print >=1 .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart)
-         WRITE(numout,*)
-         WRITE(numout,*) '          longitude and e1 scale factors'
-         WRITE(numout,*) '          ------------------------------'
-         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
-            glamv(ji,1), glamf(ji,1),   &
-            e1t(ji,1), e1u(ji,1),   &
-            e1v(ji,1), e1f(ji,1), ji = 1, jpi,10)
-9300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
-            f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 )
-            !
-         WRITE(numout,*)
-         WRITE(numout,*) '          latitude and e2 scale factors'
-         WRITE(numout,*) '          -----------------------------'
-         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   &
-            &                     gphiv(1,jj), gphif(1,jj),   &
-            &                     e2t  (1,jj), e2u  (1,jj),   &
-            &                     e2v  (1,jj), e2f  (1,jj), jj = 1, jpj, 10 )
-      ENDIF
-
-
-      ! ================= !
-      !  Coriolis factor  !
-      ! ================= !
-
-      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
-      !
-      CASE ( 0, 1, 4 )               ! mesh on the sphere
-         !
-         ff_f(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 
-         ff_t(:,:) = 2. * omega * SIN( rad * gphit(:,:) )     !    -        -       - at t-point
-         !
-      CASE ( 2 )                     ! f-plane at ppgphi0 
-         !
-         ff_f(:,:) = 2. * omega * SIN( rad * ppgphi0 )
-         ff_t(:,:) = 2. * omega * SIN( rad * ppgphi0 )
-         !
-         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff_f(1,1)
-         !
-      CASE ( 3 )                     ! beta-plane
-         !
-         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                       ! beta at latitude ppgphi0
-         zphi0   = ppgphi0 - REAL( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points
-         !
-         zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south
-         !
-         ff_f(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south)
-         ff_t(:,:) = ( zf0  + zbeta * gphit(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south)
-         !
-         IF(lwp) THEN
-            WRITE(numout,*) 
-            WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff_f(nldi,nldj)
-            WRITE(numout,*) '          Coriolis parameter varies from ', ff_f(nldi,nldj),' to ', ff_f(nldi,nlej)
-         ENDIF
-         IF( lk_mpp ) THEN 
-            zminff=ff_f(nldi,nldj)
-            zmaxff=ff_f(nldi,nlej)
-            CALL mpp_min( zminff )   ! min over the global domain
-            CALL mpp_max( zmaxff )   ! max over the global domain
-            IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff
-         END IF
-         !
-      CASE ( 5 )                     ! beta-plane and rotated domain (gyre configuration)
-         !
-         zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
-         zphi0 = 15._wp                                                     ! latitude of the first row F-points
-         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
-         !
-         ff_f(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
-         ff_t(:,:) = ( zf0 + zbeta * ABS( gphit(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
-         !
-         IF(lwp) THEN
-            WRITE(numout,*) 
-            WRITE(numout,*) '          Beta-plane and rotated domain : '
-            WRITE(numout,*) '          Coriolis parameter varies in this processor from ', ff_f(nldi,nldj),' to ', ff_f(nldi,nlej)
-         ENDIF
-         !
-         IF( lk_mpp ) THEN 
-            zminff=ff_f(nldi,nldj)
-            zmaxff=ff_f(nldi,nlej)
-            CALL mpp_min( zminff )   ! min over the global domain
-            CALL mpp_max( zmaxff )   ! max over the global domain
-            IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff
-         END IF
-         !
-      END SELECT
-
-
-      ! Control of domain for symetrical condition
-      ! ------------------------------------------
-      ! The equator line must be the latitude coordinate axe
-
-      IF( nperio == 2 ) THEN
-         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi )
-         IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' )
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_hgr')
-      !
-   END SUBROUTINE dom_hgr
-
-
-   SUBROUTINE hgr_read( ke1e2u_v )
-      !!---------------------------------------------------------------------
-      !!              ***  ROUTINE hgr_read  ***
-      !!
-      !! ** Purpose :   Read a coordinate file in NetCDF format using IOM
-      !!
-      !!----------------------------------------------------------------------
-      USE iom
-      !!
-      INTEGER, INTENT( inout ) ::   ke1e2u_v   ! fag: e1e2u & e1e2v read in coordinate file (=1) or not (=0)
-      !
-      INTEGER ::   inum   ! temporary logical unit
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'hgr_read : read the horizontal coordinates'
-         WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk
-      ENDIF
-      !
-      CALL iom_open( 'coordinates', inum )
-      !
-      CALL iom_get( inum, jpdom_data, 'glamt', glamt, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'glamu', glamu, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'glamv', glamv, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'glamf', glamf, lrowattr=ln_use_jattr )
-      !
-      CALL iom_get( inum, jpdom_data, 'gphit', gphit, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'gphiu', gphiu, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'gphiv', gphiv, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'gphif', gphif, lrowattr=ln_use_jattr )
-      !
-      CALL iom_get( inum, jpdom_data, 'e1t'  , e1t  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e1u'  , e1u  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e1v'  , e1v  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e1f'  , e1f  , lrowattr=ln_use_jattr )
-      !
-      CALL iom_get( inum, jpdom_data, 'e2t'  , e2t  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e2u'  , e2u  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e2v'  , e2v  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e2f'  , e2f  , lrowattr=ln_use_jattr )
-      !
-      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN
-         IF(lwp) WRITE(numout,*) 'hgr_read : e1e2u & e1e2v read in coordinates file'
-         CALL iom_get( inum, jpdom_data, 'e1e2u'  , e1e2u  , lrowattr=ln_use_jattr )
-         CALL iom_get( inum, jpdom_data, 'e1e2v'  , e1e2v  , lrowattr=ln_use_jattr )
-         ke1e2u_v = 1
-      ELSE
-         ke1e2u_v = 0
-      ENDIF
-      !
-      CALL iom_close( inum )
-      
-    END SUBROUTINE hgr_read
-    
-   !!======================================================================
-END MODULE domhgr
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domisf.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domisf.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domisf.F90	(revision 12101)
@@ -0,0 +1,568 @@
+MODULE domisf
+   !!==============================================================================
+   !!                       ***  MODULE domisf   ***
+   !! Ocean domain : 
+   !!==============================================================================
+   !! History :  4.1  ! 2019-07  (P. Mathiot) re-write of the geometry definition under ice shelf
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   zgr_isf_nam    : read ice shelf namelist; print and compatibility option check
+   !!   zgr_isf_zspace : check compatibility between bathymetry and ice shelf draft and adjust ice shelf draft if needed (z space) 
+   !!   zgr_isf_kspace : adjust ice shelf draft and compute top level to fit 2 cell in the water column (k space) 
+   !!   zgr_isf        : compute top partial cell scale factor
+   !!   zgr_isf_e3uv_w : correct e3uw and e3vw in case of 2 cell in water column under an ice shelf
+   !!---------------------------------------------------------------------
+   USE dom_oce
+   USE domutil           ! flood filling algorithm
+   USE domngb            ! find nearest neighbourg
+   USE in_out_manager    ! I/O manager
+   USE lbclnk            ! lbclnk and lbclnk_multi
+   USE lib_mpp           ! 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zgr_isf_nam    !: read domisf namelist
+   PUBLIC   zgr_isf_zspace !: check compatibility ice shelf draft/bathymetry and dig ice shelf draft if needed
+   PUBLIC   zgr_isf_kspace !: compute misfdep and dig ice shelf draft if needed
+   PUBLIC   zps_isf        !: compute zps scale factor
+   PUBLIC   zps_isf_e3uv_w !: compute e3uw and e3vw in case of 2 cell in water column
+   PUBLIC   zgr_isf_subgl
+
+   INTEGER          :: nn_kisfmax    = 999              !: maximal number of level change allowed by ln_isfconnect option 
+   REAL(wp), PUBLIC :: rn_isfdep_min = 10.0_wp          !: ice shelf minimal thickness 
+   REAL(wp), PUBLIC :: rn_glhw_min   = 1.0e-3           !: threshold on hw to define grounding line water
+   REAL(wp), PUBLIC :: rn_isfhw_min  = 1.0e-3           !: threshold on hw to define isf draft into the cavity
+   REAL(wp), PUBLIC :: rn_isfshallow = 0.0_wp           !: threshold to define shallow ice shelf cavity
+   REAL(wp), PUBLIC :: rn_zisfmax    = 6000.0_wp        !: maximun meter of ice we are allowed to dig to assure connectivity
+   REAL(wp), PUBLIC :: rn_isfsubgllon, rn_isfsubgllat   !: seed for the detection of the 3d open ocean
+   LOGICAL , PUBLIC :: ln_isfcheminey= .FALSE.          !: remove cheminey
+   LOGICAL , PUBLIC :: ln_isfconnect = .FALSE.          !: assure connectivity 
+   LOGICAL , PUBLIC :: ln_isfchannel = .FALSE.          !: remove channel in water column (on z space not level space)
+   LOGICAL , PUBLIC :: ln_isfsubgl   = .FALSE.          !: remove subglacial lakes
+
+CONTAINS
+
+   SUBROUTINE zgr_isf_nam
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zps_isf  ***
+      !!   
+      !! ** Purpose :   Read namzgr_isf namelist and 
+      !!                check compatibility with other option
+      !!   
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  :: ios, ierr 
+      !!---------------------------------------------------------------------
+      NAMELIST/namzgr_isf/nn_kisfmax, rn_zisfmax, rn_isfdep_min, rn_glhw_min, rn_isfhw_min, &
+         &                ln_isfcheminey, ln_isfconnect, ln_isfchannel, ln_isfsubgl, rn_isfsubgllon, rn_isfsubgllat
+      !
+      ! 0.0 read namelist
+      REWIND( numnam_ref )              ! Namelist namzgr_isf in reference namelist : ice shelf geometry definition
+      READ  ( numnam_ref, namzgr_isf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_isf in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr_sco in configuration namelist : ice shelf geometry definition
+      READ  ( numnam_cfg, namzgr_isf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_isf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzgr_isf )
+      !
+      IF (lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' dom_isf : '
+         WRITE(numout,*) ' ~~~~~~~   '
+         WRITE(numout,*) ' nn_kisfmax       = ',nn_kisfmax           !
+         WRITE(numout,*) ' rn_zisfmax       = ',rn_zisfmax           !
+         WRITE(numout,*) ' rn_isfdep_min    = ',rn_isfdep_min        !
+         WRITE(numout,*) ' rn_isfhw_min     = ',rn_isfhw_min         !
+         WRITE(numout,*) ' rn_glhw_min      = ',rn_glhw_min          !
+         WRITE(numout,*) ' ln_isfcheminey   = ',ln_isfcheminey       !
+         WRITE(numout,*) ' ln_isfconnect    = ',ln_isfconnect        !
+         WRITE(numout,*) ' ln_isfchannel    = ',ln_isfchannel        !
+      END IF
+      !
+      ! 0.1 compatibility option
+      ierr = 0
+      IF ( ln_zco .OR. ln_sco ) ierr = ierr + 1
+      IF ( ierr > 0 ) CALL ctl_stop( ' Cavity not tested/compatible with full step (zco) and sigma (ln_sco) ' )
+
+   END SUBROUTINE zgr_isf_nam
+
+   SUBROUTINE zgr_isf_zspace
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_isf  ***
+      !!   
+      !! ** Purpose :   compute the grounding line position
+      !!   
+      !! ** Method  :   bathy set to 0 and isfdraft are modified (dig/close) to respect
+      !!                these criterions.
+      !!                digging and filling base on depth criterion only
+      !!                          1.0 = set iceshelf to the minimum depth allowed
+      !!                          1.1 = ground ice shelf if water column less than X m
+      !!                          1.2 = ensure a minimum thickness for iceshelf cavity in shallow water
+      !!                          1.3 = remove channels and single point 'bay'
+      !!   
+      !! ** Action  : - test compatibility between isfdraft and bathy 
+      !!              - bathy and isfdraft are modified
+      !!----------------------------------------------------------------------
+      !!  
+      INTEGER  :: ji, jj                             ! loop indexes
+      INTEGER  :: imskjp1, imskjm1, imskip1, imskim1 ! local variable
+      INTEGER, DIMENSION(jpi,jpj) :: imask           ! isf mask
+      !
+      REAL(wp) ::   zisfdep_min  ! minimal ice shelf draft allowed
+      !!---------------------------------------------------------------------
+      !
+      ! 1.0 set iceshelf to the minimum depth allowed
+      zisfdep_min = MAX(rn_isfdep_min,e3t_1d(1))
+      WHERE(risfdep(:,:) > 0.0_wp .AND. risfdep(:,:) < zisfdep_min)
+         risfdep(:,:) = zisfdep_min
+      END WHERE
+      !  
+      ! 1.1 ground ice shelf if water column less than rn_glhw_min m 
+      ! => set the grounding line position
+      WHERE( bathy(:,:) - risfdep(:,:) < rn_glhw_min .AND. risfdep(:,:) > 0.0_wp ) 
+         bathy  (:,:) = 0._wp ; risfdep(:,:) = 0._wp
+      END WHERE
+      !
+      ! 1.2 ensure a minimum thickness for iceshelf cavity 
+      ! => avoid to negative e3t if ssh + sum(e3t_0*tmask) < 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF ( bathy(ji,jj) - risfdep(ji,jj) < rn_isfhw_min .AND. risfdep(ji,jj) > 0.0_wp ) THEN
+               risfdep(ji,jj) = bathy(ji,jj) - rn_isfhw_min
+               ! sanity check on risfdep (if < zisfdep_min)
+               ! => we ground it as it failed to respect condition 1.0 and 1.1
+               IF ( risfdep(ji,jj) < zisfdep_min ) THEN 
+                  bathy(ji,jj)=0._wp ; risfdep(ji,jj)=0._wp
+               END IF
+            END IF
+         END DO
+      END DO
+      !
+      ! 1.3 Remove channels and single point 'bay' using bathy mask.
+      ! => channel could be created if connectivity is enforced later.
+      IF (ln_isfchannel) THEN
+         imask(:,:) = 0
+         WHERE ( bathy(:,:) > 0._wp )
+            imask(:,:) = 1
+         END WHERE
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF( imask(ji,jj) == 1 .AND. risfdep(ji,jj) > 0._wp) THEN
+                  ! define connexion
+                  imskip1=imask(ji,jj)*imask(ji+1,jj  )  ! 1 = connexion
+                  imskjp1=imask(ji,jj)*imask(ji  ,jj+1)  ! 1 = connexion
+                  imskim1=imask(ji,jj)*imask(ji-1,jj  )  ! 1 = connexion
+                  imskjm1=imask(ji,jj)*imask(ji  ,jj-1)  ! 1 = connexion
+                  ! zonal channel and single bay
+                  IF ((imskip1+imskim1>=1) .AND. (imskjp1+imskjm1==0)) THEN
+                     bathy(ji,jj)=0._wp ; risfdep(ji,jj)=0._wp
+                  END IF
+                  ! meridionnal channel and single bay
+                  IF ((imskjp1+imskjm1>=1) .AND. (imskip1+imskim1==0)) THEN
+                     bathy(ji,jj)=0._wp ; risfdep(ji,jj)=0._wp
+                  END IF
+               END IF
+            END DO
+         END DO
+         ! ensure halo correct 
+         CALL lbc_lnk_multi( 'domisf', risfdep, 'T', 1._wp, bathy  , 'T', 1._wp )
+      END IF
+      !
+   END SUBROUTINE zgr_isf_zspace
+
+   SUBROUTINE zgr_isf_kspace
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_isf  ***
+      !!   
+      !! ** Purpose :   compute misfdep and update isf draft if needed
+      !!   
+      !! ** Method  :   The water column has to contain at least 2 wet cells in the water column under an ice shelf
+      !!                isf draft is modified (dig/close) to respect this criterion.
+      !!                compute level
+      !!                          2.0 = compute level
+      !!                          2.1 = ensure misfdep is not below bathymetry after step 2.0
+      !!                digging and filling base on level criterion only                
+      !!                          3.0 = dig to fit the 2 water level criterion (closed pool possible after this step)
+      !!                          3.1 = dig enough to ensure connectivity of all the cell beneath an ice shelf 
+      !!                                (most of the close pool should be remove after this step)
+      !!                          3.2 = fill chimney
+      !!   
+      !! ** Action  : - compute misfdep
+      !!              - isf draft is modified if needed
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jn
+      INTEGER  ::   icompt
+      INTEGER  ::   ibtest,           ibtestim1, ibtestip1, ibtestjm1, ibtestjp1
+      INTEGER  ::   ibathy, ibathyij, ibathyim1, ibathyip1, ibathyjm1, ibathyjp1
+      INTEGER  ::   imskjp1  , imskjm1  , imskip1  , imskim1
+      INTEGER  ::   imskip1_r, imskim1_r, imskjp1_r, imskjm1_r
+      INTEGER , DIMENSION(jpi,jpj) :: imbathy, imisfdep, imask
+      !
+      REAL(wp) ::   zdepth
+      REAL(wp), DIMENSION(jpi,jpj) :: zrisfdep, zdummy   ! 2D workspace (ISH)
+      !!---------------------------------------------------------------------
+      !
+      ! 2 Compute misfdep for ocean points (i.e. first wet level) 
+      ! find the first ocean level such that the first level thickness 
+      ! is larger than the bot_level of e3zps_min and e3zps_rat * e3t_0 (where 
+      ! e3t_0 is the reference level thickness 
+      !
+      ! 2.0 compute misfdep (taking into account the minimal cell thickness allowed)
+      ! set misfdep to 1 on open water and initialisation beneath ice shelf
+      WHERE( risfdep(:,:) == 0._wp ) ;   misfdep(:,:) = 1   ! open water or grounded : set misfdep to 1  
+      ELSEWHERE                      ;   misfdep(:,:) = 2   ! iceshelf : initialize misfdep to second level 
+      END WHERE  
+      !
+      DO jk = 2, jpkm1 
+         zdepth = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
+         WHERE( risfdep(:,:) > 0._wp .AND. risfdep(:,:) >= zdepth )   misfdep(:,:) = jk+1 
+      END DO 
+      !
+      ! 2.1 fill isolated grid point in the bathymetry
+      ! will be done again later on in zgr_bat_ctl, but need to be done here to adjust misfdep respectively
+      icompt = 0
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            ibtest = MAX(  mbathy(ji-1,jj), mbathy(ji+1,jj),   &
+               &           mbathy(ji,jj-1), mbathy(ji,jj+1)  )
+               IF( ibtest < mbathy(ji,jj) ) THEN
+                  mbathy(ji,jj) = ibtest
+                  icompt = icompt + 1
+               END IF
+         END DO
+      END DO
+      !
+      ! ensure halo correct 
+      zdummy(:,:) = FLOAT( mbathy(:,:) ) ; CALL lbc_lnk('domisf', zdummy, 'T', 1._wp ) ; mbathy(:,:) = INT( zdummy(:,:) )
+      !
+      IF( lk_mpp )   CALL mpp_sum('domisf', icompt )
+      IF( icompt == 0 ) THEN
+         IF(lwp) WRITE(numout,*)'     no isolated ocean grid points'
+      ELSE
+         IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points suppressed'
+      ENDIF
+      !
+      ! 2.2 be sure misfdep not below mbathy 
+      ! warning because of condition 4 we could have 'wet cell with misfdep below mbathy
+      ! risfdep of these cells will be fix later on (see 3)
+      WHERE( misfdep > mbathy ) misfdep(:,:) = MAX( 1, mbathy(:,:) )
+      !
+      ! 3.0 Assure 2 wet cells in the water column at T point and along the edge.
+      ! find the deepest isfdep level that fit the 2 wet cell on the water column
+      ! on all the sides (still need 4 pass)
+      ! It need 4 iterations: if un-luky, digging cell U-1 can trigger case for U+1, then V-1, then V+1
+      DO jn = 1, 4
+         imisfdep = misfdep
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ! ISF cell only
+               IF(  (misfdep(ji,jj) > 1) .AND. (mbathy(ji,jj) > 0) ) THEN
+                  ibathyij  = mbathy(ji  ,jj)
+                  !
+                  ! set ground edge value to jpk to skip it later on
+                  ibathyip1 = mbathy(ji+1,jj) ; IF ( ibathyip1 < misfdep(ji,jj) ) ibathyip1 = jpk ! no wet cell in common on this edge
+                  ibathyim1 = mbathy(ji-1,jj) ; IF ( ibathyim1 < misfdep(ji,jj) ) ibathyim1 = jpk ! no wet cell in common on this edge
+                  ibathyjp1 = mbathy(ji,jj+1) ; IF ( ibathyjp1 < misfdep(ji,jj) ) ibathyjp1 = jpk ! no wet cell in common on this edge
+                  ibathyjm1 = mbathy(ji,jj-1) ; IF ( ibathyjm1 < misfdep(ji,jj) ) ibathyjm1 = jpk ! no wet cell in common on this edge
+                  !
+                  ! find shallowest bathy level among the current cell and the neigbourging cells
+                  ibathy = MIN(ibathyij,ibathyip1,ibathyim1,ibathyjp1,ibathyjm1)
+                  !
+                  ! update misfdep and risfdep if needed
+                  ! misfdep need to be <= zmbathyij-1 to fit 2 wet cell on the water column
+                  jk = MIN(misfdep(ji,jj),ibathy-1)
+                  IF ( jk < misfdep(ji,jj) ) THEN
+                     imisfdep(ji,jj) = jk
+                     risfdep(ji,jj)  = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+                  END IF
+               ENDIF
+            END DO
+         END DO
+         misfdep=imisfdep
+         !
+         ! ensure halo correct before new pass 
+         zdummy(:,:) = FLOAT( misfdep(:,:) ); CALL lbc_lnk('domisf', zdummy, 'T', 1. ); misfdep(:,:) = INT( zdummy(:,:) )
+         CALL lbc_lnk('domisf', risfdep, 'T', 1. )
+      END DO ! jn
+      !
+      ! 3.1 condition block to inssure connectivity everywhere beneath an ice shelf
+      IF (ln_isfconnect) THEN
+         imask(:,:) = 1
+         imbathy  = mbathy
+         imisfdep = misfdep
+         zrisfdep = risfdep
+         WHERE ( mbathy(:,:) == 0 )
+            imask(:,:) = 0
+            imbathy(:,:) = jpk
+         END WHERE
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF(  (misfdep(ji,jj) > 1) .AND. (mbathy(ji,jj) > 0) ) THEN
+                  !
+                  ! what it should be
+                  imskip1 = imask(ji,jj) * imask(ji+1,jj  )  ! 1 = should be connected
+                  imskim1 = imask(ji,jj) * imask(ji-1,jj  )  ! 1 = should be connected
+                  imskjp1 = imask(ji,jj) * imask(ji  ,jj+1)  ! 1 = should be connected
+                  imskjm1 = imask(ji,jj) * imask(ji  ,jj-1)  ! 1 = should be connected
+                  !
+                  ! what it is
+                  imskip1_r=jpk ; imskim1_r=jpk; imskjp1_r=jpk; imskjm1_r=jpk
+                  IF (misfdep(ji,jj) > imbathy(ji+1,jj  )) imskip1_r=1.0 ! 1 = no effective connection
+                  IF (misfdep(ji,jj) > imbathy(ji-1,jj  )) imskim1_r=1.0 ! 1 = no effective connection
+                  IF (misfdep(ji,jj) > imbathy(ji  ,jj+1)) imskjp1_r=1.0 ! 1 = no effective connection
+                  IF (misfdep(ji,jj) > imbathy(ji  ,jj-1)) imskjm1_r=1.0 ! 1 = no effective connection
+                  !
+                  ! defining level needed for connectivity
+                  ! imskip1 * imskip1_r == 1 means connections need to be enforce
+                  jk=MIN(imbathy(ji+1,jj  ) * imskip1_r * imskip1, &
+                     &   imbathy(ji-1,jj  ) * imskim1_r * imskim1, &
+                     &   imbathy(ji  ,jj+1) * imskjp1_r * imskjp1, &
+                     &   imbathy(ji  ,jj-1) * imskjm1_r * imskjm1, &
+                     &   jpk+1 ) ! add jpk in the MIN to avoid out of boundary later on
+                  !
+                  ! if connectivity is OK or no connection needed (grounding line) or grounded, zmisfdep=misfdep
+                  imisfdep(ji,jj)=MIN(misfdep(ji,jj),jk-1)
+                  !
+                  ! update isf draft if needed (need to be done here because next test is in meter and level)
+                  IF ( imisfdep(ji,jj) < misfdep(ji,jj) ) THEN
+                     jk = imisfdep(ji,jj)
+                     zrisfdep(ji,jj)  = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+                  END IF
+   
+                  ! sanity check
+                  ! check if we dig more than nn_kisfmax level or reach the surface
+                  ! check if we dig more than rn_zisfmax meter
+                  ! => if this is the case, undo what has been done before
+                  IF (      (misfdep(ji,jj)-imisfdep(ji,jj) > MIN(nn_kisfmax,misfdep(ji,jj)-2)) &
+                     & .OR. (risfdep(ji,jj)-zrisfdep(ji,jj) > MIN(rn_zisfmax,risfdep(ji,jj)  )) ) THEN
+                     imisfdep(ji,jj)=misfdep(ji,jj) 
+                     zrisfdep(ji,jj)=risfdep(ji,jj)
+                  END IF
+               END IF
+            END DO
+         END DO
+         misfdep=imisfdep
+         risfdep=zrisfdep
+         !
+         ! ensure halo correct 
+         zdummy(:,:) = FLOAT( misfdep(:,:) ); CALL lbc_lnk('domisf', zdummy, 'T', 1. ); misfdep(:,:) = INT( zdummy(:,:) )
+         CALL lbc_lnk('domisf', risfdep, 'T', 1. )
+      END IF
+      !
+      ! 3.2 fill hole in ice shelf (ie cell with no velocity point)
+      !      => misfdep = MIN(misfdep at U, U-1, V, V-1)
+      !         risfdep = gdepw(misfdep) (ie full cell)
+      IF (ln_isfcheminey) THEN
+         imisfdep = misfdep
+         WHERE (mbathy == 0) imisfdep=jpk   ! grounded
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ibtest    = imisfdep(ji  ,jj  )
+               ibtestim1 = imisfdep(ji-1,jj  ) ; ibtestip1 = imisfdep(ji+1,jj  )
+               ibtestjm1 = imisfdep(ji  ,jj-1) ; ibtestjp1 = imisfdep(ji  ,jj+1)
+               !
+               ! correction in case isfdraft(ii,jj) deeper than bathy U-1/U+1/V-1/V+1
+               IF( imisfdep(ji,jj) > mbathy(ji-1,jj  ) ) ibtestim1 = jpk ! mask at U-1
+               IF( imisfdep(ji,jj) > mbathy(ji+1,jj  ) ) ibtestip1 = jpk ! mask at U+1
+               IF( imisfdep(ji,jj) > mbathy(ji  ,jj-1) ) ibtestjm1 = jpk ! mask at V-1
+               IF( imisfdep(ji,jj) > mbathy(ji  ,jj+1) ) ibtestjp1 = jpk ! mask at V+1
+               !
+               ! correction in case bathy(ii,jj) shallower than isfdraft U-1/U+1/V-1/V+1
+               IF( mbathy(ji,jj) < imisfdep(ji-1,jj  ) ) ibtestim1 = jpk ! mask at U-1
+               IF( mbathy(ji,jj) < imisfdep(ji+1,jj  ) ) ibtestip1 = jpk ! mask at U+1
+               IF( mbathy(ji,jj) < imisfdep(ji  ,jj-1) ) ibtestjm1 = jpk ! mask at V-1
+               IF( mbathy(ji,jj) < imisfdep(ji  ,jj+1) ) ibtestjp1 = jpk ! mask at V+1
+               ! 
+               ! if hole in the ice shelf, set to the min of surrounding (the MIN is doing the job) 
+               ! if misfdep is not changed, nothing is done
+               ibtest = MAX(ibtest,MIN(ibtestim1, ibtestip1, ibtestjm1,ibtestjp1))
+               IF (misfdep(ji,jj) < ibtest) THEN
+                  misfdep(ji,jj) = ibtest
+                  risfdep(ji,jj) = gdepw_1d(ibtest)
+               END IF
+            ENDDO
+         ENDDO
+         !
+         ! if surround is fully masked, we mask it
+         WHERE( misfdep(:,:) == jpk)   ! ground case (1)
+            mbathy(:,:) = 0 ; bathy(:,:) = 0.0_wp ; misfdep(:,:) = 1 ; risfdep(:,:) = 0.0_wp
+         END WHERE
+         !
+         ! ensure halo correct
+         zdummy(:,:) = FLOAT( misfdep(:,:) ); CALL lbc_lnk('domisf', zdummy, 'T', 1. ); misfdep(:,:) = INT( zdummy(:,:) )
+         zdummy(:,:) = FLOAT( mbathy (:,:) ); CALL lbc_lnk('domisf', zdummy, 'T', 1. ); mbathy (:,:) = INT( zdummy(:,:) )
+         CALL lbc_lnk('domisf', risfdep, 'T', 1. )
+         CALL lbc_lnk('domisf', bathy  , 'T', 1. )
+      END IF
+      !
+   END SUBROUTINE zgr_isf_kspace
+
+   SUBROUTINE zgr_isf_subgl
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zps_isf_subg  ***
+      !!   
+      !! ** Purpose :   remove subglacial lakes
+      !!   
+      !! ** Method  :   Use a flood filling algorithm to detect the open ocean
+      !!                and reverse the mask
+      !!   
+      !! ** Action  : - ckeck if seed on land
+      !!              - detect main ocean
+      !!              - mask subglacial lake (closed sea under an ice shelf)
+      !!              - mask properly mbathy, misfdep, bathy, risfdep
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  :: jk                       ! loop index
+      INTEGER  :: iiseed, ijseed           ! seed for flood filling algorithm
+      INTEGER, DIMENSION(jpi,jpj) :: imask ! 2d mask
+      !
+      REAL(wp)               :: zdist      ! distance between the seed and the nearest neighbourg                
+      REAL(wp), DIMENSION(1) :: zchk       ! sanity check variable
+      !!----------------------------------------------------------------------
+      !
+      ! check closed wet pool
+      CALL dom_ngb(rn_isfsubgllon, rn_isfsubgllat, iiseed, ijseed, zdist, 'T')
+      !
+      ! fill open ocean
+      CALL fill_pool( iiseed, ijseed, 1, tmask, -1._wp )
+      ! at this point tmask:,:,:) can have 3 different values :
+      !              0 where there where already 0
+      !             -1 where the ocean points are connected
+      !              1 where ocean points in tmask are not connected
+      IF (lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'dom_isf_subg : removal of subglacial lakes '
+         WRITE(numout,*)'~~~~~~~~~~~~'
+         WRITE(numout,*)'Number of disconected points : ', COUNT(  (tmask(:,:,:) == 1) )
+         WRITE(numout,*)'lon/lat seed to detect main ocean is: ', rn_isfsubgllon, rn_isfsubgllat
+         WRITE(numout,*)'i/j     seed to detect main ocean is: ', iiseed, ijseed
+         WRITE(numout,*)
+      END IF
+      !
+      DO jk = 1, jpk
+         ! remove only subglacial lake (ie similar to close sea only below an ice shelf)
+         WHERE (tmask(:,:,jk) > 0 .AND. misfdep(:,:) > 1) tmask(:,:,jk) = 0
+         WHERE (tmask(:,:,jk) < 0) tmask(:,:,jk) = 1
+         !
+      END DO
+      !
+      ! surface mask
+      imask(:,:)   = MAXVAL( tmask(:,:,:), DIM=3 )
+      !
+      ! mask mbathy, misfdep, bathy and risfdep 
+      bathy(:,:)   = bathy(:,:)   * imask(:,:) 
+      mbathy(:,:)  = mbathy(:,:)  * imask(:,:)
+      risfdep(:,:) = risfdep(:,:) * imask(:,:) 
+      misfdep(:,:) = misfdep(:,:) * imask(:,:)
+      !
+      ! sanity check on seed location (land or not)
+      zchk = 0._wp
+      IF (mi0(iiseed) == mi1(iiseed) .AND. mj0(ijseed) == mj1(ijseed)) zchk = tmask(mi0(iiseed),mj0(ijseed),1)
+      CALL mpp_max('domisf',zchk)
+      IF (zchk(1) == 0._wp) CALL ctl_stop( 'STOP', 'open sea seed is on land, please update namelist (rn_lon_opnsea,rn_lat_opnsea)' )
+      !
+   END SUBROUTINE zgr_isf_subgl
+
+
+   SUBROUTINE zps_isf
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zps_isf  ***
+      !!   
+      !! ** Purpose : compute top partial cell
+      !!   
+      !! ** Method  : same method as for the bottom adapted for the top
+      !!   
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER :: jj, ji   ! loop indices
+      INTEGER :: ik       ! local top level
+      INTEGER :: it       ! counter index
+      !
+      REAL(wp) :: zdiff
+      !!----------------------------------------------------------------------
+      !
+      ! compute top partial cell
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = misfdep(ji,jj)
+            IF( ik > 1 ) THEN               ! ice shelf point only 
+               IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik)
+               gdepw_0(ji,jj,ik) = risfdep(ji,jj)
+!gm Bu check the gdepw_0 
+            !       ... on ik 
+               gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   &
+                  &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   &
+                  &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      )
+               e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik)
+               e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik)
+
+               IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column) 
+                  e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik)
+               ENDIF
+         !       ... on ik / ik-1 
+               e3w_0  (ji,jj,ik  ) = e3t_0  (ji,jj,ik) !2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik)) 
+               e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1)
+               gdept_0(ji,jj,ik-1) = gdept_0(ji,jj,ik) - e3w_0(ji,jj,ik)
+               gdepw_0(ji,jj,ik-1) = gdepw_0(ji,jj,ik) - e3t_0(ji,jj,ik-1)
+               IF ( ik > 2 ) THEN
+                  e3w_0  (ji,jj,ik-1) = gdept_0(ji,jj,ik-1) - gdept_0(ji,jj,ik-2)
+               ELSE
+                  e3w_0  (ji,jj,ik-1) = 2.0 * gdept_0(ji,jj,ik-1)
+               END IF
+            ENDIF
+         END DO
+      END DO
+      !
+      it = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = misfdep(ji,jj)
+            IF( ik > 1 ) THEN               ! ice shelf point only 
+               e3tp (ji,jj) = e3t_0(ji,jj,ik  )
+               e3wp (ji,jj) = e3w_0(ji,jj,ik+1 )
+            ! test 
+               zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  )
+               IF( zdiff <= 0. .AND. lwp ) THEN
+                  it = it + 1
+                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj
+                  WRITE(numout,*) ' risfdep = ', risfdep(ji,jj)
+                  WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
+                  WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj)
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+   END SUBROUTINE zps_isf
+
+   SUBROUTINE zps_isf_e3uv_w
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zps_isf  ***
+      !!   
+      !! ** Purpose :   correct e3uw and e3vw for case with 2 wet cell in the water column under an ice shelf
+      !!   
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER :: ji , jj   ! loop indices
+      INTEGER :: ikt, ikb  ! local top/bottom level
+      !!----------------------------------------------------------------------
+      !
+      ! define e3uw (adapted for 2 cells in the water column)
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1   ! vector opt. 
+            ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj))
+            ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj))
+            IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) &
+                                    &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) )
+            ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1))
+            ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1))
+            IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) &
+                                    &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) )
+         END DO
+      END DO
+      !
+   END SUBROUTINE zps_isf_e3uv_w
+
+END MODULE domisf
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dommsk.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dommsk.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dommsk.F90	(revision 12101)
@@ -0,0 +1,296 @@
+MODULE dommsk
+   !!======================================================================
+   !!                       ***  MODULE dommsk   ***
+   !! Ocean initialization : domain land/sea mask 
+   !!======================================================================
+   !! History :  OPA  ! 1987-07  (G. Madec)  Original code
+   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
+   !!            7.0  ! 1996-01  (G. Madec)  suppression of common work arrays
+   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask
+   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F
+   !!            8.1  ! 1997-07  (G. Madec)  modification of kbat and fmask
+   !!             -   ! 1998-05  (G. Roullet)  free surface
+   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
+   !!             -   ! 2001-09  (J.-M. Molines)  Open boundaries
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask
+   !!            4.0  ! 2016-06  (G. Madec, S. Flavoni)  domain configuration / user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_msk       : compute land/ocean mask
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE domisf         ! domain: ice shelf
+   USE domwri         ! domain: write the meshmask file
+   USE bdy_oce        ! open boundary
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! IOM library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! Massively Parallel Processing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_msk    ! routine called by inidom.F90
+
+   !                            !!* Namelist namlbc : lateral boundary condition *
+   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity
+   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition 
+   !                                            with analytical eqs.
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: dommsk.F90 10425 2018-12-19 21:54:16Z smasson $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_msk
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
+      !!      zontal velocity points (u & v), vorticity points (f) points.
+      !!
+      !! ** Method  :   The ocean/land mask  at t-point is deduced from ko_top 
+      !!      and ko_bot, the indices of the fist and last ocean t-levels which 
+      !!      are either defined in usrdef_zgr or read in zgr_read.
+      !!                The velocity masks (umask, vmask) 
+      !!      are deduced from a product of the two neighboring tmask.
+      !!                The vorticity mask (fmask) is deduced from tmask taking
+      !!      into account the choice of lateral boundary condition (rn_shlat) :
+      !!         rn_shlat = 0, free slip  (no shear along the coast)
+      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast)
+      !!         0 < rn_shlat < 2, partial slip   | non-linear velocity profile
+      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer
+      !!
+      !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
+      !!                rows/lines due to cyclic or North Fold boundaries as well
+      !!                as MPP halos.
+      !!      tmask_h : halo mask at t-point, i.e. excluding duplicated rows/lines
+      !!                due to cyclic or North Fold boundaries as well as MPP halos.
+      !!
+      !! ** Action :   tmask, umask, vmask, wmask : land/ocean mask 
+      !!                         at t-, u-, v- w, wu-, and wv-points (=0. or 1.)
+      !!               fmask   : land/ocean mask at f-point (=0., or =1., or 
+      !!                         =rn_shlat along lateral boundaries)
+      !!               tmask_i : interior ocean mask 
+      !!               tmask_h : halo mask
+      !!               ssmask , ssumask, ssvmask, ssfmask : 2D ocean mask
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  ::   ji, jj, jk     ! dummy loop indices
+      INTEGER  ::   iif, iil       ! local integers
+      INTEGER  ::   ijf, ijl       !   -       -
+      INTEGER  ::   iktop, ikbot   !   -       -
+      INTEGER  ::   ios, inum
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace
+      !!
+      NAMELIST/namlbc/ rn_shlat, ln_vorlat
+      NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file,         &
+         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
+         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &
+         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
+         &             cn_ice, nn_ice_dta,                                     &
+         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     &
+         &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
+      !!---------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
+      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist', lwp )
+      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition
+      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namlbc )
+      
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dommsk : ocean mask '
+         WRITE(numout,*) '~~~~~~'
+         WRITE(numout,*) '   Namelist namlbc'
+         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat
+         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat 
+      ENDIF
+      !
+      IF(lwp) WRITE(numout,*)
+      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  free-slip'
+      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  no-slip'
+      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  partial-slip'
+      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  strong-slip'
+      ELSE
+         CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' )
+      ENDIF
+
+     ! 1. Ocean/land mask at t-point (computed from mbathy)
+     ! -----------------------------
+     ! N.B. tmask has already the right boundary conditions since mbathy is ok
+     !
+      tmask(:,:,:) = 0._wp
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF(      ( REAL( mbathy (ji,jj) - jk, wp ) + 0.1_wp >= 0._wp )         &
+               &  .AND. ( REAL( misfdep(ji,jj) - jk, wp ) - 0.1_wp <= 0._wp ) ) THEN
+                  tmask(ji,jj,jk) = 1._wp
+               END IF  
+            END DO
+         END DO
+      END DO    
+ 
+      IF ( ln_isfsubgl ) CALL zgr_isf_subgl
+
+!SF  add here lbc_lnk: bug not still understood : cause now domain configuration is read !
+!!gm I don't understand why...  
+      CALL lbc_lnk( 'dommsk', tmask  , 'T', 1._wp )      ! Lateral boundary conditions
+
+     ! Mask corrections for bdy (read in mppini2)
+      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries
+      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp )
+      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries
+      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
+904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )
+      ! ------------------------
+      IF ( ln_bdy .AND. ln_mask_file ) THEN
+         CALL iom_open( cn_mask_file, inum )
+         CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) )
+         CALL iom_close( inum )
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
+               END DO
+            END DO
+         END DO
+      ENDIF
+         
+      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask)
+      ! ----------------------------------------
+      ! NB: at this point, fmask is designed for free slip lateral boundary condition
+      DO jk = 1, jpk
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector loop
+               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
+               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
+            END DO
+            DO ji = 1, jpim1      ! NO vector opt.
+               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
+                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1., vmask, 'V', 1., fmask, 'F', 1. )      ! Lateral boundary conditions
+ 
+      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask)
+      !-----------------------------------------
+      wmask (:,:,1) = tmask(:,:,1)     ! surface
+      DO jk = 2, jpk                   ! interior values
+         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
+      END DO
+
+
+      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical)
+      ! ----------------------------------------------
+      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 )
+      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 )
+      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 )
+
+      ! Interior domain mask  (used for global sum)
+      ! --------------------
+      !
+      iif = nn_hls   ;   iil = nlci - nn_hls + 1
+      ijf = nn_hls   ;   ijl = nlcj - nn_hls + 1
+      !
+      !                          ! halo mask : 0 on the halo and 1 elsewhere
+      tmask_h(:,:) = 1._wp                  
+      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns
+      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
+      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows
+      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
+      !
+      !                          ! north fold mask
+      tpol(1:jpiglo) = 1._wp 
+      fpol(1:jpiglo) = 1._wp
+      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot
+         tpol(jpiglo/2+1:jpiglo) = 0._wp
+         fpol(     1    :jpiglo) = 0._wp
+         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h
+            DO ji = iif+1, iil-1
+               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji))
+            END DO
+         ENDIF
+      ENDIF
+      !
+      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
+         tpol(     1    :jpiglo) = 0._wp
+         fpol(jpiglo/2+1:jpiglo) = 0._wp
+      ENDIF
+      !
+      !                          ! interior mask : 2D ocean mask x halo mask 
+      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:)
+
+
+      ! Lateral boundary conditions on velocity (modify fmask)
+      ! ---------------------------------------  
+      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition
+         !
+         ALLOCATE( zwf(jpi,jpj) )
+         !
+         DO jk = 1, jpk
+            zwf(:,:) = fmask(:,:,jk)         
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( fmask(ji,jj,jk) == 0._wp ) THEN
+                     fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
+                        &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  )
+                  ENDIF
+               END DO
+            END DO
+            DO jj = 2, jpjm1
+               IF( fmask(1,jj,jk) == 0._wp ) THEN
+                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
+               ENDIF
+               IF( fmask(jpi,jj,jk) == 0._wp ) THEN
+                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
+               ENDIF
+            END DO         
+            DO ji = 2, jpim1
+               IF( fmask(ji,1,jk) == 0._wp ) THEN
+                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
+               ENDIF
+               IF( fmask(ji,jpj,jk) == 0._wp ) THEN
+                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
+               ENDIF
+            END DO
+#if defined key_agrif 
+            IF( .NOT. AGRIF_Root() ) THEN 
+               IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east 
+               IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west 
+               IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north 
+               IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south 
+            ENDIF 
+#endif 
+         END DO
+         !
+         DEALLOCATE( zwf )
+         !
+         CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
+         !
+         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat
+         !
+      ENDIF
+      !
+      ! write out mesh mask
+      IF ( nn_msh > 0 ) CALL dom_wri
+      !
+   END SUBROUTINE dom_msk
+   
+   !!======================================================================
+END MODULE dommsk
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dommsk.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dommsk.f90	(revision 12100)
+++ 	(revision )
@@ -1,369 +1,0 @@
-MODULE dommsk
-   !!======================================================================
-   !!                       ***  MODULE dommsk   ***
-   !! Ocean initialization : domain land/sea mask 
-   !!======================================================================
-   !! History :  OPA  ! 1987-07  (G. Madec)  Original code
-   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
-   !!            7.0  ! 1996-01  (G. Madec)  suppression of common work arrays
-   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask
-   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F
-   !!            8.1  ! 1997-07  (G. Madec)  modification of mbathy and fmask
-   !!             -   ! 1998-05  (G. Roullet)  free surface
-   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
-   !!             -   ! 2001-09  (J.-M. Molines)  Open boundaries
-   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
-   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
-   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
-   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dom_msk        : compute land/ocean mask
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   !
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         !
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dom_msk    ! routine called by inidom.F90
-
-   !                            !!* Namelist namlbc : lateral boundary condition *
-   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity
-   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition 
-   !                                            with analytical eqs.
-
-   !! * Substitutions
-   !!----------------------------------------------------------------------
-   !!                   ***  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.2 , LODYC-IPSL  (2009)
-   !! $Id: dommsk.F90 6140 2015-12-21 11:35:23Z timgraham $ 
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dom_msk
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE dom_msk  ***
-      !!
-      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
-      !!      zontal velocity points (u & v), vorticity points (f) points.
-      !!
-      !! ** Method  :   The ocean/land mask is computed from the basin bathy-
-      !!      metry in level (mbathy) which is defined or read in dommba.
-      !!      mbathy equals 0 over continental T-point 
-      !!      and the number of ocean level over the ocean.
-      !!
-      !!      At a given position (ji,jj,jk) the ocean/land mask is given by:
-      !!      t-point : 0. IF mbathy( ji ,jj) =< 0
-      !!                1. IF mbathy( ji ,jj) >= jk
-      !!      u-point : 0. IF mbathy( ji ,jj)  or mbathy(ji+1, jj ) =< 0
-      !!                1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk.
-      !!      v-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) =< 0
-      !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk.
-      !!      f-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1)
-      !!                   or mbathy(ji+1,jj)  or mbathy(ji+1,jj+1) =< 0
-      !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1)
-      !!                  and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk.
-      !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
-      !!                rows/lines due to cyclic or North Fold boundaries as well
-      !!                as MPP halos.
-      !!
-      !!        The lateral friction is set through the value of fmask along
-      !!      the coast and topography. This value is defined by rn_shlat, a
-      !!      namelist parameter:
-      !!         rn_shlat = 0, free slip  (no shear along the coast)
-      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast)
-      !!         0 < rn_shlat < 2, partial slip   | non-linear velocity profile
-      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer
-      !!
-      !!      N.B. If nperio not equal to 0, the land/ocean mask arrays
-      !!      are defined with the proper value at lateral domain boundaries.
-      !!
-      !!      In case of open boundaries (lk_bdy=T):
-      !!        - tmask is set to 1 on the points to be computed bay the open
-      !!          boundaries routines.
-      !!
-      !! ** Action :   tmask    : land/ocean mask at t-point (=0. or 1.)
-      !!               umask    : land/ocean mask at u-point (=0. or 1.)
-      !!               vmask    : land/ocean mask at v-point (=0. or 1.)
-      !!               fmask    : land/ocean mask at f-point (=0. or 1.)
-      !!                          =rn_shlat along lateral boundaries
-      !!               tmask_i  : interior ocean mask
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk               ! dummy loop indices
-      INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers
-      INTEGER  ::   ijf, ijl, ij0, ij1       !   -       -
-      INTEGER  ::   ios
-      INTEGER  ::   isrow                    ! index for ORCA1 starting row
-      INTEGER , POINTER, DIMENSION(:,:) ::  imsk
-      REAL(wp), POINTER, DIMENSION(:,:) ::  zwf
-      !!
-      NAMELIST/namlbc/ rn_shlat, ln_vorlat
-      !!---------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_msk')
-      !
-      CALL wrk_alloc( jpi, jpj, imsk )
-      CALL wrk_alloc( jpi, jpj, zwf  )
-      !
-      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
-      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition
-      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namlbc )
-      
-      IF(lwp) THEN                  ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dommsk : ocean mask '
-         WRITE(numout,*) '~~~~~~'
-         WRITE(numout,*) '   Namelist namlbc'
-         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat
-         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat 
-      ENDIF
-
-      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  free-slip '
-      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  no-slip '
-      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  partial-slip '
-      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  strong-slip '
-      ELSE
-         WRITE(ctmp1,*) ' rn_shlat is negative = ', rn_shlat
-         CALL ctl_stop( ctmp1 )
-      ENDIF
-
-      ! 1. Ocean/land mask at t-point (computed from mbathy)
-      ! -----------------------------
-      ! N.B. tmask has already the right boundary conditions since mbathy is ok
-      !
-      tmask(:,:,:) = 0._wp
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp )   tmask(ji,jj,jk) = 1._wp
-            END DO  
-         END DO  
-      END DO  
-      
-      ! (ISF) define barotropic mask and mask the ice shelf point
-      ssmask(:,:)=tmask(:,:,1) ! at this stage ice shelf is not masked
-      
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( REAL( misfdep(ji,jj) - jk, wp ) - 0.1_wp >= 0._wp )   THEN
-                  tmask(ji,jj,jk) = 0._wp
-               END IF
-            END DO  
-         END DO  
-      END DO  
-
-      ! Interior domain mask (used for global sum)
-      ! --------------------
-      tmask_i(:,:) = ssmask(:,:)            ! (ISH) tmask_i = 1 even on the ice shelf
-
-      tmask_h(:,:) = 1._wp                 ! 0 on the halo and 1 elsewhere
-      iif = jpreci                         ! ???
-      iil = nlci - jpreci + 1
-      ijf = jprecj                         ! ???
-      ijl = nlcj - jprecj + 1
-
-      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns
-      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
-      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows
-      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
-
-      ! north fold mask
-      ! ---------------
-      tpol(1:jpiglo) = 1._wp 
-      fpol(1:jpiglo) = 1._wp
-      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot
-         tpol(jpiglo/2+1:jpiglo) = 0._wp
-         fpol(     1    :jpiglo) = 0._wp
-         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row
-            DO ji = iif+1, iil-1
-               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji))
-            END DO
-         ENDIF
-      ENDIF
-     
-      tmask_i(:,:) = tmask_i(:,:) * tmask_h(:,:)
-
-      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
-         tpol(     1    :jpiglo) = 0._wp
-         fpol(jpiglo/2+1:jpiglo) = 0._wp
-      ENDIF
-
-      ! 2. Ocean/land mask at u-,  v-, and z-points (computed from tmask)
-      ! -------------------------------------------
-      DO jk = 1, jpk
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1   ! vector loop
-               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
-               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
-            END DO
-            DO ji = 1, jpim1      ! NO vector opt.
-               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
-                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
-            END DO
-         END DO
-      END DO
-      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1   ! vector loop
-            ssumask(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:)))
-            ssvmask(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:)))
-         END DO
-         DO ji = 1, jpim1      ! NO vector opt.
-            ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   &
-               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:)))
-         END DO
-      END DO
-      CALL lbc_lnk( umask  , 'U', 1._wp )      ! Lateral boundary conditions
-      CALL lbc_lnk( vmask  , 'V', 1._wp )
-      CALL lbc_lnk( fmask  , 'F', 1._wp )
-      CALL lbc_lnk( ssumask, 'U', 1._wp )      ! Lateral boundary conditions
-      CALL lbc_lnk( ssvmask, 'V', 1._wp )
-      CALL lbc_lnk( ssfmask, 'F', 1._wp )
-
-      ! 3. Ocean/land mask at wu-, wv- and w points 
-      !----------------------------------------------
-      wmask (:,:,1) = tmask(:,:,1)     ! surface
-      wumask(:,:,1) = umask(:,:,1)
-      wvmask(:,:,1) = vmask(:,:,1)
-      DO jk = 2, jpk                   ! interior values
-         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
-         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)   
-         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
-      END DO
-
-      ! Lateral boundary conditions on velocity (modify fmask)
-      ! ---------------------------------------     
-      DO jk = 1, jpk
-         zwf(:,:) = fmask(:,:,jk)         
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-               IF( fmask(ji,jj,jk) == 0._wp ) THEN
-                  fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
-                     &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  )
-               ENDIF
-            END DO
-         END DO
-         DO jj = 2, jpjm1
-            IF( fmask(1,jj,jk) == 0._wp ) THEN
-               fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
-            ENDIF
-            IF( fmask(jpi,jj,jk) == 0._wp ) THEN
-               fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
-            ENDIF
-         END DO         
-         DO ji = 2, jpim1
-            IF( fmask(ji,1,jk) == 0._wp ) THEN
-               fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
-            ENDIF
-            IF( fmask(ji,jpj,jk) == 0._wp ) THEN
-               fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
-            ENDIF
-         END DO
-      END DO
-      !
-      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA_R2 configuration
-         !                                                 ! Increased lateral friction near of some straits
-         !                                ! Gibraltar strait  : partial slip (fmask=0.5)
-         ij0 = 101   ;   ij1 = 101
-         ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
-         ij0 = 102   ;   ij1 = 102
-         ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
-         !
-         !                                ! Bab el Mandeb : partial slip (fmask=1)
-         ij0 =  87   ;   ij1 =  88
-         ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
-         ij0 =  88   ;   ij1 =  88
-         ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
-         !
-         !                                ! Danish straits  : strong slip (fmask > 2)
-! We keep this as an example but it is instable in this case 
-!         ij0 = 115   ;   ij1 = 115
-!         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
-!         ij0 = 116   ;   ij1 = 116
-!         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
-         !
-      ENDIF
-      !
-      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN   ! ORCA R1 configuration
-         !                                                 ! Increased lateral friction near of some straits
-         ! This dirty section will be suppressed by simplification process:
-         ! all this will come back in input files
-         ! Currently these hard-wired indices relate to configuration with
-         ! extend grid (jpjglo=332)
-         !
-         isrow = 332 - jpjglo
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : '
-         IF(lwp) WRITE(numout,*) '      Gibraltar '
-         ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait 
-         ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
-
-         IF(lwp) WRITE(numout,*) '      Bhosporus '
-         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait 
-         ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
-
-         IF(lwp) WRITE(numout,*) '      Makassar (Top) '
-         ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top) 
-         ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
-
-         IF(lwp) WRITE(numout,*) '      Lombok '
-         ii0 =  44           ;   ii1 =  44        ! Lombok Strait 
-         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
-
-         IF(lwp) WRITE(numout,*) '      Ombai '
-         ii0 =  53           ;   ii1 =  53        ! Ombai Strait 
-         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
-
-         IF(lwp) WRITE(numout,*) '      Timor Passage '
-         ii0 =  56           ;   ii1 =  56        ! Timor Passage 
-         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
-
-         IF(lwp) WRITE(numout,*) '      West Halmahera '
-         ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait 
-         ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
-
-         IF(lwp) WRITE(numout,*) '      East Halmahera '
-         ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait 
-         ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
-         !
-      ENDIF
-      !
-      CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
-      !
-      ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 )
-      !
-      CALL wrk_dealloc( jpi, jpj, imsk )
-      CALL wrk_dealloc( jpi, jpj, zwf  )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_msk')
-      !
-   END SUBROUTINE dom_msk
-   
-   !!======================================================================
-END MODULE dommsk
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domngb.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domngb.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domngb.F90	(revision 12101)
@@ -0,0 +1,101 @@
+MODULE domngb
+   !!======================================================================
+   !!                       ***  MODULE  domngb  ***
+   !! Grid search:  find the closest grid point from a given on/lat position
+   !!======================================================================
+   !! History : 3.2  !  2009-11  (S. Masson)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_ngb       : find the closest grid point from a given lon/lat position
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! for mppsum
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_ngb   ! routine called in iom.F90 and domclo.F90 module
+   PUBLIC   dist
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: domngb.F90 10425 2018-12-19 21:54:16Z smasson $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_ngb( plon, plat, kii, kjj, rdist, cdgrid, kkk )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_ngb  ***
+      !!
+      !! ** Purpose :   find the closest grid point from a given lon/lat position
+      !!
+      !! ** Method  :   look for minimum distance in cylindrical projection 
+      !!                -> not good if located at too high latitude...
+      !!----------------------------------------------------------------------
+      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
+      REAL(wp)        , INTENT(  out) ::   rdist        ! distance between the located point and the source
+      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
+      INTEGER         , INTENT(in   ), OPTIONAL :: kkk  ! k-index of the mask level used
+      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
+      !
+      INTEGER :: ik         ! working level
+      INTEGER , DIMENSION(2) ::   iloc
+      REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zmask, zdist
+      !!--------------------------------------------------------------------
+      !
+      zmask(:,:) = 0._wp
+      ik = 1
+      IF ( PRESENT(kkk) ) ik=kkk
+      SELECT CASE( cdgrid )
+      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik)
+      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik)
+      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik)
+      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik)
+      END SELECT
+
+      zdist = dist(plon, plat, zglam, zgphi)
+
+      IF( lk_mpp ) THEN  
+         CALL mpp_minloc( 'domngb', zdist(:,:), zmask, rdist, iloc)
+         kii = iloc(1) ; kjj = iloc(2)
+      ELSE
+         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
+         rdist = MINVAL( zdist(:,:) )
+         kii = iloc(1) + nimpp - 1
+         kjj = iloc(2) + njmpp - 1
+      ENDIF
+      !
+   END SUBROUTINE dom_ngb
+
+   FUNCTION dist(plonsrc, platsrc, plontrg, plattrg)
+      REAL(wp),                     INTENT(in) :: plonsrc, platsrc ! lat/lon of the source point
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plontrg, plattrg ! lat/lon of the target (2d in this case)
+
+      REAL(wp) :: zxs, zys, zzs
+      REAL(wp), DIMENSION(jpi,jpj) :: zxt, zyt, zzt
+
+      REAL(wp), DIMENSION(jpi,jpj) :: dist ! distance between src and trg
+
+      zxs = COS( rad * platsrc ) * COS( rad * plonsrc )
+      zys = COS( rad * platsrc ) * SIN( rad * plonsrc )
+      zzs = SIN( rad * platsrc )
+
+      zxt = COS( rad * plattrg ) * COS( rad * plontrg )
+      zyt = COS( rad * plattrg ) * SIN( rad * plontrg )
+      zzt = SIN( rad * plattrg )
+
+      dist(:,:) = ( zxs - zxt(:,:) )**2   &
+         &      + ( zys - zyt(:,:) )**2   &
+         &      + ( zzs - zzt(:,:) )**2
+
+      dist(:,:) = ra * SQRT( dist(:,:) )
+
+   END FUNCTION dist
+
+   !!======================================================================
+END MODULE domngb
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domngb.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domngb.f90	(revision 12100)
+++ 	(revision )
@@ -1,92 +1,0 @@
-MODULE domngb
-   !!======================================================================
-   !!                       ***  MODULE  domngb  ***
-   !! Grid search:  find the closest grid point from a given on/lat position
-   !!======================================================================
-   !! History : 3.2  !  2009-11  (S. Masson)  Original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dom_ngb       : find the closest grid point from a given lon/lat position
-   !!----------------------------------------------------------------------
-   USE dom_oce        ! ocean space and time domain
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! for mppsum
-   USE wrk_nemo       ! Memory allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dom_ngb   ! routine called in iom.F90 module
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: domngb.F90 6140 2015-12-21 11:35:23Z timgraham $ 
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid, kkk )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE dom_ngb  ***
-      !!
-      !! ** Purpose :   find the closest grid point from a given lon/lat position
-      !!
-      !! ** Method  :   look for minimum distance in cylindrical projection 
-      !!                -> not good if located at too high latitude...
-      !!----------------------------------------------------------------------
-      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
-      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
-      INTEGER         , INTENT(in   ), OPTIONAL :: kkk  ! k-index of the mask level used
-      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
-      !
-      INTEGER :: ik         ! working level
-      INTEGER , DIMENSION(2) ::   iloc
-      REAL(wp)               ::   zlon, zmini
-      REAL(wp), POINTER, DIMENSION(:,:) ::  zglam, zgphi, zmask, zdist
-      !!--------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_ngb')
-      !
-      CALL wrk_alloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
-      !
-      zmask(:,:) = 0._wp
-      ik = 1
-      IF ( PRESENT(kkk) ) ik=kkk
-      SELECT CASE( cdgrid )
-      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik)
-      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik)
-      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik)
-      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik)
-      END SELECT
-
-      IF (jphgr_msh /= 2 .AND. jphgr_msh /= 3) THEN
-         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
-      ELSE
-         zglam(:,:) = zglam(:,:) - plon
-      END IF
-
-      zgphi(:,:) = zgphi(:,:) - plat
-      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
-      
-      IF( lk_mpp ) THEN  
-         CALL mpp_minloc( zdist(:,:), zmask, zmini, kii, kjj)
-      ELSE
-         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
-         kii = iloc(1) + nimpp - 1
-         kjj = iloc(2) + njmpp - 1
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_ngb')
-      !
-   END SUBROUTINE dom_ngb
-
-   !!======================================================================
-END MODULE domngb
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domstp.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domstp.f90	(revision 12100)
+++ 	(revision )
@@ -1,71 +1,0 @@
-MODULE domstp
-   !!==============================================================================
-   !!                       ***  MODULE domstp   ***
-   !! Ocean initialization : time domain
-   !!==============================================================================
-
-   !!----------------------------------------------------------------------
-   !!   dom_stp        : ocean time domain initialization
-   !!----------------------------------------------------------------------
-   !! History :  OPA  ! 1990-10  (O. Marti)  Original code
-   !!                 ! 1996-01  (G. Madec)  terrain following coordinates
-   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers
-   USE dom_oce        ! ocean space and time domain
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dom_stp   ! routine called by inidom.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: domstp.F90 6140 2015-12-21 11:35:23Z timgraham $ 
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dom_stp
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE dom_stp  ***
-      !!          
-      !! ** Purpose :   Intialize ocean time step for the run
-      !!
-      !! ** Method  : - Initialization of a coef. use in the Asselin time
-      !!      filter:  atfp1 = 1 - 2 * atfp  where atfp is the Asselin time
-      !!      filter parameter read in namelist
-      !!              - Model time step:
-      !!                synchronous time intergration.
-      !!      There is one time step only, defined by: rdt for dynamics and
-      !!      tracer,wind stress, surface heat and salt fluxes
-      !!
-      !! ** Action  : [REMOVED - rdttra: vertical profile of tracer time step]
-      !!              - atfp1    : = 1 - 2*atfp
-      !!
-      !! References :   Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673.
-      !!----------------------------------------------------------------------
-      INTEGER ::   jk              ! dummy loop indice
-      !!----------------------------------------------------------------------
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_stp : time stepping setting'
-         WRITE(numout,*) '~~~~~~~'
-      ENDIF
-
-      ! 0. Asselin Time filter
-      ! ----------------------
-      
-      atfp1 = 1. - 2. * atfp
-
-      IF(lwp) WRITE(numout,*)'               synchronous time stepping'
-      IF(lwp) WRITE(numout,*)'               dynamics and tracer time step = ', rdt/3600., ' hours'
-
-
-   END SUBROUTINE dom_stp
-
-   !!======================================================================
-END MODULE domstp
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domutl.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domutl.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domutl.F90	(revision 12101)
@@ -0,0 +1,268 @@
+MODULE domutil
+   !!
+   !!======================================================================
+   !!                       ***  MODULE  closea  ***
+   !! modutl : specific module to do
+   !!              - 2d flood filling (closea)
+   !!              - 3d flood filling (zgr_isf)
+   !!
+   !!======================================================================
+   !! History :   4.0  !  03-18  (P. Mathiot) Original code
+   !!----------------------------------------------------------------------
+   !!
+   !!----------------------------------------------------------------------
+   !!   fillpool    : replace all point connected to the seed by a fillvalue 
+   !!----------------------------------------------------------------------
+   !!
+   USE dom_oce         ! ocean space and time domain
+   USE domngb
+   USE in_out_manager    ! I/O manager
+   USE lib_mpp
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC fill_pool      ! routine called by domain module
+
+   INTERFACE fill_pool
+      MODULE PROCEDURE FillPool2D, FillPool3D
+   END INTERFACE
+
+   TYPE idx
+      INTEGER :: i,j,k
+      TYPE(idx), POINTER :: next
+   END TYPE idx
+
+CONTAINS
+   SUBROUTINE FillPool3D(kiseed, kjseed, kkseed, rdta, rfill)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE FillPool3D  ***
+      !!
+      !! ** Purpose :  Replace all area surrounding by mask value by kifill value
+      !!
+      !! ** Method  :  flood fill algorithm
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                          INTENT(in)    :: kiseed, kjseed, kkseed ! seed
+      REAL(wp),                         INTENT(in)    :: rfill                  ! filling value
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: rdta                   ! input data
+      REAL(wp), DIMENSION(jpi,jpj,jpk)                :: rseedmap, rseedmap_b   ! map of seed (use for processor communication)
+ 
+      INTEGER :: ii  , ij  , ik   , kii, kjj, jj, kk    ! working integer
+      INTEGER :: iip1, ijp1, ikp1                       ! working integer
+      INTEGER :: iim1, ijm1, ikm1                       ! working integer
+      INTEGER :: nseed                                  ! size of the stack
+      TYPE (idx), POINTER :: seed
+      !!---------------------------------------------------------------------- 
+      !
+      ! initialisation seed
+      NULLIFY(seed)
+      !
+      ! create the first seed and update nseed for all processors
+      nseed = 0
+      rseedmap = 0.
+      ii=kiseed; ij=kjseed ; ik=kkseed
+      IF ((mi0(ii) == mi1(ii)) .AND. (mj0(ij) == mj1(ij))) THEN   ! T if seed on the local domain
+         ii = mi0(ii) ; ij = mj0(ij);                             ! conversion to local index
+         IF (rdta(ii,ij,ik) > 0 ) THEN                            ! create seed if not on land
+            CALL add_head_idx(seed,ii,ij,ik)
+            rdta    (ii,ij,ik) = rfill
+            rseedmap(ii,ij,ik) = 1.
+         END IF
+      END IF
+      nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! nseed =0 means on land => WARNING later on
+      !
+      ! loop until the stack size is 0 or if the pool is larger than the critical size
+      IF (nseed > 0) THEN
+         ! seed on ocean continue
+         DO WHILE ( nseed /= 0 )
+            DO WHILE ( ASSOCIATED(seed) )
+               ii=seed%i; ij=seed%j ; ik=seed%k ; rseedmap(ii,ij,ik)=1.
+               ! 
+               ! update bathy and update stack size
+               CALL del_head_idx(seed) 
+               !
+               ! check neighbour cells
+               iip1=ii+1 ; IF (iip1 == jpi+1 ) iip1=ii
+               iim1=ii-1 ; IF (iim1 == 0     ) iim1=ii
+               ijp1=ij+1 ; IF (ijp1 == jpj+1 ) ijp1=ij
+               ijm1=ij-1 ; IF (ijm1 == 0     ) ijm1=ij
+               ikp1=ik+1 ; IF (ikp1 == jpk+1 ) ikp1=ik
+               ikm1=ik-1 ; IF (ikm1 == 0     ) ikm1=ik
+               !
+               ! ji direction
+               IF (rdta(ii,ijp1,ik) > 0 .AND. rdta(ii,ijp1,ik) /= rfill ) THEN ; CALL add_head_idx(seed,ii,ijp1,ik) ; rdta(ii,ijp1,ik) = rfill ; rseedmap(ii,ijp1,ik)=1. ; END IF
+               IF (rdta(ii,ijm1,ik) > 0 .AND. rdta(ii,ijm1,ik) /= rfill ) THEN ; CALL add_head_idx(seed,ii,ijm1,ik) ; rdta(ii,ijm1,ik) = rfill ; rseedmap(ii,ijm1,ik)=1. ; END IF
+               !
+               ! jj direction
+               IF (rdta(iip1,ij,ik) > 0 .AND. rdta(iip1,ij,ik) /= rfill ) THEN ; CALL add_head_idx(seed,iip1,ij,ik) ; rdta(iip1,ij,ik) = rfill ; rseedmap(iip1,ij,ik)=1. ; END IF
+               IF (rdta(iim1,ij,ik) > 0 .AND. rdta(iim1,ij,ik) /= rfill ) THEN ; CALL add_head_idx(seed,iim1,ij,ik) ; rdta(iim1,ij,ik) = rfill ; rseedmap(iim1,ij,ik)=1. ; END IF
+               !
+               ! jk direction
+               IF (rdta(ii,ij,ikp1) > 0 .AND. rdta(ii,ij,ikp1) /= rfill ) THEN ; CALL add_head_idx(seed,ii,ij,ikp1) ; rdta(ii,ij,ikp1) = rfill ; rseedmap(ii,ij,ik)=1. ; END IF
+               IF (rdta(ii,ij,ikm1) > 0 .AND. rdta(ii,ij,ikm1) /= rfill ) THEN ; CALL add_head_idx(seed,ii,ij,ikm1) ; rdta(ii,ij,ikm1) = rfill ; rseedmap(ii,ij,ik)=1. ; END IF
+            END DO
+            !
+            ! exchange seed
+            nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! this is the sum of all the point check this iteration
+            !
+            rseedmap_b(:,:,:)=rseedmap(:,:,:)
+            CALL lbc_lnk('domutil', rseedmap, 'T', 1.)
+            !
+            ! build new list of seed
+            DO ii=1,jpi
+               DO jj=1,jpj
+                  DO kk=1,jpk
+                     IF (rseedmap(ii,jj,kk) > 0.0 .AND. rseedmap(ii,jj,kk) /= rseedmap_b(ii,jj,kk) .AND. rdta(ii,jj,kk) > 0 .AND. rdta(ii,jj,kk) /= rfill) THEN
+                        CALL add_head_idx(seed,ii,jj,kk)
+                     END IF
+                  END DO
+               END DO
+            END DO
+            !
+            ! reset map of seed
+            rseedmap(:,:,:)=0.0
+            !
+         END DO
+      ELSE
+         WRITE(numout,*) 'W A R N I N G : SEED (',ii,ij,') is on land, nothing to do'
+      END IF
+ 
+   END SUBROUTINE FillPool3D
+
+   SUBROUTINE FillPool2D(kiseed, kjseed, rdta, rfill)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE FillPool3D  ***
+      !!
+      !! ** Purpose :  Replace all area surrounding by mask value by kifill value
+      !!
+      !! ** Method  :  flood fill algorithm
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                      INTENT(in)    :: kiseed, kjseed ! seed
+      REAL(wp),                     INTENT(in)    :: rfill          ! filling value
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: rdta           ! input data
+      REAL(wp), DIMENSION(jpi,jpj) :: rseedmap                      ! location of new seed (used for processor exchange)
+ 
+      INTEGER :: ii  , ij  , jj, kii, kjj     ! working integer
+      INTEGER :: iip1, ijp1                   ! working integer
+      INTEGER :: iim1, ijm1                   ! working integer
+      INTEGER :: nseed                        ! size of the stack
+      TYPE (idx), POINTER :: seed
+      !!----------------------------------------------------------------------
+      !
+      ! initialisation seed
+      NULLIFY(seed)
+      !
+      ! create the first seed and update nseed for all processors
+      nseed = 0
+      rseedmap = 0.
+      ii = kiseed ; ij = kjseed ;
+      IF ((mi0(ii) == mi1(ii)) .AND. (mj0(ij) == mj1(ij))) THEN   ! T if seed on the local domain
+         ii = mi0(ii) ; ij = mj0(ij)                              ! conversion to local index
+         IF (rdta(ii,ij) > 0 ) THEN                               ! create seed if not on land
+            CALL add_head_idx(seed,ii,ij,1)
+            rdta    (ii,ij) = rfill
+            rseedmap(ii,ij) = 1.
+         END IF
+      END IF
+      nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! nseed =0 means on land => WARNING later on
+      !
+      ! loop until the stack size is 0 or if the pool is larger than the critical size
+      IF (nseed > 0) THEN
+         ! seed on ocean continue
+         DO WHILE ( nseed .NE. 0 )
+            DO WHILE ( ASSOCIATED(seed) )
+               ii=seed%i; ij=seed%j
+               ! update stack size
+               CALL del_head_idx(seed) 
+               ! 
+               ! check neighbour cells
+               iip1=ii+1 ; IF (iip1 == jpi+1 ) iip1=ii
+               iim1=ii-1 ; IF (iim1 == 0     ) iim1=ii
+               ijp1=ij+1 ; IF (ijp1 == jpj+1 ) ijp1=ij
+               ijm1=ij-1 ; IF (ijm1 == 0     ) ijm1=ij
+               !
+               ! ji direction
+               IF (rdta(ii  ,ijp1) > 0 .AND. rdta(ii  ,ijp1) /= rfill ) THEN ; CALL add_head_idx(seed,ii  ,ijp1,1) ; rdta(ii  ,ijp1) = rfill ; rseedmap(ii  ,ijp1)=1. ; END IF
+               IF (rdta(ii  ,ijm1) > 0 .AND. rdta(ii  ,ijm1) /= rfill ) THEN ; CALL add_head_idx(seed,ii  ,ijm1,1) ; rdta(ii  ,ijm1) = rfill ; rseedmap(ii  ,ijm1)=1. ; END IF
+               !
+               ! jj direction
+               IF (rdta(iip1,ij  ) > 0 .AND. rdta(iip1,ij  ) /= rfill ) THEN ; CALL add_head_idx(seed,iip1,ij  ,1) ; rdta(iip1,ij  ) = rfill ; rseedmap(iip1,ij  )=1. ; END IF
+               IF (rdta(iim1,ij  ) > 0 .AND. rdta(iim1,ij  ) /= rfill ) THEN ; CALL add_head_idx(seed,iim1,ij  ,1) ; rdta(iim1,ij  ) = rfill ; rseedmap(iim1,ij  )=1. ; END IF
+            END DO
+            !
+            ! exchange seed
+            nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! this is the sum of all the point check this iteration
+            !
+            CALL lbc_lnk('domutil', rseedmap, 'T', 1.)
+            !
+            ! build new list of seed
+            ! new seed only if data > 0 (ie not land), data not already filled and rseedmap > 0
+            DO ii=1,jpi
+               DO jj=1,jpj
+                  IF (rseedmap(ii,jj) > 0.0 .AND. rdta(ii,jj) > 0 .AND. rdta(ii,jj) /= rfill) THEN
+                     CALL add_head_idx(seed, ii, jj, 1)
+                  END IF
+               END DO
+            END DO 
+            !
+            ! reset map of seed
+            rseedmap(:,:)=0.0
+            !
+         END DO
+      ELSE
+         WRITE(numout,*) 'W A R N I N G : SEED (',ii,ij,') is on land, nothing to do', narea
+      END IF
+ 
+   END SUBROUTINE FillPool2D
+   !
+   !
+   ! subroutine to deals with link list
+   !
+   SUBROUTINE add_head_idx(pt_idx, ki, kj, kk)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE add_head_idx  ***
+      !!
+      !! ** Purpose : add one element in the linked list
+      !!
+      !! ** Method  :  allocate one element, then point %next to the linked list
+      !!----------------------------------------------------------------------
+      TYPE (idx), POINTER :: pt_idx
+      TYPE (idx), POINTER :: zpt_new
+      INTEGER, INTENT(in) :: ki, kj, kk
+      !
+      ! allocate new element
+      ALLOCATE(zpt_new)
+      zpt_new%i=ki ; zpt_new%j=kj ; zpt_new%k=kk ;
+      zpt_new%next => NULL()
+      !
+      ! linked new element to main list
+      zpt_new%next => pt_idx
+      pt_idx => zpt_new
+   END SUBROUTINE add_head_idx
+
+   SUBROUTINE del_head_idx(pt_idx)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE del_head_idx  ***
+      !!
+      !! ** Purpose : delete one element in the linked list
+      !!
+      !! ** Method  : move the pointer to the next node 
+      !!----------------------------------------------------------------------
+      TYPE (idx), POINTER :: pt_idx
+      TYPE (idx), POINTER :: zpt_tmp
+      !
+      ! delete first element
+      IF (ASSOCIATED(pt_idx%next)) THEN
+         zpt_tmp => pt_idx%next
+         DEALLOCATE(pt_idx)
+         NULLIFY(pt_idx)
+         pt_idx => zpt_tmp
+      ELSE
+         NULLIFY(pt_idx)
+      ENDIF
+   END SUBROUTINE del_head_idx
+   !
+END MODULE domutil
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domvvl.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domvvl.f90	(revision 12100)
+++ 	(revision )
@@ -1,437 +1,0 @@
-MODULE domvvl
-   !!======================================================================
-   !!                       ***  MODULE domvvl   ***
-   !! Ocean : 
-   !!======================================================================
-   !! History :  2.0  !  2006-06  (B. Levier, L. Marie)  original code
-   !!            3.1  !  2009-02  (G. Madec, M. Leclair, R. Benshila)  pure z* coordinate
-   !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl:
-   !!                                          vvl option includes z_star and z_tilde coordinates
-   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness
-   !!   dom_vvl_sf_nxt   : Compute next vertical scale factors
-   !!   dom_vvl_sf_swp   : Swap vertical scale factors and update the vertical grid
-   !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another
-   !!   dom_vvl_rst      : read/write restart file
-   !!   dom_vvl_ctl      : Check the vvl options
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE phycst          ! physical constant
-   USE dom_oce         ! ocean space and time domain
-   !
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O manager library
-   USE lib_mpp         ! distributed memory computing library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC  dom_vvl_init       ! called by domain.F90
-
-   !                                                      !!* Namelist nam_vvl
-   LOGICAL , PUBLIC :: ln_vvl_zstar           = .FALSE.    ! zstar  vertical coordinate
-   LOGICAL , PUBLIC :: ln_vvl_ztilde          = .FALSE.    ! ztilde vertical coordinate
-   LOGICAL , PUBLIC :: ln_vvl_layer           = .FALSE.    ! level  vertical coordinate
-   LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar = .FALSE.    ! ztilde vertical coordinate
-   LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor  = .FALSE.    ! ztilde vertical coordinate
-   LOGICAL , PUBLIC :: ln_vvl_kepe            = .FALSE.    ! kinetic/potential energy transfer
-   !                                                       ! conservation: not used yet
-   REAL(wp)         :: rn_ahe3                             ! thickness diffusion coefficient
-   REAL(wp)         :: rn_rst_e3t                          ! ztilde to zstar restoration timescale [days]
-   REAL(wp)         :: rn_lf_cutoff                        ! cutoff frequency for low-pass filter  [days]
-   REAL(wp)         :: rn_zdef_max                         ! maximum fractional e3t deformation
-   LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE.                ! debug control prints
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                ! thickness diffusion transport
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf                     ! low frequency part of hz divergence
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n    ! baroclinic scale factors
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a   ! baroclinic scale factors
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t                 ! retoring period for scale factors
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence
-
-   !! * Substitutions
-   !!----------------------------------------------------------------------
-   !!                   ***  vectopt_loop_substitute  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
-   !!                allow unrolling of do-loop (useful with vector processors)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
-   !! Software governed by the CeCILL licence (./LICENSE)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO-Consortium (2015) 
-   !! $Id: domvvl.F90 6351 2016-02-24 18:50:11Z cetlod $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION dom_vvl_alloc()
-      !!----------------------------------------------------------------------
-      !!                ***  FUNCTION dom_vvl_alloc  ***
-      !!----------------------------------------------------------------------
-      IF( ln_vvl_zstar )   dom_vvl_alloc = 0
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
-         ALLOCATE( tilde_e3t_b(jpi,jpj,jpk)  , tilde_e3t_n(jpi,jpj,jpk) , tilde_e3t_a(jpi,jpj,jpk) ,   &
-            &      dtilde_e3t_a(jpi,jpj,jpk) , un_td  (jpi,jpj,jpk)     , vn_td  (jpi,jpj,jpk)     ,   &
-            &      STAT = dom_vvl_alloc        )
-         IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc )
-         IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
-         un_td = 0._wp
-         vn_td = 0._wp
-      ENDIF
-      IF( ln_vvl_ztilde ) THEN
-         ALLOCATE( frq_rst_e3t(jpi,jpj) , frq_rst_hdv(jpi,jpj) , hdiv_lf(jpi,jpj,jpk) , STAT= dom_vvl_alloc )
-         IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc )
-         IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
-      ENDIF
-      !
-   END FUNCTION dom_vvl_alloc
-
-
-   SUBROUTINE dom_vvl_init
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE dom_vvl_init  ***
-      !!                   
-      !! ** Purpose :  Initialization of all scale factors, depths
-      !!               and water column heights
-      !!
-      !! ** Method  :  - use restart file and/or initialize
-      !!               - interpolate scale factors
-      !!
-      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b)
-      !!              - Regrid: e3(u/v)_n
-      !!                        e3(u/v)_b       
-      !!                        e3w_n           
-      !!                        e3(u/v)w_b      
-      !!                        e3(u/v)w_n      
-      !!                        gdept_n, gdepw_n and gde3w_n
-      !!              - h(t/u/v)_0
-      !!              - frq_rst_e3t and frq_rst_hdv
-      !!
-      !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling.
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj, jk
-      INTEGER ::   ii0, ii1, ij0, ij1
-      REAL(wp)::   zcoef
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_init')
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-      !
-      CALL dom_vvl_ctl     ! choose vertical coordinate (z_star, z_tilde or layer)
-      !
-      !                    ! Allocate module arrays
-      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
-      !
-      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
-      e3t_a(:,:,jpk) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all
-      !
-      !                    !== Set of all other vertical scale factors  ==!  (now and before)
-      !                                ! Horizontal interpolation of e3t
-      CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )    ! from T to U
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
-      CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )    ! from T to V 
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
-      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )    ! from U to F
-      !                                ! Vertical interpolation of e3t,u,v 
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )  ! from T to W
-      CALL dom_vvl_interpol( e3t_b(:,:,:), e3w_b (:,:,:), 'W'  )
-      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )  ! from U to UW
-      CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
-      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )  ! from V to UW
-      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
-      !
-      !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep)
-      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)       ! reference to the ocean surface (used for MLD and light penetration)
-      gdepw_n(:,:,1) = 0.0_wp
-      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)  ! reference to a common level z=0 for hpg
-      gdept_b(:,:,1) = 0.5_wp * e3w_b(:,:,1)
-      gdepw_b(:,:,1) = 0.0_wp
-      DO jk = 2, jpk                               ! vertical sum
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
-               !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
-               !                             ! 0.5 where jk = mikt     
-!!gm ???????   BUG ?  gdept_n as well as gde3w_n  does not include the thickness of ISF ??
-               zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) )
-               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
-               gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  &
-                  &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk)) 
-               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj)
-               gdepw_b(ji,jj,jk) = gdepw_b(ji,jj,jk-1) + e3t_b(ji,jj,jk-1)
-               gdept_b(ji,jj,jk) =      zcoef  * ( gdepw_b(ji,jj,jk  ) + 0.5 * e3w_b(ji,jj,jk))  &
-                  &                + (1-zcoef) * ( gdept_b(ji,jj,jk-1) +       e3w_b(ji,jj,jk)) 
-            END DO
-         END DO
-      END DO
-      !
-      !                    !==  thickness of the water column  !!   (ocean portion only)
-      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) ....
-      hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1)
-      hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1)
-      hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1)
-      hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1)
-      DO jk = 2, jpkm1
-         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
-         hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)
-         hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
-         hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)
-         hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
-      END DO
-      !
-      !                    !==  inverse of water column thickness   ==!   (u- and v- points)
-      r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF
-      r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) )
-      r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )
-      r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) )
-
-      !                    !==   z_tilde coordinate case  ==!   (Restoring frequencies)
-      IF( ln_vvl_ztilde ) THEN
-!!gm : idea: add here a READ in a file of custumized restoring frequency
-         !                                   ! Values in days provided via the namelist
-         !                                   ! use rsmall to avoid possible division by zero errors with faulty settings
-         frq_rst_e3t(:,:) = 2._wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.0_wp )
-         frq_rst_hdv(:,:) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp )
-         !
-         IF( ln_vvl_ztilde_as_zstar ) THEN   ! z-star emulation using z-tile
-            frq_rst_e3t(:,:) = 0._wp               !Ignore namelist settings
-            frq_rst_hdv(:,:) = 1._wp / rdt
-         ENDIF
-         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-!!gm  case |gphi| >= 6 degrees is useless   initialized just above by default
-                  IF( ABS(gphit(ji,jj)) >= 6.) THEN
-                     ! values outside the equatorial band and transition zone (ztilde)
-                     frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp )
-                     frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )
-                  ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star
-                     ! values inside the equatorial band (ztilde as zstar)
-                     frq_rst_e3t(ji,jj) =  0.0_wp
-                     frq_rst_hdv(ji,jj) =  1.0_wp / rdt
-                  ELSE                                      ! transition band (2.5 to 6 degrees N/S)
-                     !                                      ! (linearly transition from z-tilde to z-star)
-                     frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   &
-                        &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
-                        &                                          * 180._wp / 3.5_wp ) )
-                     frq_rst_hdv(ji,jj) = (1.0_wp / rdt)                                &
-                        &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rdt) )*0.5_wp   &
-                        &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
-                        &                                          * 180._wp / 3.5_wp ) )
-                  ENDIF
-               END DO
-            END DO
-            IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2
-               ii0 = 103   ;   ii1 = 111       
-               ij0 = 128   ;   ij1 = 135   ;   
-               frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp
-               frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rdt
-            ENDIF
-         ENDIF
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_init')
-      !
-   END SUBROUTINE dom_vvl_init
-
-
-   SUBROUTINE dom_vvl_interpol( pe3_in, pe3_out, pout )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_vvl__interpol  ***
-      !!
-      !! ** Purpose :   interpolate scale factors from one grid point to another
-      !!
-      !! ** Method  :   e3_out = e3_0 + interpolation(e3_in - e3_0)
-      !!                - horizontal interpolation: grid cell surface averaging
-      !!                - vertical interpolation: simple averaging
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::  pe3_in    ! input e3 to be interpolated
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  pe3_out   ! output interpolated e3
-      CHARACTER(LEN=*)                , INTENT(in   ) ::  pout      ! grid point of out scale factors
-      !                                                             !   =  'U', 'V', 'W, 'F', 'UW' or 'VW'
-      !
-      INTEGER ::   ji, jj, jk                                       ! dummy loop indices
-      REAL(wp) ::  zlnwd                                            ! =1./0. when ln_wd = T/F
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_interpol')
-      !
-      zlnwd = 0.0_wp
-      !
-      SELECT CASE ( pout )    !==  type of interpolation  ==!
-         !
-      CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   &
-                     &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
-                     &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )
-         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:)
-         !
-      CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   &
-                     &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
-                     &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )
-         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:)
-         !
-      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &
-                     &                       *    r1_e1e2f(ji,jj)                                                  &
-                     &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
-                     &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp )
-         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:)
-         !
-      CASE( 'W' )                   !* from T- to W-point : vertical simple mean
-         !
-         pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1)
-         ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing
-!!gm BUG? use here wmask in case of ISF ?  to be checked
-         DO jk = 2, jpk
-            pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )   &
-               &                            * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )                               &
-               &                            +            0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )     &
-               &                            * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) )
-         END DO
-         !
-      CASE( 'UW' )                  !* from U- to UW-point : vertical simple mean
-         !
-         pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1)
-         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
-!!gm BUG? use here wumask in case of ISF ?  to be checked
-         DO jk = 2, jpk
-            pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  &
-               &                             * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )                              &
-               &                             +            0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    &
-               &                             * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) )
-         END DO
-         !
-      CASE( 'VW' )                  !* from V- to VW-point : vertical simple mean
-         !
-         pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1)
-         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
-!!gm BUG? use here wvmask in case of ISF ?  to be checked
-         DO jk = 2, jpk
-            pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  &
-               &                             * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )                              &
-               &                             +            0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    &
-               &                             * ( pe3_in(:,:,jk  ) - e3v_0(:,:,jk  ) )
-         END DO
-      END SELECT
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_interpol')
-      !
-   END SUBROUTINE dom_vvl_interpol
-
-
-   SUBROUTINE dom_vvl_ctl
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_vvl_ctl  ***
-      !!                
-      !! ** Purpose :   Control the consistency between namelist options
-      !!                for vertical coordinate
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio, ios
-      !!
-      NAMELIST/nam_vvl/ ln_vvl_zstar, ln_vvl_ztilde, ln_vvl_layer, ln_vvl_ztilde_as_zstar, &
-         &              ln_vvl_zstar_at_eqtor      , rn_ahe3     , rn_rst_e3t            , &
-         &              rn_lf_cutoff               , rn_zdef_max , ln_vvl_dbg                ! not yet implemented: ln_vvl_kepe
-      !!---------------------------------------------------------------------- 
-      !
-      REWIND( numnam_ref )              ! Namelist nam_vvl in reference namelist : 
-      READ  ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in reference namelist', lwp )
-      !
-      REWIND( numnam_cfg )              ! Namelist nam_vvl in configuration namelist : Parameters of the run
-      READ  ( numnam_cfg, nam_vvl, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, nam_vvl )
-      !
-      IF(lwp) THEN                    ! Namelist print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_vvl_ctl : choice/control of the variable vertical coordinate'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '           Namelist nam_vvl : chose a vertical coordinate'
-         WRITE(numout,*) '              zstar                      ln_vvl_zstar   = ', ln_vvl_zstar
-         WRITE(numout,*) '              ztilde                     ln_vvl_ztilde  = ', ln_vvl_ztilde
-         WRITE(numout,*) '              layer                      ln_vvl_layer   = ', ln_vvl_layer
-         WRITE(numout,*) '              ztilde as zstar   ln_vvl_ztilde_as_zstar  = ', ln_vvl_ztilde_as_zstar
-         WRITE(numout,*) '      ztilde near the equator    ln_vvl_zstar_at_eqtor  = ', ln_vvl_zstar_at_eqtor
-         ! WRITE(numout,*) '           Namelist nam_vvl : chose kinetic-to-potential energy conservation'
-         ! WRITE(numout,*) '                                         ln_vvl_kepe    = ', ln_vvl_kepe
-         WRITE(numout,*) '           Namelist nam_vvl : thickness diffusion coefficient'
-         WRITE(numout,*) '                                         rn_ahe3        = ', rn_ahe3
-         WRITE(numout,*) '           Namelist nam_vvl : maximum e3t deformation fractional change'
-         WRITE(numout,*) '                                         rn_zdef_max    = ', rn_zdef_max
-         IF( ln_vvl_ztilde_as_zstar ) THEN
-            WRITE(numout,*) '           ztilde running in zstar emulation mode; '
-            WRITE(numout,*) '           ignoring namelist timescale parameters and using:'
-            WRITE(numout,*) '                 hard-wired : z-tilde to zstar restoration timescale (days)'
-            WRITE(numout,*) '                                         rn_rst_e3t     =    0.0'
-            WRITE(numout,*) '                 hard-wired : z-tilde cutoff frequency of low-pass filter (days)'
-            WRITE(numout,*) '                                         rn_lf_cutoff   =    1.0/rdt'
-         ELSE
-            WRITE(numout,*) '           Namelist nam_vvl : z-tilde to zstar restoration timescale (days)'
-            WRITE(numout,*) '                                         rn_rst_e3t     = ', rn_rst_e3t
-            WRITE(numout,*) '           Namelist nam_vvl : z-tilde cutoff frequency of low-pass filter (days)'
-            WRITE(numout,*) '                                         rn_lf_cutoff   = ', rn_lf_cutoff
-         ENDIF
-         WRITE(numout,*) '           Namelist nam_vvl : debug prints'
-         WRITE(numout,*) '                                         ln_vvl_dbg     = ', ln_vvl_dbg
-      ENDIF
-      !
-      ioptio = 0                      ! Parameter control
-      IF( ln_vvl_ztilde_as_zstar )   ln_vvl_ztilde = .true.
-      IF( ln_vvl_zstar           )   ioptio = ioptio + 1
-      IF( ln_vvl_ztilde          )   ioptio = ioptio + 1
-      IF( ln_vvl_layer           )   ioptio = ioptio + 1
-      !
-      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' )
-      !
-      IF(lwp) THEN                   ! Print the choice
-         WRITE(numout,*)
-         IF( ln_vvl_zstar           ) WRITE(numout,*) '              zstar vertical coordinate is used'
-         IF( ln_vvl_ztilde          ) WRITE(numout,*) '              ztilde vertical coordinate is used'
-         IF( ln_vvl_layer           ) WRITE(numout,*) '              layer vertical coordinate is used'
-         IF( ln_vvl_ztilde_as_zstar ) WRITE(numout,*) '              to emulate a zstar coordinate'
-         ! - ML - Option not developed yet
-         ! IF(       ln_vvl_kepe ) WRITE(numout,*) '              kinetic to potential energy transfer : option used'
-         ! IF( .NOT. ln_vvl_kepe ) WRITE(numout,*) '              kinetic to potential energy transfer : option not used'
-      ENDIF
-      !
-      !
-   END SUBROUTINE dom_vvl_ctl
-
-   !!======================================================================
-END MODULE domvvl
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domwri.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domwri.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domwri.F90	(revision 12101)
@@ -0,0 +1,292 @@
+MODULE domwri
+   !!======================================================================
+   !!                       ***  MODULE domwri  ***
+   !! Ocean initialization : write the ocean domain mesh file(s)
+   !!======================================================================
+   !! History :  OPA  ! 1997-02  (G. Madec)  Original code
+   !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file
+   !!            3.0  ! 2008-01  (S. Masson)  add dom_uniq 
+   !!            4.0  ! 2016-01  (G. Madec)  simplified mesh_mask.nc file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_wri        : create and write mesh and mask file(s)
+   !!   dom_uniq       : identify unique point of a grid (TUVF)
+   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate)
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE phycst ,   ONLY :   rsmall
+ !  USE wet_dry,   ONLY :   ll_wd  ! Wetting and drying
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+   USE lbclnk          ! lateral boundary conditions - mpp exchanges
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_wri              ! routine called by inidom.F90
+   PUBLIC   dom_stiff            ! routine called by inidom.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: domwri.F90 10425 2018-12-19 21:54:16Z smasson $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_wri
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_wri  ***
+      !!                   
+      !! ** Purpose :   Create the NetCDF file(s) which contain(s) all the
+      !!      ocean domain informations (mesh and mask arrays). This (these)
+      !!      file(s) is (are) used for visualisation (SAXO software) and
+      !!      diagnostic computation.
+      !!
+      !! ** Method  :   create a file with all domain related arrays
+      !!
+      !! ** output file :   meshmask.nc  : domain size, horizontal grid-point position,
+      !!                                   masks, depth and vertical scale factors
+      !!----------------------------------------------------------------------
+      INTEGER           ::   inum    ! temprary units for 'mesh_mask.nc' file
+      CHARACTER(len=21) ::   clnam   ! filename (mesh and mask informations)
+      INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      INTEGER           ::   izco, izps, isco, icav
+      !                               
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zprt, zprw     ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepu, zdepv   ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      
+      clnam = 'mesh_mask'  ! filename (mesh and mask informations)
+      
+      !                                  ! ============================
+      !                                  !  create 'mesh_mask.nc' file
+      !                                  ! ============================
+      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )
+      !
+      !                                                         ! global domain size
+      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpkglo, wp), ktype = jp_i4 )
+
+      !                                                         ! domain characteristics
+      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
+      !                                                         ! type of vertical coordinate
+      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
+      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
+      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
+      !                                                         ! ocean cavities under iceshelves
+      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
+  
+      !                                                         ! masks
+      CALL iom_rstput( 0, 0, inum, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask
+      CALL iom_rstput( 0, 0, inum, 'umask', umask, ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum, 'vmask', vmask, ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum, 'fmask', fmask, ktype = jp_i1 )
+      
+      CALL dom_uniq( zprw, 'T' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zprt(ji,jj) = ssmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO                             !    ! unique point mask
+      CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'U' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zprt(ji,jj) = ssumask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO
+      CALL iom_rstput( 0, 0, inum, 'umaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'V' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zprt(ji,jj) = ssvmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO
+      CALL iom_rstput( 0, 0, inum, 'vmaskutil', zprt, ktype = jp_i1 )  
+!!gm  ssfmask has been removed  ==>> find another solution to defined fmaskutil
+!!    Here we just remove the output of fmaskutil.
+!      CALL dom_uniq( zprw, 'F' )
+!      DO jj = 1, jpj
+!         DO ji = 1, jpi
+!            zprt(ji,jj) = ssfmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+!         END DO
+!      END DO
+!      CALL iom_rstput( 0, 0, inum, 'fmaskutil', zprt, ktype = jp_i1 )  
+!!gm
+
+      !                                                         ! horizontal mesh (inum3)
+      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )     !    ! latitude
+      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude
+      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors
+      CALL iom_rstput( 0, 0, inum, 'e1u', e1u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1v', e1v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1f', e1f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors
+      CALL iom_rstput( 0, 0, inum, 'e2u', e2u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2v', e2v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2f', e2f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum, 'ff_f', ff_f, ktype = jp_r8 )       !    ! coriolis factor
+      CALL iom_rstput( 0, 0, inum, 'ff_t', ff_t, ktype = jp_r8 )
+      
+      ! note that mbkt and mikt is set to 1 over land ==> use surface tmask
+      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum, 'mbathy', zprt, ktype = jp_i4 )                              !    ! nb of ocean T-points
+      CALL iom_rstput( 0, 0, inum, 'bathy_metry', bathy(:,:)   * ssmask(:,:), ktype = jp_r8 )   !    ! bathymetry
+      zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum, 'misf', zprt, ktype = jp_i4 )                                !    ! first wet level
+      CALL iom_rstput( 0, 0, inum, 'isfdraft'   , risfdep(:,:) * ssmask(:,:), ktype = jp_r8 )   !    ! ice shelf draft
+      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) - mikt(:,:) + 1, wp )
+      CALL iom_rstput( 0, 0, inum, 'mhw',zprt, ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'hw' ,(bathy-risfdep)*ssmask, ktype = jp_r8 )
+
+      !		             ! vertical mesh
+      CALL iom_rstput( 0, 0, inum, 'e3t_0', e3t_0, ktype = jp_r8  )    !    ! scale factors
+      CALL iom_rstput( 0, 0, inum, 'e3u_0', e3u_0, ktype = jp_r8  )
+      CALL iom_rstput( 0, 0, inum, 'e3v_0', e3v_0, ktype = jp_r8  )
+      CALL iom_rstput( 0, 0, inum, 'e3w_0', e3w_0, ktype = jp_r8  )
+      !
+      CALL iom_rstput( 0, 0, inum, 'gdept_1d' , gdept_1d , ktype = jp_r8 )  ! stretched system
+      CALL iom_rstput( 0, 0, inum, 'gdepw_1d' , gdepw_1d , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gdept_0'  , gdept_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gdepw_0'  , gdepw_0  , ktype = jp_r8 )
+      !
+      IF( ln_sco ) THEN                                         ! s-coordinate stiffness
+         CALL dom_stiff( zprt )
+         CALL iom_rstput( 0, 0, inum, 'stiffness', zprt )       ! Max. grid stiffness ratio
+      ENDIF
+      !
+      !                                     ! ============================
+      CALL iom_close( inum )                !        close the files 
+      !                                     ! ============================
+   END SUBROUTINE dom_wri
+
+
+   SUBROUTINE dom_uniq( puniq, cdgrd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_uniq  ***
+      !!                   
+      !! ** Purpose :   identify unique point of a grid (TUVF)
+      !!
+      !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element
+      !!                2) check which elements have been changed
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   ! 
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   ! 
+      !
+      REAL(wp) ::  zshift   ! shift value link to the process number
+      INTEGER  ::  ji       ! dummy loop indices
+      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztstref
+      !!----------------------------------------------------------------------
+      !
+      ! build an array with different values for each element 
+      ! in mpp: make sure that these values are different even between process
+      ! -> apply a shift value according to the process number
+      zshift = jpi * jpj * ( narea - 1 )
+      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) )
+      !
+      puniq(:,:) = ztstref(:,:)                   ! default definition
+      CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. )            ! apply boundary conditions
+      lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed 
+      !
+      puniq(:,:) = 1.                             ! default definition
+      ! fill only the inner part of the cpu with llbl converted into real 
+      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp )
+      !
+   END SUBROUTINE dom_uniq
+
+
+   SUBROUTINE dom_stiff( px1 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_stiff  ***
+      !!                     
+      !! ** Purpose :   Diagnose maximum grid stiffness/hydrostatic consistency
+      !!
+      !! ** Method  :   Compute Haney (1991) hydrostatic condition ratio
+      !!                Save the maximum in the vertical direction
+      !!                (this number is only relevant in s-coordinates)
+      !!
+      !!                Haney, 1991, J. Phys. Oceanogr., 21, 610-619.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out), OPTIONAL ::   px1   ! stiffness
+      !
+      INTEGER  ::   ji, jj, jk 
+      REAL(wp) ::   zrxmax
+      REAL(wp), DIMENSION(4) ::   zr1
+      REAL(wp), DIMENSION(jpi,jpj) ::   zx1
+      !!----------------------------------------------------------------------
+      zx1(:,:) = 0._wp
+      zrxmax   = 0._wp
+      zr1(:)   = 0._wp
+      !
+      DO ji = 2, jpim1
+         DO jj = 2, jpjm1
+            DO jk = 1, jpkm1
+!!gm   remark: dk(gdepw) = e3t   ===>>>  possible simplification of the following calculation....
+!!             especially since it is gde3w which is used to compute the pressure gradient
+!!             furthermore, I think gdept_0 should be used below instead of w point in the numerator
+!!             so that the ratio is computed at the same point (i.e. uw and vw) ....
+               zr1(1) = ABS(  ( gdepw_0(ji  ,jj,jk  )-gdepw_0(ji-1,jj,jk  )               & 
+                    &          +gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) )             &
+                    &       / ( gdepw_0(ji  ,jj,jk  )+gdepw_0(ji-1,jj,jk  )               &
+                    &          -gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall )  ) * umask(ji-1,jj,jk)
+               zr1(2) = ABS(  ( gdepw_0(ji+1,jj,jk  )-gdepw_0(ji  ,jj,jk  )               &
+                    &          +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) )             &
+                    &       / ( gdepw_0(ji+1,jj,jk  )+gdepw_0(ji  ,jj,jk  )               &
+                    &          -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) + rsmall )  ) * umask(ji  ,jj,jk)
+               zr1(3) = ABS(  ( gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               &
+                    &          +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) )             &
+                    &       / ( gdepw_0(ji,jj+1,jk  )+gdepw_0(ji,jj  ,jk  )               &
+                    &          -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) + rsmall )  ) * vmask(ji,jj  ,jk)
+               zr1(4) = ABS(  ( gdepw_0(ji,jj  ,jk  )-gdepw_0(ji,jj-1,jk  )               &
+                    &          +gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) )             &
+                    &       / ( gdepw_0(ji,jj  ,jk  )+gdepw_0(ji,jj-1,jk  )               &
+                    &          -gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall )  ) * vmask(ji,jj-1,jk)
+               zrxmax = MAXVAL( zr1(1:4) )
+               zx1(ji,jj) = MAX( zx1(ji,jj) , zrxmax )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( 'domwri', zx1, 'T', 1. )
+      !
+      IF( PRESENT( px1 ) )    px1 = zx1
+      !
+      zrxmax = MAXVAL( zx1 )
+      !
+      CALL mpp_max( 'domwri', zrxmax ) ! max over the global domain
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax
+         WRITE(numout,*) '~~~~~~~~~'
+      ENDIF
+      !
+   END SUBROUTINE dom_stiff
+
+   !!======================================================================
+END MODULE domwri
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domwri.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domwri.f90	(revision 12100)
+++ 	(revision )
@@ -1,480 +1,0 @@
-MODULE domwri
-   !!======================================================================
-   !!                       ***  MODULE domwri  ***
-   !! Ocean initialization : write the ocean domain mesh file(s)
-   !!======================================================================
-   !! History :  OPA  ! 1997-02  (G. Madec)  Original code
-   !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
-   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file
-   !!            3.0  ! 2008-01  (S. Masson)  add dom_uniq 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dom_wri        : create and write mesh and mask file(s)
-   !!   dom_uniq       : identify unique point of a grid (TUVF)
-   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate)
-   !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O library
-   USE lbclnk          ! lateral boundary conditions - mpp exchanges
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
-   USE phycst
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dom_wri              ! routine called by inidom.F90
-   PUBLIC   dom_wri_coordinate   ! routine called by domhgr.F90
-   PUBLIC   dom_stiff            ! routine called by inidom.F90
-
-   !!----------------------------------------------------------------------
-   !! 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)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dom_wri_coordinate
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_wri_coordinate  ***
-      !!                   
-      !! ** Purpose :   Create the NetCDF file which contains all the
-      !!              standard coordinate information plus the surface,
-      !!              e1e2u and e1e2v. By doing so, those surface will
-      !!              not be changed by the reduction of e1u or e2v scale 
-      !!              factors in some straits. 
-      !!                 NB: call just after the read of standard coordinate
-      !!              and the reduction of scale factors in some straits
-      !!
-      !! ** output file :   coordinate_e1e2u_v.nc
-      !!----------------------------------------------------------------------
-      INTEGER           ::   inum0    ! temprary units for 'coordinate_e1e2u_v.nc' file
-      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations)
-      !                                   !  workspaces
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw 
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_wri_coordinate')
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'dom_wri_coordinate : create NetCDF coordinate file'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~'
-      
-      clnam0 = 'coordinate_e1e2u_v'  ! filename (mesh and mask informations)
-      
-      !  create 'coordinate_e1e2u_v.nc' file
-      ! ============================
-      !
-      CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib )
-      !
-      !                                                         ! horizontal mesh (inum3)
-      CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r8 )     !    ! latitude
-      CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r8 )
-      
-      CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude
-      CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r8 )
-      
-      CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors
-      CALL iom_rstput( 0, 0, inum0, 'e1u', e1u, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum0, 'e1v', e1v, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum0, 'e1f', e1f, ktype = jp_r8 )
-      
-      CALL iom_rstput( 0, 0, inum0, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors
-      CALL iom_rstput( 0, 0, inum0, 'e2u', e2u, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum0, 'e2v', e2v, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum0, 'e2f', e2f, ktype = jp_r8 )
-      
-      CALL iom_rstput( 0, 0, inum0, 'e1e2u', e1e2u, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum0, 'e1e2v', e1e2v, ktype = jp_r8 )
-
-      CALL iom_close( inum0 )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_wri_coordinate')
-      !
-   END SUBROUTINE dom_wri_coordinate
-
-
-   SUBROUTINE dom_wri
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_wri  ***
-      !!                   
-      !! ** Purpose :   Create the NetCDF file(s) which contain(s) all the
-      !!      ocean domain informations (mesh and mask arrays). This (these)
-      !!      file(s) is (are) used for visualisation (SAXO software) and
-      !!      diagnostic computation.
-      !!
-      !! ** Method  :   Write in a file all the arrays generated in routines
-      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
-      !!      the vertical coord. used (z-coord, partial steps, s-coord)
-      !!            MOD(nmsh, 3) = 1  :   'mesh_mask.nc' file
-      !!                         = 2  :   'mesh.nc' and mask.nc' files
-      !!                         = 0  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
-      !!                                  'mask.nc' files
-      !!      For huge size domain, use option 2 or 3 depending on your 
-      !!      vertical coordinate.
-      !!
-      !!      if     nmsh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw]
-      !!      if 3 < nmsh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays 
-      !!                        corresponding to the depth of the bottom t- and w-points
-      !!      if 6 < nmsh <= 9: write 2D arrays corresponding to the depth and the
-      !!                        thickness (e3[tw]_ps) of the bottom points 
-      !!
-      !! ** output file :   meshmask.nc  : domain size, horizontal grid-point position,
-      !!                                   masks, depth and vertical scale factors
-      !!----------------------------------------------------------------------
-      !!
-      INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file
-      INTEGER           ::   inum1    ! temprary units for 'mesh.nc'      file
-      INTEGER           ::   inum2    ! temprary units for 'mask.nc'      file
-      INTEGER           ::   inum3    ! temprary units for 'mesh_hgr.nc'  file
-      INTEGER           ::   inum4    ! temprary units for 'mesh_zgr.nc'  file
-      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations)
-      CHARACTER(len=21) ::   clnam1   ! filename (mesh informations)
-      CHARACTER(len=21) ::   clnam2   ! filename (mask informations)
-      CHARACTER(len=21) ::   clnam3   ! filename (horizontal mesh informations)
-      CHARACTER(len=21) ::   clnam4   ! filename (vertical   mesh informations)
-      INTEGER           ::   ji, jj, jk   ! dummy loop indices
-      !                                   !  workspaces
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw 
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_wri')
-      !
-      CALL wrk_alloc( jpi, jpj, zprt, zprw )
-      CALL wrk_alloc( jpi, jpj, jpk, zdepu, zdepv )
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)'
-      IF(lwp) WRITE(numout,*) '~~~~~~~'
-      
-      clnam0 = 'mesh_mask'  ! filename (mesh and mask informations)
-      clnam1 = 'mesh'       ! filename (mesh informations)
-      clnam2 = 'mask'       ! filename (mask informations)
-      clnam3 = 'mesh_hgr'   ! filename (horizontal mesh informations)
-      clnam4 = 'mesh_zgr'   ! filename (vertical   mesh informations)
-      
-      SELECT CASE ( MOD(nmsh, 3) )
-         !                                  ! ============================
-      CASE ( 1 )                            !  create 'mesh_mask.nc' file
-         !                                  ! ============================
-         CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib )
-         inum2 = inum0                                            ! put all the informations
-         inum3 = inum0                                            ! in unit inum0
-         inum4 = inum0
-         
-         !                                  ! ============================
-      CASE ( 2 )                            !  create 'mesh.nc' and 
-         !                                  !         'mask.nc' files
-         !                                  ! ============================
-         CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib )
-         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
-         inum3 = inum1                                            ! put mesh informations 
-         inum4 = inum1                                            ! in unit inum1 
-         !                                  ! ============================
-      CASE ( 0 )                            !  create 'mesh_hgr.nc'
-         !                                  !         'mesh_zgr.nc' and
-         !                                  !         'mask.nc'     files
-         !                                  ! ============================
-         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
-         CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib )
-         CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib )
-         !
-      END SELECT
-      
-      !                                                         ! masks (inum2) 
-      CALL iom_rstput( 0, 0, inum2, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask
-      CALL iom_rstput( 0, 0, inum2, 'umask', umask, ktype = jp_i1 )
-      CALL iom_rstput( 0, 0, inum2, 'vmask', vmask, ktype = jp_i1 )
-      CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 )
-      
-      CALL dom_uniq( zprw, 'T' )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            jk=mikt(ji,jj) 
-            zprt(ji,jj) = tmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
-         END DO
-      END DO                             !    ! unique point mask
-      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 )  
-      CALL dom_uniq( zprw, 'U' )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            jk=miku(ji,jj) 
-            zprt(ji,jj) = umask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
-         END DO
-      END DO
-      CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )  
-      CALL dom_uniq( zprw, 'V' )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            jk=mikv(ji,jj) 
-            zprt(ji,jj) = vmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
-         END DO
-      END DO
-      CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )  
-      CALL dom_uniq( zprw, 'F' )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            jk=mikf(ji,jj) 
-            zprt(ji,jj) = fmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
-         END DO
-      END DO
-      CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )  
-
-      !                                                         ! horizontal mesh (inum3)
-      CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r8 )     !    ! latitude
-      CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r8 )
-      
-      CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude
-      CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r8 )
-      
-      CALL iom_rstput( 0, 0, inum3, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors
-      CALL iom_rstput( 0, 0, inum3, 'e1u', e1u, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum3, 'e1v', e1v, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum3, 'e1f', e1f, ktype = jp_r8 )
-      
-      CALL iom_rstput( 0, 0, inum3, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors
-      CALL iom_rstput( 0, 0, inum3, 'e2u', e2u, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum3, 'e2v', e2v, ktype = jp_r8 )
-      CALL iom_rstput( 0, 0, inum3, 'e2f', e2f, ktype = jp_r8 )
-      
-      CALL iom_rstput( 0, 0, inum3, 'ff_f', ff_f, ktype = jp_r8 )           !    ! coriolis factor
-      CALL iom_rstput( 0, 0, inum3, 'ff_t', ff_t, ktype = jp_r8 )           !    ! coriolis factor
-      
-      ! note that mbkt is set to 1 over land ==> use surface tmask
-      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp )
-      CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 )     !    ! nb of ocean T-points
-      zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp )
-      CALL iom_rstput( 0, 0, inum4, 'misf', zprt, ktype = jp_i2 )       !    ! nb of ocean T-points
-      zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp )
-      CALL iom_rstput( 0, 0, inum4, 'isfdraft', zprt, ktype = jp_r8 )       !    ! nb of ocean T-points
-            
-      IF( ln_sco ) THEN                                         ! s-coordinate
-         CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt )
-         CALL iom_rstput( 0, 0, inum4, 'hbatu', hbatu )
-         CALL iom_rstput( 0, 0, inum4, 'hbatv', hbatv )
-         CALL iom_rstput( 0, 0, inum4, 'hbatf', hbatf )
-         !
-         CALL iom_rstput( 0, 0, inum4, 'gsigt', gsigt )         !    ! scaling coef.
-         CALL iom_rstput( 0, 0, inum4, 'gsigw', gsigw )  
-         CALL iom_rstput( 0, 0, inum4, 'gsi3w', gsi3w )
-         CALL iom_rstput( 0, 0, inum4, 'esigt', esigt )
-         CALL iom_rstput( 0, 0, inum4, 'esigw', esigw )
-         !
-         CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 )         !    ! scale factors
-         CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 )
-         CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 )
-         CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 )
-         !
-         CALL iom_rstput( 0, 0, inum4, 'gdept_1d' , gdept_1d )  !    ! stretched system
-         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d' , gdepw_1d )
-         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r8 )     
-         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r8 )
-         CALL dom_stiff( zprt )
-         CALL iom_rstput( 0, 0, inum4, 'stiffness', zprt )       !    ! Max. grid stiffness ratio
-      ENDIF
-      
-      IF( ln_zps ) THEN                                         ! z-coordinate - partial steps
-         !
-         IF( nmsh <= 6 ) THEN                                   !    ! 3D vertical scale factors
-            CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 )         
-            CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 )
-            CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 )
-            CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 )
-         ELSE                                                   !    ! 2D masked bottom ocean scale factors
-            DO jj = 1,jpj   
-               DO ji = 1,jpi
-                  e3tp(ji,jj) = e3t_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj)
-                  e3wp(ji,jj) = e3w_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj)
-               END DO
-            END DO
-            CALL iom_rstput( 0, 0, inum4, 'e3t_ps', e3tp )      
-            CALL iom_rstput( 0, 0, inum4, 'e3w_ps', e3wp )
-         END IF
-         !
-         IF( nmsh <= 3 ) THEN                                   !    ! 3D depth
-            CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r8 )     
-            DO jk = 1,jpk   
-               DO jj = 1, jpjm1   
-                  DO ji = 1, jpim1   ! vector opt.
-                     zdepu(ji,jj,jk) = MIN( gdept_0(ji,jj,jk) , gdept_0(ji+1,jj  ,jk) )
-                     zdepv(ji,jj,jk) = MIN( gdept_0(ji,jj,jk) , gdept_0(ji  ,jj+1,jk) )
-                  END DO   
-               END DO   
-            END DO
-            CALL lbc_lnk( zdepu, 'U', 1. )   ;   CALL lbc_lnk( zdepv, 'V', 1. ) 
-            CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r8 )
-            CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r8 )
-            CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r8 )
-         ELSE                                                   !    ! 2D bottom depth
-            DO jj = 1,jpj   
-               DO ji = 1,jpi
-                  zprt(ji,jj) = gdept_0(ji,jj,mbkt(ji,jj)  ) * ssmask(ji,jj)
-                  zprw(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) * ssmask(ji,jj)
-               END DO
-            END DO
-            CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r8 )     
-            CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r8 ) 
-         ENDIF
-         !
-         CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )   !    ! reference z-coord.
-         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d )
-         CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )
-         CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   )
-      ENDIF
-      
-      IF( ln_zco ) THEN
-         !                                                      ! z-coordinate - full steps
-         CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )   !    ! depth
-         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d )
-         CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )   !    ! scale factors
-         CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   )
-      ENDIF
-      !                                     ! ============================
-      !                                     !        close the files 
-      !                                     ! ============================
-      SELECT CASE ( MOD(nmsh, 3) )
-      CASE ( 1 )                
-         CALL iom_close( inum0 )
-      CASE ( 2 )
-         CALL iom_close( inum1 )
-         CALL iom_close( inum2 )
-      CASE ( 0 )
-         CALL iom_close( inum2 )
-         CALL iom_close( inum3 )
-         CALL iom_close( inum4 )
-      END SELECT
-      !
-      CALL wrk_dealloc( jpi, jpj, zprt, zprw )
-      CALL wrk_dealloc( jpi, jpj, jpk, zdepu, zdepv )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_wri')
-      !
-   END SUBROUTINE dom_wri
-
-
-   SUBROUTINE dom_uniq( puniq, cdgrd )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_uniq  ***
-      !!                   
-      !! ** Purpose :   identify unique point of a grid (TUVF)
-      !!
-      !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element
-      !!                2) check which elements have been changed
-      !!----------------------------------------------------------------------
-      !
-      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   ! 
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   ! 
-      !
-      REAL(wp) ::  zshift   ! shift value link to the process number
-      INTEGER  ::  ji       ! dummy loop indices
-      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztstref
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_uniq')
-      !
-      CALL wrk_alloc( jpi, jpj, ztstref )
-      !
-      ! build an array with different values for each element 
-      ! in mpp: make sure that these values are different even between process
-      ! -> apply a shift value according to the process number
-      zshift = jpi * jpj * ( narea - 1 )
-      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) )
-      !
-      puniq(:,:) = ztstref(:,:)                   ! default definition
-      CALL lbc_lnk( puniq, cdgrd, 1. )            ! apply boundary conditions
-      lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed 
-      !
-      puniq(:,:) = 1.                             ! default definition
-      ! fill only the inner part of the cpu with llbl converted into real 
-      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp )
-      !
-      CALL wrk_dealloc( jpi, jpj, ztstref )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_uniq')
-      !
-   END SUBROUTINE dom_uniq
-
-
-   SUBROUTINE dom_stiff( px1 )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_stiff  ***
-      !!                     
-      !! ** Purpose :   Diagnose maximum grid stiffness/hydrostatic consistency
-      !!
-      !! ** Method  :   Compute Haney (1991) hydrostatic condition ratio
-      !!                Save the maximum in the vertical direction
-      !!                (this number is only relevant in s-coordinates)
-      !!
-      !!                Haney, 1991, J. Phys. Oceanogr., 21, 610-619.
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(out), OPTIONAL ::   px1   ! stiffness
-      !
-      INTEGER  ::   ji, jj, jk 
-      REAL(wp) ::   zrxmax
-      REAL(wp), DIMENSION(4) ::   zr1
-      REAL(wp), DIMENSION(jpi,jpj) ::   zx1
-      !!----------------------------------------------------------------------
-      zx1(:,:) = 0._wp
-      zrxmax   = 0._wp
-      zr1(:)   = 0._wp
-      !
-      DO ji = 2, jpim1
-         DO jj = 2, jpjm1
-            DO jk = 1, jpkm1
-!!gm   remark: dk(gdepw) = e3t   ===>>>  possible simplification of the following calculation....
-!!             especially since it is gde3w which is used to compute the pressure gradient
-!!             furthermore, I think gdept_0 should be used below instead of w point in the numerator
-!!             so that the ratio is computed at the same point (i.e. uw and vw) ....
-               zr1(1) = ABS(  ( gdepw_0(ji  ,jj,jk  )-gdepw_0(ji-1,jj,jk  )               & 
-                    &          +gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) )             &
-                    &       / ( gdepw_0(ji  ,jj,jk  )+gdepw_0(ji-1,jj,jk  )               &
-                    &          -gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall )  ) * umask(ji-1,jj,jk)
-               zr1(2) = ABS(  ( gdepw_0(ji+1,jj,jk  )-gdepw_0(ji  ,jj,jk  )               &
-                    &          +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) )             &
-                    &       / ( gdepw_0(ji+1,jj,jk  )+gdepw_0(ji  ,jj,jk  )               &
-                    &          -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) + rsmall )  ) * umask(ji  ,jj,jk)
-               zr1(3) = ABS(  ( gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               &
-                    &          +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) )             &
-                    &       / ( gdepw_0(ji,jj+1,jk  )+gdepw_0(ji,jj  ,jk  )               &
-                    &          -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) + rsmall )  ) * vmask(ji,jj  ,jk)
-               zr1(4) = ABS(  ( gdepw_0(ji,jj  ,jk  )-gdepw_0(ji,jj-1,jk  )               &
-                    &          +gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) )             &
-                    &       / ( gdepw_0(ji,jj  ,jk  )+gdepw_0(ji,jj-1,jk  )               &
-                    &          -gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall )  ) * vmask(ji,jj-1,jk)
-               zrxmax = MAXVAL( zr1(1:4) )
-               zx1(ji,jj) = MAX( zx1(ji,jj) , zrxmax )
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( zx1, 'T', 1. )
-      !
-      IF( PRESENT( px1 ) )    px1 = zx1
-      !
-      zrxmax = MAXVAL( zx1 )
-      !
-      IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain
-      !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax
-         WRITE(numout,*) '~~~~~~~~~'
-      ENDIF
-      !
-   END SUBROUTINE dom_stiff
-
-   !!======================================================================
-END MODULE domwri
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domzgr.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domzgr.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/domzgr.F90	(revision 12101)
@@ -0,0 +1,1932 @@
+MODULE domzgr
+   !!==============================================================================
+   !!                       ***  MODULE domzgr   ***
+   !! Ocean domain : definition of the vertical coordinate system
+   !!==============================================================================
+   !! History :  OPA  ! 1995-12  (G. Madec)  Original code : s vertical coordinate
+   !!                 ! 1997-07  (G. Madec)  lbc_lnk call
+   !!                 ! 1997-04  (J.-O. Beismann) 
+   !!            8.5  ! 2002-09  (A. Bozec, G. Madec)  F90: Free form and module
+   !!             -   ! 2002-09  (A. de Miranda)  rigid-lid + islands
+   !!  NEMO      1.0  ! 2003-08  (G. Madec)  F90: Free form and module
+   !!             -   ! 2005-10  (A. Beckmann)  modifications for hybrid s-ccordinates & new stretching function
+   !!            2.0  ! 2006-04  (R. Benshila, G. Madec)  add zgr_zco
+   !!            3.0  ! 2008-06  (G. Madec)  insertion of domzgr_zps.h90 & conding style
+   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
+   !!            3.4  ! 2012-08  (J. Siddorn) added Siddorn and Furner stretching function
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  modify C1D case  
+   !!            3.6  ! 2014-11  (P. Mathiot and C. Harris) add ice shelf capability
+   !!            3.?  ! 2015-11  (H. Liu) Modifications for Wetting/Drying
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_zgr          : defined the ocean vertical coordinate system
+   !!       zgr_bat      : bathymetry fields (levels and meters)
+   !!       zgr_bat_zoom : modify the bathymetry field if zoom domain
+   !!       zgr_bat_ctl  : check the bathymetry files
+   !!       zgr_bot_level: deepest ocean level for t-, u, and v-points
+   !!       zgr_z        : reference z-coordinate 
+   !!       zgr_zco      : z-coordinate 
+   !!       zgr_zps      : z-coordinate with partial steps
+   !!       zgr_sco      : s-coordinate
+   !!       fssig        : tanh stretch function
+   !!       fssig1       : Song and Haidvogel 1994 stretch function
+   !!       fgamma       : Siddorn and Furner 2012 stretching function
+   !!---------------------------------------------------------------------
+   USE dom_oce           ! ocean domain
+   !
+   USE in_out_manager    ! I/O manager
+   USE iom               ! I/O library
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp           ! distributed memory computing library
+   USE lib_fortran
+   USE dombat
+   USE domisf
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_zgr        ! called by dom_init.F90
+   !
+   !                              !!* Namelist namzgr_sco *
+   LOGICAL  ::   ln_s_sh94         ! use hybrid s-sig Song and Haidvogel 1994 stretching function fssig1 (ln_sco=T)
+   LOGICAL  ::   ln_s_sf12         ! use hybrid s-z-sig Siddorn and Furner 2012 stretching function fgamma (ln_sco=T)
+   !
+   REAL(wp) ::   rn_sbot_min       ! minimum depth of s-bottom surface (>0) (m)
+   REAL(wp) ::   rn_sbot_max       ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   REAL(wp) ::   rn_rmax           ! maximum cut-off r-value allowed (0<rn_rmax<1)
+   REAL(wp) ::   rn_hc             ! Critical depth for transition from sigma to stretched coordinates
+
+   ! Song and Haidvogel 1994 stretching parameters
+   REAL(wp) ::   rn_theta          ! surface control parameter (0<=rn_theta<=20)
+   REAL(wp) ::   rn_thetb          ! bottom control parameter  (0<=rn_thetb<= 1)
+   REAL(wp) ::   rn_bb             ! stretching parameter 
+   !                                        ! ( rn_bb=0; top only, rn_bb =1; top and bottom)
+   ! Siddorn and Furner stretching parameters
+   LOGICAL  ::   ln_sigcrit        ! use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch 
+   REAL(wp) ::   rn_alpha          ! control parameter ( > 1 stretch towards surface, < 1 towards seabed)
+   REAL(wp) ::   rn_efold          !  efold length scale for transition to stretched coord
+   REAL(wp) ::   rn_zs             !  depth of surface grid box
+                           !  bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
+   REAL(wp) ::   rn_zb_a           !  bathymetry scaling factor for calculating Zb
+   REAL(wp) ::   rn_zb_b           !  offset for calculating Zb
+
+  !! * Substitutions
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3.1 , NEMO Consortium (2011)
+   !! $Id: domzgr.F90 6827 2016-08-01 13:37:15Z flavoni $
+   !! Software governed by the CeCILL licence     (./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS       
+
+   SUBROUTINE dom_zgr
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_zgr  ***
+      !!                   
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!              vertical scale factors.
+      !!
+      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
+      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
+      !!              - vertical coordinate (gdep., e3.) depending on the 
+      !!                coordinate chosen :
+      !!                   ln_zco=T   z-coordinate   
+      !!                   ln_zps=T   z-coordinate with partial steps
+      !!                   ln_zco=T   s-coordinate 
+      !!
+      !! ** Action  :   define gdep., e3., mbathy and bathy
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ibat   ! local integer
+      INTEGER ::   ios
+      !
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh
+      !!----------------------------------------------------------------------
+      !
+      !
+      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
+      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
+      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzgr )
+
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr : vertical coordinate'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namzgr : set vertical coordinate'
+         WRITE(numout,*) '      z-coordinate - full steps      ln_zco    = ', ln_zco
+         WRITE(numout,*) '      z-coordinate - partial steps   ln_zps    = ', ln_zps
+         WRITE(numout,*) '      s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
+         WRITE(numout,*) '      ice shelf cavities             ln_isfcav = ', ln_isfcav
+         WRITE(numout,*) '      linear free surface            ln_linssh = ', ln_linssh
+      ENDIF
+
+      IF( ln_linssh .AND. lwp) WRITE(numout,*) '   linear free surface: the vertical mesh does not change in time'
+
+      ioptio = 0                       ! Check Vertical coordinate options
+      IF( ln_zco      )   ioptio = ioptio + 1
+      IF( ln_zps      )   ioptio = ioptio + 1
+      IF( ln_sco      )   ioptio = ioptio + 1
+      IF( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
+      !
+      IF ( ln_isfcav ) CALL zgr_isf_nam
+      ioptio = 0
+      IF ( ln_zco .AND. ln_isfcav ) ioptio = ioptio + 1
+      IF ( ln_sco .AND. ln_isfcav ) ioptio = ioptio + 1
+      IF( ioptio > 0 )   CALL ctl_stop( ' Cavity not tested/compatible with full step (zco) and sigma (ln_sco) ' )
+      !
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+                          CALL zgr_z            ! Reference z-coordinate system (always called)
+                          CALL zgr_bat          ! Bathymetry fields (levels and meters)
+      IF( ln_zco      )   CALL zgr_zco          ! z-coordinate
+      IF( ln_zps      )   CALL zgr_zps          ! Partial step z-coordinate
+      IF( ln_sco      )   CALL zgr_sco          ! s-coordinate or hybrid z-s coordinate
+                          CALL zgr_bat_ctl      ! check bathymetry (mbathy) and suppress isolated ocean points
+      !
+      ! final adjustment of mbathy & check 
+      ! -----------------------------------
+                          CALL zgr_bot_level    ! deepest ocean level for t-, u- and v-points
+                          CALL zgr_top_level    ! shallowest ocean level for T-, U-, V- points
+      !
+      IF( nprint == 1 .AND. lwp )   THEN
+         WRITE(numout,*) ' MIN val mbathy  ', MINVAL(  mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )
+         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MINVAL( gdepw_0(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL(   e3t_0(:,:,:) ), ' f ', MINVAL(   e3f_0(:,:,:) ),  &
+            &                          ' u ', MINVAL(   e3u_0(:,:,:) ), ' u ', MINVAL(   e3v_0(:,:,:) ),  &
+            &                          ' uw', MINVAL(  e3uw_0(:,:,:) ), ' vw', MINVAL(  e3vw_0(:,:,:)),   &
+            &                          ' w ', MINVAL(   e3w_0(:,:,:) )
+
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MAXVAL( gdepw_0(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL(   e3t_0(:,:,:) ), ' f ', MAXVAL(   e3f_0(:,:,:) ),  &
+            &                          ' u ', MAXVAL(   e3u_0(:,:,:) ), ' u ', MAXVAL(   e3v_0(:,:,:) ),  &
+            &                          ' uw', MAXVAL(  e3uw_0(:,:,:) ), ' vw', MAXVAL(  e3vw_0(:,:,:) ),  &
+            &                          ' w ', MAXVAL(   e3w_0(:,:,:) )
+      ENDIF
+      !
+   END SUBROUTINE dom_zgr
+
+
+   SUBROUTINE zgr_z
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zgr_z  ***
+      !!                   
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  :   z-coordinate system (use in all type of coordinate)
+      !!        The depth of model levels is defined from an analytical
+      !!      function the derivative of which gives the scale factors.
+      !!        both depth and scale factors only depend on k (1d arrays).
+      !!              w-level: gdepw_1d  = gdep(k)
+      !!                       e3w_1d(k) = dk(gdep)(k)     = e3(k)
+      !!              t-level: gdept_1d  = gdep(k+0.5)
+      !!                       e3t_1d(k) = dk(gdep)(k+0.5) = e3(k+0.5)
+      !!
+      !! ** Action  : - gdept_1d, gdepw_1d : depth of T- and W-point (m)
+      !!              - e3t_1d  , e3w_1d   : scale factors at T- and W-levels (m)
+      !!
+      !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk                     ! dummy loop indices
+      REAL(wp) ::   zt, zw                 ! temporary scalars
+      REAL(wp) ::   zsur, za0, za1, zkth   ! Values set from parameters in
+      REAL(wp) ::   zacr, zdzmin, zhmax    ! par_CONFIG_Rxx.h90
+      REAL(wp) ::   zrefdep                ! depth of the reference level (~10m)
+      REAL(wp) ::   za2, zkth2, zacr2      ! Values for optional double tanh function set from parameters 
+      !!----------------------------------------------------------------------
+      !
+      ! Set variables from parameters
+      ! ------------------------------
+       zkth = ppkth       ;   zacr = ppacr
+       zdzmin = ppdzmin   ;   zhmax = pphmax
+       zkth2 = ppkth2     ;   zacr2 = ppacr2   ! optional (ldbletanh=T) double tanh parameters
+
+      ! If ppa1 and ppa0 and ppsur are et to pp_to_be_computed
+      !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr
+      IF(   ppa1  == pp_to_be_computed  .AND.  &
+         &  ppa0  == pp_to_be_computed  .AND.  &
+         &  ppsur == pp_to_be_computed           ) THEN
+         !
+         za1  = (  ppdzmin - pphmax / FLOAT(jpkm1)  )                                                      &
+            & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpk-1) * (  LOG( COSH( (jpk - ppkth) / ppacr) )      &
+            &                                                   - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+         za0  = ppdzmin - za1 *              TANH( (1-ppkth) / ppacr )
+         zsur =   - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+      ELSE
+         za1 = ppa1 ;       za0 = ppa0 ;          zsur = ppsur
+         za2 = ppa2                            ! optional (ldbletanh=T) double tanh parameter
+      ENDIF
+
+      IF(lwp) THEN                         ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates'
+         WRITE(numout,*) '    ~~~~~~~'
+         IF(  ppkth == 0._wp ) THEN              
+              WRITE(numout,*) '            Uniform grid with ',jpk-1,' layers'
+              WRITE(numout,*) '            Total depth    :', zhmax
+              WRITE(numout,*) '            Layer thickness:', zhmax/(jpk-1)
+         ELSE
+            IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN
+               WRITE(numout,*) '         zsur, za0, za1 computed from '
+               WRITE(numout,*) '                 zdzmin = ', zdzmin
+               WRITE(numout,*) '                 zhmax  = ', zhmax
+            ENDIF
+            WRITE(numout,*) '           Value of coefficients for vertical mesh:'
+            WRITE(numout,*) '                 zsur = ', zsur
+            WRITE(numout,*) '                 za0  = ', za0
+            WRITE(numout,*) '                 za1  = ', za1
+            WRITE(numout,*) '                 zkth = ', zkth
+            WRITE(numout,*) '                 zacr = ', zacr
+            IF( ldbletanh ) THEN
+               WRITE(numout,*) ' (Double tanh    za2  = ', za2
+               WRITE(numout,*) '  parameters)    zkth2= ', zkth2
+               WRITE(numout,*) '                 zacr2= ', zacr2
+            ENDIF
+         ENDIF
+      ENDIF
+
+
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)
+      ! ======================
+      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid 
+
+
+
+         za1 = zhmax / FLOAT(jpk-1) 
+
+         DO jk = 1, jpk
+            zw = FLOAT( jk )
+            zt = FLOAT( jk ) + 0.5_wp
+            gdepw_1d(jk) = ( zw - 1 ) * za1
+            gdept_1d(jk) = ( zt - 1 ) * za1
+            e3w_1d  (jk) =  za1
+            e3t_1d  (jk) =  za1
+         END DO
+      ELSE                                ! Madec & Imbard 1996 function
+         IF( .NOT. ldbletanh ) THEN
+            DO jk = 1, jpk
+               zw = REAL( jk , wp )
+               zt = REAL( jk , wp ) + 0.5_wp
+               gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  )
+               gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  )
+               e3w_1d  (jk) =          za0      + za1        * TANH(       (zw-zkth) / zacr   )
+               e3t_1d  (jk) =          za0      + za1        * TANH(       (zt-zkth) / zacr   )
+            END DO
+         ELSE
+            DO jk = 1, jpk
+               zw = FLOAT( jk )
+               zt = FLOAT( jk ) + 0.5_wp
+               ! Double tanh function
+               gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr  ) )    &
+                  &                             + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) )  )
+               gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr  ) )    &
+                  &                             + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) )  )
+               e3w_1d  (jk) =          za0      + za1        * TANH(       (zw-zkth ) / zacr  )      &
+                  &                             + za2        * TANH(       (zw-zkth2) / zacr2 )
+               e3t_1d  (jk) =          za0      + za1        * TANH(       (zt-zkth ) / zacr  )      &
+                  &                             + za2        * TANH(       (zt-zkth2) / zacr2 )
+            END DO
+         ENDIF
+         gdepw_1d(1) = 0._wp                    ! force first w-level to be exactly at zero
+      ENDIF
+
+      IF ( ln_isfcav .OR. ln_e3_dep ) THEN      ! e3. = dk[gdep]   
+         !
+         DO jk = 1, jpkm1
+            e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk) 
+         END DO
+         e3t_1d(jpk) = e3t_1d(jpk-1)   ! we don't care because this level is masked in NEMO
+
+         DO jk = 2, jpk
+            e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1) 
+         END DO
+         e3w_1d(1  ) = 2._wp * (gdept_1d(1) - gdepw_1d(1)) 
+      END IF
+
+!!gm BUG in s-coordinate this does not work!
+      ! deepest/shallowest W level Above/Below ~10m
+      zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_1d )                   ! ref. depth with tolerance (10% of minimum layer thickness)
+      nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m
+      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m
+!!gm end bug
+
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_1d(jk), gdepw_1d(jk), e3t_1d(jk), e3w_1d(jk), jk = 1, jpk )
+      ENDIF
+      DO jk = 1, jpk                      ! control positivity
+         IF( e3w_1d  (jk) <= 0._wp .OR. e3t_1d  (jk) <= 0._wp )   CALL ctl_stop( 'dom:zgr_z: e3w_1d or e3t_1d =< 0 '    )
+         IF( gdepw_1d(jk) <  0._wp .OR. gdept_1d(jk) <  0._wp )   CALL ctl_stop( 'dom:zgr_z: gdepw_1d or gdept_1d < 0 ' )
+      END DO
+      !
+   END SUBROUTINE zgr_z
+
+
+   SUBROUTINE zgr_bat
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat  ***
+      !! 
+      !! ** Purpose :   set bathymetry both in levels and meters
+      !!
+      !! ** Method  :   read or define mbathy and bathy arrays
+      !!       * level bathymetry:
+      !!      The ocean basin geometry is given by a two-dimensional array,
+      !!      mbathy, which is defined as follow :
+      !!            mbathy(ji,jj) = 1, ..., jpk-1, the number of ocean level
+      !!                              at t-point (ji,jj).
+      !!                            = 0  over the continental t-point.
+      !!      The array mbathy is checked to verified its consistency with
+      !!      model option. in particular:
+      !!            mbathy must have at least 1 land grid-points (mbathy<=0)
+      !!                  along closed boundary.
+      !!            mbathy must be cyclic IF jperio=1.
+      !!            mbathy must be lower or equal to jpk-1.
+      !!            isolated ocean grid points are suppressed from mbathy
+      !!                  since they are only connected to remaining
+      !!                  ocean through vertical diffusion.
+      !!      ntopo=-1 :   rectangular channel or bassin with a bump 
+      !!      ntopo= 0 :   flat rectangular channel or basin 
+      !!      ntopo= 1 :   mbathy is read in 'bathy_level.nc' NetCDF file
+      !!                   bathy  is read in 'bathy_meter.nc' NetCDF file
+      !!
+      !! ** Action  : - mbathy: level bathymetry (in level index)
+      !!              - bathy : meter bathymetry (in meters)
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk            ! dummy loop indices
+      INTEGER  ::   inum                      ! temporary logical unit
+      INTEGER  ::   ierror                    ! error flag
+      INTEGER  ::   ii_bump, ij_bump, ih      ! bump center position
+      INTEGER  ::   ii0, ii1, ij0, ij1, ik    ! local indices
+      REAL(wp) ::   r_bump , h_bump , h_oce   ! bump characteristics 
+      REAL(wp) ::   zi, zj, zh, zhmin         ! local scalars
+      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   idta   ! global domain integer data
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdta   ! global domain scalar data
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat : defines level and meter bathymetry'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~'
+      !                                               ! ================== ! 
+      IF( ntopo == 0 .OR. ntopo == -1 ) THEN          !   defined by hand  !
+         !                                            ! ================== !
+         !                                            ! global domain level and meter bathymetry (idta,zdta)
+         !
+         ALLOCATE( idta(jpiglo,jpjglo), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate idta array' )
+         ALLOCATE( zdta(jpiglo,jpjglo), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate zdta array' )
+         !
+         IF( ntopo == 0 ) THEN                        ! flat basin
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin'
+            IF( rn_bathy > 0.01 ) THEN 
+               IF(lwp) WRITE(numout,*) '         Depth = rn_bathy read in namelist'
+               zdta(:,:) = rn_bathy
+               IF( ln_sco ) THEN                                   ! s-coordinate (zsc       ): idta()=jpk
+                  idta(:,:) = jpkm1
+               ELSE                                                ! z-coordinate (zco or zps): step-like topography
+                  idta(:,:) = jpkm1
+                  DO jk = 1, jpkm1
+                     WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) )   idta(:,:) = jk
+                  END DO
+               ENDIF
+            ELSE
+               IF(lwp) WRITE(numout,*) '         Depth = depthw(jpkm1)'
+               idta(:,:) = jpkm1                            ! before last level
+               zdta(:,:) = gdepw_1d(jpk)                     ! last w-point depth
+               h_oce     = gdepw_1d(jpk)
+            ENDIF
+         ELSE                                         ! bump centered in the basin
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin with a bump'
+            ii_bump = jpiglo / 2                           ! i-index of the bump center
+            ij_bump = jpjglo / 2                           ! j-index of the bump center
+            r_bump  = 50000._wp                            ! bump radius (meters)       
+            h_bump  =  2700._wp                            ! bump height (meters)
+            h_oce   = gdepw_1d(jpk)                        ! background ocean depth (meters)
+            IF(lwp) WRITE(numout,*) '            bump characteristics: '
+            IF(lwp) WRITE(numout,*) '               bump center (i,j)   = ', ii_bump, ii_bump
+            IF(lwp) WRITE(numout,*) '               bump height         = ', h_bump , ' meters'
+            IF(lwp) WRITE(numout,*) '               bump radius         = ', r_bump , ' index'
+            IF(lwp) WRITE(numout,*) '            background ocean depth = ', h_oce  , ' meters'
+            !                                        
+            DO jj = 1, jpjglo                              ! zdta :
+               DO ji = 1, jpiglo
+                  zi = FLOAT( ji - ii_bump ) * ppe1_m / r_bump
+                  zj = FLOAT( jj - ij_bump ) * ppe2_m / r_bump
+                  zdta(ji,jj) = h_oce - h_bump * EXP( -( zi*zi + zj*zj ) )
+               END DO
+            END DO
+            !                                              ! idta :
+            IF( ln_sco ) THEN                                   ! s-coordinate (zsc       ): idta()=jpk
+               idta(:,:) = jpkm1
+            ELSE                                                ! z-coordinate (zco or zps): step-like topography
+               idta(:,:) = jpkm1
+               DO jk = 1, jpkm1
+                  WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) )   idta(:,:) = jk
+               END DO
+            ENDIF
+         ENDIF
+         !
+         !                                            ! set GLOBAL boundary conditions 
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+            idta( :    , 1    ) = -1                ;      zdta( :    , 1    ) = -1._wp
+            idta( :    ,jpjglo) =  0                ;      zdta( :    ,jpjglo) =  0._wp
+         ELSEIF( jperio == 2 ) THEN
+            idta( :    , 1    ) = idta( : ,  3  )   ;      zdta( :    , 1    ) = zdta( : ,  3  )
+            idta( :    ,jpjglo) = 0                 ;      zdta( :    ,jpjglo) =  0._wp
+            idta( 1    , :    ) = 0                 ;      zdta( 1    , :    ) =  0._wp
+            idta(jpiglo, :    ) = 0                 ;      zdta(jpiglo, :    ) =  0._wp
+         ELSE
+            ih = 0                                  ;      zh = 0._wp
+            IF( ln_sco )   ih = jpkm1               ;      IF( ln_sco )   zh = h_oce
+            idta( :    , 1    ) = ih                ;      zdta( :    , 1    ) =  zh
+            idta( :    ,jpjglo) = ih                ;      zdta( :    ,jpjglo) =  zh
+            idta( 1    , :    ) = ih                ;      zdta( 1    , :    ) =  zh
+            idta(jpiglo, :    ) = ih                ;      zdta(jpiglo, :    ) =  zh
+         ENDIF
+
+         !                                            ! local domain level and meter bathymetries (mbathy,bathy)
+         mbathy(:,:) = 0                                   ! set to zero extra halo points
+         bathy (:,:) = 0._wp                               ! (require for mpp case)
+         DO jj = 1, nlcj                                   ! interior values
+            DO ji = 1, nlci
+               mbathy(ji,jj) = idta( mig(ji), mjg(jj) )
+               bathy (ji,jj) = zdta( mig(ji), mjg(jj) )
+            END DO
+         END DO
+         risfdep(:,:)=0.e0
+         misfdep(:,:)=1
+         !
+         DEALLOCATE( idta, zdta )
+         !
+         !                                            ! ================ !
+      ELSEIF( ntopo == 1 .OR. ntopo ==2 ) THEN                       !   read in file   ! (over the local domain)
+         !                                            ! ================ !
+         !
+         IF( ln_zco )   THEN                          ! zco : read level bathymetry 
+            CALL iom_open ( 'bathy_level.nc', inum )  
+            CALL iom_get  ( inum, jpdom_data, 'Bathy_level', bathy )
+            CALL iom_close( inum )
+            mbathy(:,:) = INT( bathy(:,:) )
+            ! initialisation isf variables
+            risfdep(:,:)=0._wp ; misfdep(:,:)=1             
+            !                                                ! =====================
+            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+               !                                             ! =====================
+               !
+               ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
+               ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                  DO jj = mj0(ij0), mj1(ij1)
+                     mbathy(ji,jj) = 15
+                  END DO
+               END DO
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+               !
+               ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open
+               ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                  DO jj = mj0(ij0), mj1(ij1)
+                     mbathy(ji,jj) = 12
+                  END DO
+               END DO
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '      orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
+               !
+            ENDIF
+            !
+         ENDIF
+         IF( ln_zps .OR. ln_sco )   THEN              ! zps or sco : read meter bathymetry
+#if defined key_agrif
+            IF (agrif_root()) THEN
+#endif
+            IF( ntopo == 1) THEN
+               CALL iom_open ( 'bathy_meter.nc', inum ) 
+               IF ( ln_isfcav ) THEN
+                  CALL iom_get  ( inum, jpdom_data, 'Bathymetry_isf', bathy, lrowattr=.false. )
+               ELSE
+                  CALL iom_get  ( inum, jpdom_data, 'Bathymetry'    , bathy, lrowattr=ln_use_jattr  )
+               END IF
+               CALL iom_close( inum )
+            ELSE
+               CALL dom_bat
+            ENDIF       
+#if defined key_agrif
+            ELSE
+               IF( ntopo == 1) THEN
+                  CALL agrif_create_bathy_meter()
+               ELSE 
+                  CALL dom_bat 
+               ENDIF    
+            ENDIF
+#endif
+            !                                                
+            ! initialisation isf variables
+            risfdep(:,:)=0._wp ; misfdep(:,:)=1             
+            !
+            IF ( ln_isfcav ) THEN
+               CALL iom_open ( 'isf_draft_meter.nc', inum ) 
+               CALL iom_get  ( inum, jpdom_data, 'isf_draft', risfdep )
+               CALL iom_close( inum )
+            END IF
+            !       
+            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+            !
+              ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open 
+              ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995)
+              DO ji = mi0(ii0), mi1(ii1)
+                 DO jj = mj0(ij0), mj1(ij1)
+                    bathy(ji,jj) = 284._wp
+                 END DO
+               END DO
+              IF(lwp) WRITE(numout,*)     
+              IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+              !
+              ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open
+              ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                 DO jj = mj0(ij0), mj1(ij1)
+                    bathy(ji,jj) = 137._wp
+                 END DO
+              END DO
+              IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
+              !
+           ENDIF
+            !
+        ENDIF
+         !                                            ! =============== !
+      ELSE                                            !      error      !
+         !                                            ! =============== !
+         WRITE(ctmp1,*) 'parameter , ntopo = ', ntopo
+         CALL ctl_stop( '    zgr_bat : '//trim(ctmp1) )
+      ENDIF
+      !
+      IF ( .not. ln_sco ) THEN                                !==  set a minimum depth  ==!
+         IF( rn_hmin < 0._wp ) THEN    ;   ik = - INT( rn_hmin )                                      ! from a nb of level
+         ELSE                          ;   ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 )  ! from a depth
+         ENDIF
+         zhmin = gdepw_1d(ik+1)                                                        ! minimum depth = ik+1 w-levels 
+         WHERE( bathy(:,:) <= 0._wp )   ;   bathy(:,:) = 0._wp                         ! min=0     over the lands
+         ELSE WHERE ( risfdep == 0._wp );   bathy(:,:) = MAX(  zhmin , bathy(:,:)  )   ! min=zhmin over the oceans
+         END WHERE
+         IF(lwp) write(numout,*) 'Minimum ocean depth: ', zhmin, ' minimum number of ocean levels : ', ik
+      ENDIF
+      !
+   END SUBROUTINE zgr_bat
+
+   SUBROUTINE zgr_bat_ctl
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat_ctl  ***
+      !!
+      !! ** Purpose :   check the bathymetry in levels
+      !!
+      !! ** Method  :   The array mbathy is checked to verified its consistency
+      !!      with the model options. in particular:
+      !!            mbathy must have at least 1 land grid-points (mbathy<=0)
+      !!                  along closed boundary.
+      !!            mbathy must be cyclic IF jperio=1.
+      !!            mbathy must be lower or equal to jpk-1.
+      !!            isolated ocean grid points are suppressed from mbathy
+      !!                  since they are only connected to remaining
+      !!                  ocean through vertical diffusion.
+      !!      C A U T I O N : mbathy will be modified during the initializa-
+      !!      tion phase to become the number of non-zero w-levels of a water
+      !!      column, with a minimum value of 1.
+      !!
+      !! ** Action  : - update mbathy: level bathymetry (in level index)
+      !!              - update bathy : meter bathymetry (in meters)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jl                    ! dummy loop indices
+      INTEGER ::   icompt, ibtest, ikmax         ! temporary integers
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::  zbathy
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE(zbathy(jpi,jpj))
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat_ctl : check the bathymetry'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
+      !                                          ! Suppress isolated ocean grid points
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)'                   suppress isolated ocean grid points'
+      IF(lwp) WRITE(numout,*)'                   -----------------------------------'
+      icompt = 0
+      DO jl = 1, 2
+         IF( l_Iperio ) THEN
+            mbathy( 1 ,:) = mbathy(jpim1,:)           ! local domain is cyclic east-west
+            mbathy(jpi,:) = mbathy(  2  ,:)
+         ENDIF
+         zbathy(:,:) = FLOAT( mbathy(:,:) )
+         CALL lbc_lnk( 'domzgr',zbathy, 'T', 1._wp )
+         mbathy(:,:) = INT( zbathy(:,:) )
+         
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ibtest = MAX(  mbathy(ji-1,jj), mbathy(ji+1,jj),   &
+                  &           mbathy(ji,jj-1), mbathy(ji,jj+1)  )
+               IF( ibtest < mbathy(ji,jj) ) THEN
+                  IF(lwp) WRITE(numout,*) ' the number of ocean level at ',   &
+                     &   'grid-point (i,j) =  ',ji,jj,' is changed from ', mbathy(ji,jj),' to ', ibtest
+                  mbathy(ji,jj) = ibtest
+                  icompt = icompt + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      IF( lk_mpp )   CALL mpp_sum( 'domzgr', icompt )
+      IF( icompt == 0 ) THEN
+         IF(lwp) WRITE(numout,*)'     no isolated ocean grid points'
+      ELSE
+         IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points suppressed'
+      ENDIF
+
+      zbathy(:,:) = FLOAT( mbathy(:,:) )
+      CALL lbc_lnk( 'domzgr',zbathy, 'T', 1._wp )
+      mbathy(:,:) = INT( zbathy(:,:) )
+
+      !                                          ! East-west cyclic boundary conditions
+      IF( jperio == 0 ) THEN
+         IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west boundary: jperio = ', jperio
+         IF( lk_mpp ) THEN
+            IF( nbondi == -1 .OR. nbondi == 2 ) THEN
+               IF( jperio /= 1 )   mbathy(1,:) = 0
+            ENDIF
+            IF( nbondi == 1 .OR. nbondi == 2 ) THEN
+               IF( jperio /= 1 )   mbathy(nlci,:) = 0
+            ENDIF
+         ELSE
+            IF( ln_zco .OR. ln_zps ) THEN
+               mbathy( 1 ,:) = 0
+               mbathy(jpi,:) = 0
+            ELSE
+               mbathy( 1 ,:) = jpkm1
+               mbathy(jpi,:) = jpkm1
+            ENDIF
+         ENDIF
+      ELSEIF( l_Iperio ) THEN
+         IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions on mbathy: jperio = ', jperio
+         mbathy( 1 ,:) = mbathy(jpim1,:)
+         mbathy(jpi,:) = mbathy(  2  ,:)
+      ELSEIF( jperio == 2 ) THEN
+         IF(lwp) WRITE(numout,*) '   equatorial boundary conditions on mbathy: jperio = ', jperio
+      ELSE
+         IF(lwp) WRITE(numout,*) '    e r r o r'
+         IF(lwp) WRITE(numout,*) '    parameter , jperio = ', jperio
+         !         STOP 'dom_mba'
+      ENDIF
+
+      !  Boundary condition on mbathy
+      IF( .NOT.lk_mpp ) THEN 
+!!gm     !!bug ???  think about it !
+         !   ... mono- or macro-tasking: T-point, >0, 2D array, no slab
+         zbathy(:,:) = FLOAT( mbathy(:,:) )
+         CALL lbc_lnk( 'domzgr',zbathy, 'T', 1._wp )
+         mbathy(:,:) = INT( zbathy(:,:) )
+      ENDIF
+
+      ! Number of ocean level inferior or equal to jpkm1
+      zbathy(:,:) = FLOAT( mbathy(:,:) )
+      ikmax = glob_max( 'domzgr', zbathy(:,:) )
+
+      IF( ikmax > jpkm1 ) THEN
+         IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' >  jpk-1'
+         IF(lwp) WRITE(numout,*) ' change jpk to ',ikmax+1,' to use the exact ead bathymetry'
+      ELSE IF( ikmax < jpkm1 ) THEN
+         IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' < jpk-1' 
+         IF(lwp) WRITE(numout,*) ' you can decrease jpk to ', ikmax+1
+      ENDIF
+      !
+      DEALLOCATE( zbathy )
+      !
+   END SUBROUTINE zgr_bat_ctl
+
+
+   SUBROUTINE zgr_bot_level
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bot_level  ***
+      !!
+      !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays)
+      !!
+      !! ** Method  :   computes from mbathy with a minimum value of 1 over land
+      !!
+      !! ** Action  :   mbkt, mbku, mbkv :   vertical indices of the deeptest 
+      !!                                     ocean level at t-, u- & v-points
+      !!                                     (min value = 1 over land)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop indices
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::  zmbk
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zmbk(jpi,jpj) )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bot_level : ocean bottom k-index of T-, U-, V- and W-levels '
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~'
+      !
+      mbkt(:,:) = MAX( mbathy(:,:) , 1 )    ! bottom k-index of T-level (=1 over land)
+ 
+      !                                     ! bottom k-index of W-level = mbkt+1
+      DO jj = 1, jpjm1                      ! bottom k-index of u- (v-) level
+         DO ji = 1, jpim1
+            mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )
+            mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
+         END DO
+      END DO
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
+      zmbk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk('domzgr',zmbk,'U',1.)   ;   mbku  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk('domzgr',zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      !
+      DEALLOCATE( zmbk )
+      !
+   END SUBROUTINE zgr_bot_level
+
+
+   SUBROUTINE zgr_top_level
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_top_level  ***
+      !!
+      !! ** Purpose :   defines the vertical index of ocean top (mik. arrays)
+      !!
+      !! ** Method  :   computes from misfdep with a minimum value of 1
+      !!
+      !! ** Action  :   mikt, miku, mikv :   vertical indices of the shallowest 
+      !!                                     ocean level at t-, u- & v-points
+      !!                                     (min value = 1)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop indices
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::  zmik
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zmik(jpi,jpj) )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_top_level : ocean top k-index of T-, U-, V- and W-levels '
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~'
+      !
+      mikt(:,:) = MAX( misfdep(:,:) , 1 )    ! top k-index of T-level (=1)
+      !                                      ! top k-index of W-level (=mikt)
+      DO jj = 1, jpjm1                       ! top k-index of U- (U-) level
+         DO ji = 1, jpim1
+            miku(ji,jj) = MAX(  mikt(ji+1,jj  ) , mikt(ji,jj)  )
+            mikv(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj)  )
+            mikf(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj), mikt(ji+1,jj  ), mikt(ji+1,jj+1)  )
+         END DO
+      END DO
+
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
+      zmik(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk('domzgr',zmik,'U',1.)   ;   miku  (:,:) = MAX( INT( zmik(:,:) ), 1 )
+      zmik(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk('domzgr',zmik,'V',1.)   ;   mikv  (:,:) = MAX( INT( zmik(:,:) ), 1 )
+      zmik(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk('domzgr',zmik,'F',1.)   ;   mikf  (:,:) = MAX( INT( zmik(:,:) ), 1 )
+      !
+      DEALLOCATE( zmik )
+      !
+   END SUBROUTINE zgr_top_level
+
+
+   SUBROUTINE zgr_zco
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zco  ***
+      !!
+      !! ** Purpose :   define the reference z-coordinate system
+      !!
+      !! ** Method  :   set 3D coord. arrays to reference 1D array 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk
+      !!----------------------------------------------------------------------
+      !
+      DO jk = 1, jpk
+         gdept_0(:,:,jk) = gdept_1d(jk)
+         gdepw_0(:,:,jk) = gdepw_1d(jk)
+         e3t_0  (:,:,jk) = e3t_1d  (jk)
+         e3u_0  (:,:,jk) = e3t_1d  (jk)
+         e3v_0  (:,:,jk) = e3t_1d  (jk)
+         e3f_0  (:,:,jk) = e3t_1d  (jk)
+         e3w_0  (:,:,jk) = e3w_1d  (jk)
+         e3uw_0 (:,:,jk) = e3w_1d  (jk)
+         e3vw_0 (:,:,jk) = e3w_1d  (jk)
+      END DO
+      !
+   END SUBROUTINE zgr_zco
+
+
+   SUBROUTINE zgr_zps
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zps  ***
+      !!                     
+      !! ** Purpose :   the depth and vertical scale factor in partial step
+      !!              reference z-coordinate case
+      !!
+      !! ** Method  :   Partial steps : computes the 3D vertical scale factors
+      !!      of T-, U-, V-, W-, UW-, VW and F-points that are associated with
+      !!      a partial step representation of bottom topography.
+      !!
+      !!        The reference depth of model levels is defined from an analytical
+      !!      function the derivative of which gives the reference vertical
+      !!      scale factors.
+      !!        From  depth and scale factors reference, we compute there new value
+      !!      with partial steps  on 3d arrays ( i, j, k ).
+      !!
+      !!              w-level: gdepw_0(i,j,k)  = gdep(k)
+      !!                       e3w_0(i,j,k) = dk(gdep)(k)     = e3(i,j,k)
+      !!              t-level: gdept_0(i,j,k)  = gdep(k+0.5)
+      !!                       e3t_0(i,j,k) = dk(gdep)(k+0.5) = e3(i,j,k+0.5)
+      !!
+      !!        With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc),
+      !!      we find the mbathy index of the depth at each grid point.
+      !!      This leads us to three cases:
+      !!
+      !!              - bathy = 0 => mbathy = 0
+      !!              - 1 < mbathy < jpkm1    
+      !!              - bathy > gdepw_0(jpk) => mbathy = jpkm1  
+      !!
+      !!        Then, for each case, we find the new depth at t- and w- levels
+      !!      and the new vertical scale factors at t-, u-, v-, w-, uw-, vw- 
+      !!      and f-points.
+      !! 
+      !!        This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order accuracy
+      !!      schemes.
+      !!
+      !!         c a u t i o n : gdept_1d, gdepw_1d and e3._1d are positives
+      !!         - - - - - - -   gdept_0, gdepw_0 and e3. are positives
+      !!      
+      !!  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk       ! dummy loop indices
+      INTEGER  ::   ik, it, ikb, ikt ! temporary integers
+      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
+      REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t
+      REAL(wp) ::   zdiff            ! temporary scalar
+      REAL(wp) ::   zmax             ! temporary scalar
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  zprt
+      !!---------------------------------------------------------------------
+      !
+      ALLOCATE( zprt(jpi,jpj,jpk) )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_zps : z-coordinate with partial steps'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~ '
+      IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used'
+
+      ! compute position of the ice shelf grounding line
+      ! set bathy and isfdraft to 0 where grounded
+      IF ( ln_isfcav ) CALL zgr_isf_zspace
+
+      ! bathymetry in level (from bathy_meter)
+      ! ===================
+      zmax = gdepw_1d(jpk) + e3t_1d(jpk)        ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
+      bathy(:,:) = MIN( zmax ,  bathy(:,:) )    ! bounded value of bathy (min already set at the end of zgr_bat)
+      WHERE( bathy(:,:) == 0._wp )   ;   mbathy(:,:) = 0       ! land  : set mbathy to 0
+      ELSE WHERE                     ;   mbathy(:,:) = jpkm1   ! ocean : initialize mbathy to the max ocean level
+      END WHERE
+
+      ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+      ! find the number of ocean levels such that the last level thickness
+      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where
+      ! e3t_1d is the reference level thickness
+      DO jk = jpkm1, 1, -1
+         zdepth = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+         WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth )   mbathy(:,:) = jk-1
+      END DO
+
+      ! Check compatibility between bathy and iceshelf draft
+      ! insure at least 2 wet level on the vertical under an ice shelf
+      ! compute misfdep and adjust isf draft if needed
+      IF ( ln_isfcav ) CALL zgr_isf_kspace
+
+      ! Scale factors and depth at T- and W-points
+      DO jk = 1, jpk                        ! intitialization to the reference z-coordinate
+         gdept_0(:,:,jk) = gdept_1d(jk)
+         gdepw_0(:,:,jk) = gdepw_1d(jk)
+         e3t_0  (:,:,jk) = e3t_1d  (jk)
+         e3w_0  (:,:,jk) = e3w_1d  (jk)
+      END DO
+      
+      ! Scale factors and depth at T- and W-points
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbathy(ji,jj)
+            IF( ik > 0 ) THEN               ! ocean point only
+               ! max ocean level case
+               IF( ik == jpkm1 ) THEN
+                  zdepwp = bathy(ji,jj)
+                  ze3tp  = bathy(ji,jj) - gdepw_1d(ik)
+                  ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
+                  e3t_0(ji,jj,ik  ) = ze3tp
+                  e3t_0(ji,jj,ik+1) = ze3tp
+                  e3w_0(ji,jj,ik  ) = ze3wp
+                  e3w_0(ji,jj,ik+1) = ze3tp
+                  gdepw_0(ji,jj,ik+1) = zdepwp
+                  gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp
+                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
+                  !
+               ELSE                         ! standard case
+                  IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj)
+                  ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
+                  ENDIF
+!gm Bug?  check the gdepw_1d
+                  !       ... on ik
+                  gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   &
+                     &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   &
+                     &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) ))
+                  e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   & 
+                     &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) ) 
+                  e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   &
+                     &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
+                  !       ... on ik+1
+                  e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                  e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      it = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbathy(ji,jj)
+            IF( ik > 0 ) THEN               ! ocean point only
+               e3tp (ji,jj) = e3t_0(ji,jj,ik)
+               e3wp (ji,jj) = e3w_0(ji,jj,ik)
+               ! test
+               zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  )
+               IF( zdiff <= 0._wp .AND. lwp ) THEN 
+                  it = it + 1
+                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj
+                  WRITE(numout,*) ' bathy = ', bathy(ji,jj)
+                  WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
+                  WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  )
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      ! compute top scale factor if ice shelf
+      IF (ln_isfcav) CALL zps_isf
+      !
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3u_0 (:,:,jk) = e3t_1d(jk)
+         e3v_0 (:,:,jk) = e3t_1d(jk)
+         e3uw_0(:,:,jk) = e3w_1d(jk)
+         e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+
+      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
+               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
+               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
+               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
+            END DO
+         END DO
+      END DO
+
+      ! update e3uw in case only 2 cells in the water column
+      IF ( ln_isfcav ) CALL zps_isf_e3uv_w
+      !
+      CALL lbc_lnk('domzgr', e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk('domzgr', e3uw_0, 'U', 1._wp )   ! lateral boundary conditions
+      CALL lbc_lnk('domzgr', e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk('domzgr', e3vw_0, 'V', 1._wp )
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk)
+         WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+      
+      ! Scale factor at F-point
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk('domzgr', e3f_0, 'F', 1._wp )       ! Lateral boundary conditions
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+!!gm  bug ? :  must be a do loop with mj0,mj1
+      ! 
+      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
+      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:) 
+      e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:) 
+      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:) 
+      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:) 
+
+      ! Control of the sign
+      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' )
+      IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' )
+      IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' )
+      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' )
+      !
+      ! if in the future gde3w_0 need to be compute, use the function defined in NEMO
+      ! for now gde3w_0 computation is removed as not an output of domcfg
+
+      DEALLOCATE( zprt )
+      !
+   END SUBROUTINE zgr_zps
+
+   SUBROUTINE zgr_sco
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_sco  ***
+      !!                     
+      !! ** Purpose :   define the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate
+      !!         The depth of model levels is defined as the product of an
+      !!      analytical function by the local bathymetry, while the vertical
+      !!      scale factors are defined as the product of the first derivative
+      !!      of the analytical function by the bathymetry.
+      !!      (this solution save memory as depth and scale factors are not
+      !!      3d fields)
+      !!          - Read bathymetry (in meters) at t-point and compute the
+      !!         bathymetry at u-, v-, and f-points.
+      !!            hbatu = mi( hbatt )
+      !!            hbatv = mj( hbatt )
+      !!            hbatf = mi( mj( hbatt ) )
+      !!          - Compute z_gsigt, z_gsigw, z_esigt, z_esigw from an analytical
+      !!         function and its derivative given as function.
+      !!            z_gsigt(k) = fssig (k    )
+      !!            z_gsigw(k) = fssig (k-0.5)
+      !!            z_esigt(k) = fsdsig(k    )
+      !!            z_esigw(k) = fsdsig(k-0.5)
+      !!      Three options for stretching are give, and they can be modified
+      !!      following the users requirements. Nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order accuracy
+      !!      schemes.
+      !!
+      !!      The three methods for stretching available are:
+      !! 
+      !!           s_sh94 (Song and Haidvogel 1994)
+      !!                a sinh/tanh function that allows sigma and stretched sigma
+      !!
+      !!           s_sf12 (Siddorn and Furner 2012?)
+      !!                allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !! 
+      !!          s_tanh  (Madec et al 1996)
+      !!                a cosh/tanh function that gives stretched coordinates        
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument
+      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
+      INTEGER  ::   ios                      ! Local integer output status for namelist read
+      REAL(wp) ::   zrmax, ztaper   ! temporary scalars
+      REAL(wp) ::   zrfact
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat
+      !!
+      NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, &
+         &                rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
+     !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zenv(jpi,jpj), ztmp(jpi,jpj), zmsk(jpi,jpj), zri(jpi,jpj), zrj(jpi,jpj), zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj) )
+      !
+      REWIND( numnam_ref )              ! Namelist namzgr_sco in reference namelist : Sigma-stretching parameters
+      READ  ( numnam_ref, namzgr_sco, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_sco in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr_sco in configuration namelist : Sigma-stretching parameters
+      READ  ( numnam_cfg, namzgr_sco, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_sco in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzgr_sco )
+
+      IF(lwp) THEN                           ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr_sco : s-coordinate or hybrid z-s-coordinate'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzgr_sco'
+         WRITE(numout,*) '     stretching coeffs '
+         WRITE(numout,*) '        maximum depth of s-bottom surface (>0)       rn_sbot_max   = ',rn_sbot_max
+         WRITE(numout,*) '        minimum depth of s-bottom surface (>0)       rn_sbot_min   = ',rn_sbot_min
+         WRITE(numout,*) '        Critical depth                               rn_hc         = ',rn_hc
+         WRITE(numout,*) '        maximum cut-off r-value allowed              rn_rmax       = ',rn_rmax
+         WRITE(numout,*) '     Song and Haidvogel 1994 stretching              ln_s_sh94     = ',ln_s_sh94
+         WRITE(numout,*) '        Song and Haidvogel 1994 stretching coefficients'
+         WRITE(numout,*) '        surface control parameter (0<=rn_theta<=20)  rn_theta      = ',rn_theta
+         WRITE(numout,*) '        bottom  control parameter (0<=rn_thetb<= 1)  rn_thetb      = ',rn_thetb
+         WRITE(numout,*) '        stretching parameter (song and haidvogel)    rn_bb         = ',rn_bb
+         WRITE(numout,*) '     Siddorn and Furner 2012 stretching              ln_s_sf12     = ',ln_s_sf12
+         WRITE(numout,*) '        switching to sigma (T) or Z (F) at H<Hc      ln_sigcrit    = ',ln_sigcrit
+         WRITE(numout,*) '        Siddorn and Furner 2012 stretching coefficients'
+         WRITE(numout,*) '        stretchin parameter ( >1 surface; <1 bottom) rn_alpha      = ',rn_alpha
+         WRITE(numout,*) '        e-fold length scale for transition region    rn_efold      = ',rn_efold
+         WRITE(numout,*) '        Surface cell depth (Zs) (m)                  rn_zs         = ',rn_zs
+         WRITE(numout,*) '        Bathymetry multiplier for Zb                 rn_zb_a       = ',rn_zb_a
+         WRITE(numout,*) '        Offset for Zb                                rn_zb_b       = ',rn_zb_b
+         WRITE(numout,*) '        Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b'
+      ENDIF
+
+      hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate
+      hifu(:,:) = rn_sbot_min
+      hifv(:,:) = rn_sbot_min
+      hiff(:,:) = rn_sbot_min
+
+      !                                        ! set maximum ocean depth
+      bathy(:,:) = MIN( rn_sbot_max, bathy(:,:) )
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              IF( bathy(ji,jj) > 0._wp )   bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) )
+            END DO
+         END DO
+      !                                        ! =============================
+      !                                        ! Define the envelop bathymetry   (hbatt)
+      !                                        ! =============================
+      ! use r-value to create hybrid coordinates
+      zenv(:,:) = bathy(:,:)
+      !
+      ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( bathy(ji,jj) == 0._wp ) THEN
+                  iip1 = MIN( ji+1, jpi )
+                  ijp1 = MIN( jj+1, jpj )
+                  iim1 = MAX( ji-1, 1 )
+                  ijm1 = MAX( jj-1, 1 )
+!!gm BUG fix see ticket #1617
+                  IF( ( + bathy(iim1,ijm1) + bathy(ji,ijp1) + bathy(iip1,ijp1)              &
+                     &  + bathy(iim1,jj  )                  + bathy(iip1,jj  )              &
+                     &  + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1)  ) > 0._wp ) &
+                     &    zenv(ji,jj) = rn_sbot_min
+!!gm
+!!gm               IF( ( bathy(iip1,jj  ) + bathy(iim1,jj  ) + bathy(ji,ijp1  ) + bathy(ji,ijm1) +         &
+!!gm                  &  bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN
+!!gm               zenv(ji,jj) = rn_sbot_min
+!!gm             ENDIF
+!!gm end
+              ENDIF
+            END DO
+         END DO
+
+      ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+      CALL lbc_lnk( 'domzgr',zenv, 'T', 1._wp, 'no0' )
+      ! 
+      ! smooth the bathymetry (if required)
+      scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea)
+      scobot(:,:) = bathy(:,:)        ! ocean bottom  depth
+      !
+      jl = 0
+      zrmax = 1._wp
+      !   
+      !     
+      ! set scaling factor used in reducing vertical gradients
+      zrfact = ( 1._wp - rn_rmax ) / ( 1._wp + rn_rmax )
+      !
+      ! initialise temporary evelope depth arrays
+      ztmpi1(:,:) = zenv(:,:)
+      ztmpi2(:,:) = zenv(:,:)
+      ztmpj1(:,:) = zenv(:,:)
+      ztmpj2(:,:) = zenv(:,:)
+      !
+      ! initialise temporary r-value arrays
+      zri(:,:) = 1._wp
+      zrj(:,:) = 1._wp
+      !                                                            ! ================ !
+      DO WHILE( jl <= 10000 .AND. ( zrmax - rn_rmax ) > 1.e-8_wp ) !  Iterative loop  !
+         !                                                         ! ================ !
+         jl = jl + 1
+         zrmax = 0._wp
+         ! we set zrmax from previous r-values (zri and zrj) first
+         ! if set after current r-value calculation (as previously)
+         ! we could exit DO WHILE prematurely before checking r-value
+         ! of current zenv
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
+            END DO
+         END DO
+         zri(:,:) = 0._wp
+         zrj(:,:) = 0._wp
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               iip1 = MIN( ji+1, nlci )      ! force zri = 0 on last line (ji=ncli+1 to jpi)
+               ijp1 = MIN( jj+1, nlcj )      ! force zrj = 0 on last raw  (jj=nclj+1 to jpj)
+               IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(iip1,jj) > 0._wp)) THEN
+                  zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
+               END IF
+               IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(ji,ijp1) > 0._wp)) THEN
+                  zrj(ji,jj) = ( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
+               END IF
+               IF( zri(ji,jj) >  rn_rmax )   ztmpi1(ji  ,jj  ) = zenv(iip1,jj  ) * zrfact
+               IF( zri(ji,jj) < -rn_rmax )   ztmpi2(iip1,jj  ) = zenv(ji  ,jj  ) * zrfact
+               IF( zrj(ji,jj) >  rn_rmax )   ztmpj1(ji  ,jj  ) = zenv(ji  ,ijp1) * zrfact
+               IF( zrj(ji,jj) < -rn_rmax )   ztmpj2(ji  ,ijp1) = zenv(ji  ,jj  ) * zrfact
+            END DO
+         END DO
+  !       IF( lk_mpp )   CALL mpp_max( zrmax )   ! max over the global domain
+         !
+         IF(lwp)WRITE(numout,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax
+         !
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) )
+            END DO
+         END DO
+         ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+         CALL lbc_lnk( 'domzgr',zenv, 'T', 1._wp, 'no0' )
+         !                                                  ! ================ !
+      END DO                                                !     End loop     !
+      !                                                     ! ================ !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zenv(ji,jj) = MAX( zenv(ji,jj), rn_sbot_min ) ! set all points to avoid undefined scale value warnings
+         END DO
+      END DO
+      !
+      ! Envelope bathymetry saved in hbatt
+      hbatt(:,:) = zenv(:,:) 
+      IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN
+         CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztaper = EXP( -(gphit(ji,jj)/8._wp)**2._wp )
+               hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper )
+            END DO
+         END DO
+      ENDIF
+      !
+      !                                        ! ==============================
+      !                                        !   hbatu, hbatv, hbatf fields
+      !                                        ! ==============================
+      IF(lwp) THEN
+         WRITE(numout,*)
+           WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min
+      ENDIF
+      hbatu(:,:) = rn_sbot_min
+      hbatv(:,:) = rn_sbot_min
+      hbatf(:,:) = rn_sbot_min
+      DO jj = 1, jpjm1
+        DO ji = 1, jpim1   ! NO vector opt.
+           hbatu(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) )
+           hbatv(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) )
+           hbatf(ji,jj) = 0.25_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   &
+              &                     + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) )
+        END DO
+      END DO
+
+      ! 
+      ! Apply lateral boundary condition
+!!gm  ! CAUTION: retain non zero value in the initial file this should be OK for orca cfg, not for EEL
+      zhbat(:,:) = hbatu(:,:)   ;   CALL lbc_lnk('domzgr', hbatu, 'U', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatu(ji,jj) == 0._wp ) THEN
+               !No worries about the following line when ln_wd == .true.
+               IF( zhbat(ji,jj) == 0._wp )   hbatu(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatu(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatv(:,:)   ;   CALL lbc_lnk('domzgr', hbatv, 'V', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatv(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatv(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatv(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatf(:,:)   ;   CALL lbc_lnk('domzgr', hbatf, 'F', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatf(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatf(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatf(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+
+!!bug:  key_helsinki a verifer
+        hift(:,:) = MIN( hift(:,:), hbatt(:,:) )
+        hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) )
+        hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) )
+        hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) )
+
+      IF( nprint == 1 .AND. lwp )   THEN
+         WRITE(numout,*) ' MAX val hif   t ', MAXVAL( hift (:,:) ), ' f ', MAXVAL( hiff (:,:) ),  &
+            &                        ' u ',   MAXVAL( hifu (:,:) ), ' v ', MAXVAL( hifv (:,:) )
+         WRITE(numout,*) ' MIN val hif   t ', MINVAL( hift (:,:) ), ' f ', MINVAL( hiff (:,:) ),  &
+            &                        ' u ',   MINVAL( hifu (:,:) ), ' v ', MINVAL( hifv (:,:) )
+         WRITE(numout,*) ' MAX val hbat  t ', MAXVAL( hbatt(:,:) ), ' f ', MAXVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MAXVAL( hbatu(:,:) ), ' v ', MAXVAL( hbatv(:,:) )
+         WRITE(numout,*) ' MIN val hbat  t ', MINVAL( hbatt(:,:) ), ' f ', MINVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MINVAL( hbatu(:,:) ), ' v ', MINVAL( hbatv(:,:) )
+      ENDIF
+!! helsinki
+
+      !                                            ! =======================
+      !                                            !   s-ccordinate fields     (gdep., e3.)
+      !                                            ! =======================
+      !
+      ! non-dimensional "sigma" for model level depth at w- and t-levels
+
+
+!========================================================================
+! Song and Haidvogel  1994 (ln_s_sh94=T)
+! Siddorn and Furner 2012 (ln_sf12=T)
+! or  tanh function       (both false)                    
+!========================================================================
+      IF      ( ln_s_sh94 ) THEN 
+                           CALL s_sh94()
+      ELSE IF ( ln_s_sf12 ) THEN
+                           CALL s_sf12()
+      ELSE                 
+                           CALL s_tanh()
+      ENDIF 
+
+      CALL lbc_lnk( 'domzgr',e3t_0 , 'T', 1._wp )
+      CALL lbc_lnk( 'domzgr',e3u_0 , 'U', 1._wp )
+      CALL lbc_lnk( 'domzgr',e3v_0 , 'V', 1._wp )
+      CALL lbc_lnk( 'domzgr',e3f_0 , 'F', 1._wp )
+      CALL lbc_lnk( 'domzgr',e3w_0 , 'W', 1._wp )
+      CALL lbc_lnk( 'domzgr',e3uw_0, 'U', 1._wp )
+      CALL lbc_lnk('domzgr', e3vw_0, 'V', 1._wp )
+      !
+        WHERE( e3t_0 (:,:,:) == 0._wp )   e3t_0 (:,:,:) = 1._wp
+        WHERE( e3u_0 (:,:,:) == 0._wp )   e3u_0 (:,:,:) = 1._wp
+        WHERE( e3v_0 (:,:,:) == 0._wp )   e3v_0 (:,:,:) = 1._wp
+        WHERE( e3f_0 (:,:,:) == 0._wp )   e3f_0 (:,:,:) = 1._wp
+        WHERE( e3w_0 (:,:,:) == 0._wp )   e3w_0 (:,:,:) = 1._wp
+        WHERE( e3uw_0(:,:,:) == 0._wp )   e3uw_0(:,:,:) = 1._wp
+        WHERE( e3vw_0(:,:,:) == 0._wp )   e3vw_0(:,:,:) = 1._wp
+!!
+      ! HYBRID : 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+               IF( scobot(ji,jj) >= gdept_0(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk )
+            END DO
+         END DO
+      END DO
+      IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ),   &
+         &                                                       ' MAX ', MAXVAL( mbathy(:,:) )
+
+      IF( nprint == 1  .AND. lwp )   THEN         ! min max values over the local domain
+         WRITE(numout,*) ' MIN val mbathy  ', MINVAL( mbathy(:,:)    ), ' MAX ', MAXVAL( mbathy(:,:) )
+         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MINVAL( gdepw_0(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL( e3t_0  (:,:,:) ), ' f '  , MINVAL( e3f_0  (:,:,:) ),   &
+            &                          ' u ', MINVAL( e3u_0  (:,:,:) ), ' u '  , MINVAL( e3v_0  (:,:,:) ),   &
+            &                          ' uw', MINVAL( e3uw_0 (:,:,:) ), ' vw'  , MINVAL( e3vw_0 (:,:,:) ),   &
+            &                          ' w ', MINVAL( e3w_0  (:,:,:) )
+
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MAXVAL( gdepw_0(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( e3t_0  (:,:,:) ), ' f '  , MAXVAL( e3f_0  (:,:,:) ),   &
+            &                          ' u ', MAXVAL( e3u_0  (:,:,:) ), ' u '  , MAXVAL( e3v_0  (:,:,:) ),   &
+            &                          ' uw', MAXVAL( e3uw_0 (:,:,:) ), ' vw'  , MAXVAL( e3vw_0 (:,:,:) ),   &
+            &                          ' w ', MAXVAL( e3w_0  (:,:,:) )
+      ENDIF
+      !  END DO
+      IF(lwp) THEN                                  ! selected vertical profiles
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: vertical coordinates : point (1,1,k) bathy = ', bathy(1,1), hbatt(1,1)
+         WRITE(numout,*) ' ~~~~~~  --------------------'
+         WRITE(numout,"(9x,' level  gdept_0   gdepw_0   e3t_0    e3w_0')")
+         WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(1,1,jk), gdepw_0(1,1,jk),     &
+            &                                 e3t_0 (1,1,jk) , e3w_0 (1,1,jk) , jk=1,jpk )
+         DO jj = mj0(20), mj1(20)
+            DO ji = mi0(20), mi1(20)
+               WRITE(numout,*)
+               WRITE(numout,*) ' domzgr: vertical coordinates : point (20,20,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj)
+               WRITE(numout,*) ' ~~~~~~  --------------------'
+               WRITE(numout,"(9x,' level  gdept_0   gdepw_0   e3t_0    e3w_0')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(ji,jj,jk), gdepw_0(ji,jj,jk),     &
+                  &                                 e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk )
+            END DO
+         END DO
+         DO jj = mj0(74), mj1(74)
+            DO ji = mi0(100), mi1(100)
+               WRITE(numout,*)
+               WRITE(numout,*) ' domzgr: vertical coordinates : point (100,74,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj)
+               WRITE(numout,*) ' ~~~~~~  --------------------'
+               WRITE(numout,"(9x,' level  gdept_0   gdepw_0   e3t_0    e3w_0')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(ji,jj,jk), gdepw_0(ji,jj,jk),     &
+                  &                                 e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk )
+            END DO
+         END DO
+      ENDIF
+      !
+      !================================================================================
+      ! check the coordinate makes sense
+      !================================================================================
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+            !
+            IF( hbatt(ji,jj) > 0._wp) THEN
+               DO jk = 1, mbathy(ji,jj)
+                 ! check coordinate is monotonically increasing
+                 IF (e3w_0(ji,jj,jk) <= 0._wp .OR. e3t_0(ji,jj,jk) <= 0._wp ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'e3w',e3w_0(ji,jj,:)
+                    WRITE(numout,*) 'e3t',e3t_0(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+                 ! and check it has never gone negative
+                 IF( gdepw_0(ji,jj,jk) < 0._wp .OR. gdept_0(ji,jj,jk) < 0._wp ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   gdepw   or gdept   =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'gdepw',gdepw_0(ji,jj,:)
+                    WRITE(numout,*) 'gdept',gdept_0(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+                 ! and check it never exceeds the total depth
+                 IF( gdepw_0(ji,jj,jk) > hbatt(ji,jj) ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'gdepw',gdepw_0(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+               END DO
+               !
+               DO jk = 1, mbathy(ji,jj)-1
+                 ! and check it never exceeds the total depth
+                IF( gdept_0(ji,jj,jk) > hbatt(ji,jj) ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'gdept',gdept_0(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+               END DO
+            ENDIF
+         END DO
+      END DO
+      !
+      DEALLOCATE( zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 )
+      !
+   END SUBROUTINE zgr_sco
+
+
+   SUBROUTINE s_sh94()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sh94  ***
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Song and Haidvogel 1994
+      !!                mixed S/sigma coordinate
+      !!
+      !! Reference : Song and Haidvogel 1994. 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk           ! dummy loop argument
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+      REAL(wp) ::   ztmpu,  ztmpv,  ztmpf
+      REAL(wp) ::   ztmpu1, ztmpv1, ztmpf1
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( z_gsigw3 (jpi,jpj,jpk), z_gsigt3 (jpi,jpj,jpk) )
+      ALLOCATE( z_esigt3 (jpi,jpj,jpk), z_esigw3 (jpi,jpj,jpk), z_esigtu3(jpi,jpj,jpk), z_esigtv3(jpi,jpj,jpk) )
+      ALLOCATE( z_esigtf3(jpi,jpj,jpk), z_esigwu3(jpi,jpj,jpk), z_esigwv3(jpi,jpj,jpk) )
+
+      z_gsigw3  = 0._wp   ;   z_gsigt3  = 0._wp
+      z_esigt3  = 0._wp   ;   z_esigw3  = 0._wp 
+      z_esigtu3 = 0._wp   ;   z_esigtv3 = 0._wp   ;   z_esigtf3 = 0._wp
+      z_esigwu3 = 0._wp   ;   z_esigwv3 = 0._wp
+      !
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+            !
+            IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma
+               DO jk = 1, jpk
+                  z_gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb )
+                  z_gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb )
+               END DO
+            ELSE ! shallow water, uniform sigma
+               DO jk = 1, jpk
+                  z_gsigw3(ji,jj,jk) =   REAL(jk-1,wp)            / REAL(jpk-1,wp)
+                  z_gsigt3(ji,jj,jk) = ( REAL(jk-1,wp) + 0.5_wp ) / REAL(jpk-1,wp)
+                  END DO
+            ENDIF
+            !
+            DO jk = 1, jpkm1
+               z_esigt3(ji,jj,jk  ) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
+               z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
+            END DO
+            z_esigw3(ji,jj,1  ) = 2._wp * ( z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ) )
+            z_esigt3(ji,jj,jpk) = 2._wp * ( z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk) )
+            !
+            DO jk = 1, jpk
+               zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+               zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+               gdept_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj,jk)+rn_hc*zcoeft )
+               gdepw_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj,jk)+rn_hc*zcoefw )
+            END DO
+           !
+         END DO   ! for all jj's
+      END DO    ! for all ji's
+
+      DO ji = 1, jpim1
+         DO jj = 1, jpjm1
+            ! extended for Wetting/Drying case
+            ztmpu  = hbatt(ji,jj)+hbatt(ji+1,jj)
+            ztmpv  = hbatt(ji,jj)+hbatt(ji,jj+1)
+            ztmpf  = hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1)
+            ztmpu1 = hbatt(ji,jj)*hbatt(ji+1,jj)
+            ztmpv1 = hbatt(ji,jj)*hbatt(ji,jj+1)
+            ztmpf1 = MIN(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) * &
+                   & MAX(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1))
+            DO jk = 1, jpk
+                 z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) &
+                        &              / ztmpu
+                 z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) &
+                        &              / ztmpu
+
+                 z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) &
+                        &              / ztmpv
+                 z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) &
+                        &              / ztmpv
+
+                 z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                               &
+                        &            +   hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                               &
+                        &            +   hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                               &
+                        &            +   hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf
+
+               !
+               e3t_0(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigt3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3u_0(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigtu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3v_0(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigtv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3f_0(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*z_esigtf3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               !
+               e3w_0 (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigw3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3uw_0(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigwu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3vw_0(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigwv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+            END DO
+        END DO
+      END DO
+      !
+      DEALLOCATE( z_gsigw3, z_gsigt3                                                        )
+      DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+      !
+   END SUBROUTINE s_sh94
+
+
+   SUBROUTINE s_sf12
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sf12 *** 
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Siddorn and Furner 2012?
+      !!                mixed S/sigma/Z coordinate
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !!
+      !! Reference : Siddorn and Furner 2012 (submitted Ocean modelling).
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk           ! dummy loop argument
+      REAL(wp) ::   zsmth               ! smoothing around critical depth
+      REAL(wp) ::   zzs, zzb           ! Surface and bottom cell thickness in sigma space
+      REAL(wp) ::   ztmpu, ztmpv, ztmpf
+      REAL(wp) ::   ztmpu1, ztmpv1, ztmpf1
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( z_gsigw3 (jpi,jpj,jpk), z_gsigt3 (jpi,jpj,jpk) )
+      ALLOCATE( z_esigt3 (jpi,jpj,jpk), z_esigw3 (jpi,jpj,jpk), z_esigtu3(jpi,jpj,jpk), z_esigtv3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtf3(jpi,jpj,jpk), z_esigwu3(jpi,jpj,jpk), z_esigwv3(jpi,jpj,jpk) )
+
+      z_gsigw3  = 0._wp   ;   z_gsigt3  = 0._wp
+      z_esigt3  = 0._wp   ;   z_esigw3  = 0._wp 
+      z_esigtu3 = 0._wp   ;   z_esigtv3 = 0._wp   ;   z_esigtf3 = 0._wp
+      z_esigwu3 = 0._wp   ;   z_esigwv3 = 0._wp
+
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+
+          IF (hbatt(ji,jj)>rn_hc) THEN !deep water, stretched sigma
+              
+              zzb = hbatt(ji,jj)*rn_zb_a + rn_zb_b   ! this forces a linear bottom cell depth relationship with H,.
+                                                     ! could be changed by users but care must be taken to do so carefully
+              zzb = 1.0_wp-(zzb/hbatt(ji,jj))
+            
+              zzs = rn_zs / hbatt(ji,jj) 
+              
+              IF (rn_efold /= 0.0_wp) THEN
+                zsmth   = tanh( (hbatt(ji,jj)- rn_hc ) / rn_efold )
+              ELSE
+                zsmth = 1.0_wp 
+              ENDIF
+               
+              DO jk = 1, jpk
+                z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)
+                z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5_wp)/REAL(jpk-1,wp)
+              ENDDO
+              z_gsigw3(ji,jj,:) = fgamma( z_gsigw3(ji,jj,:), zzb, zzs, zsmth  )
+              z_gsigt3(ji,jj,:) = fgamma( z_gsigt3(ji,jj,:), zzb, zzs, zsmth  )
+ 
+          ELSE IF (ln_sigcrit) THEN ! shallow water, uniform sigma
+
+            DO jk = 1, jpk
+              z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)     /REAL(jpk-1,wp)
+              z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)
+            END DO
+
+          ELSE  ! shallow water, z coordinates
+
+            DO jk = 1, jpk
+              z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+              z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5_wp)/REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+            END DO
+
+          ENDIF
+
+          DO jk = 1, jpkm1
+             z_esigt3(ji,jj,jk) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
+             z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
+          END DO
+          z_esigw3(ji,jj,1  ) = 2.0_wp * (z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ))
+          z_esigt3(ji,jj,jpk) = 2.0_wp * (z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk))
+
+          DO jk = 1, jpk
+             gdept_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj,jk)
+             gdepw_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj,jk)
+          END DO
+
+        ENDDO   ! for all jj's
+      ENDDO    ! for all ji's
+
+      DO ji=1,jpi-1
+        DO jj=1,jpj-1
+
+           ! extend to suit for Wetting/Drying case
+           ztmpu  = hbatt(ji,jj)+hbatt(ji+1,jj)
+           ztmpv  = hbatt(ji,jj)+hbatt(ji,jj+1)
+           ztmpf  = hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1)
+           ztmpu1 = hbatt(ji,jj)*hbatt(ji+1,jj)
+           ztmpv1 = hbatt(ji,jj)*hbatt(ji,jj+1)
+           ztmpf1 = MIN(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) * &
+                  & MAX(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1))
+           DO jk = 1, jpk
+                z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) &
+                       &              / ztmpu
+                z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) &
+                       &              / ztmpu
+                z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) &
+                       &              / ztmpv
+                z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) &
+                       &              / ztmpv
+
+                z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                               &
+                       &              + hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                               &
+                       &              + hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                               &
+                       &              + hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf
+
+             ! Code prior to wetting and drying option (for reference)
+             !z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji+1,jj) )
+             !
+             !z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji+1,jj) )
+             !
+             !z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji,jj+1) )
+             !
+             !z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji,jj+1) )
+             !
+             !z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                                 &
+             !                    &  +hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                                 &
+             !                       +hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                                 &
+             !                    &  +hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) )                               &
+             !                     /( hbatt(ji  ,jj  )+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+
+             e3t_0(ji,jj,jk)=(scosrf(ji,jj)+hbatt(ji,jj))*z_esigt3(ji,jj,jk)
+             e3u_0(ji,jj,jk)=(scosrf(ji,jj)+hbatu(ji,jj))*z_esigtu3(ji,jj,jk)
+             e3v_0(ji,jj,jk)=(scosrf(ji,jj)+hbatv(ji,jj))*z_esigtv3(ji,jj,jk)
+             e3f_0(ji,jj,jk)=(scosrf(ji,jj)+hbatf(ji,jj))*z_esigtf3(ji,jj,jk)
+             !
+             e3w_0 (ji,jj,jk)=hbatt(ji,jj)*z_esigw3(ji,jj,jk)
+             e3uw_0(ji,jj,jk)=hbatu(ji,jj)*z_esigwu3(ji,jj,jk)
+             e3vw_0(ji,jj,jk)=hbatv(ji,jj)*z_esigwv3(ji,jj,jk)
+          END DO
+
+        ENDDO
+      ENDDO
+      !
+      CALL lbc_lnk('domzgr',e3t_0 ,'T',1.) ; CALL lbc_lnk('domzgr',e3u_0 ,'T',1.)
+      CALL lbc_lnk('domzgr',e3v_0 ,'T',1.) ; CALL lbc_lnk('domzgr',e3f_0 ,'T',1.)
+      CALL lbc_lnk('domzgr',e3w_0 ,'T',1.)
+      CALL lbc_lnk('domzgr',e3uw_0,'T',1.) ; CALL lbc_lnk('domzgr',e3vw_0,'T',1.)
+      !
+      DEALLOCATE( z_gsigw3, z_gsigt3                                                        )
+      DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+      !
+   END SUBROUTINE s_sf12
+
+
+   SUBROUTINE s_tanh()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_tanh*** 
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch 
+      !!
+      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk       ! dummy loop argument
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_gsigw, z_gsigt
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_esigt, z_esigw
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( z_gsigw(jpk), z_gsigt(jpk) )
+      ALLOCATE( z_esigt(jpk), z_esigw(jpk) )
+
+      z_gsigw  = 0._wp   ;   z_gsigt  = 0._wp
+      z_esigt  = 0._wp   ;   z_esigw  = 0._wp 
+
+      DO jk = 1, jpk
+        z_gsigw(jk) = -fssig( REAL(jk,wp)-0.5_wp )
+        z_gsigt(jk) = -fssig( REAL(jk,wp)        )
+      END DO
+      IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'z_gsigw 1 jpk    ', z_gsigw(1), z_gsigw(jpk)
+      !
+      ! Coefficients for vertical scale factors at w-, t- levels
+!!gm bug :  define it from analytical function, not like juste bellow....
+!!gm        or betteroffer the 2 possibilities....
+      DO jk = 1, jpkm1
+         z_esigt(jk  ) = z_gsigw(jk+1) - z_gsigw(jk)
+         z_esigw(jk+1) = z_gsigt(jk+1) - z_gsigt(jk)
+      END DO
+      z_esigw( 1 ) = 2._wp * ( z_gsigt(1  ) - z_gsigw(1  ) ) 
+      z_esigt(jpk) = 2._wp * ( z_gsigt(jpk) - z_gsigw(jpk) )
+      !
+      DO jk = 1, jpk
+         zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+         zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+         gdept_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigt(jk) + hift(:,:)*zcoeft )
+         gdepw_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigw(jk) + hift(:,:)*zcoefw )
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+              e3t_0(ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigt(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+              e3u_0(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigt(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+              e3v_0(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigt(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+              e3f_0(ji,jj,jk) = ( (hbatf(ji,jj)-hiff(ji,jj))*z_esigt(jk) + hiff(ji,jj)/REAL(jpkm1,wp) )
+              !
+              e3w_0 (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigw(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+              e3uw_0(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigw(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+              e3vw_0(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigw(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+            END DO
+         END DO
+      END DO
+      !
+      DEALLOCATE( z_gsigw, z_gsigt )
+      DEALLOCATE( z_esigt, z_esigw )
+      !
+   END SUBROUTINE s_tanh
+
+
+   FUNCTION fssig( pk ) RESULT( pf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig ***
+      !!       
+      !! ** Purpose :   provide the analytical function in s-coordinate
+      !!          
+      !! ** Method  :   the function provide the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate
+      REAL(wp)             ::   pf   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      pf =   (   TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1) + rn_thetb )  )   &
+         &     - TANH( rn_thetb * rn_theta                                )  )   &
+         & * (   COSH( rn_theta                           )                      &
+         &     + COSH( rn_theta * ( 2._wp * rn_thetb - 1._wp ) )  )              &
+         & / ( 2._wp * SINH( rn_theta ) )
+      !
+   END FUNCTION fssig
+
+
+   FUNCTION fssig1( pk1, pbb ) RESULT( pf1 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig1 ***
+      !!
+      !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate
+      REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient
+      REAL(wp)             ::   pf1   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      IF ( rn_theta == 0 ) then      ! uniform sigma
+         pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1 )
+      ELSE                        ! stretched sigma
+         pf1 =   ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1)) ) ) / SINH( rn_theta )              &
+            &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1)) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta )  )  &
+            &        / ( 2._wp * TANH( 0.5_wp * rn_theta ) )  )
+      ENDIF
+      !
+   END FUNCTION fssig1
+
+
+   FUNCTION fgamma( pk1, pzb, pzs, psmth) RESULT( p_gamma )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fgamma  ***
+      !!
+      !! ** Purpose :   provide analytical function for the s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !! Reference  :   Siddorn and Furner, in prep
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ) ::   pk1(jpk)       ! continuous "k" coordinate
+      REAL(wp)                ::   p_gamma(jpk)   ! stretched coordinate
+      REAL(wp), INTENT(in   ) ::   pzb            ! Bottom box depth
+      REAL(wp), INTENT(in   ) ::   pzs            ! surface box depth
+      REAL(wp), INTENT(in   ) ::   psmth          ! Smoothing parameter
+      !
+      INTEGER  ::   jk             ! dummy loop index
+      REAL(wp) ::   za1,za2,za3    ! local scalar
+      REAL(wp) ::   zn1,zn2        !   -      - 
+      REAL(wp) ::   za,zb,zx       !   -      - 
+      !!----------------------------------------------------------------------
+      !
+      zn1  =  1._wp / REAL( jpkm1, wp )
+      zn2  =  1._wp -  zn1
+      !
+      za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp) 
+      za2 = (rn_alpha+2.0_wp)*zn2**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn2**(rn_alpha+2.0_wp)
+      za3 = (zn2**3.0_wp - za2)/( zn1**3.0_wp - za1)
+      !
+      za = pzb - za3*(pzs-za1)-za2
+      za = za/( zn2-0.5_wp*(za2+zn2**2.0_wp) - za3*(zn1-0.5_wp*(za1+zn1**2.0_wp) ) )
+      zb = (pzs - za1 - za*( zn1-0.5_wp*(za1+zn1**2.0_wp ) ) ) / (zn1**3.0_wp - za1)
+      zx = 1.0_wp-za/2.0_wp-zb
+      !
+      DO jk = 1, jpk
+         p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp +  &
+            &          zx*( (rn_alpha+2.0_wp)*pk1(jk)**(rn_alpha+1.0_wp)- &
+            &               (rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) )
+        p_gamma(jk) = p_gamma(jk)*psmth+pk1(jk)*(1.0_wp-psmth)
+      END DO
+      !
+   END FUNCTION fgamma
+
+   !!======================================================================
+END MODULE domzgr
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dtatsd.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/dtatsd.f90	(revision 12100)
+++ 	(revision )
@@ -1,265 +1,0 @@
-MODULE dtatsd
-   !!======================================================================
-   !!                     ***  MODULE  dtatsd  ***
-   !! Ocean data  :  read ocean Temperature & Salinity Data from gridded data
-   !!======================================================================
-   !! History :  OPA  ! 1991-03  ()  Original code
-   !!             -   ! 1992-07  (M. Imbard)
-   !!            8.0  ! 1999-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT 
-   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
-   !!            3.3  ! 2010-10  (C. Bricaud, S. Masson)  use of fldread
-   !!            3.4  ! 2010-11  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dta_tsd      : read and time interpolated ocean Temperature & Salinity Data
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE fldread         ! read input fields
-   USE in_out_manager  ! I/O manager
-   USE phycst          ! physical constants
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dta_tsd_init   ! called by opa.F90
-   PUBLIC   dta_tsd        ! called by istate.F90 and tradmp.90
-
-   LOGICAL , PUBLIC ::   ln_tsd_init      !: T & S data flag
-   LOGICAL , PUBLIC ::   ln_tsd_tradmp    !: internal damping toward input data flag
-
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read)
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: dtatsd.F90 6140 2015-12-21 11:35:23Z timgraham $ 
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dta_tsd_init( ld_tradmp )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE dta_tsd_init  ***
-      !!                    
-      !! ** Purpose :   initialisation of T & S input data 
-      !! 
-      !! ** Method  : - Read namtsd namelist
-      !!              - allocates T & S data structure 
-      !!----------------------------------------------------------------------
-      LOGICAL, INTENT(in), OPTIONAL ::   ld_tradmp   ! force the initialization when tradp is used
-      !
-      INTEGER ::   ierr0, ierr1, ierr2, ierr3   ! temporary integers
-      !
-      CHARACTER(len=100)            ::   cn_dir          ! Root directory for location of ssr files
-      TYPE(FLD_N), DIMENSION( jpts) ::   slf_i           ! array of namelist informations on the fields to read
-      TYPE(FLD_N)                   ::   sn_tem, sn_sal
-      !!
-      NAMELIST/namtsd/   ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal
-      INTEGER  ::   ios
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dta_tsd_init')
-      !
-      !  Initialisation
-      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0
-      !
-      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist : 
-      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run
-      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namtsd )
-
-      IF( PRESENT( ld_tradmp ) )   ln_tsd_tradmp = .TRUE.     ! forces the initialization when tradmp is used
-      
-      IF(lwp) THEN                  ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dta_tsd_init : Temperature & Salinity data '
-         WRITE(numout,*) '~~~~~~~~~~~~ '
-         WRITE(numout,*) '   Namelist namtsd'
-         WRITE(numout,*) '      Initialisation of ocean T & S with T &S input data   ln_tsd_init   = ', ln_tsd_init
-         WRITE(numout,*) '      damping of ocean T & S toward T &S input data        ln_tsd_tradmp = ', ln_tsd_tradmp
-         WRITE(numout,*)
-         IF( .NOT.ln_tsd_init .AND. .NOT.ln_tsd_tradmp ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) '   T & S data not used'
-         ENDIF
-      ENDIF
-      !
-      IF( ln_rstart .AND. ln_tsd_init ) THEN
-         CALL ctl_warn( 'dta_tsd_init: ocean restart and T & S data intialisation, ',   &
-            &           'we keep the restart T & S values and set ln_tsd_init to FALSE' )
-         ln_tsd_init = .FALSE.
-      ENDIF
-      !
-      !                             ! allocate the arrays (if necessary)
-      IF(  ln_tsd_init .OR. ln_tsd_tradmp  ) THEN
-         !
-         ALLOCATE( sf_tsd(jpts), STAT=ierr0 )
-         IF( ierr0 > 0 ) THEN
-            CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' )   ;   RETURN
-         ENDIF
-         !
-                                ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 )
-         IF( sn_tem%ln_tint )   ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
-                                ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
-         IF( sn_sal%ln_tint )   ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
-         !
-         IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
-            CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' )   ;   RETURN
-         ENDIF
-         !                         ! fill sf_tsd with sn_tem & sn_sal and control print
-         slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal
-         CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd' )
-         !
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dta_tsd_init')
-      !
-   END SUBROUTINE dta_tsd_init
-
-
-   SUBROUTINE dta_tsd( kt, ptsd )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE dta_tsd  ***
-      !!                    
-      !! ** Purpose :   provides T and S data at kt
-      !! 
-      !! ** Method  : - call fldread routine
-      !!              - ORCA_R2: add some hand made alteration to read data  
-      !!              - 'key_orca_lev10' interpolates on 10 times more levels
-      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
-      !!              - ln_tsd_tradmp=F: deallocates the T-S data structure
-      !!                as T-S data are no are used
-      !!
-      !! ** Action  :   ptsd   T-S data on medl mesh and interpolated at time-step kt
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data
-      !
-      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies
-      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers
-      REAL(wp)::   zl, zi
-      REAL(wp), POINTER, DIMENSION(:) ::  ztp, zsp   ! 1D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dta_tsd')
-      !
-      CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==!
-      !
-      !
-      !                                   !==   ORCA_R2 configuration and T & S damping   ==! 
-      IF( cp_cfg == "orca" .AND. jp_cfg == 2 .AND. ln_tsd_tradmp ) THEN    ! some hand made alterations
-         !
-         ij0 = 101   ;   ij1 = 109                       ! Reduced T & S in the Alboran Sea
-         ii0 = 141   ;   ii1 = 155
-         DO jj = mj0(ij0), mj1(ij1)
-            DO ji = mi0(ii0), mi1(ii1)
-               sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp
-               sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp
-               sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp
-               !
-               sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp
-               sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp
-               sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp
-               sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp
-            END DO
-         END DO
-         ij0 =  87   ;   ij1 =  96                          ! Reduced temperature in Red Sea
-         ii0 = 148   ;   ii1 = 160
-         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp
-         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
-         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
-      ENDIF
-      !
-      ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask
-      ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 
-      !
-      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
-         !
-         CALL wrk_alloc( jpk, ztp, zsp )
-         !
-         IF( kt == nit000 .AND. lwp )THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh'
-         ENDIF
-         !
-         DO jj = 1, jpj                         ! vertical interpolation of T & S
-            DO ji = 1, jpi
-               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
-                  zl = gdept_0(ji,jj,jk)
-                  IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data
-                     ztp(jk) =  ptsd(ji,jj,1    ,jp_tem)
-                     zsp(jk) =  ptsd(ji,jj,1    ,jp_sal)
-                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data
-                     ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem)
-                     zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal)
-                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
-                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
-                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
-                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
-                           ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 
-                           zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi
-                        ENDIF
-                     END DO
-                  ENDIF
-               END DO
-               DO jk = 1, jpkm1
-                  ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
-                  ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk)
-               END DO
-               ptsd(ji,jj,jpk,jp_tem) = 0._wp
-               ptsd(ji,jj,jpk,jp_sal) = 0._wp
-            END DO
-         END DO
-         ! 
-         CALL wrk_dealloc( jpk, ztp, zsp )
-         ! 
-      ELSE                                !==   z- or zps- coordinate   ==!
-         !                             
-         ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask
-         ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:)
-         !
-         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ik = mbkt(ji,jj) 
-                  IF( ik > 1 ) THEN
-                     zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
-                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem)
-                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal)
-                  ENDIF
-                  ik = mikt(ji,jj)
-                  IF( ik > 1 ) THEN
-                     zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
-                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem)
-                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal)
-                  END IF
-               END DO
-            END DO
-         ENDIF
-         !
-      ENDIF
-      !
-      IF( .NOT.ln_tsd_tradmp ) THEN                   !==   deallocate T & S structure   ==! 
-         !                                              (data used only for initialisation)
-         IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run'
-                                        DEALLOCATE( sf_tsd(jp_tem)%fnow )     ! T arrays in the structure
-         IF( sf_tsd(jp_tem)%ln_tint )   DEALLOCATE( sf_tsd(jp_tem)%fdta )
-                                        DEALLOCATE( sf_tsd(jp_sal)%fnow )     ! S arrays in the structure
-         IF( sf_tsd(jp_sal)%ln_tint )   DEALLOCATE( sf_tsd(jp_sal)%fdta )
-                                        DEALLOCATE( sf_tsd              )     ! the structure itself
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dta_tsd')
-      !
-   END SUBROUTINE dta_tsd
-
-   !!======================================================================
-END MODULE dtatsd
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/eosbn2.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/eosbn2.f90	(revision 12100)
+++ 	(revision )
@@ -1,1647 +1,0 @@
-MODULE eosbn2
-   !!==============================================================================
-   !!                       ***  MODULE  eosbn2  ***
-   !! Equation Of Seawater : in situ density - Brunt-Vaisala frequency
-   !!==============================================================================
-   !! History :  OPA  ! 1989-03  (O. Marti)  Original code
-   !!            6.0  ! 1994-07  (G. Madec, M. Imbard)  add bn2
-   !!            6.0  ! 1994-08  (G. Madec)  Add Jackett & McDougall eos
-   !!            7.0  ! 1996-01  (G. Madec)  statement function for e3
-   !!            8.1  ! 1997-07  (G. Madec)  density instead of volumic mass
-   !!             -   ! 1999-02  (G. Madec, N. Grima) semi-implicit pressure gradient
-   !!            8.2  ! 2001-09  (M. Ben Jelloul)  bugfix on linear eos
-   !!   NEMO     1.0  ! 2002-10  (G. Madec)  add eos_init
-   !!             -   ! 2002-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d
-   !!             -   ! 2003-08  (G. Madec)  F90, free form
-   !!            3.0  ! 2006-08  (G. Madec)  add tfreez function (now eos_fzp function)
-   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
-   !!             -   ! 2010-10  (G. Nurser, G. Madec)  add alpha/beta used in ldfslp
-   !!            3.7  ! 2012-03  (F. Roquet, G. Madec)  add primitive of alpha and beta used in PE computation
-   !!             -   ! 2012-05  (F. Roquet)  add Vallis and original JM95 equation of state
-   !!             -   ! 2013-04  (F. Roquet, G. Madec)  add eos_rab, change bn2 computation and reorganize the module
-   !!             -   ! 2014-09  (F. Roquet)  add TEOS-10, S-EOS, and modify EOS-80
-   !!             -   ! 2015-06  (P.A. Bouttier) eos_fzp functions changed to subroutines for AGRIF
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   eos           : generic interface of the equation of state
-   !!   eos_insitu    : Compute the in situ density
-   !!   eos_insitu_pot: Compute the insitu and surface referenced potential volumic mass
-   !!   eos_insitu_2d : Compute the in situ density for 2d fields
-   !!   bn2           : Compute the Brunt-Vaisala frequency
-   !!   eos_rab       : generic interface of in situ thermal/haline expansion ratio 
-   !!   eos_rab_3d    : compute in situ thermal/haline expansion ratio
-   !!   eos_rab_2d    : compute in situ thermal/haline expansion ratio for 2d fields
-   !!   eos_fzp_2d    : freezing temperature for 2d fields
-   !!   eos_fzp_0d    : freezing temperature for scalar
-   !!   eos_init      : set eos parameters (namelist)
-   !!----------------------------------------------------------------------
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants
-   !
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE prtctl         ! Print control
-   USE wrk_nemo       ! Memory Allocation
-   USE lbclnk         ! ocean lateral boundary conditions
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !                  !! * Interface
-   INTERFACE eos
-      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
-   END INTERFACE
-   !
-   INTERFACE eos_rab
-      MODULE PROCEDURE rab_3d, rab_2d, rab_0d
-   END INTERFACE
-   !
-   INTERFACE eos_fzp 
-      MODULE PROCEDURE eos_fzp_2d, eos_fzp_0d
-   END INTERFACE
-   !
-   PUBLIC   eos            ! called by step, istate, tranpc and zpsgrd modules
-   PUBLIC   bn2            ! called by step module
-   PUBLIC   eos_rab        ! called by ldfslp, zdfddm, trabbl
-   PUBLIC   eos_pt_from_ct ! called by sbcssm
-   PUBLIC   eos_fzp        ! called by traadv_cen2 and sbcice_... modules
-   PUBLIC   eos_pen        ! used for pe diagnostics in trdpen module
-   PUBLIC   eos_init       ! called by istate module
-
-   !                               !!** Namelist nameos **
-   LOGICAL , PUBLIC ::   ln_TEOS10   ! determine if eos_pt_from_ct is used to compute sst_m
-   LOGICAL , PUBLIC ::   ln_EOS80   ! determine if eos_pt_from_ct is used to compute sst_m
-   LOGICAL , PUBLIC ::   ln_SEOS   ! determine if eos_pt_from_ct is used to compute sst_m
-
-   ! Parameters
-   LOGICAL , PUBLIC    ::   l_useCT         ! =T in ln_TEOS10=T (i.e. use eos_pt_from_ct to compute sst_m), =F otherwise
-   INTEGER , PUBLIC    ::   neos            ! Identifier for equation of state used
-
-   INTEGER , PARAMETER ::   np_teos10 = -1  ! parameter for using TEOS10
-   INTEGER , PARAMETER ::   np_eos80  =  0  ! parameter for using EOS80
-   INTEGER , PARAMETER ::   np_seos   = 1   ! parameter for using Simplified Equation of state
-
-   !                               !!!  simplified eos coefficients (default value: Vallis 2006)
-   REAL(wp) ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff. 
-   REAL(wp) ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff. 
-   REAL(wp) ::   rn_lambda1 = 5.9520e-2_wp     ! cabbeling coeff. in T^2        
-   REAL(wp) ::   rn_lambda2 = 5.4914e-4_wp     ! cabbeling coeff. in S^2        
-   REAL(wp) ::   rn_mu1     = 1.4970e-4_wp     ! thermobaric coeff. in T  
-   REAL(wp) ::   rn_mu2     = 1.1090e-5_wp     ! thermobaric coeff. in S  
-   REAL(wp) ::   rn_nu      = 2.4341e-3_wp     ! cabbeling coeff. in theta*salt  
-   
-   ! TEOS10/EOS80 parameters
-   REAL(wp) ::   r1_S0, r1_T0, r1_Z0, rdeltaS
-   
-   ! EOS parameters
-   REAL(wp) ::   EOS000 , EOS100 , EOS200 , EOS300 , EOS400 , EOS500 , EOS600
-   REAL(wp) ::   EOS010 , EOS110 , EOS210 , EOS310 , EOS410 , EOS510
-   REAL(wp) ::   EOS020 , EOS120 , EOS220 , EOS320 , EOS420
-   REAL(wp) ::   EOS030 , EOS130 , EOS230 , EOS330
-   REAL(wp) ::   EOS040 , EOS140 , EOS240
-   REAL(wp) ::   EOS050 , EOS150
-   REAL(wp) ::   EOS060
-   REAL(wp) ::   EOS001 , EOS101 , EOS201 , EOS301 , EOS401
-   REAL(wp) ::   EOS011 , EOS111 , EOS211 , EOS311
-   REAL(wp) ::   EOS021 , EOS121 , EOS221
-   REAL(wp) ::   EOS031 , EOS131
-   REAL(wp) ::   EOS041
-   REAL(wp) ::   EOS002 , EOS102 , EOS202
-   REAL(wp) ::   EOS012 , EOS112
-   REAL(wp) ::   EOS022
-   REAL(wp) ::   EOS003 , EOS103
-   REAL(wp) ::   EOS013 
-   
-   ! ALPHA parameters
-   REAL(wp) ::   ALP000 , ALP100 , ALP200 , ALP300 , ALP400 , ALP500
-   REAL(wp) ::   ALP010 , ALP110 , ALP210 , ALP310 , ALP410
-   REAL(wp) ::   ALP020 , ALP120 , ALP220 , ALP320
-   REAL(wp) ::   ALP030 , ALP130 , ALP230
-   REAL(wp) ::   ALP040 , ALP140
-   REAL(wp) ::   ALP050
-   REAL(wp) ::   ALP001 , ALP101 , ALP201 , ALP301
-   REAL(wp) ::   ALP011 , ALP111 , ALP211
-   REAL(wp) ::   ALP021 , ALP121
-   REAL(wp) ::   ALP031
-   REAL(wp) ::   ALP002 , ALP102
-   REAL(wp) ::   ALP012
-   REAL(wp) ::   ALP003
-   
-   ! BETA parameters
-   REAL(wp) ::   BET000 , BET100 , BET200 , BET300 , BET400 , BET500
-   REAL(wp) ::   BET010 , BET110 , BET210 , BET310 , BET410
-   REAL(wp) ::   BET020 , BET120 , BET220 , BET320
-   REAL(wp) ::   BET030 , BET130 , BET230
-   REAL(wp) ::   BET040 , BET140
-   REAL(wp) ::   BET050
-   REAL(wp) ::   BET001 , BET101 , BET201 , BET301
-   REAL(wp) ::   BET011 , BET111 , BET211
-   REAL(wp) ::   BET021 , BET121
-   REAL(wp) ::   BET031
-   REAL(wp) ::   BET002 , BET102
-   REAL(wp) ::   BET012
-   REAL(wp) ::   BET003
-
-   ! PEN parameters
-   REAL(wp) ::   PEN000 , PEN100 , PEN200 , PEN300 , PEN400
-   REAL(wp) ::   PEN010 , PEN110 , PEN210 , PEN310
-   REAL(wp) ::   PEN020 , PEN120 , PEN220
-   REAL(wp) ::   PEN030 , PEN130
-   REAL(wp) ::   PEN040
-   REAL(wp) ::   PEN001 , PEN101 , PEN201
-   REAL(wp) ::   PEN011 , PEN111
-   REAL(wp) ::   PEN021
-   REAL(wp) ::   PEN002 , PEN102
-   REAL(wp) ::   PEN012
-   
-   ! ALPHA_PEN parameters
-   REAL(wp) ::   APE000 , APE100 , APE200 , APE300
-   REAL(wp) ::   APE010 , APE110 , APE210
-   REAL(wp) ::   APE020 , APE120
-   REAL(wp) ::   APE030
-   REAL(wp) ::   APE001 , APE101
-   REAL(wp) ::   APE011
-   REAL(wp) ::   APE002
-
-   ! BETA_PEN parameters
-   REAL(wp) ::   BPE000 , BPE100 , BPE200 , BPE300
-   REAL(wp) ::   BPE010 , BPE110 , BPE210
-   REAL(wp) ::   BPE020 , BPE120
-   REAL(wp) ::   BPE030
-   REAL(wp) ::   BPE001 , BPE101
-   REAL(wp) ::   BPE011
-   REAL(wp) ::   BPE002
-
-   !! * Substitutions
-   !!----------------------------------------------------------------------
-   !!                   ***  vectopt_loop_substitute  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
-   !!                allow unrolling of do-loop (useful with vector processors)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
-   !! Software governed by the CeCILL licence (./LICENSE)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: eosbn2.F90 6505 2016-05-01 16:11:06Z gm $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE eos_insitu( pts, prd, pdep )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE eos_insitu  ***
-      !!
-      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
-      !!       potential temperature and salinity using an equation of state
-      !!       selected in the nameos namelist
-      !!
-      !! ** Method  :   prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0
-      !!         with   prd    in situ density anomaly      no units
-      !!                t      TEOS10: CT or EOS80: PT      Celsius
-      !!                s      TEOS10: SA or EOS80: SP      TEOS10: g/kg or EOS80: psu
-      !!                z      depth                        meters
-      !!                rho    in situ density              kg/m^3
-      !!                rau0   reference density            kg/m^3
-      !!
-      !!     ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z).
-      !!         Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celcius, sa=35.5 g/kg
-      !!
-      !!     ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z).
-      !!         Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celcius, sp=35.5 psu
-      !!
-      !!     ln_seos : simplified equation of state
-      !!              prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0
-      !!              linear case function of T only: rn_alpha<>0, other coefficients = 0
-      !!              linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0
-      !!              Vallis like equation: use default values of coefficients
-      !!
-      !! ** Action  :   compute prd , the in situ density (no units)
-      !!
-      !! References :   Roquet et al, Ocean Modelling, in preparation (2014)
-      !!                Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006
-      !!                TEOS-10 Manual, 2010
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
-      !                                                               ! 2 : salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd   ! in situ density            [-]
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep  ! depth                      [m]
-      !
-      INTEGER  ::   ji, jj, jk                ! dummy loop indices
-      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars
-      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('eos-insitu')
-      !
-      SELECT CASE( neos )
-      !
-      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
-         !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !
-                  zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
-                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
-                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-                  ztm = tmask(ji,jj,jk)                                         ! tmask
-                  !
-                  zn3 = EOS013*zt   &
-                     &   + EOS103*zs+EOS003
-                     !
-                  zn2 = (EOS022*zt   &
-                     &   + EOS112*zs+EOS012)*zt   &
-                     &   + (EOS202*zs+EOS102)*zs+EOS002
-                     !
-                  zn1 = (((EOS041*zt   &
-                     &   + EOS131*zs+EOS031)*zt   &
-                     &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
-                     &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
-                     &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
-                     !
-                  zn0 = (((((EOS060*zt   &
-                     &   + EOS150*zs+EOS050)*zt   &
-                     &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
-                     &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
-                     &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
-                     &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
-                     &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
-                     !
-                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-                  !
-                  prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm  ! density anomaly (masked)
-                  !
-               END DO
-            END DO
-         END DO
-         !
-      CASE( np_seos )                !==  simplified EOS  ==!
-         !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp
-                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp
-                  zh  = pdep (ji,jj,jk)
-                  ztm = tmask(ji,jj,jk)
-                  !
-                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   &
-                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   &
-                     &  - rn_nu * zt * zs
-                     !                                 
-                  prd(ji,jj,jk) = zn * r1_rau0 * ztm                ! density anomaly (masked)
-               END DO
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', ovlap=1, kdim=jpk )
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('eos-insitu')
-      !
-   END SUBROUTINE eos_insitu
-
-
-   SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE eos_insitu_pot  ***
-      !!
-      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) and the
-      !!      potential volumic mass (Kg/m3) from potential temperature and
-      !!      salinity fields using an equation of state selected in the
-      !!     namelist.
-      !!
-      !! ** Action  : - prd  , the in situ density (no units)
-      !!              - prhop, the potential volumic mass (Kg/m3)
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius]
-      !                                                                ! 2 : salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-]
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m]
-      !
-      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices
-      INTEGER  ::   jdof
-      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars
-      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      -
-      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('eos-pot')
-      !
-      SELECT CASE ( neos )
-      !
-      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
-         !
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     !
-                     zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
-                     zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
-                     zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-                     ztm = tmask(ji,jj,jk)                                         ! tmask
-                     !
-                     zn3 = EOS013*zt   &
-                        &   + EOS103*zs+EOS003
-                        !
-                     zn2 = (EOS022*zt   &
-                        &   + EOS112*zs+EOS012)*zt   &
-                        &   + (EOS202*zs+EOS102)*zs+EOS002
-                        !
-                     zn1 = (((EOS041*zt   &
-                        &   + EOS131*zs+EOS031)*zt   &
-                        &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
-                        &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
-                        &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
-                        !
-                     zn0 = (((((EOS060*zt   &
-                        &   + EOS150*zs+EOS050)*zt   &
-                        &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
-                        &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
-                        &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
-                        &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
-                        &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
-                        !
-                     zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-                     !
-                     prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface
-                     !
-                     prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked)
-                  END DO
-               END DO
-            END DO
-         
-      CASE( np_seos )                !==  simplified EOS  ==!
-         !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp
-                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp
-                  zh  = pdep (ji,jj,jk)
-                  ztm = tmask(ji,jj,jk)
-                  !                                                     ! potential density referenced at the surface
-                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   &
-                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   &
-                     &  - rn_nu * zt * zs
-                  prhop(ji,jj,jk) = ( rau0 + zn ) * ztm
-                  !                                                     ! density anomaly (masked)
-                  zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh
-                  prd(ji,jj,jk) = zn * r1_rau0 * ztm
-                  !
-               END DO
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk )
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('eos-pot')
-      !
-   END SUBROUTINE eos_insitu_pot
-
-
-   SUBROUTINE eos_insitu_2d( pts, pdep, prd )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE eos_insitu_2d  ***
-      !!
-      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
-      !!      potential temperature and salinity using an equation of state
-      !!      selected in the nameos namelist. * 2D field case
-      !!
-      !! ** Action  : - prd , the in situ density (no units) (unmasked)
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
-      !                                                           ! 2 : salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m]
-      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density
-      !
-      INTEGER  ::   ji, jj, jk                ! dummy loop indices
-      REAL(wp) ::   zt , zh , zs              ! local scalars
-      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('eos2d')
-      !
-      prd(:,:) = 0._wp
-      !
-      SELECT CASE( neos )
-      !
-      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1   ! vector opt.
-               !
-               zh  = pdep(ji,jj) * r1_Z0                                  ! depth
-               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
-               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-               !
-               zn3 = EOS013*zt   &
-                  &   + EOS103*zs+EOS003
-                  !
-               zn2 = (EOS022*zt   &
-                  &   + EOS112*zs+EOS012)*zt   &
-                  &   + (EOS202*zs+EOS102)*zs+EOS002
-                  !
-               zn1 = (((EOS041*zt   &
-                  &   + EOS131*zs+EOS031)*zt   &
-                  &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
-                  &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
-                  &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
-                  !
-               zn0 = (((((EOS060*zt   &
-                  &   + EOS150*zs+EOS050)*zt   &
-                  &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
-                  &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
-                  &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
-                  &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
-                  &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
-                  !
-               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-               !
-               prd(ji,jj) = zn * r1_rau0 - 1._wp               ! unmasked in situ density anomaly
-               !
-            END DO
-         END DO
-         !
-         CALL lbc_lnk( prd, 'T', 1. )                    ! Lateral boundary conditions
-         !
-      CASE( np_seos )                !==  simplified EOS  ==!
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1   ! vector opt.
-               !
-               zt    = pts  (ji,jj,jp_tem)  - 10._wp
-               zs    = pts  (ji,jj,jp_sal)  - 35._wp
-               zh    = pdep (ji,jj)                         ! depth at the partial step level
-               !
-               zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   &
-                  &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   &
-                  &  - rn_nu * zt * zs
-                  !
-               prd(ji,jj) = zn * r1_rau0               ! unmasked in situ density anomaly
-               !
-            END DO
-         END DO
-         !
-         CALL lbc_lnk( prd, 'T', 1. )                    ! Lateral boundary conditions
-         !
-      END SELECT
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('eos2d')
-      !
-   END SUBROUTINE eos_insitu_2d
-
-
-   SUBROUTINE rab_3d( pts, pab )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE rab_3d  ***
-      !!
-      !! ** Purpose :   Calculates thermal/haline expansion ratio at T-points
-      !!
-      !! ** Method  :   calculates alpha / beta at T-points
-      !!
-      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! pot. temperature & salinity
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab   ! thermal/haline expansion ratio
-      !
-      INTEGER  ::   ji, jj, jk                ! dummy loop indices
-      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars
-      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('rab_3d')
-      !
-      SELECT CASE ( neos )
-      !
-      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
-         !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !
-                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth
-                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
-                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-                  ztm = tmask(ji,jj,jk)                                         ! tmask
-                  !
-                  ! alpha
-                  zn3 = ALP003
-                  !
-                  zn2 = ALP012*zt + ALP102*zs+ALP002
-                  !
-                  zn1 = ((ALP031*zt   &
-                     &   + ALP121*zs+ALP021)*zt   &
-                     &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
-                     &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
-                     !
-                  zn0 = ((((ALP050*zt   &
-                     &   + ALP140*zs+ALP040)*zt   &
-                     &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
-                     &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
-                     &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
-                     &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
-                     !
-                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-                  !
-                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm
-                  !
-                  ! beta
-                  zn3 = BET003
-                  !
-                  zn2 = BET012*zt + BET102*zs+BET002
-                  !
-                  zn1 = ((BET031*zt   &
-                     &   + BET121*zs+BET021)*zt   &
-                     &   + (BET211*zs+BET111)*zs+BET011)*zt   &
-                     &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
-                     !
-                  zn0 = ((((BET050*zt   &
-                     &   + BET140*zs+BET040)*zt   &
-                     &   + (BET230*zs+BET130)*zs+BET030)*zt   &
-                     &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
-                     &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
-                     &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
-                     !
-                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-                  !
-                  pab(ji,jj,jk,jp_sal) = zn / zs * r1_rau0 * ztm
-                  !
-               END DO
-            END DO
-         END DO
-         !
-      CASE( np_seos )                  !==  simplified EOS  ==!
-         !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
-                  zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
-                  zh  = gdept_n(ji,jj,jk)                ! depth in meters at t-point
-                  ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask
-                  !
-                  zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
-                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm   ! alpha
-                  !
-                  zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
-                  pab(ji,jj,jk,jp_sal) = zn * r1_rau0 * ztm   ! beta
-                  !
-               END DO
-            END DO
-         END DO
-         !
-      CASE DEFAULT
-         IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
-         nstop = nstop + 1
-         !
-      END SELECT
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', &
-         &                       tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', ovlap=1, kdim=jpk )
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('rab_3d')
-      !
-   END SUBROUTINE rab_3d
-
-
-   SUBROUTINE rab_2d( pts, pdep, pab )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE rab_2d  ***
-      !!
-      !! ** Purpose :   Calculates thermal/haline expansion ratio for a 2d field (unmasked)
-      !!
-      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity
-      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(in   ) ::   pdep   ! depth                  [m]
-      REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio
-      !
-      INTEGER  ::   ji, jj, jk                ! dummy loop indices
-      REAL(wp) ::   zt , zh , zs              ! local scalars
-      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('rab_2d')
-      !
-      pab(:,:,:) = 0._wp
-      !
-      SELECT CASE ( neos )
-      !
-      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1   ! vector opt.
-               !
-               zh  = pdep(ji,jj) * r1_Z0                                  ! depth
-               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
-               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-               !
-               ! alpha
-               zn3 = ALP003
-               !
-               zn2 = ALP012*zt + ALP102*zs+ALP002
-               !
-               zn1 = ((ALP031*zt   &
-                  &   + ALP121*zs+ALP021)*zt   &
-                  &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
-                  &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
-                  !
-               zn0 = ((((ALP050*zt   &
-                  &   + ALP140*zs+ALP040)*zt   &
-                  &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
-                  &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
-                  &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
-                  &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
-                  !
-               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-               !
-               pab(ji,jj,jp_tem) = zn * r1_rau0
-               !
-               ! beta
-               zn3 = BET003
-               !
-               zn2 = BET012*zt + BET102*zs+BET002
-               !
-               zn1 = ((BET031*zt   &
-                  &   + BET121*zs+BET021)*zt   &
-                  &   + (BET211*zs+BET111)*zs+BET011)*zt   &
-                  &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
-                  !
-               zn0 = ((((BET050*zt   &
-                  &   + BET140*zs+BET040)*zt   &
-                  &   + (BET230*zs+BET130)*zs+BET030)*zt   &
-                  &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
-                  &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
-                  &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
-                  !
-               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-               !
-               pab(ji,jj,jp_sal) = zn / zs * r1_rau0
-               !
-               !
-            END DO
-         END DO
-         !
-         CALL lbc_lnk( pab(:,:,jp_tem), 'T', 1. )                    ! Lateral boundary conditions
-         CALL lbc_lnk( pab(:,:,jp_sal), 'T', 1. )                    
-         !
-      CASE( np_seos )                  !==  simplified EOS  ==!
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1   ! vector opt.
-               !
-               zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
-               zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
-               zh    = pdep (ji,jj)                   ! depth at the partial step level
-               !
-               zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
-               pab(ji,jj,jp_tem) = zn * r1_rau0   ! alpha
-               !
-               zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
-               pab(ji,jj,jp_sal) = zn * r1_rau0   ! beta
-               !
-            END DO
-         END DO
-         !
-         CALL lbc_lnk( pab(:,:,jp_tem), 'T', 1. )                    ! Lateral boundary conditions
-         CALL lbc_lnk( pab(:,:,jp_sal), 'T', 1. )                    
-         !
-      CASE DEFAULT
-         IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
-         nstop = nstop + 1
-         !
-      END SELECT
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', &
-         &                       tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' )
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('rab_2d')
-      !
-   END SUBROUTINE rab_2d
-
-
-   SUBROUTINE rab_0d( pts, pdep, pab )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE rab_0d  ***
-      !!
-      !! ** Purpose :   Calculates thermal/haline expansion ratio for a 2d field (unmasked)
-      !!
-      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity
-      REAL(wp),                      INTENT(in   ) ::   pdep   ! depth                  [m]
-      REAL(wp), DIMENSION(jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio
-      !
-      REAL(wp) ::   zt , zh , zs              ! local scalars
-      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('rab_2d')
-      !
-      pab(:) = 0._wp
-      !
-      SELECT CASE ( neos )
-      !
-      CASE( np_teos10, np_eos80 )      !==  polynomial TEOS-10 / EOS-80 ==!
-         !
-         !
-         zh  = pdep * r1_Z0                                  ! depth
-         zt  = pts (jp_tem) * r1_T0                           ! temperature
-         zs  = SQRT( ABS( pts(jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-         !
-         ! alpha
-         zn3 = ALP003
-         !
-         zn2 = ALP012*zt + ALP102*zs+ALP002
-         !
-         zn1 = ((ALP031*zt   &
-            &   + ALP121*zs+ALP021)*zt   &
-            &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
-            &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
-            !
-         zn0 = ((((ALP050*zt   &
-            &   + ALP140*zs+ALP040)*zt   &
-            &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
-            &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
-            &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
-            &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
-            !
-         zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-         !
-         pab(jp_tem) = zn * r1_rau0
-         !
-         ! beta
-         zn3 = BET003
-         !
-         zn2 = BET012*zt + BET102*zs+BET002
-         !
-         zn1 = ((BET031*zt   &
-            &   + BET121*zs+BET021)*zt   &
-            &   + (BET211*zs+BET111)*zs+BET011)*zt   &
-            &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
-            !
-         zn0 = ((((BET050*zt   &
-            &   + BET140*zs+BET040)*zt   &
-            &   + (BET230*zs+BET130)*zs+BET030)*zt   &
-            &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
-            &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
-            &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
-            !
-         zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-         !
-         pab(jp_sal) = zn / zs * r1_rau0
-         !
-         !
-         !
-      CASE( np_seos )                  !==  simplified EOS  ==!
-         !
-         zt    = pts(jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
-         zs    = pts(jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
-         zh    = pdep                   ! depth at the partial step level
-         !
-         zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
-         pab(jp_tem) = zn * r1_rau0   ! alpha
-         !
-         zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
-         pab(jp_sal) = zn * r1_rau0   ! beta
-         !
-      CASE DEFAULT
-         IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
-         nstop = nstop + 1
-         !
-      END SELECT
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('rab_2d')
-      !
-   END SUBROUTINE rab_0d
-
-
-   SUBROUTINE bn2( pts, pab, pn2 )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE bn2  ***
-      !!
-      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the 
-      !!                time-step of the input arguments
-      !!
-      !! ** Method  :   pn2 = grav * (alpha dk[T] + beta dk[S] ) / e3w
-      !!      where alpha and beta are given in pab, and computed on T-points.
-      !!      N.B. N^2 is set one for all to zero at jk=1 in istate module.
-      !!
-      !! ** Action  :   pn2 : square of the brunt-vaisala frequency at w-point 
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celcius,psu]
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celcius-1,psu-1]
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2]
-      !
-      INTEGER  ::   ji, jj, jk      ! dummy loop indices
-      REAL(wp) ::   zaw, zbw, zrw   ! local scalars
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('bn2')
-      !
-      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 )
-         DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90
-            DO ji = 1, jpi
-               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
-                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
-                  !
-               zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 
-               zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw
-               !
-               pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     &
-                  &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  &
-                  &            / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk )
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('bn2')
-      !
-   END SUBROUTINE bn2
-
-
-   FUNCTION eos_pt_from_ct( ctmp, psal ) RESULT( ptmp )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE eos_pt_from_ct  ***
-      !!
-      !! ** Purpose :   Compute pot.temp. from cons. temp. [Celcius]
-      !!
-      !! ** Method  :   rational approximation (5/3th order) of TEOS-10 algorithm
-      !!       checkvalue: pt=20.02391895 Celsius for sa=35.7g/kg, ct=20degC
-      !!
-      !! Reference  :   TEOS-10, UNESCO
-      !!                Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC)
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp [Celcius]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity   [psu]
-      ! Leave result array automatic rather than making explicitly allocated
-      REAL(wp), DIMENSION(jpi,jpj) ::   ptmp   ! potential temperature [Celcius]
-      !
-      INTEGER  ::   ji, jj               ! dummy loop indices
-      REAL(wp) ::   zt , zs , ztm        ! local scalars
-      REAL(wp) ::   zn , zd              ! local scalars
-      REAL(wp) ::   zdeltaS , z1_S0 , z1_T0
-      !!----------------------------------------------------------------------
-      !
-      IF ( nn_timing == 1 )   CALL timing_start('eos_pt_from_ct')
-      !
-      zdeltaS = 5._wp
-      z1_S0   = 0.875_wp/35.16504_wp
-      z1_T0   = 1._wp/40._wp
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zt  = ctmp   (ji,jj) * z1_T0
-            zs  = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 )
-            ztm = tmask(ji,jj,1)
-            !
-            zn = ((((-2.1385727895e-01_wp*zt   &
-               &   - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt   &
-               &   + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt   &
-               &   + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt   &
-               &   + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs   &
-               &      +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt   &
-               &   + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs   &
-               &      -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp
-               !
-            zd = (2.0035003456_wp*zt   &
-               &   -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt   &
-               &   + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp
-               !
-            ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm
-               !
-         END DO
-      END DO
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('eos_pt_from_ct')
-      !
-   END FUNCTION eos_pt_from_ct
-
-
-   SUBROUTINE  eos_fzp_2d( psal, ptf, pdep )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE eos_fzp  ***
-      !!
-      !! ** Purpose :   Compute the freezing point temperature [Celcius]
-      !!
-      !! ** Method  :   UNESCO freezing point (ptf) in Celcius is given by
-      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z
-      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m
-      !!
-      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celcius]
-      !
-      INTEGER  ::   ji, jj          ! dummy loop indices
-      REAL(wp) ::   zt, zs, z1_S0   ! local scalars
-      !!----------------------------------------------------------------------
-      !
-      SELECT CASE ( neos )
-      !
-      CASE ( np_teos10, np_seos )      !==  CT,SA (TEOS-10 and S-EOS formulations) ==!
-         !
-         z1_S0 = 1._wp / 35.16504_wp
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 )           ! square root salinity
-               ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
-                  &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
-            END DO
-         END DO
-         ptf(:,:) = ptf(:,:) * psal(:,:)
-         !
-         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
-         !
-      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==!
-         !
-         ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   &
-            &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:)
-            !
-         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
-         !
-      CASE DEFAULT
-         IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
-         nstop = nstop + 1
-         !
-      END SELECT      
-      !
-  END SUBROUTINE eos_fzp_2d
-
-
-  SUBROUTINE eos_fzp_0d( psal, ptf, pdep )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE eos_fzp  ***
-      !!
-      !! ** Purpose :   Compute the freezing point temperature [Celcius]
-      !!
-      !! ** Method  :   UNESCO freezing point (ptf) in Celcius is given by
-      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z
-      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m
-      !!
-      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in )           ::   psal         ! salinity   [psu]
-      REAL(wp), INTENT(in ), OPTIONAL ::   pdep         ! depth      [m]
-      REAL(wp), INTENT(out)           ::   ptf          ! freezing temperature [Celcius]
-      !
-      REAL(wp) :: zs   ! local scalars
-      !!----------------------------------------------------------------------
-      !
-      SELECT CASE ( neos )
-      !
-      CASE ( np_teos10, np_seos )      !==  CT,SA (TEOS-10 and S-EOS formulations) ==!
-         !
-         zs  = SQRT( ABS( psal ) / 35.16504_wp )           ! square root salinity
-         ptf = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
-                  &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
-         ptf = ptf * psal
-         !
-         IF( PRESENT( pdep ) )   ptf = ptf - 7.53e-4 * pdep
-         !
-      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==!
-         !
-         ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal )   &
-            &                - 2.154996e-4_wp *       psal   ) * psal
-            !
-         IF( PRESENT( pdep ) )   ptf = ptf - 7.53e-4 * pdep
-         !
-      CASE DEFAULT
-         IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
-         nstop = nstop + 1
-         !
-      END SELECT
-      !
-   END SUBROUTINE eos_fzp_0d
-
-
-   SUBROUTINE eos_pen( pts, pab_pe, ppen )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE eos_pen  ***
-      !!
-      !! ** Purpose :   Calculates nonlinear anomalies of alpha_PE, beta_PE and PE at T-points
-      !!
-      !! ** Method  :   PE is defined analytically as the vertical 
-      !!                   primitive of EOS times -g integrated between 0 and z>0.
-      !!                pen is the nonlinear bsq-PE anomaly: pen = ( PE - rau0 gz ) / rau0 gz - rd
-      !!                                                      = 1/z * /int_0^z rd dz - rd 
-      !!                                where rd is the density anomaly (see eos_rhd function)
-      !!                ab_pe are partial derivatives of PE anomaly with respect to T and S:
-      !!                    ab_pe(1) = - 1/(rau0 gz) * dPE/dT + drd/dT = - d(pen)/dT
-      !!                    ab_pe(2) =   1/(rau0 gz) * dPE/dS + drd/dS =   d(pen)/dS
-      !!
-      !! ** Action  : - pen         : PE anomaly given at T-points
-      !!            : - pab_pe  : given at T-points
-      !!                    pab_pe(:,:,:,jp_tem) is alpha_pe
-      !!                    pab_pe(:,:,:,jp_sal) is beta_pe
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts     ! pot. temperature & salinity
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab_pe  ! alpha_pe and beta_pe
-      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   ppen     ! potential energy anomaly
-      !
-      INTEGER  ::   ji, jj, jk                ! dummy loop indices
-      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars
-      REAL(wp) ::   zn , zn0, zn1, zn2        !   -      -
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('eos_pen')
-      !
-      SELECT CASE ( neos )
-      !
-      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
-         !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !
-                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth
-                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
-                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-                  ztm = tmask(ji,jj,jk)                                         ! tmask
-                  !
-                  ! potential energy non-linear anomaly
-                  zn2 = (PEN012)*zt   &
-                     &   + PEN102*zs+PEN002
-                     !
-                  zn1 = ((PEN021)*zt   &
-                     &   + PEN111*zs+PEN011)*zt   &
-                     &   + (PEN201*zs+PEN101)*zs+PEN001
-                     !
-                  zn0 = ((((PEN040)*zt   &
-                     &   + PEN130*zs+PEN030)*zt   &
-                     &   + (PEN220*zs+PEN120)*zs+PEN020)*zt   &
-                     &   + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt   &
-                     &   + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000
-                     !
-                  zn  = ( zn2 * zh + zn1 ) * zh + zn0
-                  !
-                  ppen(ji,jj,jk)  = zn * zh * r1_rau0 * ztm
-                  !
-                  ! alphaPE non-linear anomaly
-                  zn2 = APE002
-                  !
-                  zn1 = (APE011)*zt   &
-                     &   + APE101*zs+APE001
-                     !
-                  zn0 = (((APE030)*zt   &
-                     &   + APE120*zs+APE020)*zt   &
-                     &   + (APE210*zs+APE110)*zs+APE010)*zt   &
-                     &   + ((APE300*zs+APE200)*zs+APE100)*zs+APE000
-                     !
-                  zn  = ( zn2 * zh + zn1 ) * zh + zn0
-                  !                              
-                  pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rau0 * ztm
-                  !
-                  ! betaPE non-linear anomaly
-                  zn2 = BPE002
-                  !
-                  zn1 = (BPE011)*zt   &
-                     &   + BPE101*zs+BPE001
-                     !
-                  zn0 = (((BPE030)*zt   &
-                     &   + BPE120*zs+BPE020)*zt   &
-                     &   + (BPE210*zs+BPE110)*zs+BPE010)*zt   &
-                     &   + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000
-                     !
-                  zn  = ( zn2 * zh + zn1 ) * zh + zn0
-                  !                              
-                  pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rau0 * ztm
-                  !
-               END DO
-            END DO
-         END DO
-         !
-      CASE( np_seos )                !==  Vallis (2006) simplified EOS  ==!
-         !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0)
-                  zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0)
-                  zh  = gdept_n(ji,jj,jk)              ! depth in meters  at t-point
-                  ztm = tmask(ji,jj,jk)                ! tmask
-                  zn  = 0.5_wp * zh * r1_rau0 * ztm
-                  !                                    ! Potential Energy
-                  ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn
-                  !                                    ! alphaPE
-                  pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn
-                  pab_pe(ji,jj,jk,jp_sal) =   rn_b0 * rn_mu2 * zn
-                  !
-               END DO
-            END DO
-         END DO
-         !
-      CASE DEFAULT
-         IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
-         nstop = nstop + 1
-         !
-      END SELECT
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('eos_pen')
-      !
-   END SUBROUTINE eos_pen
-
-
-   SUBROUTINE eos_init
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE eos_init  ***
-      !!
-      !! ** Purpose :   initializations for the equation of state
-      !!
-      !! ** Method  :   Read the namelist nameos and control the parameters
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ios   ! local integer
-      INTEGER  ::   ioptio   ! local integer
-      !!
-      NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, rn_a0, rn_b0, rn_lambda1, rn_mu1,   &
-         &                                             rn_lambda2, rn_mu2, rn_nu
-      !!----------------------------------------------------------------------
-      !
-      REWIND( numnam_ref )              ! Namelist nameos in reference namelist : equation of state
-      READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 )
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist', lwp )
-      !
-      REWIND( numnam_cfg )              ! Namelist nameos in configuration namelist : equation of state
-      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp )
-      IF(lwm) WRITE( numond, nameos )
-      !
-      rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3]
-      rcp         = 3991.86795711963_wp      !: heat capacity     [J/K]
-      !
-      IF(lwp) THEN                ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'eos_init : equation of state'
-         WRITE(numout,*) '~~~~~~~~'
-         WRITE(numout,*) '   Namelist nameos : Chosen the Equation Of Seawater (EOS)'
-         WRITE(numout,*) '      TEOS-10 : rho=F(Conservative Temperature, Absolute  Salinity, depth)   ln_TEOS10 = ', ln_TEOS10
-         WRITE(numout,*) '      EOS-80  : rho=F(Potential    Temperature, Practical Salinity, depth)   ln_EOS80  = ', ln_EOS80
-         WRITE(numout,*) '      S-EOS   : rho=F(Conservative Temperature, Absolute  Salinity, depth)   ln_SEOS   = ', ln_SEOS
-      ENDIF
-
-      ! Check options for equation of state & set neos based on logical flags
-      ioptio = 0
-      IF( ln_TEOS10 ) THEN   ;   ioptio = ioptio+1   ;   neos = np_teos10   ;   ENDIF
-      IF( ln_EOS80  ) THEN   ;   ioptio = ioptio+1   ;   neos = np_eos80    ;   ENDIF
-      IF( ln_SEOS   ) THEN   ;   ioptio = ioptio+1   ;   neos = np_seos     ;   ENDIF
-      IF( ioptio /= 1 )   CALL ctl_stop("Exactly one equation of state option must be selected")
-      !
-      SELECT CASE( neos )         ! check option
-      !
-      CASE( np_teos10 )                       !==  polynomial TEOS-10  ==!
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          use of TEOS-10 equation of state (cons. temp. and abs. salinity)'
-         !
-         l_useCT = .TRUE.                          ! model temperature is Conservative temperature 
-         !
-         rdeltaS = 32._wp
-         r1_S0  = 0.875_wp/35.16504_wp
-         r1_T0  = 1._wp/40._wp
-         r1_Z0  = 1.e-4_wp
-         !
-         EOS000 = 8.0189615746e+02_wp
-         EOS100 = 8.6672408165e+02_wp
-         EOS200 = -1.7864682637e+03_wp
-         EOS300 = 2.0375295546e+03_wp
-         EOS400 = -1.2849161071e+03_wp
-         EOS500 = 4.3227585684e+02_wp
-         EOS600 = -6.0579916612e+01_wp
-         EOS010 = 2.6010145068e+01_wp
-         EOS110 = -6.5281885265e+01_wp
-         EOS210 = 8.1770425108e+01_wp
-         EOS310 = -5.6888046321e+01_wp
-         EOS410 = 1.7681814114e+01_wp
-         EOS510 = -1.9193502195_wp
-         EOS020 = -3.7074170417e+01_wp
-         EOS120 = 6.1548258127e+01_wp
-         EOS220 = -6.0362551501e+01_wp
-         EOS320 = 2.9130021253e+01_wp
-         EOS420 = -5.4723692739_wp
-         EOS030 = 2.1661789529e+01_wp
-         EOS130 = -3.3449108469e+01_wp
-         EOS230 = 1.9717078466e+01_wp
-         EOS330 = -3.1742946532_wp
-         EOS040 = -8.3627885467_wp
-         EOS140 = 1.1311538584e+01_wp
-         EOS240 = -5.3563304045_wp
-         EOS050 = 5.4048723791e-01_wp
-         EOS150 = 4.8169980163e-01_wp
-         EOS060 = -1.9083568888e-01_wp
-         EOS001 = 1.9681925209e+01_wp
-         EOS101 = -4.2549998214e+01_wp
-         EOS201 = 5.0774768218e+01_wp
-         EOS301 = -3.0938076334e+01_wp
-         EOS401 = 6.6051753097_wp
-         EOS011 = -1.3336301113e+01_wp
-         EOS111 = -4.4870114575_wp
-         EOS211 = 5.0042598061_wp
-         EOS311 = -6.5399043664e-01_wp
-         EOS021 = 6.7080479603_wp
-         EOS121 = 3.5063081279_wp
-         EOS221 = -1.8795372996_wp
-         EOS031 = -2.4649669534_wp
-         EOS131 = -5.5077101279e-01_wp
-         EOS041 = 5.5927935970e-01_wp
-         EOS002 = 2.0660924175_wp
-         EOS102 = -4.9527603989_wp
-         EOS202 = 2.5019633244_wp
-         EOS012 = 2.0564311499_wp
-         EOS112 = -2.1311365518e-01_wp
-         EOS022 = -1.2419983026_wp
-         EOS003 = -2.3342758797e-02_wp
-         EOS103 = -1.8507636718e-02_wp
-         EOS013 = 3.7969820455e-01_wp
-         !
-         ALP000 = -6.5025362670e-01_wp
-         ALP100 = 1.6320471316_wp
-         ALP200 = -2.0442606277_wp
-         ALP300 = 1.4222011580_wp
-         ALP400 = -4.4204535284e-01_wp
-         ALP500 = 4.7983755487e-02_wp
-         ALP010 = 1.8537085209_wp
-         ALP110 = -3.0774129064_wp
-         ALP210 = 3.0181275751_wp
-         ALP310 = -1.4565010626_wp
-         ALP410 = 2.7361846370e-01_wp
-         ALP020 = -1.6246342147_wp
-         ALP120 = 2.5086831352_wp
-         ALP220 = -1.4787808849_wp
-         ALP320 = 2.3807209899e-01_wp
-         ALP030 = 8.3627885467e-01_wp
-         ALP130 = -1.1311538584_wp
-         ALP230 = 5.3563304045e-01_wp
-         ALP040 = -6.7560904739e-02_wp
-         ALP140 = -6.0212475204e-02_wp
-         ALP050 = 2.8625353333e-02_wp
-         ALP001 = 3.3340752782e-01_wp
-         ALP101 = 1.1217528644e-01_wp
-         ALP201 = -1.2510649515e-01_wp
-         ALP301 = 1.6349760916e-02_wp
-         ALP011 = -3.3540239802e-01_wp
-         ALP111 = -1.7531540640e-01_wp
-         ALP211 = 9.3976864981e-02_wp
-         ALP021 = 1.8487252150e-01_wp
-         ALP121 = 4.1307825959e-02_wp
-         ALP031 = -5.5927935970e-02_wp
-         ALP002 = -5.1410778748e-02_wp
-         ALP102 = 5.3278413794e-03_wp
-         ALP012 = 6.2099915132e-02_wp
-         ALP003 = -9.4924551138e-03_wp
-         !
-         BET000 = 1.0783203594e+01_wp
-         BET100 = -4.4452095908e+01_wp
-         BET200 = 7.6048755820e+01_wp
-         BET300 = -6.3944280668e+01_wp
-         BET400 = 2.6890441098e+01_wp
-         BET500 = -4.5221697773_wp
-         BET010 = -8.1219372432e-01_wp
-         BET110 = 2.0346663041_wp
-         BET210 = -2.1232895170_wp
-         BET310 = 8.7994140485e-01_wp
-         BET410 = -1.1939638360e-01_wp
-         BET020 = 7.6574242289e-01_wp
-         BET120 = -1.5019813020_wp
-         BET220 = 1.0872489522_wp
-         BET320 = -2.7233429080e-01_wp
-         BET030 = -4.1615152308e-01_wp
-         BET130 = 4.9061350869e-01_wp
-         BET230 = -1.1847737788e-01_wp
-         BET040 = 1.4073062708e-01_wp
-         BET140 = -1.3327978879e-01_wp
-         BET050 = 5.9929880134e-03_wp
-         BET001 = -5.2937873009e-01_wp
-         BET101 = 1.2634116779_wp
-         BET201 = -1.1547328025_wp
-         BET301 = 3.2870876279e-01_wp
-         BET011 = -5.5824407214e-02_wp
-         BET111 = 1.2451933313e-01_wp
-         BET211 = -2.4409539932e-02_wp
-         BET021 = 4.3623149752e-02_wp
-         BET121 = -4.6767901790e-02_wp
-         BET031 = -6.8523260060e-03_wp
-         BET002 = -6.1618945251e-02_wp
-         BET102 = 6.2255521644e-02_wp
-         BET012 = -2.6514181169e-03_wp
-         BET003 = -2.3025968587e-04_wp
-         !
-         PEN000 = -9.8409626043_wp
-         PEN100 = 2.1274999107e+01_wp
-         PEN200 = -2.5387384109e+01_wp
-         PEN300 = 1.5469038167e+01_wp
-         PEN400 = -3.3025876549_wp
-         PEN010 = 6.6681505563_wp
-         PEN110 = 2.2435057288_wp
-         PEN210 = -2.5021299030_wp
-         PEN310 = 3.2699521832e-01_wp
-         PEN020 = -3.3540239802_wp
-         PEN120 = -1.7531540640_wp
-         PEN220 = 9.3976864981e-01_wp
-         PEN030 = 1.2324834767_wp
-         PEN130 = 2.7538550639e-01_wp
-         PEN040 = -2.7963967985e-01_wp
-         PEN001 = -1.3773949450_wp
-         PEN101 = 3.3018402659_wp
-         PEN201 = -1.6679755496_wp
-         PEN011 = -1.3709540999_wp
-         PEN111 = 1.4207577012e-01_wp
-         PEN021 = 8.2799886843e-01_wp
-         PEN002 = 1.7507069098e-02_wp
-         PEN102 = 1.3880727538e-02_wp
-         PEN012 = -2.8477365341e-01_wp
-         !
-         APE000 = -1.6670376391e-01_wp
-         APE100 = -5.6087643219e-02_wp
-         APE200 = 6.2553247576e-02_wp
-         APE300 = -8.1748804580e-03_wp
-         APE010 = 1.6770119901e-01_wp
-         APE110 = 8.7657703198e-02_wp
-         APE210 = -4.6988432490e-02_wp
-         APE020 = -9.2436260751e-02_wp
-         APE120 = -2.0653912979e-02_wp
-         APE030 = 2.7963967985e-02_wp
-         APE001 = 3.4273852498e-02_wp
-         APE101 = -3.5518942529e-03_wp
-         APE011 = -4.1399943421e-02_wp
-         APE002 = 7.1193413354e-03_wp
-         !
-         BPE000 = 2.6468936504e-01_wp
-         BPE100 = -6.3170583896e-01_wp
-         BPE200 = 5.7736640125e-01_wp
-         BPE300 = -1.6435438140e-01_wp
-         BPE010 = 2.7912203607e-02_wp
-         BPE110 = -6.2259666565e-02_wp
-         BPE210 = 1.2204769966e-02_wp
-         BPE020 = -2.1811574876e-02_wp
-         BPE120 = 2.3383950895e-02_wp
-         BPE030 = 3.4261630030e-03_wp
-         BPE001 = 4.1079296834e-02_wp
-         BPE101 = -4.1503681096e-02_wp
-         BPE011 = 1.7676120780e-03_wp
-         BPE002 = 1.7269476440e-04_wp
-         !
-      CASE( np_eos80 )                        !==  polynomial EOS-80 formulation  ==!
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          use of EOS-80 equation of state (pot. temp. and pract. salinity)'
-         !
-         l_useCT = .FALSE.                         ! model temperature is Potential temperature
-         rdeltaS = 20._wp
-         r1_S0  = 1._wp/40._wp
-         r1_T0  = 1._wp/40._wp
-         r1_Z0  = 1.e-4_wp
-         !
-         EOS000 = 9.5356891948e+02_wp
-         EOS100 = 1.7136499189e+02_wp
-         EOS200 = -3.7501039454e+02_wp
-         EOS300 = 5.1856810420e+02_wp
-         EOS400 = -3.7264470465e+02_wp
-         EOS500 = 1.4302533998e+02_wp
-         EOS600 = -2.2856621162e+01_wp
-         EOS010 = 1.0087518651e+01_wp
-         EOS110 = -1.3647741861e+01_wp
-         EOS210 = 8.8478359933_wp
-         EOS310 = -7.2329388377_wp
-         EOS410 = 1.4774410611_wp
-         EOS510 = 2.0036720553e-01_wp
-         EOS020 = -2.5579830599e+01_wp
-         EOS120 = 2.4043512327e+01_wp
-         EOS220 = -1.6807503990e+01_wp
-         EOS320 = 8.3811577084_wp
-         EOS420 = -1.9771060192_wp
-         EOS030 = 1.6846451198e+01_wp
-         EOS130 = -2.1482926901e+01_wp
-         EOS230 = 1.0108954054e+01_wp
-         EOS330 = -6.2675951440e-01_wp
-         EOS040 = -8.0812310102_wp
-         EOS140 = 1.0102374985e+01_wp
-         EOS240 = -4.8340368631_wp
-         EOS050 = 1.2079167803_wp
-         EOS150 = 1.1515380987e-01_wp
-         EOS060 = -2.4520288837e-01_wp
-         EOS001 = 1.0748601068e+01_wp
-         EOS101 = -1.7817043500e+01_wp
-         EOS201 = 2.2181366768e+01_wp
-         EOS301 = -1.6750916338e+01_wp
-         EOS401 = 4.1202230403_wp
-         EOS011 = -1.5852644587e+01_wp
-         EOS111 = -7.6639383522e-01_wp
-         EOS211 = 4.1144627302_wp
-         EOS311 = -6.6955877448e-01_wp
-         EOS021 = 9.9994861860_wp
-         EOS121 = -1.9467067787e-01_wp
-         EOS221 = -1.2177554330_wp
-         EOS031 = -3.4866102017_wp
-         EOS131 = 2.2229155620e-01_wp
-         EOS041 = 5.9503008642e-01_wp
-         EOS002 = 1.0375676547_wp
-         EOS102 = -3.4249470629_wp
-         EOS202 = 2.0542026429_wp
-         EOS012 = 2.1836324814_wp
-         EOS112 = -3.4453674320e-01_wp
-         EOS022 = -1.2548163097_wp
-         EOS003 = 1.8729078427e-02_wp
-         EOS103 = -5.7238495240e-02_wp
-         EOS013 = 3.8306136687e-01_wp
-         !
-         ALP000 = -2.5218796628e-01_wp
-         ALP100 = 3.4119354654e-01_wp
-         ALP200 = -2.2119589983e-01_wp
-         ALP300 = 1.8082347094e-01_wp
-         ALP400 = -3.6936026529e-02_wp
-         ALP500 = -5.0091801383e-03_wp
-         ALP010 = 1.2789915300_wp
-         ALP110 = -1.2021756164_wp
-         ALP210 = 8.4037519952e-01_wp
-         ALP310 = -4.1905788542e-01_wp
-         ALP410 = 9.8855300959e-02_wp
-         ALP020 = -1.2634838399_wp
-         ALP120 = 1.6112195176_wp
-         ALP220 = -7.5817155402e-01_wp
-         ALP320 = 4.7006963580e-02_wp
-         ALP030 = 8.0812310102e-01_wp
-         ALP130 = -1.0102374985_wp
-         ALP230 = 4.8340368631e-01_wp
-         ALP040 = -1.5098959754e-01_wp
-         ALP140 = -1.4394226233e-02_wp
-         ALP050 = 3.6780433255e-02_wp
-         ALP001 = 3.9631611467e-01_wp
-         ALP101 = 1.9159845880e-02_wp
-         ALP201 = -1.0286156825e-01_wp
-         ALP301 = 1.6738969362e-02_wp
-         ALP011 = -4.9997430930e-01_wp
-         ALP111 = 9.7335338937e-03_wp
-         ALP211 = 6.0887771651e-02_wp
-         ALP021 = 2.6149576513e-01_wp
-         ALP121 = -1.6671866715e-02_wp
-         ALP031 = -5.9503008642e-02_wp
-         ALP002 = -5.4590812035e-02_wp
-         ALP102 = 8.6134185799e-03_wp
-         ALP012 = 6.2740815484e-02_wp
-         ALP003 = -9.5765341718e-03_wp
-         !
-         BET000 = 2.1420623987_wp
-         BET100 = -9.3752598635_wp
-         BET200 = 1.9446303907e+01_wp
-         BET300 = -1.8632235232e+01_wp
-         BET400 = 8.9390837485_wp
-         BET500 = -1.7142465871_wp
-         BET010 = -1.7059677327e-01_wp
-         BET110 = 2.2119589983e-01_wp
-         BET210 = -2.7123520642e-01_wp
-         BET310 = 7.3872053057e-02_wp
-         BET410 = 1.2522950346e-02_wp
-         BET020 = 3.0054390409e-01_wp
-         BET120 = -4.2018759976e-01_wp
-         BET220 = 3.1429341406e-01_wp
-         BET320 = -9.8855300959e-02_wp
-         BET030 = -2.6853658626e-01_wp
-         BET130 = 2.5272385134e-01_wp
-         BET230 = -2.3503481790e-02_wp
-         BET040 = 1.2627968731e-01_wp
-         BET140 = -1.2085092158e-01_wp
-         BET050 = 1.4394226233e-03_wp
-         BET001 = -2.2271304375e-01_wp
-         BET101 = 5.5453416919e-01_wp
-         BET201 = -6.2815936268e-01_wp
-         BET301 = 2.0601115202e-01_wp
-         BET011 = -9.5799229402e-03_wp
-         BET111 = 1.0286156825e-01_wp
-         BET211 = -2.5108454043e-02_wp
-         BET021 = -2.4333834734e-03_wp
-         BET121 = -3.0443885826e-02_wp
-         BET031 = 2.7786444526e-03_wp
-         BET002 = -4.2811838287e-02_wp
-         BET102 = 5.1355066072e-02_wp
-         BET012 = -4.3067092900e-03_wp
-         BET003 = -7.1548119050e-04_wp
-         !
-         PEN000 = -5.3743005340_wp
-         PEN100 = 8.9085217499_wp
-         PEN200 = -1.1090683384e+01_wp
-         PEN300 = 8.3754581690_wp
-         PEN400 = -2.0601115202_wp
-         PEN010 = 7.9263222935_wp
-         PEN110 = 3.8319691761e-01_wp
-         PEN210 = -2.0572313651_wp
-         PEN310 = 3.3477938724e-01_wp
-         PEN020 = -4.9997430930_wp
-         PEN120 = 9.7335338937e-02_wp
-         PEN220 = 6.0887771651e-01_wp
-         PEN030 = 1.7433051009_wp
-         PEN130 = -1.1114577810e-01_wp
-         PEN040 = -2.9751504321e-01_wp
-         PEN001 = -6.9171176978e-01_wp
-         PEN101 = 2.2832980419_wp
-         PEN201 = -1.3694684286_wp
-         PEN011 = -1.4557549876_wp
-         PEN111 = 2.2969116213e-01_wp
-         PEN021 = 8.3654420645e-01_wp
-         PEN002 = -1.4046808820e-02_wp
-         PEN102 = 4.2928871430e-02_wp
-         PEN012 = -2.8729602515e-01_wp
-         !
-         APE000 = -1.9815805734e-01_wp
-         APE100 = -9.5799229402e-03_wp
-         APE200 = 5.1430784127e-02_wp
-         APE300 = -8.3694846809e-03_wp
-         APE010 = 2.4998715465e-01_wp
-         APE110 = -4.8667669469e-03_wp
-         APE210 = -3.0443885826e-02_wp
-         APE020 = -1.3074788257e-01_wp
-         APE120 = 8.3359333577e-03_wp
-         APE030 = 2.9751504321e-02_wp
-         APE001 = 3.6393874690e-02_wp
-         APE101 = -5.7422790533e-03_wp
-         APE011 = -4.1827210323e-02_wp
-         APE002 = 7.1824006288e-03_wp
-         !
-         BPE000 = 1.1135652187e-01_wp
-         BPE100 = -2.7726708459e-01_wp
-         BPE200 = 3.1407968134e-01_wp
-         BPE300 = -1.0300557601e-01_wp
-         BPE010 = 4.7899614701e-03_wp
-         BPE110 = -5.1430784127e-02_wp
-         BPE210 = 1.2554227021e-02_wp
-         BPE020 = 1.2166917367e-03_wp
-         BPE120 = 1.5221942913e-02_wp
-         BPE030 = -1.3893222263e-03_wp
-         BPE001 = 2.8541225524e-02_wp
-         BPE101 = -3.4236710714e-02_wp
-         BPE011 = 2.8711395266e-03_wp
-         BPE002 = 5.3661089288e-04_wp
-         !
-      CASE( np_seos )                        !==  Simplified EOS     ==!
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) '          use of simplified eos:    rhd(dT=T-10,dS=S-35,Z) = '
-            WRITE(numout,*) '             [-a0*(1+lambda1/2*dT+mu1*Z)*dT + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS]/rau0'
-            WRITE(numout,*)
-            WRITE(numout,*) '             thermal exp. coef.    rn_a0      = ', rn_a0
-            WRITE(numout,*) '             saline  cont. coef.   rn_b0      = ', rn_b0
-            WRITE(numout,*) '             cabbeling coef.       rn_lambda1 = ', rn_lambda1
-            WRITE(numout,*) '             cabbeling coef.       rn_lambda2 = ', rn_lambda2
-            WRITE(numout,*) '             thermobar. coef.      rn_mu1     = ', rn_mu1
-            WRITE(numout,*) '             thermobar. coef.      rn_mu2     = ', rn_mu2
-            WRITE(numout,*) '             2nd cabbel. coef.     rn_nu      = ', rn_nu
-            WRITE(numout,*) '               Caution: rn_beta0=0 incompatible with ddm parameterization '
-         ENDIF
-         l_useCT = .TRUE.          ! Use conservative temperature
-         !
-      CASE DEFAULT                     !==  ERROR in neos  ==!
-         WRITE(ctmp1,*) '          bad flag value for neos = ', neos, '. You should never see this error'
-         CALL ctl_stop( ctmp1 )
-         !
-      END SELECT
-      !
-      rau0_rcp    = rau0 * rcp 
-      r1_rau0     = 1._wp / rau0
-      r1_rcp      = 1._wp / rcp
-      r1_rau0_rcp = 1._wp / rau0_rcp 
-      !
-      IF(lwp) THEN
-         IF( l_useCT )   THEN
-            WRITE(numout,*) '             model uses Conservative Temperature'
-            WRITE(numout,*) '             Important: model must be initialized with CT and SA fields'
-         ELSE
-            WRITE(numout,*) '             model does not use Conservative Temperature'
-         ENDIF
-      ENDIF
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3'
-      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg'
-      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin'
-      IF(lwp) WRITE(numout,*) '          rau0 * rcp                       rau0_rcp = ', rau0_rcp
-      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp
-      !
-   END SUBROUTINE eos_init
-
-   !!======================================================================
-END MODULE eosbn2
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/flincom.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/flincom.f90	(revision 12100)
+++ 	(revision )
@@ -1,1939 +1,0 @@
-MODULE flincom
-!-
-!$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
-!-
-!===
-!-
-END MODULE flincom
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/getincom.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/getincom.f90	(revision 12100)
+++ 	(revision )
@@ -1,2008 +1,0 @@
-MODULE getincom
-!-
-!$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
-!===
-!------------------
-END MODULE getincom
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/histcom.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/histcom.f90	(revision 12100)
+++ 	(revision )
@@ -1,2501 +1,0 @@
-MODULE histcom
-!-
-!$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
-!-
-!===
-!-
-!-----------------
-END MODULE histcom
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/in_out_manager.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/in_out_manager.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/in_out_manager.F90	(revision 12101)
@@ -0,0 +1,186 @@
+MODULE in_out_manager   
+   !!======================================================================
+   !!                       ***  MODULE  in_out_manager  ***
+   !! I/O manager utilities : Defines run parameters together with logical units
+   !!=====================================================================
+   !! History :   1.0  !  2002-06  (G. Madec)   original code
+   !!             2.0  !  2006-07  (S. Masson)  iom, add ctl_stop, ctl_warn
+   !!             3.0  !  2008-06  (G. Madec)   add ctmp4 to ctmp10
+   !!             3.2  !  2009-08  (S. MAsson)  add new ctl_opn
+   !!             3.3  !  2010-10  (A. Coward)  add NetCDF4 usage
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   USE par_oce       ! ocean parameter
+   USE nc4interface  ! NetCDF4 interface
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!                   namrun namelist parameters
+   !!----------------------------------------------------------------------
+   CHARACTER(lc) ::   cn_exp           !: experiment name used for output filename
+   CHARACTER(lc) ::   cn_ocerst_in     !: suffix of ocean restart name (input)
+   CHARACTER(lc) ::   cn_ocerst_indir  !: restart input directory
+   CHARACTER(lc) ::   cn_ocerst_out    !: suffix of ocean restart name (output)
+   CHARACTER(lc) ::   cn_ocerst_outdir !: restart output directory
+   LOGICAL       ::   ln_rstart        !: start from (F) rest or (T) a restart file
+   LOGICAL       ::   ln_rst_list      !: output restarts at list of times (T) or by frequency (F)
+   INTEGER       ::   nn_rstctl        !: control of the time step (0, 1 or 2)
+   INTEGER       ::   nn_rstssh   = 0  !: hand made initilization of ssh or not (1/0)
+   INTEGER       ::   nn_it000         !: index of the first time step
+   INTEGER       ::   nn_itend         !: index of the last time step
+   INTEGER       ::   nn_date0         !: initial calendar date aammjj
+   INTEGER       ::   nn_time0         !: initial time of day in hhmm
+   INTEGER       ::   nn_leapy         !: Leap year calendar flag (0/1 or 30)
+   INTEGER       ::   nn_istate        !: initial state output flag (0/1)
+   INTEGER       ::   nn_write         !: model standard output frequency
+   INTEGER       ::   nn_stock         !: restart file frequency
+   INTEGER, DIMENSION(10) :: nn_stocklist  !: restart dump times
+   LOGICAL       ::   ln_mskland       !: mask land points in NetCDF outputs (costly: + ~15%)
+   LOGICAL       ::   ln_cfmeta        !: output additional data to netCDF files required for compliance with the CF metadata standard
+   LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file
+   INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+   LOGICAL       ::   ln_xios_read     !: use xios to read single file restart
+   INTEGER       ::   nn_wxios         !: write resart using xios 0 - no, 1 - single, 2 - multiple file output
+   INTEGER       ::   nn_no            !: Assimilation cycle
+
+#if defined key_netcdf4
+   !!----------------------------------------------------------------------
+   !!                   namnc4 namelist parameters                         (key_netcdf4)
+   !!----------------------------------------------------------------------
+   ! The following four values determine the partitioning of the output fields
+   ! into netcdf4 chunks. They are unrelated to the nn_chunk_sz setting which is
+   ! for runtime optimisation. The individual netcdf4 chunks can be optionally 
+   ! gzipped (recommended) leading to significant reductions in I/O volumes 
+   !                         !!!**  variables only used with iom_nf90 routines and key_netcdf4 **
+   INTEGER ::   nn_nchunks_i   !: number of chunks required in the i-dimension 
+   INTEGER ::   nn_nchunks_j   !: number of chunks required in the j-dimension 
+   INTEGER ::   nn_nchunks_k   !: number of chunks required in the k-dimension 
+   INTEGER ::   nn_nchunks_t   !: number of chunks required in the t-dimension 
+   LOGICAL ::   ln_nc4zip      !: netcdf4 usage: (T) chunk and compress output using the HDF5 sublayers of netcdf4
+   !                           !                 (F) ignore chunking request and use the netcdf4 library 
+   !                           !                     to produce netcdf3-compatible files 
+#endif
+
+!$AGRIF_DO_NOT_TREAT
+   TYPE(snc4_ctl)     :: snc4set        !: netcdf4 chunking control structure (always needed for decision making)
+!$AGRIF_END_DO_NOT_TREAT
+
+
+   !! conversion of DOCTOR norm namelist name into model name
+   !! (this should disappear in a near futur)
+
+   CHARACTER(lc) ::   cexper                      !: experiment name used for output filename
+   INTEGER       ::   nrstdt                      !: control of the time step (0, 1 or 2)
+   INTEGER       ::   nit000                      !: index of the first time step
+   INTEGER       ::   nitend                      !: index of the last time step
+   INTEGER       ::   ndate0                      !: initial calendar date aammjj
+   INTEGER       ::   nleapy                      !: Leap year calendar flag (0/1 or 30)
+   INTEGER       ::   ninist                      !: initial state output flag (0/1)
+   INTEGER       ::   nwrite                      !: model standard output frequency
+   INTEGER       ::   nstock                      !: restart file frequency
+   INTEGER, DIMENSION(10) :: nstocklist           !: restart dump times
+
+   !!----------------------------------------------------------------------
+   !! was in restart but moved here because of the OFF line... better solution should be found...
+   !!----------------------------------------------------------------------
+   INTEGER ::   nitrst                !: time step at which restart file should be written
+   LOGICAL ::   lrst_oce              !: logical to control the oce restart write 
+   LOGICAL ::   lrst_ice              !: logical to control the ice restart write 
+   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90)
+   INTEGER ::   numrir                !: logical unit for ice   restart (read)
+   INTEGER ::   numrow                !: logical unit for ocean restart (write)
+   INTEGER ::   numriw                !: logical unit for ice   restart (write)
+   INTEGER ::   nrst_lst              !: number of restart to output next
+
+   !!----------------------------------------------------------------------
+   !!                    output monitoring
+   !!----------------------------------------------------------------------
+   LOGICAL ::   ln_ctl           !: run control for debugging
+   TYPE :: sn_ctl                !: optional use structure for finer control over output selection
+      LOGICAL :: l_config  = .FALSE.  !: activate/deactivate finer control
+                                      !  Note if l_config is True then ln_ctl is ignored.
+                                      !  Otherwise setting ln_ctl True is equivalent to setting
+                                      !  all the following logicals in this structure True
+      LOGICAL :: l_runstat = .FALSE.  !: Produce/do not produce run.stat file (T/F)
+      LOGICAL :: l_trcstat = .FALSE.  !: Produce/do not produce tracer.stat file (T/F)
+      LOGICAL :: l_oceout  = .FALSE.  !: Produce all ocean.outputs    (T) or just one (F)
+      LOGICAL :: l_layout  = .FALSE.  !: Produce all layout.dat files (T) or just one (F)
+      LOGICAL :: l_mppout  = .FALSE.  !: Produce/do not produce mpp.output_XXXX files (T/F)
+      LOGICAL :: l_mpptop  = .FALSE.  !: Produce/do not produce mpp.top.output_XXXX files (T/F)
+                                      !  Optional subsetting of processor report files
+                                      !  Default settings of 0/1000000/1 should ensure all areas report.
+                                      !  Set to a more restrictive range to select specific areas
+      INTEGER :: procmin   = 0        !: Minimum narea to output
+      INTEGER :: procmax   = 1000000  !: Maximum narea to output
+      INTEGER :: procincr  = 1        !: narea increment to output
+      INTEGER :: ptimincr  = 1        !: timestep increment to output (time.step and run.stat)
+   END TYPE sn_ctl
+
+   TYPE (sn_ctl) :: sn_cfctl     !: run control structure for selective output
+   LOGICAL ::   ln_timing        !: run control for timing
+   LOGICAL ::   ln_diacfl        !: flag whether to create CFL diagnostics
+   INTEGER ::   nn_print         !: level of print (0 no print)
+   INTEGER ::   nn_ictls         !: Start i indice for the SUM control
+   INTEGER ::   nn_ictle         !: End   i indice for the SUM control
+   INTEGER ::   nn_jctls         !: Start j indice for the SUM control
+   INTEGER ::   nn_jctle         !: End   j indice for the SUM control
+   INTEGER ::   nn_isplt         !: number of processors following i
+   INTEGER ::   nn_jsplt         !: number of processors following j
+   INTEGER ::   nn_bench         !: benchmark parameter (0/1)
+   INTEGER ::   nn_bit_cmp = 0   !: bit reproducibility  (0/1)
+   !                                          
+   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt    !: OLD namelist names
+
+   INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors
+
+   !!----------------------------------------------------------------------
+   !!                        logical units
+   !!----------------------------------------------------------------------
+   INTEGER ::   numstp          =   -1      !: logical unit for time step
+   INTEGER ::   numtime         =   -1      !: logical unit for timing
+   INTEGER ::   numout          =    6      !: logical unit for output print; Set to stdout to ensure any
+   INTEGER ::   numnul          =   -1      !: logical unit for /dev/null
+      !                                     !  early output can be collected; do not change
+   INTEGER ::   numnam_ref      =   -1      !: logical unit for reference namelist
+   INTEGER ::   numnam_cfg      =   -1      !: logical unit for configuration specific namelist
+   INTEGER ::   numond          =   -1      !: logical unit for Output Namelist Dynamics
+   INTEGER ::   numnam_ice_ref  =   -1      !: logical unit for ice reference namelist
+   INTEGER ::   numnam_ice_cfg  =   -1      !: logical unit for ice reference namelist
+   INTEGER ::   numoni          =   -1      !: logical unit for Output Namelist Ice
+   INTEGER ::   numevo_ice      =   -1      !: logical unit for ice variables (temp. evolution)
+   INTEGER ::   numrun          =   -1      !: logical unit for run statistics
+   INTEGER ::   numdct_in       =   -1      !: logical unit for transports computing
+   INTEGER ::   numdct_vol      =   -1      !: logical unit for voulume transports output
+   INTEGER ::   numdct_heat     =   -1      !: logical unit for heat    transports output
+   INTEGER ::   numdct_salt     =   -1      !: logical unit for salt    transports output
+   INTEGER ::   numfl           =   -1      !: logical unit for floats ascii output
+   INTEGER ::   numflo          =   -1      !: logical unit for floats ascii output
+
+   !!----------------------------------------------------------------------
+   !!                          Run control  
+   !!----------------------------------------------------------------------
+   INTEGER       ::   no_print = 0          !: optional argument of fld_fill (if present, suppress some control print)
+   INTEGER       ::   nstop = 0             !: error flag (=number of reason for a premature stop run)
+   INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run)
+   CHARACTER(lc) ::   ctmp1, ctmp2, ctmp3   !: temporary characters 1 to 3
+   CHARACTER(lc) ::   ctmp4, ctmp5, ctmp6   !: temporary characters 4 to 6
+   CHARACTER(lc) ::   ctmp7, ctmp8, ctmp9   !: temporary characters 7 to 9
+   CHARACTER(lc) ::   ctmp10                !: temporary character 10
+   CHARACTER(lc) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !:
+   CHARACTER(lc) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !:
+   LOGICAL       ::   lwm      = .FALSE.    !: boolean : true on the 1st processor only (always)
+   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl
+   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area
+   CHARACTER(lc) ::   cxios_context         !: context name used in xios
+   CHARACTER(lc) ::   crxios_context         !: context name used in xios to read restart
+   CHARACTER(lc) ::   cwxios_context        !: context name used in xios to write restart file
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: in_out_manager.F90 10570 2019-01-24 15:14:49Z acc $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!=====================================================================
+END MODULE in_out_manager
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/in_out_manager.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/in_out_manager.f90	(revision 12100)
+++ 	(revision )
@@ -1,140 +1,0 @@
-MODULE in_out_manager   
-   !!======================================================================
-   !!                       ***  MODULE  in_out_manager  ***
-   !! I/O manager utilities : Defines run parameters together with logical units
-   !!=====================================================================
-   !! History :   1.0  !  2002-06  (G. Madec)   original code
-   !!             2.0  !  2006-07  (S. Masson)  iom, add ctl_stop, ctl_warn
-   !!             3.0  !  2008-06  (G. Madec)   add ctmp4 to ctmp10
-   !!             3.2  !  2009-08  (S. MAsson)  add new ctl_opn
-   !!             3.3  !  2010-10  (A. Coward)  add NetCDF4 usage
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   USE par_oce       ! ocean parameter
-   USE nc4interface  ! NetCDF4 interface
-
-   IMPLICIT NONE
-   PUBLIC
-
- 
-   !
-   !!----------------------------------------------------------------------
-   !!                   namrun namelist parameters
-   !!----------------------------------------------------------------------
-   CHARACTER(lc) ::   cn_exp           !: experiment name used for output filename
-   CHARACTER(lc) ::   cn_ocerst_in     !: suffix of ocean restart name (input)
-   CHARACTER(lc) ::   cn_ocerst_indir  !: restart input directory
-   CHARACTER(lc) ::   cn_ocerst_out    !: suffix of ocean restart name (output)
-   CHARACTER(lc) ::   cn_ocerst_outdir !: restart output directory
-   LOGICAL       ::   ln_rstart        !: start from (F) rest or (T) a restart file
-   LOGICAL       ::   ln_rst_list      !: output restarts at list of times (T) or by frequency (F)
-   INTEGER       ::   nn_no            !: job number
-   INTEGER       ::   nn_rstctl        !: control of the time step (0, 1 or 2)
-   INTEGER       ::   nn_rstssh   = 0  !: hand made initilization of ssh or not (1/0)
-   INTEGER       ::   nn_it000         !: index of the first time step
-   INTEGER       ::   nn_itend         !: index of the last time step
-   INTEGER       ::   nn_date0         !: initial calendar date aammjj
-   INTEGER       ::   nn_time0         !: initial time of day in hhmm
-   INTEGER       ::   nn_leapy         !: Leap year calendar flag (0/1 or 30)
-   INTEGER       ::   nn_istate        !: initial state output flag (0/1)
-   INTEGER       ::   nn_write         !: model standard output frequency
-   INTEGER       ::   nn_stock         !: restart file frequency
-   INTEGER, DIMENSION(10) :: nn_stocklist  !: restart dump times
-   LOGICAL       ::   ln_mskland       !: mask land points in NetCDF outputs (costly: + ~15%)
-   LOGICAL       ::   ln_cfmeta        !: output additional data to netCDF files required for compliance with the CF metadata standard
-   LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file
-   INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
-!$AGRIF_DO_NOT_TREAT
-   TYPE(snc4_ctl)     :: snc4set        !: netcdf4 chunking control structure (always needed for decision making)
-!$AGRIF_END_DO_NOT_TREAT
-
-
-   !! conversion of DOCTOR norm namelist name into model name
-   !! (this should disappear in a near futur)
-
-   CHARACTER(lc) ::   cexper                      !: experiment name used for output filename
-   INTEGER       ::   no                          !: job number
-   INTEGER       ::   nrstdt                      !: control of the time step (0, 1 or 2)
-   INTEGER       ::   nit000                      !: index of the first time step
-   INTEGER       ::   nitend                      !: index of the last time step
-   INTEGER       ::   ndate0                      !: initial calendar date aammjj
-   INTEGER       ::   nleapy                      !: Leap year calendar flag (0/1 or 30)
-   INTEGER       ::   ninist                      !: initial state output flag (0/1)
-   INTEGER       ::   nwrite                      !: model standard output frequency
-   INTEGER       ::   nstock                      !: restart file frequency
-   INTEGER, DIMENSION(10) :: nstocklist           !: restart dump times
-
-   !!----------------------------------------------------------------------
-   !! was in restart but moved here because of the OFF line... better solution should be found...
-   !!----------------------------------------------------------------------
-   INTEGER ::   nitrst                !: time step at which restart file should be written
-   LOGICAL ::   lrst_oce              !: logical to control the oce restart write 
-   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90)
-   INTEGER ::   numrow                !: logical unit for ocean restart (write)
-   INTEGER ::   nrst_lst              !: number of restart to output next
-
-   !!----------------------------------------------------------------------
-   !!                    output monitoring
-   !!----------------------------------------------------------------------
-   LOGICAL ::   ln_ctl       !: run control for debugging
-   INTEGER ::   nn_timing    !: run control for timing
-   INTEGER ::   nn_diacfl    !: flag whether to create CFL diagnostics
-   INTEGER ::   nn_print     !: level of print (0 no print)
-   INTEGER ::   nn_ictls     !: Start i indice for the SUM control
-   INTEGER ::   nn_ictle     !: End   i indice for the SUM control
-   INTEGER ::   nn_jctls     !: Start j indice for the SUM control
-   INTEGER ::   nn_jctle     !: End   j indice for the SUM control
-   INTEGER ::   nn_isplt     !: number of processors following i
-   INTEGER ::   nn_jsplt     !: number of processors following j
-   INTEGER ::   nn_bench     !: benchmark parameter (0/1)
-   INTEGER ::   nn_bit_cmp   =    0    !: bit reproducibility  (0/1)
-
-   !                                          
-   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt, nbench    !: OLD namelist names
-
-   INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors
-
-   !!----------------------------------------------------------------------
-   !!                        logical units
-   !!----------------------------------------------------------------------
-   INTEGER ::   numstp          =   -1      !: logical unit for time step
-   INTEGER ::   numtime         =   -1      !: logical unit for timing
-   INTEGER ::   numout          =    6      !: logical unit for output print; Set to stdout to ensure any early
-                                            !  output can be collected; do not change
-   INTEGER ::   numnam_ref      =   -1      !: logical unit for reference namelist
-   INTEGER ::   numnam_cfg      =   -1      !: logical unit for configuration specific namelist
-   INTEGER ::   numond          =   -1      !: logical unit for Output Namelist Dynamics
-   INTEGER ::   numnam_ice_ref  =   -1      !: logical unit for ice reference namelist
-   INTEGER ::   numnam_ice_cfg  =   -1      !: logical unit for ice reference namelist
-   INTEGER ::   numoni          =   -1      !: logical unit for Output Namelist Ice
-   INTEGER ::   numevo_ice      =   -1      !: logical unit for ice variables (temp. evolution)
-   INTEGER ::   numsol          =   -1      !: logical unit for solver statistics
-   INTEGER ::   numdct_in       =   -1      !: logical unit for transports computing
-   INTEGER ::   numdct_vol      =   -1      !: logical unit for voulume transports output
-   INTEGER ::   numdct_heat     =   -1      !: logical unit for heat    transports output
-   INTEGER ::   numdct_salt     =   -1      !: logical unit for salt    transports output
-   INTEGER ::   numfl           =   -1      !: logical unit for floats ascii output
-   INTEGER ::   numflo          =   -1      !: logical unit for floats ascii output
-
-   !!----------------------------------------------------------------------
-   !!                          Run control  
-   !!----------------------------------------------------------------------
-   INTEGER       ::   nstop = 0             !: error flag (=number of reason for a premature stop run)
-   INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run)
-   CHARACTER(lc) ::   ctmp1, ctmp2, ctmp3   !: temporary characters 1 to 3
-   CHARACTER(lc) ::   ctmp4, ctmp5, ctmp6   !: temporary characters 4 to 6
-   CHARACTER(lc) ::   ctmp7, ctmp8, ctmp9   !: temporary characters 7 to 9
-   CHARACTER(lc) ::   ctmp10                !: temporary character 10
-   CHARACTER(lc) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !:
-   CHARACTER(lc) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !:
-   LOGICAL       ::   lwm      = .FALSE.    !: boolean : true on the 1st processor only (always)
-   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl
-   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: in_out_manager.F90 6140 2015-12-21 11:35:23Z timgraham $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!=====================================================================
-END MODULE in_out_manager
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/ioipsl.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/ioipsl.f90	(revision 12100)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/ioipsl.f90	(revision 12101)
@@ -6,12 +6,8 @@
 ! See IOIPSL/IOIPSL_License_CeCILL.txt
 !
-  USE errioipsl 
+  USE errioipsl   
+  USE calendar   
   USE stringop
-  USE mathelp    
-  USE getincom
-  USE calendar   
   USE fliocom    
-  USE flincom    
-  USE histcom    
-  USE restcom
+
 END MODULE ioipsl
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom.F90	(revision 12101)
@@ -0,0 +1,2393 @@
+MODULE iom
+   !!======================================================================
+   !!                    ***  MODULE  iom ***
+   !! Input/Output manager :  Library to read input files
+   !!======================================================================
+   !! History :  2.0  ! 2005-12  (J. Belier) Original code
+   !!            2.0  ! 2006-02  (S. Masson) Adaptation to NEMO
+   !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case  
+   !!            3.6  ! 2014-15  DIMG format removed
+   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes
+   !!            4.0  ! 2017-11  (M. Andrejczuk) Extend IOM interface to write any 3D fields
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iom_open       : open a file read only
+   !!   iom_close      : close a file or all files opened by iom
+   !!   iom_get        : read a field (interfaced to several routines)
+   !!   iom_varid      : get the id of a variable in a file
+   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+   USE iom_nf90        ! NetCDF format with native NetCDF library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp           ! MPP library
+#if defined key_iomput
+   USE sbc_oce  , ONLY :   nn_fsbc         ! ocean space and time domain
+   USE trc_oce  , ONLY :   nn_dttrc        !  !: frequency of step on passive tracers
+   USE icb_oce  , ONLY :   nclasses, class_num       !  !: iceberg classes
+#if defined key_si3
+   USE ice      , ONLY :   jpl
+#endif
+   USE domngb          ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE xios
+# endif
+   USE ioipsl, ONLY :  ju2ymds    ! for calendar
+#if defined key_top
+   USE trc, ONLY    :  profsed
+#endif
+   USE lib_fortran 
+
+   IMPLICIT NONE
+   PUBLIC   !   must be public to be able to access iom_def through iom
+   
+#if defined key_iomput
+   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.        !: iom_put flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag
+#endif
+   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get
+   PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put
+   PUBLIC iom_use, iom_context_finalize
+
+   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
+   PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d
+   PRIVATE iom_p1d, iom_p2d, iom_p3d
+#if defined key_iomput
+   PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr
+   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate
+   PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active
+# endif
+   PUBLIC iom_set_rstw_var_active, iom_set_rst_vars
+
+   INTERFACE iom_get
+      MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d
+   END INTERFACE
+   INTERFACE iom_getatt
+      MODULE PROCEDURE iom_g0d_iatt, iom_g1d_iatt, iom_g0d_ratt, iom_g1d_ratt, iom_g0d_catt
+   END INTERFACE
+   INTERFACE iom_putatt
+      MODULE PROCEDURE iom_p0d_iatt, iom_p1d_iatt, iom_p0d_ratt, iom_p1d_ratt, iom_p0d_catt
+   END INTERFACE
+   INTERFACE iom_rstput
+      MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
+   END INTERFACE
+   INTERFACE iom_put
+      MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
+   END INTERFACE iom_put
+  
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: iom.F90 10523 2019-01-16 09:36:03Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE iom_init( cdname, fname, ld_tmppatch ) 
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),           INTENT(in)  :: cdname
+      CHARACTER(len=*), OPTIONAL, INTENT(in)  :: fname
+      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_tmppatch
+#if defined key_iomput
+      !
+      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0)
+      TYPE(xios_date)     :: start_date
+      CHARACTER(len=lc) :: clname
+      INTEGER           :: ji, jkmin
+      LOGICAL :: llrst_context              ! is context related to restart
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds
+      LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity
+      INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files
+      INTEGER ::   nldj_save, nlej_save    !:
+      !!----------------------------------------------------------------------
+      !
+      ! seb: patch before we remove periodicity and close boundaries in output files
+      IF( PRESENT(ld_tmppatch) ) THEN   ;   ll_tmppatch = ld_tmppatch
+      ELSE                              ;   ll_tmppatch = .TRUE.
+      ENDIF
+      IF ( ll_tmppatch ) THEN
+         nldi_save = nldi   ;   nlei_save = nlei
+         nldj_save = nldj   ;   nlej_save = nlej
+         IF( nimpp           ==      1 ) nldi = 1
+         IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi
+         IF( njmpp           ==      1 ) nldj = 1
+         IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj
+      ENDIF
+      !
+      ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) )
+      !
+      clname = cdname
+      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
+      CALL xios_context_initialize(TRIM(clname), mpi_comm_oce)
+      CALL iom_swap( cdname )
+      llrst_context =  (TRIM(cdname) == TRIM(crxios_context) .OR. TRIM(cdname) == TRIM(cwxios_context))
+
+      ! Calendar type is now defined in xml file 
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), &
+          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
+      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1900,01,01,00,00,00), &
+          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
+      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1900,01,01,00,00,00), &
+          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
+      END SELECT
+
+      ! horizontal grid definition
+      IF(.NOT.llrst_context) CALL set_scalar
+      !
+      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN  
+         CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 
+         CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. )
+         CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. )
+         CALL set_grid( "W", glamt, gphit, .FALSE., .FALSE. )
+         CALL set_grid_znl( gphit )
+         !
+         IF( ln_cfmeta ) THEN   ! Add additional grid metadata
+            CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej))
+            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
+            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
+            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
+            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
+         ENDIF
+      ENDIF
+      !
+      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN  
+         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+         !
+         CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 
+         CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. ) 
+         CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. ) 
+         CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 
+         CALL set_grid_znl( gphit_crs )
+          !
+         CALL dom_grid_glo   ! Return to parent grid domain
+         !
+         IF( ln_cfmeta .AND. .NOT. llrst_context) THEN   ! Add additional grid metadata
+            CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej))
+            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
+            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs )
+            CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs )
+            CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
+         ENDIF
+      ENDIF
+      !
+      ! vertical grid definition
+      IF(.NOT.llrst_context) THEN
+          CALL iom_set_axis_attr( "deptht",  paxis = gdept_1d )
+          CALL iom_set_axis_attr( "depthu",  paxis = gdept_1d )
+          CALL iom_set_axis_attr( "depthv",  paxis = gdept_1d )
+          CALL iom_set_axis_attr( "depthw",  paxis = gdepw_1d )
+
+          ! Add vertical grid bounds
+          jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D)
+          zt_bnds(2,:        ) = gdept_1d(:)
+          zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1)
+          zt_bnds(1,1        ) = gdept_1d(1) - e3w_1d(1)
+          zw_bnds(1,:        ) = gdepw_1d(:)
+          zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk)
+          zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk)
+          CALL iom_set_axis_attr( "deptht", bounds=zw_bnds )
+          CALL iom_set_axis_attr( "depthu", bounds=zw_bnds )
+          CALL iom_set_axis_attr( "depthv", bounds=zw_bnds )
+          CALL iom_set_axis_attr( "depthw", bounds=zt_bnds )
+          !
+# if defined key_floats
+          CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) )
+# endif
+# if defined key_si3
+          CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )
+          ! SIMIP diagnostics (4 main arctic straits)
+          CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) )
+# endif
+#if defined key_top
+          CALL iom_set_axis_attr( "profsed", paxis = profsed )
+#endif
+          CALL iom_set_axis_attr( "icbcla", class_num )
+          CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )
+          CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )
+      ENDIF
+      !
+      ! automatic definitions of some of the xml attributs
+      IF( TRIM(cdname) == TRIM(crxios_context) ) THEN
+!set names of the fields in restart file IF using XIOS to read data
+          CALL iom_set_rst_context(.TRUE.)
+          CALL iom_set_rst_vars(rst_rfields)
+!set which fields are to be read from restart file
+          CALL iom_set_rstr_active()
+      ELSE IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN
+!set names of the fields in restart file IF using XIOS to write data
+          CALL iom_set_rst_context(.FALSE.)
+          CALL iom_set_rst_vars(rst_wfields)
+!set which fields are to be written to a restart file
+          CALL iom_set_rstw_active(fname)
+      ELSE
+          CALL set_xmlatt
+      ENDIF
+      !
+      ! end file definition
+      dtime%second = rdt
+      CALL xios_set_timestep( dtime )
+      CALL xios_close_context_definition()
+      CALL xios_update_calendar( 0 )
+      !
+      DEALLOCATE( zt_bnds, zw_bnds )
+      !
+      IF ( ll_tmppatch ) THEN
+         nldi = nldi_save   ;   nlei = nlei_save
+         nldj = nldj_save   ;   nlej = nlej_save
+      ENDIF
+#endif
+      !
+   END SUBROUTINE iom_init
+
+   SUBROUTINE iom_set_rstw_var_active(field)
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_set_rstw_var_active  ***
+      !!
+      !! ** Purpose :  enable variable in restart file when writing with XIOS 
+      !!---------------------------------------------------------------------
+   CHARACTER(len = *), INTENT(IN) :: field
+   INTEGER :: i
+   LOGICAL :: llis_set
+   CHARACTER(LEN=256) :: clinfo    ! info character
+
+#if defined key_iomput
+   llis_set = .FALSE.
+
+   DO i = 1, max_rst_fields
+       IF(TRIM(rst_wfields(i)%vname) == field) THEN 
+          rst_wfields(i)%active = .TRUE.
+          llis_set = .TRUE.
+          EXIT
+       ENDIF
+   ENDDO
+!Warn if variable is not in defined in rst_wfields
+   IF(.NOT.llis_set) THEN
+      WRITE(ctmp1,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 
+      CALL ctl_stop( 'iom_set_rstw_var_active:', ctmp1 )
+   ENDIF
+#else
+        clinfo = 'iom_set_rstw_var_active: key_iomput is needed to use XIOS restart read/write functionality'
+        CALL ctl_stop('STOP', TRIM(clinfo))
+#endif
+
+   END SUBROUTINE iom_set_rstw_var_active
+
+   SUBROUTINE iom_set_rstr_active()
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_set_rstr_active  ***
+      !!
+      !! ** Purpose :  define file name in XIOS context for reading restart file,
+      !!               enable variables present in restart file for reading with XIOS 
+      !!---------------------------------------------------------------------
+
+!sets enabled = .TRUE. for each field in restart file
+   CHARACTER(len=256) :: rst_file
+
+#if defined key_iomput
+   TYPE(xios_field) :: field_hdl
+   TYPE(xios_file) :: file_hdl
+   TYPE(xios_filegroup) :: filegroup_hdl
+   INTEGER :: i
+   CHARACTER(lc)  ::   clpath
+
+        clpath = TRIM(cn_ocerst_indir)
+        IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+        IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+           rst_file = TRIM(clpath)//TRIM(cn_ocerst_in)
+        ELSE
+           rst_file = TRIM(clpath)//'1_'//TRIM(cn_ocerst_in)
+        ENDIF
+!set name of the restart file and enable available fields
+        if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ',rst_file
+        CALL xios_get_handle("file_definition", filegroup_hdl )
+        CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart')
+        CALL xios_set_file_attr( "rrestart", name=trim(rst_file), type="one_file", &
+             par_access="collective", enabled=.TRUE., mode="read",                 &
+             output_freq=xios_timestep)
+!define variables for restart context
+        DO i = 1, max_rst_fields
+         IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN
+           IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN
+                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname))
+                SELECT CASE (TRIM(rst_rfields(i)%grid))
+                 CASE ("grid_N_3D")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), &
+                        domain_ref="grid_N", axis_ref="nav_lev", operation = "instant")
+                 CASE ("grid_N")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), &
+                        domain_ref="grid_N", operation = "instant") 
+                CASE ("grid_vector")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), &
+                         axis_ref="nav_lev", operation = "instant")
+                 CASE ("grid_scalar")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), &
+                        scalar_ref = "grid_scalar", operation = "instant")
+                END SELECT
+                IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file)
+           ENDIF
+         ENDIF
+        END DO
+#endif
+   END SUBROUTINE iom_set_rstr_active
+
+   SUBROUTINE iom_set_rst_vars(fields)
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_set_rst_vars   ***
+      !!
+      !! ** Purpose :  Fill array fields with the information about all 
+      !!               possible variables and corresponding grids definition 
+      !!               for reading/writing restart with XIOS
+      !!---------------------------------------------------------------------
+   TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields)
+   INTEGER :: i
+
+        i = 0
+        i = i + 1; fields(i)%vname="rdt";            fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="un";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="ub";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="vn";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="vb";             fields(i)%grid="grid_N_3D"  
+        i = i + 1; fields(i)%vname="tn";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="tb";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="sn";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="sb";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="sshn";           fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sshb";           fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="rhop";           fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="kt";             fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="ndastp";         fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="adatrj";         fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="utau_b";         fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="vtau_b";         fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="qns_b";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="emp_b";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sfx_b";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="en" ;            fields(i)%grid="grid_N_3D" 
+        i = i + 1; fields(i)%vname="avt_k";            fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="avm_k";            fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="dissl";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="sbc_hc_b";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sbc_sc_b";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="qsr_hc_b";       fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="fraqsr_1lev";    fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="greenland_icesheet_mass"
+                                               fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="greenland_icesheet_timelapsed"
+                                               fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="greenland_icesheet_mass_roc"
+                                               fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="antarctica_icesheet_mass"
+                                               fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="antarctica_icesheet_timelapsed"
+                                               fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="antarctica_icesheet_mass_roc"
+                                               fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="frc_v";          fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="frc_t";          fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="frc_s";          fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="frc_wn_t";       fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="frc_wn_s";       fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="ssh_ini";        fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="e3t_ini";        fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="hc_loc_ini";     fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="sc_loc_ini";     fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="tilde_e3t_b";    fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="tilde_e3t_n";    fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="hdiv_lf";        fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ub2_b";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="vb2_b";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sshbb_e";        fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ubb_e";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="vbb_e";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sshb_e";         fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ub_e";           fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="vb_e";           fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="fwf_isf_b";      fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="isf_sc_b";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="isf_hc_b";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ssh_ibb";        fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="rnf_b";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="rnf_hc_b";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="rnf_sc_b";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="nn_fsbc";        fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="ssu_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ssv_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sst_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sss_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ssh_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="e3t_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="frq_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="avmb";           fields(i)%grid="grid_vector"
+        i = i + 1; fields(i)%vname="avtb";           fields(i)%grid="grid_vector"
+        i = i + 1; fields(i)%vname="ub2_i_b";        fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="vb2_i_b";        fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ntime";          fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="Dsst";           fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="tmask";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="umask";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="vmask";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="smask";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="gdepw_n";        fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="e3t_n";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="e3u_n";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="e3v_n";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="surf_ini";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="e3t_b";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="hmxl_n";         fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="un_bf";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="vn_bf";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="hbl";            fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="hbli";           fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="wn";             fields(i)%grid="grid_N_3D"
+
+        IF( i-1 > max_rst_fields) THEN
+           WRITE(ctmp1,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small'
+           CALL ctl_stop( 'iom_set_rst_vars:', ctmp1 )
+        ENDIF
+   END SUBROUTINE iom_set_rst_vars
+
+
+   SUBROUTINE iom_set_rstw_active(cdrst_file)
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_set_rstw_active   ***
+      !!
+      !! ** Purpose :  define file name in XIOS context for writing restart
+      !!               enable variables present in restart file for writing
+      !!---------------------------------------------------------------------
+!sets enabled = .TRUE. for each field in restart file
+   CHARACTER(len=*) :: cdrst_file
+#if defined key_iomput
+   TYPE(xios_field) :: field_hdl
+   TYPE(xios_file) :: file_hdl
+   TYPE(xios_filegroup) :: filegroup_hdl
+   INTEGER :: i
+   CHARACTER(lc)  ::   clpath
+
+!set name of the restart file and enable available fields
+        IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',cdrst_file
+        CALL xios_get_handle("file_definition", filegroup_hdl )
+        CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart')
+        IF(nxioso.eq.1) THEN 
+           CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 
+                                    mode="write", output_freq=xios_timestep) 
+           if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 
+        ELSE  
+           CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 
+                                    mode="write", output_freq=xios_timestep) 
+           if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 
+        ENDIF 
+        CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file))
+!define fields for restart context
+        DO i = 1, max_rst_fields
+         IF( rst_wfields(i)%active ) THEN
+                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname))
+                SELECT CASE (TRIM(rst_wfields(i)%grid))
+                 CASE ("grid_N_3D")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), &
+                        domain_ref="grid_N", axis_ref="nav_lev", prec = 8, operation = "instant")
+                 CASE ("grid_N")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), &
+                        domain_ref="grid_N", prec = 8, operation = "instant") 
+                 CASE ("grid_vector")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), &
+                         axis_ref="nav_lev", prec = 8, operation = "instant")
+                 CASE ("grid_scalar")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), &
+                        scalar_ref = "grid_scalar", prec = 8, operation = "instant")
+                END SELECT
+         ENDIF
+        END DO
+#endif
+   END SUBROUTINE iom_set_rstw_active
+
+   SUBROUTINE iom_set_rst_context(ld_rstr) 
+     !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_set_rst_context  ***
+      !!
+      !! ** Purpose : Define domain, axis and grid for restart (read/write) 
+      !!              context 
+      !!               
+      !!---------------------------------------------------------------------
+   LOGICAL, INTENT(IN)               :: ld_rstr
+!ld_rstr is true for restart context. There is no need to define grid for 
+!restart read, because it's read from file
+#if defined key_iomput
+   TYPE(xios_domaingroup)            :: domaingroup_hdl 
+   TYPE(xios_domain)                 :: domain_hdl 
+   TYPE(xios_axisgroup)              :: axisgroup_hdl 
+   TYPE(xios_axis)                   :: axis_hdl 
+   TYPE(xios_scalar)                 :: scalar_hdl 
+   TYPE(xios_scalargroup)            :: scalargroup_hdl 
+
+     CALL xios_get_handle("domain_definition",domaingroup_hdl) 
+     CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 
+     CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr) 
+ 
+     CALL xios_get_handle("axis_definition",axisgroup_hdl) 
+     CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 
+!AGRIF fails to compile when unit= is in call to xios_set_axis_attr
+!    CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels",  unit="m", positive="down") 
+     CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down")
+     CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 
+
+     CALL xios_get_handle("scalar_definition", scalargroup_hdl) 
+     CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 
+#endif
+   END SUBROUTINE iom_set_rst_context
+
+   SUBROUTINE iom_swap( cdname )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_swap  ***
+      !!
+      !! ** Purpose :  swap context between different agrif grid for xmlio_server
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdname
+#if defined key_iomput
+      TYPE(xios_context) :: nemo_hdl
+
+      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+        CALL xios_get_handle(TRIM(cdname),nemo_hdl)
+      ELSE
+        CALL xios_get_handle(TRIM(Agrif_CFixed())//"_"//TRIM(cdname),nemo_hdl)
+      ENDIF
+      !
+      CALL xios_set_current_context(nemo_hdl)
+#endif
+      !
+   END SUBROUTINE iom_swap
+
+
+   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, lagrif, ldstop, ldiof, kdlev )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose :  open an input file (return 0 if not found)
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   )           ::   cdname   ! File name
+      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.)
+      INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap)
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   lagrif   ! add 1_ prefix for AGRIF (default = .TRUE.
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
+      INTEGER         , INTENT(in   ), OPTIONAL ::   kdlev    ! number of vertical levels
+      !
+      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
+      CHARACTER(LEN=256)    ::   cltmpn    ! tempory name to store clname (in writting mode)
+      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" 
+      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits)
+      CHARACTER(LEN=256)    ::   clinfo    ! info character
+      LOGICAL               ::   llok      ! check the existence 
+      LOGICAL               ::   llwrt     ! local definition of ldwrt
+      LOGICAL               ::   llnoov    ! local definition to read overlap
+      LOGICAL               ::   llstop    ! local definition of ldstop
+      LOGICAL               ::   lliof     ! local definition of ldiof
+      LOGICAL               ::   llagrif   ! local definition of lagrif
+      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits)
+      INTEGER               ::   iln, ils  ! lengths of character
+      INTEGER               ::   idom      ! type of domain
+      INTEGER               ::   istop     ! 
+      INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters: 
+      ! local number of points for x,y dimensions
+      ! position of first local point for x,y dimensions
+      ! position of last local point for x,y dimensions
+      ! start halo size for x,y dimensions
+      ! end halo size for x,y dimensions
+      !
+      INTEGER ::   nldi_save, nlei_save    !:patch before we remove periodicity and close boundaries in output files
+      INTEGER ::   nldj_save, nlej_save    !:
+      !
+      !---------------------------------------------------------------------
+      ! Initializations and control
+      ! =============
+      kiomid = -1
+      clinfo = '                    iom_open ~~~  '
+      istop = nstop
+
+      ! use patch to force the writing off periodicity and close boundaries
+      ! without this, issue in some model decomposition
+      ! seb: patch before we remove periodicity and close boundaries in output files
+      nldi_save = nldi   ;   nlei_save = nlei
+      nldj_save = nldj   ;   nlej_save = nlej
+      IF( nimpp           ==      1 ) nldi = 1
+      IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi
+      IF( njmpp           ==      1 ) nldj = 1
+      IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj
+
+      ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
+      ! (could be done when defining iom_file in f95 but not in f90)
+      IF( Agrif_Root() ) THEN
+         IF( iom_open_init == 0 ) THEN
+            iom_file(:)%nfid = 0
+            iom_open_init = 1
+         ENDIF
+      ENDIF
+      ! do we read or write the file?
+      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt
+      ELSE                        ;   llwrt = .FALSE.
+      ENDIF
+      ! do we call ctl_stop if we try to open a non-existing file in read mode?
+      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
+      ELSE                         ;   llstop = .TRUE.
+      ENDIF
+      ! do we add agrif suffix
+      IF( PRESENT(lagrif) ) THEN   ;   llagrif = lagrif
+      ELSE                         ;   llagrif = .TRUE.
+      ENDIF
+      ! are we using interpolation on the fly?
+      IF( PRESENT(ldiof) ) THEN   ;   lliof = ldiof
+      ELSE                        ;   lliof = .FALSE.
+      ENDIF
+      ! do we read the overlap 
+      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+      !llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif
+      ! for domain_cfg, force to read the full domain
+      llnoov = .FALSE.
+      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
+      ! =============
+      clname   = trim(cdname)
+      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof .AND. llagrif) THEN
+         iln    = INDEX(clname,'/') 
+         cltmpn = clname(1:iln)
+         clname = clname(iln+1:LEN_TRIM(clname))
+         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
+      ENDIF
+      ! which suffix should we use?
+      clsuffix = '.nc'
+      ! Add the suffix if needed
+      iln = LEN_TRIM(clname)
+      ils = LEN_TRIM(clsuffix)
+      IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 )   &
+         &   clname = TRIM(clname)//TRIM(clsuffix)
+      cltmpn = clname   ! store this name
+      ! try to find if the file to be opened already exist
+      ! =============
+      INQUIRE( FILE = clname, EXIST = llok )
+      IF( .NOT.llok ) THEN
+         ! we try to add the cpu number to the name
+         WRITE(clcpu,*) narea-1
+
+         clcpu  = TRIM(ADJUSTL(clcpu))
+         iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
+         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
+         icnt = 0
+         INQUIRE( FILE = clname, EXIST = llok ) 
+         ! we try different formats for the cpu number by adding 0
+         DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
+            clcpu  = "0"//trim(clcpu)
+            clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
+            INQUIRE( FILE = clname, EXIST = llok )
+            icnt = icnt + 1
+         END DO
+      ELSE
+         lxios_sini = .TRUE.
+      ENDIF
+      IF( llwrt ) THEN
+         ! check the domain definition
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!         idom = jpdom_local_noovlap   ! default definition
+         IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition
+         ELSE                ;   idom = jpdom_local_full      ! default definition
+         ENDIF
+         IF( PRESENT(kdom) )   idom = kdom
+         ! create the domain informations
+         ! =============
+         SELECT CASE (idom)
+         CASE (jpdom_local_full)
+            idompar(:,1) = (/ jpi             , jpj              /)
+            idompar(:,2) = (/ nimpp           , njmpp            /)
+            idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /)
+            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
+            idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /)
+         CASE (jpdom_local_noextra)
+            idompar(:,1) = (/ nlci            , nlcj             /)
+            idompar(:,2) = (/ nimpp           , njmpp            /)
+            idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)
+            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
+            idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /)
+         CASE (jpdom_local_noovlap)
+            idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /)
+            idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)
+            idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)
+            idompar(:,4) = (/ 0               , 0                /)
+            idompar(:,5) = (/ 0               , 0                /)
+         CASE DEFAULT
+            CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' )
+         END SELECT
+      ENDIF
+      ! Open the NetCDF file
+      ! =============
+      ! do we have some free file identifier?
+      IF( MINVAL(iom_file(:)%nfid) /= 0 )   &
+         &   CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
+      ! if no file was found...
+      IF( .NOT. llok ) THEN
+         IF( .NOT. llwrt ) THEN   ! we are in read mode 
+            IF( llstop ) THEN   ;   CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
+            ELSE                ;   istop = nstop + 1   ! make sure that istop /= nstop so we don't open the file
+            ENDIF
+         ELSE                     ! we are in write mode so we 
+            clname = cltmpn       ! get back the file name without the cpu number
+         ENDIF
+      ELSE
+         IF( llwrt .AND. .NOT. ln_clobber ) THEN   ! we stop as we want to write in a new file 
+            CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' )
+            istop = nstop + 1                      ! make sure that istop /= nstop so we don't open the file
+         ELSEIF( llwrt ) THEN     ! the file exists and we are in write mode with permission to 
+            clname = cltmpn       ! overwrite so get back the file name without the cpu number
+         ENDIF
+      ENDIF
+      IF( istop == nstop ) THEN   ! no error within this routine
+         CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev )
+      ENDIF
+
+      nldi = nldi_save   ;   nlei = nlei_save
+      nldj = nldj_save   ;   nlej = nlej_save
+      !
+   END SUBROUTINE iom_open
+
+
+   SUBROUTINE iom_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_close  ***
+      !!
+      !! ** Purpose : close an input file, or all files opened by iom
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(inout), OPTIONAL ::   kiomid   ! iom identifier of the file to be closed
+      !                                              ! return 0 when file is properly closed
+      !                                              ! No argument: all files opened by iom are closed
+
+      INTEGER ::   jf         ! dummy loop indices
+      INTEGER ::   i_s, i_e   ! temporary integer
+      CHARACTER(LEN=100)    ::   clinfo    ! info character
+      !---------------------------------------------------------------------
+      !
+      clinfo = '                    iom_close ~~~  '
+      IF( PRESENT(kiomid) ) THEN
+         i_s = kiomid
+         i_e = kiomid
+      ELSE
+         i_s = 1
+         i_e = jpmax_files
+      ENDIF
+
+      IF( i_s > 0 ) THEN
+         DO jf = i_s, i_e
+            IF( iom_file(jf)%nfid > 0 ) THEN
+               CALL iom_nf90_close( jf )
+               iom_file(jf)%nfid       = 0          ! free the id 
+               IF( PRESENT(kiomid) )   kiomid = 0   ! return 0 as id to specify that the file was closed
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
+            ELSEIF( PRESENT(kiomid) ) THEN
+               WRITE(ctmp1,*) '--->',  kiomid
+               CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
+            ENDIF
+         END DO
+      ENDIF
+      !    
+   END SUBROUTINE iom_close
+
+
+   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_varid  ***
+      !!
+      !! ** Purpose : get the id of a variable in a file (return 0 if not found)
+      !!-----------------------------------------------------------------------
+      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
+      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension
+      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
+      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.)
+      !
+      INTEGER                        ::   iom_varid, iiv, i_nvd
+      LOGICAL                        ::   ll_fnd
+      CHARACTER(LEN=100)             ::   clinfo                   ! info character
+      LOGICAL                        ::   llstop                   ! local definition of ldstop
+      !!-----------------------------------------------------------------------
+      iom_varid = 0                         ! default definition
+      ! do we call ctl_stop if we look for non-existing variable?
+      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
+      ELSE                         ;   llstop = .TRUE.
+      ENDIF
+      !
+      IF( kiomid > 0 ) THEN
+         clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
+         IF( iom_file(kiomid)%nfid == 0 ) THEN 
+            CALL ctl_stop( trim(clinfo), 'the file is not open' )
+         ELSE
+            ll_fnd  = .FALSE.
+            iiv = 0
+            !
+            DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
+               iiv = iiv + 1
+               ll_fnd  = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
+            END DO
+            !
+            IF( .NOT.ll_fnd ) THEN
+               iiv = iiv + 1
+               IF( iiv <= jpmax_vars ) THEN
+                  iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims )
+               ELSE
+                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   &
+                        &                      'increase the parameter jpmax_vars')
+               ENDIF
+               IF( llstop .AND. iom_varid == -1 )   CALL ctl_stop( TRIM(clinfo)//' not found' ) 
+            ELSE
+               iom_varid = iiv
+               IF( PRESENT(kdimsz) ) THEN 
+                  i_nvd = iom_file(kiomid)%ndims(iiv)
+                  IF( i_nvd <= size(kdimsz) ) THEN
+                     kdimsz(1:i_nvd) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
+                  ELSE
+                     WRITE(ctmp1,*) i_nvd, size(kdimsz)
+                     CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
+                  ENDIF
+               ENDIF
+               IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv)
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+   END FUNCTION iom_varid
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_get
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, ldxios )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field
+      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number
+      LOGICAL         , INTENT(in   ),     OPTIONAL   ::   ldxios    ! use xios to read restart
+      !
+      INTEGER                                         ::   idvar     ! variable id
+      INTEGER                                         ::   idmspc    ! number of spatial dimensions
+      INTEGER         , DIMENSION(1)                  ::   itime     ! record number
+      CHARACTER(LEN=100)                              ::   clinfo    ! info character
+      CHARACTER(LEN=100)                              ::   clname    ! file name
+      CHARACTER(LEN=1)                                ::   cldmspc   !
+      LOGICAL                                         ::   llxios
+      !
+      llxios = .FALSE.
+      IF( PRESENT(ldxios) ) llxios = ldxios
+
+      IF(.NOT.llxios) THEN  ! read data using default library
+         itime = 1
+         IF( PRESENT(ktime) ) itime = ktime
+         !
+         clname = iom_file(kiomid)%name
+         clinfo = '          iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar)
+         !
+         IF( kiomid > 0 ) THEN
+            idvar = iom_varid( kiomid, cdvar )
+            IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
+               idmspc = iom_file ( kiomid )%ndims( idvar )
+               IF( iom_file(kiomid)%luld(idvar) )  idmspc = idmspc - 1
+               WRITE(cldmspc , fmt='(i1)') idmspc
+               IF( idmspc > 0 )  CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
+                                    &                         'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
+                                    &                         'Use ncwa -a to suppress the unnecessary dimensions' )
+               CALL iom_nf90_get( kiomid, idvar, pvar, itime )
+            ENDIF
+         ENDIF
+      ELSE
+#if defined key_iomput
+         IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar)
+         CALL iom_swap( TRIM(crxios_context) )
+         CALL xios_recv_field( trim(cdvar), pvar)
+         CALL iom_swap( TRIM(cxios_context) )
+#else
+         WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar)
+         CALL ctl_stop( 'iom_g0d', ctmp1 )
+#endif
+      ENDIF
+   END SUBROUTINE iom_g0d
+
+   SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios )
+      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis
+      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     ldxios=ldxios )
+      ENDIF
+   END SUBROUTINE iom_g1d
+
+   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios)
+      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis
+      LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to
+                                                                               ! look for and use a file attribute
+                                                                               ! called open_ocean_jstart to set the start
+                                                                               ! value for the 2nd dimension (netcdf only)
+      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios      ! read data using XIOS
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     lrowattr=lrowattr,  ldxios=ldxios)
+      ENDIF
+   END SUBROUTINE iom_g2d
+
+   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios )
+      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis
+      LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to
+                                                                                 ! look for and use a file attribute
+                                                                                 ! called open_ocean_jstart to set the start
+                                                                                 ! value for the 2nd dimension (netcdf only)
+      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios        ! read data using XIOS
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     lrowattr=lrowattr, ldxios=ldxios )
+      ENDIF
+   END SUBROUTINE iom_g3d
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   &
+         &                  pv_r1d, pv_r2d, pv_r3d,   &
+         &                  ktime , kstart, kcount,   &
+         &                  lrowattr, ldxios        )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_get_123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid     ! Identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read
+      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable
+      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
+      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
+      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
+      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number
+      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis 
+      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis
+      LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to
+                                                                           ! look for and use a file attribute
+                                                                           ! called open_ocean_jstart to set the start
+                                                                           ! value for the 2nd dimension (netcdf only)
+      LOGICAL                    , INTENT(in   ), OPTIONAL ::   ldxios     ! use XIOS to read restart
+      !
+      LOGICAL                        ::   llxios       ! local definition for XIOS read
+      LOGICAL                        ::   llnoov      ! local definition to read overlap
+      LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute
+      INTEGER                        ::   jstartrow   ! start point for 2nd dimension optionally set by file attribute
+      INTEGER                        ::   jl          ! loop on number of dimension 
+      INTEGER                        ::   idom        ! type of domain
+      INTEGER                        ::   idvar       ! id of the variable
+      INTEGER                        ::   inbdim      ! number of dimensions of the variable
+      INTEGER                        ::   idmspc      ! number of spatial dimensions 
+      INTEGER                        ::   itime       ! record number
+      INTEGER                        ::   istop       ! temporary value of nstop
+      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes
+      INTEGER                        ::   ji, jj      ! loop counters
+      INTEGER                        ::   irankpv     ! 
+      INTEGER                        ::   ind1, ind2  ! substring index
+      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis
+      INTEGER, DIMENSION(jpmax_dims) ::   icnt        ! number of value to read along each axis 
+      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable
+      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable
+      REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset
+      INTEGER                        ::   itmp        ! temporary integer
+      CHARACTER(LEN=256)             ::   clinfo      ! info character
+      CHARACTER(LEN=256)             ::   clname      ! file name
+      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      ! 
+      LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension.
+      INTEGER                        ::   inlev       ! number of levels for 3D data
+      REAL(wp)                       ::   gma, gmi
+      !---------------------------------------------------------------------
+      !
+      inlev = -1
+      IF( PRESENT(pv_r3d) )   inlev = SIZE(pv_r3d, 3)
+      !
+      llxios = .FALSE.
+      if(PRESENT(ldxios)) llxios = ldxios
+      idvar = iom_varid( kiomid, cdvar ) 
+      idom = kdom
+      !
+      IF(.NOT.llxios) THEN
+         clname = iom_file(kiomid)%name   !   esier to read
+         clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
+         ! local definition of the domain ?
+         ! do we read the overlap 
+         ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+         ! 
+         !llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
+         ! for domain_cfg tools force to read the full domain
+         llnoov = .FALSE.
+         ! check kcount and kstart optionals parameters...
+         IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
+         IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
+         IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_autoglo_xy  ) &
+     &          CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy')
+
+         luse_jattr = .false.
+         IF( PRESENT(lrowattr) ) THEN
+            IF( lrowattr .AND. idom /= jpdom_data   ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data')
+            IF( lrowattr .AND. idom == jpdom_data   ) luse_jattr = .true.
+         ENDIF
+
+         ! Search for the variable in the data base (eventually actualize data)
+         istop = nstop
+         !
+         IF( idvar > 0 ) THEN
+            ! to write iom_file(kiomid)%dimsz in a shorter way !
+            idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 
+            inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file
+            idmspc = inbdim                                   ! number of spatial dimensions in the file
+            IF( iom_file(kiomid)%luld(idvar) )   idmspc = inbdim - 1
+            IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 
+            !
+            ! update idom definition...
+            ! Identify the domain in case of jpdom_auto(glo/dta) definition
+            IF( idom == jpdom_autoglo_xy ) THEN
+               ll_depth_spec = .TRUE.
+               idom = jpdom_autoglo
+            ELSE
+               ll_depth_spec = .FALSE.
+            ENDIF
+            IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN            
+               IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global 
+               ELSE                               ;   idom = jpdom_data
+               ENDIF
+               ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
+               ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
+               IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF
+            ENDIF
+            ! Identify the domain in case of jpdom_local definition
+            IF( idom == jpdom_local ) THEN
+               IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full
+               ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra
+               ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap
+               ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )
+               ENDIF
+            ENDIF
+            !
+            ! check the consistency between input array and data rank in the file
+            !
+            ! initializations
+            itime = 1
+            IF( PRESENT(ktime) ) itime = ktime
+            !
+            irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) )
+            WRITE(clrankpv, fmt='(i1)') irankpv
+            WRITE(cldmspc , fmt='(i1)') idmspc
+            !
+            IF(     idmspc <  irankpv ) THEN 
+               CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
+                  &                         'it is impossible to read a '//clrankpv//'D array from this file...' )
+            ELSEIF( idmspc == irankpv ) THEN
+               IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   &
+                  &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
+            ELSEIF( idmspc >  irankpv ) THEN
+                  IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
+                     CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   &
+                           &         'As the size of the z dimension is 1 and as we try to read the first record, ',   &
+                           &         'we accept this case, even if there is a possible mix-up between z and time dimension' )   
+                     idmspc = idmspc - 1
+                  ELSE
+                     CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,'         ,   &
+                        &                         'we do not accept data with '//cldmspc//' spatial dimensions',   &
+                        &                         'Use ncwa -a to suppress the unnecessary dimensions' )
+                  ENDIF
+            ENDIF
+            !
+            ! definition of istart and icnt
+            !
+            icnt  (:) = 1
+            istart(:) = 1
+            istart(idmspc+1) = itime
+   
+            IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN 
+               istart(1:idmspc) = kstart(1:idmspc) 
+               icnt  (1:idmspc) = kcount(1:idmspc)
+            ELSE
+               IF(idom == jpdom_unknown ) THEN
+                  icnt(1:idmspc) = idimsz(1:idmspc)
+               ELSE 
+                  IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array
+                     IF(     idom == jpdom_data    ) THEN
+                        jstartrow = 1
+                        IF( luse_jattr ) THEN
+                           CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+                           jstartrow = MAX(1,jstartrow)
+                        ENDIF
+                        istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below
+                     ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below
+                     ENDIF
+                     ! we do not read the overlap                     -> we start to read at nldi, nldj
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
+                     IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
+                  ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
+                     IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
+                     ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /)
+                     ENDIF
+                     IF( PRESENT(pv_r3d) ) THEN
+                        IF( idom == jpdom_data ) THEN                        ;                               icnt(3) = inlev
+                        ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN   ;   istart(3) = kstart(3)   ;   icnt(3) = kcount(3)
+                        ELSE                                                 ;                               icnt(3) = inlev
+                        ENDIF
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDIF
+
+            ! check that istart and icnt can be used with this file
+            !-
+            DO jl = 1, jpmax_dims
+               itmp = istart(jl)+icnt(jl)-1
+               IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
+                  WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
+                  WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)"         ) jl, idimsz(jl)
+                  CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )     
+               ENDIF
+            END DO
+
+            ! check that icnt matches the input array
+            !-     
+            IF( idom == jpdom_unknown ) THEN
+               IF( irankpv == 1 )        ishape(1:1) = SHAPE(pv_r1d)
+               IF( irankpv == 2 )        ishape(1:2) = SHAPE(pv_r2d)
+               IF( irankpv == 3 )        ishape(1:3) = SHAPE(pv_r3d)
+               ctmp1 = 'd'
+            ELSE
+               IF( irankpv == 2 ) THEN
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)'
+                  IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
+                  ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)'
+                  ENDIF
+               ENDIF
+               IF( irankpv == 3 ) THEN 
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
+                  IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
+                  ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
+                  ENDIF
+               ENDIF
+            ENDIF
+         
+            DO jl = 1, irankpv
+               WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
+               IF( ishape(jl) /= icnt(jl) )   CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
+            END DO
+
+         ENDIF
+
+         ! read the data
+         !-     
+         IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point...
+            !
+         ! find the right index of the array to be read
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
+!         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+!         ENDIF
+            IF( llnoov ) THEN
+               IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
+               ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+               ENDIF
+            ELSE
+               IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj
+               ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+               ENDIF
+            ENDIF
+            WRITE(numout,*) 'istart icnt',istart, ' ', icnt 
+            WRITE(numout,*) ' idx i1, i2, j1, j2 ',ix1, ix2, iy1, iy2
+            CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d, pv_r3d )
+
+            IF( istop == nstop ) THEN   ! no additional errors until this point...
+               IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
+             
+               !--- overlap areas and extra hallows (mpp)
+               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
+                  CALL lbc_lnk( 'iom', pv_r2d,'Z',-999.,'no0' )
+               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN
+                  ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
+                  IF( icnt(3) == inlev ) THEN
+                     CALL lbc_lnk( 'iom', pv_r3d,'Z',-999.,'no0' )
+                  ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...)
+                     DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO
+                     DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO
+                  ENDIF
+               ENDIF
+               !
+            ELSE
+               ! return if istop == nstop is false
+               RETURN
+            ENDIF
+         ELSE
+            ! return if statment idvar > 0 .AND. istop == nstop is false
+            RETURN
+         ENDIF
+         !
+      ELSE        ! read using XIOS. Only if KEY_IOMPUT is defined
+#if defined key_iomput
+!would be good to be able to check which context is active and swap only if current is not restart
+         CALL iom_swap( TRIM(crxios_context) ) 
+         IF( PRESENT(pv_r3d) ) THEN
+            pv_r3d(:, :, :) = 0.
+            if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar)
+            CALL xios_recv_field( trim(cdvar), pv_r3d)
+            IF(idom /= jpdom_unknown ) then
+                CALL lbc_lnk( 'iom', pv_r3d,'Z',-999.,'no0' )
+            ENDIF
+         ELSEIF( PRESENT(pv_r2d) ) THEN
+            pv_r2d(:, :) = 0.
+            if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar)
+            CALL xios_recv_field( trim(cdvar), pv_r2d)
+            IF(idom /= jpdom_unknown ) THEN
+                CALL lbc_lnk('iom', pv_r2d,'Z',-999.,'no0')
+            ENDIF
+         ELSEIF( PRESENT(pv_r1d) ) THEN
+            pv_r1d(:) = 0.
+            if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar)
+            CALL xios_recv_field( trim(cdvar), pv_r1d)
+         ENDIF
+         CALL iom_swap( TRIM(cxios_context) )
+#else
+         istop = istop + 1 
+         clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar)
+#endif
+      ENDIF
+!some final adjustments
+      ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain
+
+      !--- Apply scale_factor and offset
+      zscf = iom_file(kiomid)%scf(idvar)      ! scale factor
+      zofs = iom_file(kiomid)%ofs(idvar)      ! offset
+      IF(     PRESENT(pv_r1d) ) THEN
+         IF( zscf /= 1. )   pv_r1d(:) = pv_r1d(:) * zscf 
+         IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs
+      ELSEIF( PRESENT(pv_r2d) ) THEN
+         IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
+         IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
+      ELSEIF( PRESENT(pv_r3d) ) THEN
+         IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
+         IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
+      ENDIF
+      !
+   END SUBROUTINE iom_get_123d
+
+
+   FUNCTION iom_getszuld ( kiomid )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_getszuld  ***
+      !!
+      !! ** Purpose : get the size of the unlimited dimension in a file
+      !!              (return -1 if not found)
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kiomid   ! file Identifier
+      !
+      INTEGER                ::   iom_getszuld
+      !!-----------------------------------------------------------------------
+      iom_getszuld = -1
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%iduld > 0 )   iom_getszuld = iom_file(kiomid)%lenuld
+      ENDIF
+   END FUNCTION iom_getszuld
+   
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_chkatt
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_chkatt( kiomid, cdatt, llok, ksize, cdvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      LOGICAL         , INTENT(  out)                 ::   llok      ! Error code
+      INTEGER         , INTENT(  out), OPTIONAL       ::   ksize     ! Size of the attribute array
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_chkatt( kiomid, cdatt, llok, ksize=ksize, cdvar=cdvar )
+      ENDIF
+      !
+   END SUBROUTINE iom_chkatt
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_getatt
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_g0d_iatt( kiomid, cdatt, katt0d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      INTEGER               , INTENT(  out)           ::   katt0d    ! read field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt,  katt0d =  katt0d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_g0d_iatt
+
+   SUBROUTINE iom_g1d_iatt( kiomid, cdatt, katt1d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      INTEGER, DIMENSION(:) , INTENT(  out)           ::   katt1d    ! read field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt,  katt1d =  katt1d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_g1d_iatt
+
+   SUBROUTINE iom_g0d_ratt( kiomid, cdatt, patt0d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      REAL(wp)              , INTENT(  out)           ::   patt0d    ! read field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt,  patt0d =  patt0d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_g0d_ratt
+
+   SUBROUTINE iom_g1d_ratt( kiomid, cdatt, patt1d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      REAL(wp), DIMENSION(:), INTENT(  out)           ::   patt1d    ! read field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt,  patt1d =  patt1d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_g1d_ratt
+   
+   SUBROUTINE iom_g0d_catt( kiomid, cdatt, cdatt0d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      CHARACTER(len=*)      , INTENT(  out)           ::   cdatt0d   ! read field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt, cdatt0d = cdatt0d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_g0d_catt
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_putatt
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_p0d_iatt( kiomid, cdatt, katt0d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      INTEGER               , INTENT(in   )           ::   katt0d    ! written field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt,  katt0d =  katt0d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_p0d_iatt
+
+   SUBROUTINE iom_p1d_iatt( kiomid, cdatt, katt1d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      INTEGER, DIMENSION(:) , INTENT(in   )           ::   katt1d    ! written field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt,  katt1d =  katt1d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_p1d_iatt
+
+   SUBROUTINE iom_p0d_ratt( kiomid, cdatt, patt0d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      REAL(wp)              , INTENT(in   )           ::   patt0d    ! written field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt,  patt0d =  patt0d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_p0d_ratt
+
+   SUBROUTINE iom_p1d_ratt( kiomid, cdatt, patt1d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      REAL(wp), DIMENSION(:), INTENT(in   )           ::   patt1d    ! written field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt,  patt1d =  patt1d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_p1d_ratt
+   
+   SUBROUTINE iom_p0d_catt( kiomid, cdatt, cdatt0d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt0d   ! written field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt, cdatt0d = cdatt0d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_p0d_catt
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_rstput
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in)                         ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      LOGICAL, OPTIONAL :: ldxios   ! xios write flag
+      LOGICAL :: llx                ! local xios write flag
+      INTEGER :: ivid   ! variable id
+
+      llx = .FALSE.
+      IF(PRESENT(ldxios)) llx = ldxios
+      IF( llx ) THEN
+#ifdef key_iomput
+      IF( kt == kwrite ) THEN
+          IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar)
+          CALL xios_send_field(trim(cdvar), pvar)
+      ENDIF
+#endif
+      ELSE
+         IF( kiomid > 0 ) THEN
+            IF( iom_file(kiomid)%nfid > 0 ) THEN
+               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
+            ENDIF
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp0d
+
+   SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      LOGICAL, OPTIONAL                                    ::   ldxios   ! xios write flag
+      LOGICAL :: llx                ! local xios write flag
+      INTEGER :: ivid   ! variable id
+
+      llx = .FALSE.
+      IF(PRESENT(ldxios)) llx = ldxios
+      IF( llx ) THEN
+#ifdef key_iomput
+      IF( kt == kwrite ) THEN
+         IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar)
+         CALL xios_send_field(trim(cdvar), pvar)
+      ENDIF
+#endif
+      ELSE
+         IF( kiomid > 0 ) THEN
+            IF( iom_file(kiomid)%nfid > 0 ) THEN
+               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
+            ENDIF
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp1d
+
+   SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      LOGICAL, OPTIONAL :: ldxios   ! xios write flag
+      LOGICAL :: llx
+      INTEGER :: ivid   ! variable id
+
+      llx = .FALSE.
+      IF(PRESENT(ldxios)) llx = ldxios
+      IF( llx ) THEN
+#ifdef key_iomput
+      IF( kt == kwrite ) THEN
+         IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar)
+         CALL xios_send_field(trim(cdvar), pvar)
+      ENDIF
+#endif
+      ELSE
+         IF( kiomid > 0 ) THEN
+            IF( iom_file(kiomid)%nfid > 0 ) THEN
+               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
+            ENDIF
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp2d
+
+   SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      LOGICAL, OPTIONAL :: ldxios   ! xios write flag
+      LOGICAL :: llx                 ! local xios write flag
+      INTEGER :: ivid   ! variable id
+
+      llx = .FALSE.
+      IF(PRESENT(ldxios)) llx = ldxios
+      IF( llx ) THEN
+#ifdef key_iomput
+      IF( kt == kwrite ) THEN
+         IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar)
+         CALL xios_send_field(trim(cdvar), pvar)
+      ENDIF
+#endif
+      ELSE
+         IF( kiomid > 0 ) THEN
+            IF( iom_file(kiomid)%nfid > 0 ) THEN
+               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
+            ENDIF
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp3d
+
+
+  SUBROUTINE iom_delay_rst( cdaction, cdcpnt, kncid )
+      !!---------------------------------------------------------------------
+      !!   Routine iom_delay_rst: used read/write restart related to mpp_delay
+      !!
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   ) ::   cdaction        !
+      CHARACTER(len=*), INTENT(in   ) ::   cdcpnt
+      INTEGER         , INTENT(in   ) ::   kncid
+      !
+      INTEGER  :: ji
+      INTEGER  :: indim
+      LOGICAL  :: llattexist
+      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zreal1d
+      !!---------------------------------------------------------------------
+      !
+      !                                      ===================================
+      IF( TRIM(cdaction) == 'READ' ) THEN   ! read restart related to mpp_delay !
+         !                                   ===================================
+         DO ji = 1, nbdelay
+            IF ( c_delaycpnt(ji) == cdcpnt ) THEN
+               CALL iom_chkatt( kncid, 'DELAY_'//c_delaylist(ji), llattexist, indim )
+               IF( llattexist )  THEN
+                  ALLOCATE( todelay(ji)%z1d(indim) )
+                  CALL iom_getatt( kncid, 'DELAY_'//c_delaylist(ji), todelay(ji)%z1d(:) )
+                  ndelayid(ji) = 0   ! set to 0 to specify that the value was read in the restart
+               ENDIF
+           ENDIF
+         END DO
+         !                                   ====================================
+      ELSE                                  ! write restart related to mpp_delay !
+         !                                   ====================================
+         DO ji = 1, nbdelay   ! save only ocean delayed global communication variables
+            IF ( c_delaycpnt(ji) == cdcpnt ) THEN
+               IF( ASSOCIATED(todelay(ji)%z1d) ) THEN
+                  CALL mpp_delay_rcv(ji)   ! make sure %z1d is received
+                  CALL iom_putatt( kncid, 'DELAY_'//c_delaylist(ji), todelay(ji)%z1d(:) )
+               ENDIF
+            ENDIF
+         END DO
+         !
+      ENDIF
+      
+   END SUBROUTINE iom_delay_rst
+  
+   
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_put
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_p0d( cdname, pfield0d )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      REAL(wp)        , INTENT(in) ::   pfield0d
+      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
+#if defined key_iomput
+      zz(:,:)=pfield0d
+      CALL xios_send_field(cdname, zz)
+      !CALL xios_send_field(cdname, (/pfield0d/)) 
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p0d
+
+   SUBROUTINE iom_p1d( cdname, pfield1d )
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdname
+      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d
+#if defined key_iomput
+      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p1d
+
+   SUBROUTINE iom_p2d( cdname, pfield2d )
+      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
+      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
+#if defined key_iomput
+      CALL xios_send_field(cdname, pfield2d)
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p2d
+
+   SUBROUTINE iom_p3d( cdname, pfield3d )
+      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
+      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
+#if defined key_iomput
+      CALL xios_send_field( cdname, pfield3d )
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p3d
+
+#if defined key_iomput
+   !!----------------------------------------------------------------------
+   !!   'key_iomput'                                         XIOS interface
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj,                                               &
+      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     &
+      &                                    nvertex, bounds_lon, bounds_lat, area )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)                  , INTENT(in) ::   cdid
+      INTEGER                 , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj
+      INTEGER                 , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj
+      INTEGER                 , OPTIONAL, INTENT(in) ::   nvertex
+      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue
+      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area
+      LOGICAL , DIMENSION(:)  , OPTIONAL, INTENT(in) ::   mask
+      !!----------------------------------------------------------------------
+      !
+      IF( xios_is_valid_domain     (cdid) ) THEN
+         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
+            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
+            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      &
+            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear')
+      ENDIF
+      IF( xios_is_valid_domaingroup(cdid) ) THEN
+         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
+            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
+            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      &
+            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' )
+      ENDIF
+      !
+      CALL xios_solve_inheritance()
+      !
+   END SUBROUTINE iom_set_domain_attr
+
+
+   SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*), INTENT(in) ::   cdid
+      INTEGER         , INTENT(in) ::   ibegin, jbegin, ni, nj
+      !
+      TYPE(xios_gridgroup) :: gridgroup_hdl
+      TYPE(xios_grid)      :: grid_hdl
+      TYPE(xios_domain)    :: domain_hdl 
+      TYPE(xios_axis)      :: axis_hdl 
+      CHARACTER(LEN=64)    :: cldomrefid   ! domain_ref name
+      CHARACTER(len=1)     :: cl1          ! last character of this name
+      !!----------------------------------------------------------------------
+      !
+      IF( xios_is_valid_zoom_domain(cdid) ) THEN
+         ! define the zoom_domain attributs
+         CALL xios_set_zoom_domain_attr( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj )
+         ! define a new 2D grid with this new domain
+         CALL xios_get_handle("grid_definition", gridgroup_hdl )
+         CALL xios_add_child(gridgroup_hdl, grid_hdl, TRIM(cdid)//'_2D' )   ! add a new 2D grid to grid_definition
+         CALL xios_add_child(grid_hdl, domain_hdl, TRIM(cdid) )             ! add its domain
+         ! define a new 3D grid with this new domain
+         CALL xios_add_child(gridgroup_hdl, grid_hdl, TRIM(cdid)//'_3D' )   ! add a new 3D grid to grid_definition
+         CALL xios_add_child(grid_hdl, domain_hdl, TRIM(cdid) )             ! add its domain
+         ! vertical axis
+         cl1 = cdid(LEN_TRIM(cdid):)                                        ! last letter of cdid
+         cl1 = CHAR(ICHAR(cl1)+32)                                          ! from upper to lower case
+         CALL xios_add_child(grid_hdl, axis_hdl, 'depth'//cl1)              ! add its axis
+      ENDIF
+      !      
+   END SUBROUTINE iom_set_zoom_domain_attr
+
+
+   SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)      , INTENT(in) ::   cdid
+      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   paxis
+      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds
+      !!----------------------------------------------------------------------
+      IF( PRESENT(paxis) ) THEN
+         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis )
+         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis )
+      ENDIF
+      IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds )
+      IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_axis_attr
+
+
+   SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)             , INTENT(in) ::   cdid
+      TYPE(xios_duration), OPTIONAL, INTENT(in) ::   freq_op
+      TYPE(xios_duration), OPTIONAL, INTENT(in) ::   freq_offset
+      !!----------------------------------------------------------------------
+      IF( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      IF( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_field_attr
+
+
+   SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
+      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   name, name_suffix
+      !!----------------------------------------------------------------------
+      IF( xios_is_valid_file     (cdid) )   CALL xios_set_file_attr     ( cdid, name=name, name_suffix=name_suffix )
+      IF( xios_is_valid_filegroup(cdid) )   CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_file_attr
+
+
+   SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)          , INTENT(in ) ::   cdid
+      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix
+      TYPE(xios_duration), OPTIONAL , INTENT(out) :: output_freq
+      LOGICAL                                 ::   llexist1,llexist2,llexist3
+      !---------------------------------------------------------------------
+      IF( PRESENT( name        ) )   name = ''          ! default values
+      IF( PRESENT( name_suffix ) )   name_suffix = ''
+      IF( PRESENT( output_freq ) )   output_freq = xios_duration(0,0,0,0,0,0)
+      IF( xios_is_valid_file     (cdid) ) THEN
+         CALL xios_solve_inheritance()
+         CALL xios_is_defined_file_attr     ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
+         IF(llexist1)   CALL xios_get_file_attr     ( cdid, name = name )
+         IF(llexist2)   CALL xios_get_file_attr     ( cdid, name_suffix = name_suffix )
+         IF(llexist3)   CALL xios_get_file_attr     ( cdid, output_freq = output_freq )
+      ENDIF
+      IF( xios_is_valid_filegroup(cdid) ) THEN
+         CALL xios_solve_inheritance()
+         CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
+         IF(llexist1)   CALL xios_get_filegroup_attr( cdid, name = name )
+         IF(llexist2)   CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix )
+         IF(llexist3)   CALL xios_get_filegroup_attr( cdid, output_freq = output_freq )
+      ENDIF
+   END SUBROUTINE iom_get_file_attr
+
+
+   SUBROUTINE iom_set_grid_attr( cdid, mask )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
+      LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask
+      !!----------------------------------------------------------------------
+      IF( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask_3D=mask )
+      IF( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask_3D=mask )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_grid_attr
+
+   SUBROUTINE iom_setkt( kt, cdname )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt 
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      !!----------------------------------------------------------------------
+      CALL iom_swap( cdname )   ! swap to cdname context
+      CALL xios_update_calendar(kt)
+      IF( cdname /= TRIM(cxios_context) )   CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context
+   END SUBROUTINE iom_setkt
+
+   SUBROUTINE iom_context_finalize( cdname )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*), INTENT(in) :: cdname
+      CHARACTER(LEN=120)           :: clname
+      !!----------------------------------------------------------------------
+      clname = cdname
+      IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname 
+      IF( xios_is_valid_context(clname) ) THEN
+         CALL iom_swap( cdname )   ! swap to cdname context
+         CALL xios_context_finalize() ! finalize the context
+         IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context
+      ENDIF
+      !
+   END SUBROUTINE iom_context_finalize
+
+
+   SUBROUTINE set_grid( cdgrd, plon, plat, ldxios, ldrxios )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_grid  ***
+      !!
+      !! ** Purpose :   define horizontal grids
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=1)            , INTENT(in) ::   cdgrd
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+      !
+      INTEGER  :: ni, nj
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask
+      LOGICAL, INTENT(IN) :: ldxios, ldrxios
+      !!----------------------------------------------------------------------
+      !
+      ni = nlei-nldi+1
+      nj = nlej-nldj+1
+      !
+      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
+      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+!don't define lon and lat for restart reading context. 
+      IF ( .NOT.ldrxios ) &
+         CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   &
+         &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
+      !
+      IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN
+         ! mask land points, keep values on coast line -> specific mask for U, V and W points
+         SELECT CASE ( cdgrd )
+         CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:)
+         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1. )
+         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1. )
+         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1)
+         END SELECT
+         !
+         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj    /)) /= 0. )
+         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )
+      ENDIF
+      !
+   END SUBROUTINE set_grid
+
+
+   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE set_grid_bounds  ***
+      !!
+      !! ** Purpose :   define horizontal grid corners
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=1)                      , INTENT(in) :: cdgrd
+      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) :: plon_cnr, plat_cnr  ! Lat/lon coord. of a contiguous vertex of cell (i,j)
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coord. of the point of cell (i,j)
+      !
+      INTEGER :: ji, jj, jn, ni, nj
+      INTEGER :: icnr, jcnr                                    ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
+      !                                                        ! represents the bottom-left corner of cell (i,j)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_rot       ! Lat/lon working array for rotation of cells
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  )
+      !
+      ! Offset of coordinate representing bottom-left corner
+      SELECT CASE ( TRIM(cdgrd) )
+      CASE ('T', 'W')   ;   icnr = -1   ;   jcnr = -1
+      CASE ('U')        ;   icnr =  0   ;   jcnr = -1
+      CASE ('V')        ;   icnr = -1   ;   jcnr =  0
+      END SELECT
+      !
+      ni = nlei-nldi+1   ! Dimensions of subdomain interior
+      nj = nlej-nldj+1
+      !
+      z_fld(:,:) = 1._wp
+      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1. )    ! Working array for location of northfold
+      !
+      ! Cell vertices that can be defined
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
+            z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
+            z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
+            z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
+            z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
+            z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
+            z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
+            z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
+         END DO
+      END DO
+      !
+      ! Cell vertices on boundries
+      DO jn = 1, 4
+         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp )
+         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp )
+      END DO
+      !
+      ! Zero-size cells at closed boundaries if cell points provided,
+      ! otherwise they are closed cells with unrealistic bounds
+      IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN
+         IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
+            DO jn = 1, 4        ! (West or jpni = 1), closed E-W
+               z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:)
+            END DO
+         ENDIF
+         IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
+            DO jn = 1, 4        ! (East or jpni = 1), closed E-W
+               z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:)
+            END DO
+         ENDIF
+         IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN
+            DO jn = 1, 4        ! South or (jpnj = 1, not symmetric)
+               z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1)
+            END DO
+         ENDIF
+         IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN
+            DO jn = 1, 4        ! (North or jpnj = 1), no north fold
+               z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj)
+            END DO
+         ENDIF
+      ENDIF
+      !
+      IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN    ! Rotate cells at the north fold
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( z_fld(ji,jj) == -1. ) THEN
+                  z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:)
+                  z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:)
+                  z_bnds(:,ji,jj,:) = z_rot(:,:)
+               ENDIF
+            END DO
+         END DO
+      ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN                  ! Invert cells at the symmetric equator
+         DO ji = 1, jpi
+            z_rot(1:2,:) = z_bnds(3:4,ji,1,:)
+            z_rot(3:4,:) = z_bnds(1:2,ji,1,:)
+            z_bnds(:,ji,1,:) = z_rot(:,:)
+         END DO
+      ENDIF
+      !
+      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           &
+          &                                    bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 )
+      !
+      DEALLOCATE( z_bnds, z_fld, z_rot ) 
+      !
+   END SUBROUTINE set_grid_bounds
+
+
+   SUBROUTINE set_grid_znl( plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_grid_znl  ***
+      !!
+      !! ** Purpose :   define grids for zonal mean
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+      !
+      INTEGER  :: ni, nj, ix, iy
+      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon
+      !!----------------------------------------------------------------------
+      !
+      ni=nlei-nldi+1       ! define zonal mean domain (jpj*jpk)
+      nj=nlej-nldj+1
+      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp
+      !
+      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots)
+!      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
+      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
+      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   &
+         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
+      CALL iom_set_zoom_domain_attr("znl_T", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
+      CALL iom_set_zoom_domain_attr("znl_W", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
+      !
+      CALL iom_update_file_name('ptr')
+      !
+   END SUBROUTINE set_grid_znl
+
+
+   SUBROUTINE set_scalar
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_scalar  ***
+      !!
+      !! ** Purpose :   define fake grids for scalar point
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1)   ::   zz = 1.
+      !!----------------------------------------------------------------------
+      !
+      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1)
+      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
+      !
+      zz = REAL( narea, wp )
+      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
+      !
+   END SUBROUTINE set_scalar
+
+
+   SUBROUTINE set_xmlatt
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_xmlatt  ***
+      !!
+      !! ** Purpose :   automatic definitions of some of the xml attributs...
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1),DIMENSION( 3) ::   clgrd                    ! suffix name
+      CHARACTER(len=256)             ::   clsuff                   ! suffix name
+      CHARACTER(len=1)               ::   cl1                      ! 1 character
+      CHARACTER(len=2)               ::   cl2                      ! 2 characters
+      CHARACTER(len=3)               ::   cl3                      ! 3 characters
+      INTEGER                        ::   ji, jg                   ! loop counters
+      INTEGER                        ::   ix, iy                   ! i-,j- index
+      REAL(wp)        ,DIMENSION(11) ::   zlontao                  ! longitudes of tao    moorings
+      REAL(wp)        ,DIMENSION( 7) ::   zlattao                  ! latitudes  of tao    moorings
+      REAL(wp)        ,DIMENSION( 4) ::   zlonrama                 ! longitudes of rama   moorings
+      REAL(wp)        ,DIMENSION(11) ::   zlatrama                 ! latitudes  of rama   moorings
+      REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings
+      REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings
+      TYPE(xios_duration)            ::   f_op, f_of
+      !!----------------------------------------------------------------------
+      ! 
+      ! frequency of the call of iom_put (attribut: freq_op)
+      f_op%timestep = 1        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = 2        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('trendT_even'     , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = 2        ;  f_of%timestep = -1  ; CALL iom_set_field_attr('trendT_odd'      , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of)
+
+      ! output file names (attribut: name)
+      DO ji = 1, 9
+         WRITE(cl1,'(i1)') ji 
+         CALL iom_update_file_name('file'//cl1)
+      END DO
+      DO ji = 1, 99
+         WRITE(cl2,'(i2.2)') ji 
+         CALL iom_update_file_name('file'//cl2)
+      END DO
+      DO ji = 1, 999
+         WRITE(cl3,'(i3.3)') ji 
+         CALL iom_update_file_name('file'//cl3)
+      END DO
+
+      ! Zooms...
+      clgrd = (/ 'T', 'U', 'W' /) 
+      DO jg = 1, SIZE(clgrd)                                                                   ! grid type
+         cl1 = clgrd(jg)
+         ! Equatorial section (attributs: jbegin, ni, name_suffix)
+         CALL dom_ngb( 0., 0., ix, iy, cl1 )
+         CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=jpiglo, nj=1 )
+         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             )
+         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
+         CALL iom_update_file_name('Eq'//cl1)
+      END DO
+      ! TAO moorings (attributs: ibegin, jbegin, name_suffix)
+      zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /)
+      zlattao = (/  -8.0,  -5.0,  -2.0,   0.0,    2.0,    5.0,    8.0 /)
+      CALL set_mooring( zlontao, zlattao )
+      ! RAMA moorings (attributs: ibegin, jbegin, name_suffix)
+      zlonrama = (/  55.0,  67.0, 80.5, 90.0 /)
+      zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /)
+      CALL set_mooring( zlonrama, zlatrama )
+      ! PIRATA moorings (attributs: ibegin, jbegin, name_suffix)
+      zlonpira = (/ -38.0, -23.0, -10.0 /)
+      zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
+      CALL set_mooring( zlonpira, zlatpira )
+      !
+   END SUBROUTINE set_xmlatt
+
+
+   SUBROUTINE set_mooring( plon, plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_mooring  ***
+      !!
+      !! ** Purpose :   automatic definitions of moorings xml attributs...
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:), INTENT(in) ::   plon, plat   ! longitudes/latitudes oft the mooring
+      !
+!!$      CHARACTER(len=1),DIMENSION(4) ::   clgrd = (/ 'T', 'U', 'V', 'W' /)   ! suffix name
+      CHARACTER(len=1),DIMENSION(1) ::   clgrd = (/ 'T' /)        ! suffix name
+      CHARACTER(len=256)            ::   clname                   ! file name
+      CHARACTER(len=256)            ::   clsuff                   ! suffix name
+      CHARACTER(len=1)              ::   cl1                      ! 1 character
+      CHARACTER(len=6)              ::   clon,clat                ! name of longitude, latitude
+      INTEGER                       ::   ji, jj, jg               ! loop counters
+      INTEGER                       ::   ix, iy                   ! i-,j- index
+      REAL(wp)                      ::   zlon, zlat
+      !!----------------------------------------------------------------------
+      DO jg = 1, SIZE(clgrd)
+         cl1 = clgrd(jg)
+         DO ji = 1, SIZE(plon)
+            DO jj = 1, SIZE(plat)
+               zlon = plon(ji)
+               zlat = plat(jj)
+               ! modifications for RAMA moorings
+               IF( zlon ==  67. .AND. zlat ==  15. )   zlon =  65.
+               IF( zlon ==  90. .AND. zlat <=  -4. )   zlon =  95.
+               IF( zlon ==  95. .AND. zlat ==  -4. )   zlat =  -5.
+               ! modifications for PIRATA moorings
+               IF( zlon == -38. .AND. zlat == -19. )   zlon = -34.
+               IF( zlon == -38. .AND. zlat == -14. )   zlon = -32.
+               IF( zlon == -38. .AND. zlat ==  -8. )   zlon = -30.
+               IF( zlon == -38. .AND. zlat ==   0. )   zlon = -35.
+               IF( zlon == -23. .AND. zlat ==  20. )   zlat =  21.
+               IF( zlon == -10. .AND. zlat == -14. )   zlat = -10.
+               IF( zlon == -10. .AND. zlat ==  -8. )   zlat =  -6.
+               IF( zlon == -10. .AND. zlat ==   4. ) THEN   ;   zlon = 0.   ;   zlat = 0.   ;   ENDIF
+               CALL dom_ngb( zlon, zlat, ix, iy, cl1 )
+               IF( zlon >= 0. ) THEN  
+                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT( zlon), 'e'
+                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')       zlon , 'e'
+                  ENDIF
+               ELSE             
+                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT(-zlon), 'w'
+                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')      -zlon , 'w'
+                  ENDIF
+               ENDIF
+               IF( zlat >= 0. ) THEN  
+                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT( zlat), 'n'
+                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')       zlat , 'n'
+                  ENDIF
+               ELSE             
+                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT(-zlat), 's'
+                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')      -zlat , 's'
+                  ENDIF
+               ENDIF
+               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
+               CALL iom_set_zoom_domain_attr(TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1, ni=1, nj=1)
+
+               CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         )
+               CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname))
+               CALL iom_update_file_name(TRIM(clname)//cl1)
+            END DO
+         END DO
+      END DO
+      
+   END SUBROUTINE set_mooring
+
+   
+   SUBROUTINE iom_update_file_name( cdid )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE iom_update_file_name  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
+      !
+      CHARACTER(LEN=256) ::   clname
+      CHARACTER(LEN=20)  ::   clfreq
+      CHARACTER(LEN=20)  ::   cldate
+      INTEGER            ::   idx
+      INTEGER            ::   jn
+      INTEGER            ::   itrlen
+      INTEGER            ::   iyear, imonth, iday, isec
+      REAL(wp)           ::   zsec
+      LOGICAL            ::   llexist
+      TYPE(xios_duration)   ::   output_freq 
+      !!----------------------------------------------------------------------
+      !
+      DO jn = 1, 2
+         !
+         output_freq = xios_duration(0,0,0,0,0,0)
+         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = output_freq )
+         IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname )
+         !
+         IF ( TRIM(clname) /= '' ) THEN 
+            !
+            idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
+            DO WHILE ( idx /= 0 ) 
+               clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname))
+               idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
+            END DO
+            !
+            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
+            DO WHILE ( idx /= 0 ) 
+              IF ( output_freq%timestep /= 0) THEN
+                  WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%second /= 0 ) THEN
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%second),'s' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%minute /= 0 ) THEN
+                  WRITE(clfreq,'(I18,A2)')INT(output_freq%minute),'mi' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%hour /= 0 ) THEN
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%day /= 0 ) THEN
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%month /= 0 ) THEN   
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%year /= 0 ) THEN   
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE
+                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   &
+                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
+              ENDIF
+              clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname))
+              idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
+            END DO
+            !
+            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday - rdt / rday )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
+               idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
+            END DO
+            !
+            idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
+               idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
+            END DO
+            !
+            idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname))
+               idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
+            END DO
+            !
+            idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname))
+               idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
+            END DO
+            !
+            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
+            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname )
+            IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname )
+            !
+         ENDIF
+         !
+      END DO
+      !
+   END SUBROUTINE iom_update_file_name
+
+
+   FUNCTION iom_sdate( pjday, ld24, ldfull )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE iom_sdate  ***
+      !!
+      !! ** Purpose :   send back the date corresponding to the given julian day
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   )           ::   pjday    ! julian day
+      LOGICAL , INTENT(in   ), OPTIONAL ::   ld24     ! true to force 24:00 instead of 00:00
+      LOGICAL , INTENT(in   ), OPTIONAL ::   ldfull   ! true to get the compleate date: yyyymmdd_hh:mm:ss
+      !
+      CHARACTER(LEN=20) ::   iom_sdate
+      CHARACTER(LEN=50) ::   clfmt                         !  format used to write the date 
+      INTEGER           ::   iyear, imonth, iday, ihour, iminute, isec
+      REAL(wp)          ::   zsec
+      LOGICAL           ::   ll24, llfull
+      !!----------------------------------------------------------------------
+      !
+      IF( PRESENT(ld24) ) THEN   ;   ll24 = ld24
+      ELSE                       ;   ll24 = .FALSE.
+      ENDIF
+      !
+      IF( PRESENT(ldfull) ) THEN   ;   llfull = ldfull
+      ELSE                         ;   llfull = .FALSE.
+      ENDIF
+      !
+      CALL ju2ymds( pjday, iyear, imonth, iday, zsec )
+      isec = NINT(zsec)
+      !
+      IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day
+         CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec )
+         isec = 86400
+      ENDIF
+      !
+      IF( iyear < 10000 ) THEN   ;   clfmt = "i4.4,2i2.2"                ! format used to write the date 
+      ELSE                       ;   WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1
+      ENDIF
+      !
+!$AGRIF_DO_NOT_TREAT      
+      ! needed in the conv
+      IF( llfull ) THEN 
+         clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
+         ihour   = isec / 3600
+         isec    = MOD(isec, 3600)
+         iminute = isec / 60
+         isec    = MOD(isec, 60)
+         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec    ! date of the end of run
+      ELSE
+         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run
+      ENDIF
+!$AGRIF_END_DO_NOT_TREAT      
+      !
+   END FUNCTION iom_sdate
+
+#else
+   !!----------------------------------------------------------------------
+   !!   NOT 'key_iomput'                               a few dummy routines
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_setkt( kt, cdname )
+      INTEGER         , INTENT(in)::   kt 
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      IF( .FALSE. )   WRITE(numout,*) kt, cdname   ! useless test to avoid compilation warnings
+   END SUBROUTINE iom_setkt
+
+   SUBROUTINE iom_context_finalize( cdname )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      IF( .FALSE. )   WRITE(numout,*)  cdname   ! useless test to avoid compilation warnings
+   END SUBROUTINE iom_context_finalize
+
+#endif
+
+   LOGICAL FUNCTION iom_use( cdname )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      !!----------------------------------------------------------------------
+#if defined key_iomput
+      iom_use = xios_field_is_active( cdname )
+#else
+      iom_use = .FALSE.
+#endif
+   END FUNCTION iom_use
+   
+   !!======================================================================
+END MODULE iom
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom.f90	(revision 12100)
+++ 	(revision )
@@ -1,951 +1,0 @@
-MODULE iom
-   !!=====================================================================
-   !!                    ***  MODULE  iom ***
-   !! Input/Output manager :  Library to read input files
-   !!====================================================================
-   !! History :  2.0  ! 2005-12  (J. Belier) Original code
-   !!            2.0  ! 2006-02  (S. Masson) Adaptation to NEMO
-   !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime
-   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case  
-   !!--------------------------------------------------------------------
-
-   !!--------------------------------------------------------------------
-   !!   iom_open       : open a file read only
-   !!   iom_close      : close a file or all files opened by iom
-   !!   iom_get        : read a field (interfaced to several routines)
-   !!   iom_gettime    : read the time axis cdvar in the file
-   !!   iom_varid      : get the id of a variable in a file
-   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
-   !!--------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE lbclnk          ! lateal boundary condition / mpp exchanges
-   USE iom_def         ! iom variables definitions
-   USE iom_nf90        ! NetCDF format with native NetCDF library
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp           ! MPP library
-
-   IMPLICIT NONE
-   PUBLIC   !   must be public to be able to access iom_def through iom
-   
-   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag
-   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
-   PUBLIC iom_getatt, 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
-
-   INTERFACE iom_get
-      MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d
-   END INTERFACE
-   INTERFACE iom_getatt
-      MODULE PROCEDURE iom_g0d_intatt
-   END INTERFACE
-   INTERFACE iom_rstput
-      MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
-   END INTERFACE
-  INTERFACE iom_put
-     MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
-  END INTERFACE
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: iom.F90 8572 2017-09-28 08:27:06Z cbricaud $
-   !! Software governed by the CeCILL licence (./LICENSE)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE iom_init( cdname ) 
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE   ***
-      !!
-      !! ** Purpose :   
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*), INTENT(in)  :: cdname
-      
-   END SUBROUTINE iom_init
-
-
-   SUBROUTINE iom_swap( cdname )
-      !!---------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_swap  ***
-      !!
-      !! ** Purpose :  swap context between different agrif grid for xmlio_server
-      !!---------------------------------------------------------------------
-      CHARACTER(len=*), INTENT(in) :: cdname
-      !
-   END SUBROUTINE iom_swap
-
-
-   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )
-      !!---------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_open  ***
-      !!
-      !! ** Purpose :  open an input file (return 0 if not found)
-      !!---------------------------------------------------------------------
-      CHARACTER(len=*), INTENT(in   )           ::   cdname   ! File name
-      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file
-      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.)
-      INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap)
-      INTEGER         , INTENT(in   ), OPTIONAL ::   kiolib   ! library used to open the file (default = jpnf90) 
-      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
-      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
-
-      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
-      CHARACTER(LEN=256)    ::   cltmpn    ! tempory name to store clname (in writting mode)
-      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" or ".dimg"
-      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits)
-      CHARACTER(LEN=256)    ::   clinfo    ! info character
-      LOGICAL               ::   llok      ! check the existence 
-      LOGICAL               ::   llwrt     ! local definition of ldwrt
-      LOGICAL               ::   llnoov    ! local definition to read overlap
-      LOGICAL               ::   llstop    ! local definition of ldstop
-      LOGICAL               ::   lliof     ! local definition of ldiof
-      INTEGER               ::   iolib     ! library do we use to open the file
-      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits)
-      INTEGER               ::   iln, ils  ! lengths of character
-      INTEGER               ::   idom      ! type of domain
-      INTEGER               ::   istop     ! 
-      INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters: 
-      ! local number of points for x,y dimensions
-      ! position of first local point for x,y dimensions
-      ! position of last local point for x,y dimensions
-      ! start halo size for x,y dimensions
-      ! end halo size for x,y dimensions
-      !---------------------------------------------------------------------
-      ! Initializations and control
-      ! =============
-      kiomid = -1
-      clinfo = '                    iom_open ~~~  '
-      istop = nstop
-      ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
-      ! (could be done when defining iom_file in f95 but not in f90)
-      IF( Agrif_Root() ) THEN
-         IF( iom_open_init == 0 ) THEN
-            iom_file(:)%nfid = 0
-            iom_open_init = 1
-         ENDIF
-      ENDIF
-      ! do we read or write the file?
-      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt
-      ELSE                        ;   llwrt = .FALSE.
-      ENDIF
-      ! do we call ctl_stop if we try to open a non-existing file in read mode?
-      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
-      ELSE                         ;   llstop = .TRUE.
-      ENDIF
-      ! what library do we use to open the file?
-      IF( PRESENT(kiolib) ) THEN   ;   iolib = kiolib
-      ELSE                         ;   iolib = jpnf90
-      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 
-      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
-      ! =============
-      clname   = trim(cdname)
-      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
-         iln    = INDEX(clname,'/') 
-         cltmpn = clname(1:iln)
-         clname = clname(iln+1:LEN_TRIM(clname))
-         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
-      ENDIF
-      ! which suffix should we use?
-      SELECT CASE (iolib)
-      CASE (jpnf90   ) ;   clsuffix = '.nc'
-      CASE DEFAULT     ;   clsuffix = ''
-      END SELECT
-      ! Add the suffix if needed
-      iln = LEN_TRIM(clname)
-      ils = LEN_TRIM(clsuffix)
-      IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 )   &
-         &   clname = TRIM(clname)//TRIM(clsuffix)
-      cltmpn = clname   ! store this name
-      ! try to find if the file to be opened already exist
-      ! =============
-      INQUIRE( FILE = clname, EXIST = llok )
-      IF( .NOT.llok ) THEN
-         ! we try to add the cpu number to the name
-            WRITE(clcpu,*) narea-1
-         clcpu  = TRIM(ADJUSTL(clcpu))
-         iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
-         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
-         icnt = 0
-         INQUIRE( FILE = clname, EXIST = llok ) 
-         ! we try different formats for the cpu number by adding 0
-         DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
-            clcpu  = "0"//trim(clcpu)
-            clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
-            INQUIRE( FILE = clname, EXIST = llok )
-            icnt = icnt + 1
-         END DO
-      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 or RSTDIMG file
-      ! =============
-      ! do we have some free file identifier?
-      IF( MINVAL(iom_file(:)%nfid) /= 0 )   &
-         &   CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
-      ! if no file was found...
-      IF( .NOT. llok ) THEN
-         IF( .NOT. llwrt ) THEN   ! we are in read mode 
-            IF( llstop ) THEN   ;   CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
-            ELSE                ;   istop = nstop + 1   ! make sure that istop /= nstop so we don't open the file
-            ENDIF
-         ELSE                     ! we are in write mode so we 
-            clname = cltmpn       ! get back the file name without the cpu number
-         ENDIF
-      ELSE
-         IF( llwrt .AND. .NOT. ln_clobber ) THEN   ! we stop as we want to write in a new file 
-            CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' )
-            istop = nstop + 1                      ! make sure that istop /= nstop so we don't open the file
-         ELSEIF( llwrt ) THEN     ! the file exists and we are in write mode with permission to 
-            clname = cltmpn       ! overwrite so get back the file name without the cpu number
-         ENDIF
-      ENDIF
-      IF( istop == nstop ) THEN   ! no error within this routine
-         SELECT CASE (iolib)
-         CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar )
-         CASE DEFAULT
-         END SELECT
-      ENDIF
-      !
-   END SUBROUTINE iom_open
-
-
-   SUBROUTINE iom_close( kiomid )
-      !!--------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_close  ***
-      !!
-      !! ** Purpose : close an input file, or all files opened by iom
-      !!--------------------------------------------------------------------
-      INTEGER, INTENT(inout), OPTIONAL ::   kiomid   ! iom identifier of the file to be closed
-      !                                              ! return 0 when file is properly closed
-      !                                              ! No argument: all files opened by iom are closed
-
-      INTEGER ::   jf         ! dummy loop indices
-      INTEGER ::   i_s, i_e   ! temporary integer
-      CHARACTER(LEN=100)    ::   clinfo    ! info character
-      !---------------------------------------------------------------------
-      !
-      clinfo = '                    iom_close ~~~  '
-      IF( PRESENT(kiomid) ) THEN
-         i_s = kiomid
-         i_e = kiomid
-      ELSE
-         i_s = 1
-         i_e = jpmax_files
-      ENDIF
-
-      IF( i_s > 0 ) THEN
-         DO jf = i_s, i_e
-            IF( iom_file(jf)%nfid > 0 ) THEN
-               SELECT CASE (iom_file(jf)%iolib)
-               CASE (jpnf90   )   ;   CALL iom_nf90_close(    jf )
-               CASE DEFAULT
-               END SELECT
-               iom_file(jf)%nfid       = 0          ! free the id 
-               IF( PRESENT(kiomid) )   kiomid = 0   ! return 0 as id to specify that the file was closed
-               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
-            ELSEIF( PRESENT(kiomid) ) THEN
-               WRITE(ctmp1,*) '--->',  kiomid
-               CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
-            ENDIF
-         END DO
-      ENDIF
-      !    
-   END SUBROUTINE iom_close
-
-
-   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )  
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  iom_varid  ***
-      !!
-      !! ** Purpose : get the id of a variable in a file (return 0 if not found)
-      !!-----------------------------------------------------------------------
-      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
-      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
-      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
-      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
-      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.)
-      !
-      INTEGER                        ::   iom_varid, iiv, i_nvd
-      LOGICAL                        ::   ll_fnd
-      CHARACTER(LEN=100)             ::   clinfo                   ! info character
-      LOGICAL                        ::   llstop                   ! local definition of ldstop
-      !!-----------------------------------------------------------------------
-      iom_varid = 0                         ! default definition
-      ! do we call ctl_stop if we look for non-existing variable?
-      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
-      ELSE                         ;   llstop = .TRUE.
-      ENDIF
-      !
-      IF( kiomid > 0 ) THEN
-         clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
-         IF( iom_file(kiomid)%nfid == 0 ) THEN 
-            CALL ctl_stop( trim(clinfo), 'the file is not open' )
-         ELSE
-            ll_fnd  = .FALSE.
-            iiv = 0
-            !
-            DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
-               iiv = iiv + 1
-               ll_fnd  = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
-            END DO
-            !
-            IF( .NOT.ll_fnd ) THEN
-               iiv = iiv + 1
-               IF( iiv <= jpmax_vars ) THEN
-                  SELECT CASE (iom_file(kiomid)%iolib)
-                  CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz, kndims )
-                  CASE DEFAULT   
-                  END SELECT
-               ELSE
-                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   &
-                        &                         'increase the parameter jpmax_vars')
-               ENDIF
-               IF( llstop .AND. iom_varid == -1 )   CALL ctl_stop( TRIM(clinfo)//' not found' ) 
-            ELSE
-               iom_varid = iiv
-               IF( PRESENT(kdimsz) ) THEN 
-                  i_nvd = iom_file(kiomid)%ndims(iiv)
-                  IF( i_nvd == size(kdimsz) ) THEN
-                     kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
-                  ELSE
-                     WRITE(ctmp1,*) i_nvd, size(kdimsz)
-                     CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
-                  ENDIF
-               ENDIF
-               IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv)
-            ENDIF
-         ENDIF
-      ENDIF
-      !
-   END FUNCTION iom_varid
-
-
-   !!----------------------------------------------------------------------
-   !!                   INTERFACE iom_get
-   !!----------------------------------------------------------------------
-   SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )
-      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
-      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
-      REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field
-      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number
-      !
-      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   !
-      !
-      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' )
-            SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar, itime )
-            CASE DEFAULT    
-            END SELECT
-         ENDIF
-      ENDIF
-   END SUBROUTINE iom_g0d
-
-   SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
-      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
-      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
-      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
-      REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field
-      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
-      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading 
-      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis
-      !
-      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 )
-      ENDIF
-   END SUBROUTINE iom_g1d
-
-   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
-      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)
-      !
-      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 )
-      ENDIF
-   END SUBROUTINE iom_g2d
-
-   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
-      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)
-      !
-      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 )
-      ENDIF
-   END SUBROUTINE iom_g3d
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   &
-         &                  pv_r1d, pv_r2d, pv_r3d,   &
-         &                  ktime , kstart, kcount,   &
-         &                  lrowattr                )
-      !!-----------------------------------------------------------------------
-      !!                  ***  ROUTINE  iom_get_123d  ***
-      !!
-      !! ** Purpose : read a 1D/2D/3D variable
-      !!
-      !! ** Method : read ONE record at each CALL
-      !!-----------------------------------------------------------------------
-      INTEGER                    , INTENT(in   )           ::   kiomid     ! Identifier of the file
-      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read
-      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable
-      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
-      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
-      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
-      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number
-      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis 
-      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis
-      LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to
-                                                                           ! look for and use a file attribute
-                                                                           ! called open_ocean_jstart to set the start
-                                                                           ! value for the 2nd dimension (netcdf only)
-      !
-      LOGICAL                        ::   llnoov      ! local definition to read overlap
-      LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute
-      INTEGER                        ::   jstartrow   ! start point for 2nd dimension optionally set by file attribute
-      INTEGER                        ::   jl          ! loop on number of dimension 
-      INTEGER                        ::   idom        ! type of domain
-      INTEGER                        ::   idvar       ! id of the variable
-      INTEGER                        ::   inbdim      ! number of dimensions of the variable
-      INTEGER                        ::   idmspc      ! number of spatial dimensions 
-      INTEGER                        ::   itime       ! record number
-      INTEGER                        ::   istop       ! temporary value of nstop
-      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes
-      INTEGER                        ::   ji, jj      ! loop counters
-      INTEGER                        ::   irankpv     ! 
-      INTEGER                        ::   ind1, ind2  ! substring index
-      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis
-      INTEGER, DIMENSION(jpmax_dims) ::   icnt        ! number of value to read along each axis 
-      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable
-      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable
-      REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset
-      INTEGER                        ::   itmp        ! temporary integer
-      CHARACTER(LEN=256)             ::   clinfo      ! info character
-      CHARACTER(LEN=256)             ::   clname      ! file name
-      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      ! 
-      !---------------------------------------------------------------------
-      !
-      clname = iom_file(kiomid)%name   !   esier to read
-      clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
-      ! local definition of the domain ?
-      idom = kdom
-      ! 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 
-      ! 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   ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown')
-
-      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( luse_jattr ) THEN
-         SELECT CASE (iom_file(kiomid)%iolib)
-         CASE (jpnf90   )   
-             ! Ok
-         CASE DEFAULT    
-         END SELECT
-      ENDIF
-
-      ! 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) 
-         inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file
-         idmspc = inbdim                                   ! number of spatial dimensions in the file
-         IF( iom_file(kiomid)%luld(idvar) )   idmspc = inbdim - 1
-         IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 
-         !
-         ! update idom definition...
-         ! Identify the domain in case of jpdom_auto(glo/dta) definition
-         IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN            
-            IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global 
-            ELSE                               ;   idom = jpdom_data
-            ENDIF
-            ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
-            ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
-            IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF
-         ENDIF
-         ! Identify the domain in case of jpdom_local definition
-         IF( idom == jpdom_local ) THEN
-            IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full
-            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra
-            ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap
-            ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )
-            ENDIF
-         ENDIF
-         !
-         ! check the consistency between input array and data rank in the file
-         !
-         ! initializations
-         itime = 1
-         IF( PRESENT(ktime) ) itime = ktime
-
-         irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) )
-         WRITE(clrankpv, fmt='(i1)') irankpv
-         WRITE(cldmspc , fmt='(i1)') idmspc
-         !
-         IF(     idmspc <  irankpv ) THEN 
-            CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
-               &                         'it is impossible to read a '//clrankpv//'D array from this file...' )
-         ELSEIF( idmspc == irankpv ) THEN
-            IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   &
-               &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
-         ELSEIF( idmspc >  irankpv ) THEN
-               IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
-                  CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   &
-                        &         'As the size of the z dimension is 1 and as we try to read the first record, ',   &
-                        &         'we accept this case, even if there is a possible mix-up between z and time dimension' )   
-                  idmspc = idmspc - 1
-               ELSE
-                  CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,'         ,   &
-                     &                         'we do not accept data with '//cldmspc//' spatial dimensions',   &
-                     &                         'Use ncwa -a to suppress the unnecessary dimensions' )
-               ENDIF
-         ENDIF
-
-         !
-         ! definition of istart and icnt
-         !
-         icnt  (:) = 1
-         istart(:) = 1
-         istart(idmspc+1) = itime
-
-         IF(              PRESENT(kstart)       ) 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) = jpkdta
-                     ELSE                            ; icnt(3) = jpk
-                     ENDIF
-                  ENDIF
-               ENDIF
-            ENDIF
-         ENDIF
-
-         ! check that istart and icnt can be used with this file
-         !-
-         DO jl = 1, jpmax_dims
-            itmp = istart(jl)+icnt(jl)-1
-            IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
-               WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
-               WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)"         ) jl, idimsz(jl)
-               CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )     
-            ENDIF
-         END DO
-
-         ! check that icnt matches the input array
-         !-     
-         IF( idom == jpdom_unknown ) THEN
-            IF( irankpv == 1 )        ishape(1:1) = SHAPE(pv_r1d)
-            IF( irankpv == 2 )        ishape(1:2) = SHAPE(pv_r2d)
-            IF( irankpv == 3 )        ishape(1:3) = SHAPE(pv_r3d)
-            ctmp1 = 'd'
-         ELSE
-            IF( irankpv == 2 ) THEN
-! JMM + SM: ugly patch before getting the new version of lib_mpp)
-!               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)'
-               IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
-               ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)'
-               ENDIF
-            ENDIF
-            IF( irankpv == 3 ) THEN 
-! JMM + SM: ugly patch before getting the new version of lib_mpp)
-!               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
-               IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
-               ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
-               ENDIF
-            ENDIF
-         ENDIF
-         
-         DO jl = 1, irankpv
-            WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
-            IF( ishape(jl) /= icnt(jl) )   CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
-         END DO
-
-      ENDIF
-
-      ! read the data
-      !-     
-      IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point...
-         !
-         ! find the right index of the array to be read
-! JMM + SM: ugly patch before getting the new version of lib_mpp)
-!         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
-!         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
-!         ENDIF
-         IF( llnoov ) THEN
-            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
-            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
-            ENDIF
-         ELSE
-            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj
-            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
-            ENDIF
-         ENDIF
-      
-         SELECT CASE (iom_file(kiomid)%iolib)
-         CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
-            &                                         pv_r1d, pv_r2d, pv_r3d )
-         CASE DEFAULT    
-         END SELECT
-
-         IF( istop == nstop ) THEN   ! no additional errors until this point...
-            IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
-          
-            !--- overlap areas and extra hallows (mpp)
-            IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
-               CALL lbc_lnk( 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) == jpk ) THEN
-                  CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
-               ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...)
-                  DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO
-                  DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO
-               ENDIF
-            ENDIF
-            
-            !--- Apply scale_factor and offset
-            zscf = iom_file(kiomid)%scf(idvar)      ! scale factor
-            zofs = iom_file(kiomid)%ofs(idvar)      ! offset
-            IF(     PRESENT(pv_r1d) ) THEN
-               IF( zscf /= 1. )   pv_r1d(:) = pv_r1d(:) * zscf 
-               IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs
-            ELSEIF( PRESENT(pv_r2d) ) THEN
-!CDIR COLLAPSE
-               IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
-!CDIR COLLAPSE
-               IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
-            ELSEIF( PRESENT(pv_r3d) ) THEN
-!CDIR COLLAPSE
-               IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
-!CDIR COLLAPSE
-               IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
-            ENDIF
-            !
-         ENDIF
-         !
-      ENDIF
-      !
-   END SUBROUTINE iom_get_123d
-
-
-   SUBROUTINE iom_gettime( kiomid, ptime, cdvar, kntime, cdunits, cdcalendar )
-      !!--------------------------------------------------------------------
-      !!                   ***  SUBROUTINE iom_gettime  ***
-      !!
-      !! ** Purpose : read the time axis cdvar in the file 
-      !!--------------------------------------------------------------------
-      INTEGER                    , INTENT(in   ) ::   kiomid     ! file Identifier
-      REAL(wp), DIMENSION(:)     , INTENT(  out) ::   ptime      ! the time axis
-      CHARACTER(len=*), OPTIONAL , INTENT(in   ) ::   cdvar      ! time axis name
-      INTEGER         , OPTIONAL , INTENT(  out) ::   kntime     ! number of times in file
-      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdunits    ! units attribute of time coordinate
-      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdcalendar ! calendar attribute of 
-      !
-      INTEGER, DIMENSION(1) :: kdimsz
-      INTEGER            ::   idvar    ! id of the variable
-      CHARACTER(LEN=32)  ::   tname    ! local name of time coordinate
-      CHARACTER(LEN=100) ::   clinfo   ! info character
-      !---------------------------------------------------------------------
-      !
-      IF ( PRESENT(cdvar) ) THEN
-         tname = cdvar
-      ELSE
-         tname = iom_file(kiomid)%uldname
-      ENDIF
-      IF( kiomid > 0 ) THEN
-         clinfo = 'iom_gettime, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(tname)
-         IF ( PRESENT(kntime) ) THEN
-            idvar  = iom_varid( kiomid, tname, kdimsz = kdimsz )
-            kntime = kdimsz(1)
-         ELSE
-            idvar = iom_varid( kiomid, tname )
-         ENDIF
-         !
-         ptime(:) = 0. ! default definition
-         IF( idvar > 0 ) THEN
-            IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN
-               IF( iom_file(kiomid)%luld(idvar) ) THEN
-                  IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN
-                     SELECT CASE (iom_file(kiomid)%iolib)
-                     CASE (jpnf90   )   ;   CALL iom_nf90_gettime(   kiomid, idvar, ptime, cdunits, cdcalendar )
-                     CASE DEFAULT    
-                     END SELECT
-                  ELSE
-                     WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar)
-                     CALL ctl_stop( trim(clinfo), trim(ctmp1) )
-                  ENDIF
-               ELSE
-                  CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' )
-               ENDIF
-            ELSE
-               CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' )
-            ENDIF
-         ELSE
-            CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name )
-         ENDIF
-      ENDIF
-      !
-   END SUBROUTINE iom_gettime
-
-
-   !!----------------------------------------------------------------------
-   !!                   INTERFACE iom_getatt
-   !!----------------------------------------------------------------------
-   SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar )
-      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
-      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
-      INTEGER         , INTENT(  out)                 ::   pvar      ! read field
-      !
-      IF( kiomid > 0 ) THEN
-         IF( iom_file(kiomid)%nfid > 0 ) THEN
-            SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar )
-            CASE DEFAULT    
-            END SELECT
-         ENDIF
-      ENDIF
-   END SUBROUTINE iom_g0d_intatt
-
-
-   !!----------------------------------------------------------------------
-   !!                   INTERFACE iom_rstput
-   !!----------------------------------------------------------------------
-   SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )
-      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
-      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
-      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
-      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
-      REAL(wp)        , INTENT(in)                         ::   pvar     ! written field
-      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
-      INTEGER :: ivid   ! variable id
-      IF( kiomid > 0 ) THEN
-         IF( iom_file(kiomid)%nfid > 0 ) THEN
-            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
-            SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
-            CASE DEFAULT     
-            END SELECT
-         ENDIF
-      ENDIF
-   END SUBROUTINE iom_rp0d
-
-   SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype )
-      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
-      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
-      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
-      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
-      REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field
-      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
-      INTEGER :: ivid   ! variable id
-      IF( kiomid > 0 ) THEN
-         IF( iom_file(kiomid)%nfid > 0 ) THEN
-            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
-            SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
-            CASE DEFAULT     
-            END SELECT
-         ENDIF
-      ENDIF
-   END SUBROUTINE iom_rp1d
-
-   SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype )
-      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
-      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
-      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
-      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
-      REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field
-      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
-      INTEGER :: ivid   ! variable id
-      IF( kiomid > 0 ) THEN
-         IF( iom_file(kiomid)%nfid > 0 ) THEN
-            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
-            SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
-            CASE DEFAULT     
-            END SELECT
-         ENDIF
-      ENDIF
-   END SUBROUTINE iom_rp2d
-
-   SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype )
-      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
-      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
-      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
-      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
-      REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field
-      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
-      INTEGER :: ivid   ! variable id
-      IF( kiomid > 0 ) THEN
-         IF( iom_file(kiomid)%nfid > 0 ) THEN
-            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
-            SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
-            CASE DEFAULT     
-            END SELECT
-         ENDIF
-      ENDIF
-   END SUBROUTINE iom_rp3d
-
-
-   !!----------------------------------------------------------------------
-   !!                   INTERFACE iom_put
-   !!----------------------------------------------------------------------
-   SUBROUTINE iom_p0d( cdname, pfield0d )
-      CHARACTER(LEN=*), INTENT(in) ::   cdname
-      REAL(wp)        , INTENT(in) ::   pfield0d
-      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
-      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings
-   END SUBROUTINE iom_p0d
-
-   SUBROUTINE iom_p1d( cdname, pfield1d )
-      CHARACTER(LEN=*)          , INTENT(in) ::   cdname
-      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d
-      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings
-   END SUBROUTINE iom_p1d
-
-   SUBROUTINE iom_p2d( cdname, pfield2d )
-      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
-      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
-      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings
-   END SUBROUTINE iom_p2d
-
-   SUBROUTINE iom_p3d( cdname, pfield3d )
-      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
-      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
-      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings
-   END SUBROUTINE iom_p3d
-   !!----------------------------------------------------------------------
-
-
-
-   SUBROUTINE iom_setkt( kt, cdname )
-      INTEGER         , INTENT(in)::   kt 
-      CHARACTER(LEN=*), INTENT(in) ::   cdname
-      IF( .FALSE. )   WRITE(numout,*) kt, cdname   ! useless test to avoid compilation warnings
-   END SUBROUTINE iom_setkt
-
-   SUBROUTINE iom_context_finalize( cdname )
-      CHARACTER(LEN=*), INTENT(in) ::   cdname
-      IF( .FALSE. )   WRITE(numout,*)  cdname   ! useless test to avoid compilation warnings
-   END SUBROUTINE iom_context_finalize
-
-
-   LOGICAL FUNCTION iom_use( cdname )
-      CHARACTER(LEN=*), INTENT(in) ::   cdname
-      iom_use = .FALSE.
-   END FUNCTION iom_use
-   
-   !!======================================================================
-END MODULE iom
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom_def.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom_def.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom_def.F90	(revision 12101)
@@ -0,0 +1,84 @@
+MODULE iom_def
+   !!======================================================================
+   !!                    ***  MODULE  iom_def ***
+   !! IOM variables definitions
+   !!======================================================================
+   !! History :  9.0  ! 2006 09  (S. Masson) Original code
+   !!             -   ! 2007 07  (D. Storkey) Add uldname
+   !!            4.0  ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields
+   !!----------------------------------------------------------------------
+   USE par_kind
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpiglo, 1  :jpjglo)    !!gm to be suppressed
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 2   !: ( 1  :jpiglo, 1  :jpjglo)
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 3   !: One of the 3 following cases
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_full    = 4   !: ( 1  :jpi   , 1  :jpi   )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noextra = 5   !: ( 1  :nlci  , 1  :nlcj  )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noovlap = 6   !: (nldi:nlei  ,nldj:nlej  )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 7   !: No dimension checking
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo       = 8   !: 
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo_xy    = 9   !: Automatically set horizontal dimensions only
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autodta       = 10  !: 
+
+   INTEGER, PARAMETER, PUBLIC ::   jp_r8    = 200      !: write REAL(8)
+   INTEGER, PARAMETER, PUBLIC ::   jp_r4    = 201      !: write REAL(4)
+   INTEGER, PARAMETER, PUBLIC ::   jp_i4    = 202      !: write INTEGER(4)
+   INTEGER, PARAMETER, PUBLIC ::   jp_i2    = 203      !: write INTEGER(2)
+   INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1)
+
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100  !: maximum number of simultaneously opened file
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 1200 !: maximum number of variables in one file
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name
+
+
+!$AGRIF_DO_NOT_TREAT
+   INTEGER, PUBLIC            ::   iom_open_init = 0   !: used to initialize iom_file(:)%nfid to 0
+!XIOS write restart   
+   LOGICAL, PUBLIC            ::   lwxios          !: write single file restart using XIOS
+   INTEGER, PUBLIC            ::   nxioso          !: type of restart file when writing using XIOS 1 - single, 2 - multiple
+!XIOS read restart   
+   LOGICAL, PUBLIC            ::   lrxios          !: read single file restart using XIOS
+   LOGICAL, PUBLIC            ::   lxios_sini = .FALSE. ! is restart in a single file
+   LOGICAL, PUBLIC            ::   lxios_set  = .FALSE. 
+
+
+
+   TYPE, PUBLIC ::   file_descriptor
+      CHARACTER(LEN=240)                        ::   name     !: name of the file
+      INTEGER                                   ::   nfid     !: identifier of the file (0 if closed)
+                                                              !: jpioipsl option has been removed)
+      INTEGER                                   ::   nvars    !: number of identified varibles in the file
+      INTEGER                                   ::   iduld    !: id of the unlimited dimension
+      INTEGER                                   ::   lenuld   !: length of the unlimited dimension (number of records in file)
+      INTEGER                                   ::   irec     !: writing record position  
+      CHARACTER(LEN=32)                         ::   uldname  !: name of the unlimited dimension
+      CHARACTER(LEN=32), DIMENSION(jpmax_vars)  ::   cn_var   !: names of the variables
+      INTEGER, DIMENSION(jpmax_vars)            ::   nvid     !: id of the variables
+      INTEGER, DIMENSION(jpmax_vars)            ::   ndims    !: number of dimensions of the variables
+      LOGICAL, DIMENSION(jpmax_vars)            ::   luld     !: variable using the unlimited dimension
+      INTEGER, DIMENSION(jpmax_dims,jpmax_vars) ::   dimsz    !: size of variables dimensions 
+      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables
+      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables
+      INTEGER                                   ::   nlev     ! number of vertical levels
+   END TYPE file_descriptor
+   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files
+   INTEGER, PARAMETER, PUBLIC                   :: max_rst_fields = 95 !: maximum number of restart variables defined in iom_set_rst_vars
+   TYPE, PUBLIC :: RST_FIELD  
+    CHARACTER(len=30) :: vname = "NO_NAME" ! names of variables in restart file
+    CHARACTER(len=30) :: grid = "NO_GRID"
+    LOGICAL           :: active =.FALSE. ! for restart write only: true - write field, false do not write field
+   END TYPE RST_FIELD
+!$AGRIF_END_DO_NOT_TREAT
+   !
+   TYPE(RST_FIELD), PUBLIC, SAVE :: rst_wfields(max_rst_fields), rst_rfields(max_rst_fields)
+   !
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: iom_def.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!======================================================================
+END MODULE iom_def
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom_def.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom_def.f90	(revision 12100)
+++ 	(revision )
@@ -1,71 +1,0 @@
-MODULE iom_def
-   !!=====================================================================
-   !!                    ***  MODULE  iom_def ***
-   !! IOM variables definitions
-   !!====================================================================
-   !! History :  9.0  ! 06 09  (S. Masson) Original code
-   !!             "   ! 07 07  (D. Storkey) Add uldname
-   !!--------------------------------------------------------------------
-   !!---------------------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: iom_def.F90 6140 2015-12-21 11:35:23Z timgraham $
-   !! Software governed by the CeCILL licence (./LICENSE)
-   !!---------------------------------------------------------------------------------
-
-   USE par_kind
-
-   IMPLICIT NONE
-   PRIVATE
-
-   INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpidta, 1  :jpjdta)
-   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 ::   jpnf90      = 101      !: Use nf90 library
-
-   INTEGER, PARAMETER, PUBLIC ::   jprstlib  = jpnf90     !: restarts io library
-
-   INTEGER, PARAMETER, PUBLIC ::   jp_r8    = 200      !: write REAL(8)
-   INTEGER, PARAMETER, PUBLIC ::   jp_r4    = 201      !: write REAL(4)
-   INTEGER, PARAMETER, PUBLIC ::   jp_i4    = 202      !: write INTEGER(4)
-   INTEGER, PARAMETER, PUBLIC ::   jp_i2    = 203      !: write INTEGER(2)
-   INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1)
-
-   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100   !: maximum number of simultaneously opened file
-   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 600  !: maximum number of variables in one file
-   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable
-   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name
-
-!$AGRIF_DO_NOT_TREAT
-   INTEGER, PUBLIC            ::   iom_open_init = 0   !: used to initialize iom_file(:)%nfid to 0
-
-   TYPE, PUBLIC ::   file_descriptor
-      CHARACTER(LEN=240)                        ::   name     !: name of the file
-      INTEGER                                   ::   nfid     !: identifier of the file (0 if closed)
-      INTEGER                                   ::   iolib    !: library used to read the file (jpnf90 or new formats,
-                                                              !: jpioipsl option has been removed)
-      INTEGER                                   ::   nvars    !: number of identified varibles in the file
-      INTEGER                                   ::   iduld    !: id of the unlimited dimension
-      INTEGER                                   ::   lenuld   !: length of the unlimited dimension (number of records in file)
-      INTEGER                                   ::   irec     !: writing record position  
-      CHARACTER(LEN=32)                         ::   uldname  !: name of the unlimited dimension
-      CHARACTER(LEN=32), DIMENSION(jpmax_vars)  ::   cn_var   !: names of the variables
-      INTEGER, DIMENSION(jpmax_vars)            ::   nvid     !: id of the variables
-      INTEGER, DIMENSION(jpmax_vars)            ::   ndims    !: number of dimensions of the variables
-      LOGICAL, DIMENSION(jpmax_vars)            ::   luld     !: variable using the unlimited dimension
-      INTEGER, DIMENSION(jpmax_dims,jpmax_vars) ::   dimsz    !: size of variables dimensions 
-      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables
-      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables
-   END TYPE file_descriptor
-   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files
-!$AGRIF_END_DO_NOT_TREAT
-
-   !!=====================================================================
-END MODULE iom_def
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom_nf90.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom_nf90.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom_nf90.F90	(revision 12101)
@@ -0,0 +1,740 @@
+MODULE iom_nf90
+   !!======================================================================
+   !!                    ***  MODULE  iom_nf90 ***
+   !! Input/Output manager :  Library to read input files with NF90 (only fliocom module)
+   !!======================================================================
+   !! History :  9.0  ! 05 12  (J. Belier) Original code
+   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO
+   !!             "   ! 07 07  (D. Storkey) Changes to iom_nf90_gettime
+   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes
+   !!            4.0  ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iom_open       : open a file read only
+   !!   iom_close      : close a file or all files opened by iom
+   !!   iom_get        : read a field (interfaced to several routines)
+   !!   iom_varid      : get the id of a variable in a file
+   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+   USE netcdf          ! NetCDF library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC iom_nf90_open  , iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_rstput
+   PUBLIC iom_nf90_chkatt, iom_nf90_getatt, iom_nf90_putatt
+
+   INTERFACE iom_nf90_get
+      MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d
+   END INTERFACE
+   INTERFACE iom_nf90_rstput
+      MODULE PROCEDURE iom_nf90_rp0123d
+   END INTERFACE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: iom_nf90.F90 10522 2019-01-16 08:35:15Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose : open an input file with NF90
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
+      INTEGER                , INTENT(  out)           ::   kiomid      ! nf90 identifier of the opened file
+      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file?
+      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
+      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
+      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the third dimension
+
+      CHARACTER(LEN=256) ::   clinfo           ! info character
+      CHARACTER(LEN=256) ::   cltmp            ! temporary character
+      INTEGER            ::   iln              ! lengths of character
+      INTEGER            ::   istop            ! temporary storage of nstop
+      INTEGER            ::   if90id           ! nf90 identifier of the opened file
+      INTEGER            ::   idmy             ! dummy variable
+      INTEGER            ::   jl               ! loop variable
+      INTEGER            ::   ichunk           ! temporary storage of nn_chunksz
+      INTEGER            ::   imode            ! creation mode flag: NF90_CLOBBER or NF90_NOCLOBBER or NF90_HDF5
+      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5
+      LOGICAL            ::   llclobber        ! local definition of ln_clobber
+      INTEGER            ::   ilevels           ! vertical levels
+      !---------------------------------------------------------------------
+      !
+      clinfo = '                    iom_nf90_open ~~~  '
+      istop = nstop     ! store the actual value of nstop
+      !
+      !                 !number of vertical levels
+      IF( PRESENT(kdlev) ) THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice)
+      ELSE                        ;   ilevels = jpk      ! by default jpk
+      ENDIF
+      !
+      IF( nn_chunksz > 0 ) THEN   ;   ichunk = nn_chunksz
+      ELSE                        ;   ichunk = NF90_SIZEHINT_DEFAULT
+      ENDIF
+      !
+      llclobber = ldwrt .AND. ln_clobber
+      IF( ldok .AND. .NOT. llclobber ) THEN      !==  Open existing file ==!
+         !                                       !=========================!
+         IF( ldwrt ) THEN  ! ... in write mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode'
+            IF( snc4set%luse ) THEN
+               CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id ), clinfo)
+            ELSE
+               CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id, chunksize = ichunk ), clinfo)
+            ENDIF
+            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy                          ), clinfo)
+         ELSE              ! ... in read mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
+            CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo)
+         ENDIF
+      ELSE                                       !== the file doesn't exist ==!   (or we overwrite it)
+         !                                       !============================!
+         iln = INDEX( cdname, '.nc' )
+         IF( ldwrt ) THEN              !* the file should be open in write mode so we create it...
+            IF( jpnij > 1 ) THEN
+               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc'
+               cdname = TRIM(cltmp)
+            ENDIF
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in WRITE mode'
+
+            IF( llclobber ) THEN   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_CLOBBER   )
+            ELSE                   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 
+            ENDIF
+            IF( snc4set%luse ) THEN
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' creating file: '//TRIM(cdname)//' in hdf5 (netcdf4) mode'
+               CALL GET_NF90_SYMBOL("NF90_HDF5", ihdf5)
+               IF( llclobber ) THEN   ;   imode = IOR(ihdf5, NF90_CLOBBER)
+               ELSE                   ;   imode = IOR(ihdf5, NF90_NOCLOBBER)
+               ENDIF
+               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id ), clinfo)
+            ELSE
+               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id, chunksize = ichunk ), clinfo)
+            ENDIF
+            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL,                   idmy ), clinfo)
+            ! define dimensions
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo)
+            IF( PRESENT(kdlev) )   &
+               CALL iom_nf90_check(NF90_DEF_DIM( if90id,    'numcat',          kdlev, idmy ), clinfo)
+            ! global attributes
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , kdompar(:,1)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , kdompar(:,2)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , kdompar(:,3)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', kdompar(:,4)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , kdompar(:,5)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ), clinfo)
+         ELSE                          !* the file should be open for read mode so it must exist...
+            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
+         ENDIF
+      ENDIF
+      !
+      ! start to fill file informations
+      ! =============
+      IF( istop == nstop ) THEN   ! no error within this routine
+!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
+         kiomid = 0
+         DO jl = jpmax_files, 1, -1
+            IF( iom_file(jl)%nfid == 0 )   kiomid = jl
+         ENDDO
+         iom_file(kiomid)%name   = TRIM(cdname)
+         iom_file(kiomid)%nfid   = if90id
+         iom_file(kiomid)%nvars  = 0
+         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode 
+         iom_file(kiomid)%nlev   = ilevels
+         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo)
+         IF( iom_file(kiomid)%iduld .GE. 0 ) THEN
+            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,    & 
+               &                                       name = iom_file(kiomid)%uldname,   &
+               &                                       len  = iom_file(kiomid)%lenuld ), clinfo )
+         ENDIF
+         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK'
+      ELSE
+         kiomid = 0               ! return error flag
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_open
+
+
+   SUBROUTINE iom_nf90_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_nf90_close  ***
+      !!
+      !! ** Purpose : close an input file with NF90
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
+      CHARACTER(LEN=100)  ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      clinfo = '      iom_nf90_close    , file: '//TRIM(iom_file(kiomid)%name)
+      CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo)
+   END SUBROUTINE iom_nf90_close
+
+
+   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_varid  ***
+      !!
+      !! ** Purpose : get the id of a variable in a file with NF90
+      !!-----------------------------------------------------------------------
+      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
+      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
+      INTEGER              , INTENT(in   )           ::   kiv   ! 
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
+      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
+      !
+      INTEGER                        ::   iom_nf90_varid   ! iom variable Id
+      INTEGER                        ::   if90id           ! nf90 file identifier
+      INTEGER                        ::   ji               ! dummy loop index
+      INTEGER                        ::   ivarid           ! NetCDF  variable Id
+      INTEGER                        ::   i_nvd            ! number of dimension of the variable
+      INTEGER, DIMENSION(jpmax_dims) ::   idimid           ! dimension ids of the variable
+      LOGICAL                        ::   llok             ! ok  test
+      CHARACTER(LEN=100)             ::   clinfo           ! info character
+      !!-----------------------------------------------------------------------
+      clinfo = '          iom_nf90_varid, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      iom_nf90_varid = 0                    ! default definition
+      IF( PRESENT(kdimsz) ) kdimsz(:) = 0   ! default definition
+      if90id = iom_file(kiomid)%nfid        ! get back NetCDF file id
+      !
+      llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! does the variable exist in the file
+      IF( llok ) THEN
+         iom_nf90_varid = kiv
+         iom_file(kiomid)%nvars       = kiv
+         iom_file(kiomid)%nvid(kiv)   = ivarid
+         iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar)
+         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, ndims = i_nvd), clinfo)   ! number of dimensions
+         iom_file(kiomid)%ndims(kiv)  = i_nvd
+         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids
+         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value
+         iom_file(kiomid)%dimsz(:,kiv) = 0      ! reset dimsz in case previously used
+         DO ji = 1, i_nvd                       ! dimensions size
+            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)   
+            IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension? 
+         END DO
+         !---------- Deal with scale_factor and add_offset
+         llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr
+         IF( llok) THEN
+            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'scale_factor', iom_file(kiomid)%scf(kiv)), clinfo)
+         ELSE
+            iom_file(kiomid)%scf(kiv) = 1.
+         END IF
+         llok = NF90_Inquire_attribute(if90id, ivarid, 'add_offset') == nf90_noerr
+         IF( llok ) THEN
+            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', iom_file(kiomid)%ofs(kiv)), clinfo)
+         ELSE
+            iom_file(kiomid)%ofs(kiv) = 0.
+         END IF
+         ! return the simension size
+         IF( PRESENT(kdimsz) ) THEN 
+            IF( i_nvd <= SIZE(kdimsz) ) THEN
+               kdimsz(1:i_nvd) = iom_file(kiomid)%dimsz(1:i_nvd,kiv)
+            ELSE
+               WRITE(ctmp1,*) i_nvd, SIZE(kdimsz)
+               CALL ctl_stop( TRIM(clinfo), 'error in kdimsz size'//TRIM(ctmp1) )
+            ENDIF
+         ENDIF
+         IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(kiv)
+      ELSE  
+         iom_nf90_varid = -1   !   variable not found, return error code: -1
+      ENDIF
+      !
+   END FUNCTION iom_nf90_varid
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_nf90_get
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar, kstart )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_g0d  ***
+      !!
+      !! ** Purpose : read a scalar with NF90
+      !!-----------------------------------------------------------------------
+      INTEGER ,               INTENT(in   )            ::   kiomid   ! Identifier of the file
+      INTEGER ,               INTENT(in   )            ::   kvid     ! variable id
+      REAL(wp),               INTENT(  out)            ::   pvar     ! read field
+      INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart   ! start position of the reading in each axis
+      !
+      CHARACTER(LEN=100)      ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo )
+   END SUBROUTINE iom_nf90_g0d
+
+
+   SUBROUTINE iom_nf90_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   &
+         &                    pv_r1d, pv_r2d, pv_r3d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_g123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable with NF90
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid    ! iom identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kvid      ! Name of the variable
+      INTEGER                    , INTENT(in   )           ::   knbdim    ! number of dimensions of the variable
+      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart    ! start position of the reading in each axis 
+      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis
+      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes
+      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case)
+      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case)
+      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case)
+      !
+      CHARACTER(LEN=100) ::   clinfo               ! info character
+      INTEGER            ::   if90id               ! nf90 identifier of the opened file
+      INTEGER            ::   ivid                 ! nf90 variable id
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_g123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      if90id = iom_file(kiomid)%nfid         ! get back NetCDF file id
+      ivid   = iom_file(kiomid)%nvid(kvid)   ! get back NetCDF var id
+      !
+      IF(     PRESENT(pv_r1d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r1d(:                ), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ELSEIF( PRESENT(pv_r2d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ELSEIF( PRESENT(pv_r3d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_g123d
+
+
+   SUBROUTINE iom_nf90_chkatt( kiomid, cdatt, llok, ksize, cdvar )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_chkatt  ***
+      !!
+      !! ** Purpose : check existence of attribute with NF90
+      !!              (either a global attribute (default) or a variable
+      !!               attribute if optional variable name is supplied (cdvar))
+      !!-----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
+      LOGICAL         , INTENT(  out) ::   llok     ! error code
+      INTEGER         , INTENT(  out), OPTIONAL     &
+                      &               ::   ksize    ! attribute size
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL     &
+                      &               ::   cdvar    ! name of the variable
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   isize    ! temporary integer
+      INTEGER                         ::   ivarid   ! NetCDF variable Id
+      !---------------------------------------------------------------------
+      !
+      if90id = iom_file(kiomid)%nfid
+      IF( PRESENT(cdvar) ) THEN
+         ! check the variable exists in the file
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr
+         IF( llok ) &
+            ! check the variable has the attribute required
+            llok = NF90_Inquire_attribute(if90id, ivarid, cdatt, len=isize ) == nf90_noerr
+      ELSE
+         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt, len=isize ) == nf90_noerr
+      ENDIF
+      !
+      IF( PRESENT(ksize) ) ksize = isize
+      !
+      IF( .not. llok) &
+         CALL ctl_warn('iom_nf90_chkatt: no attribute '//cdatt//' found')
+      !
+   END SUBROUTINE iom_nf90_chkatt
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_nf90_getatt
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_nf90_getatt( kiomid, cdatt, katt0d, katt1d, patt0d, patt1d, cdatt0d, cdvar)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_getatt  ***
+      !!
+      !! ** Purpose : read an attribute with NF90
+      !!              (either a global attribute (default) or a variable
+      !!               attribute if optional variable name is supplied (cdvar))
+      !!-----------------------------------------------------------------------
+      INTEGER               , INTENT(in   )           ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt    ! attribute name
+      INTEGER               , INTENT(  out), OPTIONAL ::   katt0d   ! read scalar integer
+      INTEGER, DIMENSION(:) , INTENT(  out), OPTIONAL ::   katt1d   ! read 1d array integer
+      REAL(wp)              , INTENT(  out), OPTIONAL ::   patt0d   ! read scalar  real
+      REAL(wp), DIMENSION(:), INTENT(  out), OPTIONAL ::   patt1d   ! read 1d array real
+      CHARACTER(len=*)      , INTENT(  out), OPTIONAL ::   cdatt0d  ! read character
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar    ! name of the variable
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   ivarid   ! NetCDF variable Id
+      LOGICAL                         ::   llok     ! temporary logical
+      CHARACTER(LEN=100)              ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      if90id = iom_file(kiomid)%nfid
+      IF( PRESENT(cdvar) ) THEN
+         ! check the variable exists in the file
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr
+         IF( llok ) THEN
+            ! check the variable has the attribute required
+            llok = NF90_Inquire_attribute(if90id, ivarid, cdatt) == nf90_noerr
+         ELSE
+            CALL ctl_warn('iom_nf90_getatt: no variable '//TRIM(cdvar)//' found')
+         ENDIF
+      ELSE
+         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr
+         ivarid = NF90_GLOBAL
+      ENDIF
+      !
+      IF( llok) THEN
+         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt)
+         IF(PRESENT( katt0d))   CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values =  katt0d), clinfo)
+         IF(PRESENT( katt1d))   CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values =  katt1d), clinfo)
+         IF(PRESENT( patt0d))   CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values =  patt0d), clinfo)
+         IF(PRESENT( patt1d))   CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values =  patt1d), clinfo)
+         IF(PRESENT(cdatt0d))   CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values = cdatt0d), clinfo)
+      ELSE
+         CALL ctl_warn('iom_nf90_getatt: no attribute '//TRIM(cdatt)//' found')
+         IF(PRESENT( katt0d))    katt0d    = -999
+         IF(PRESENT( katt1d))    katt1d(:) = -999
+         IF(PRESENT( patt0d))    patt0d    = -999._wp
+         IF(PRESENT( patt1d))    patt1d(:) = -999._wp
+         IF(PRESENT(cdatt0d))   cdatt0d    = '!'
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_getatt
+
+
+   SUBROUTINE iom_nf90_putatt( kiomid, cdatt, katt0d, katt1d, patt0d, patt1d, cdatt0d, cdvar)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_putatt  ***
+      !!
+      !! ** Purpose : write an attribute with NF90
+      !!              (either a global attribute (default) or a variable
+      !!               attribute if optional variable name is supplied (cdvar))
+      !!-----------------------------------------------------------------------
+      INTEGER               , INTENT(in   )           ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt    ! attribute name
+      INTEGER               , INTENT(in   ), OPTIONAL ::   katt0d   ! read scalar integer
+      INTEGER, DIMENSION(:) , INTENT(in   ), OPTIONAL ::   katt1d   ! read 1d array integer
+      REAL(wp)              , INTENT(in   ), OPTIONAL ::   patt0d   ! read scalar  real
+      REAL(wp), DIMENSION(:), INTENT(in   ), OPTIONAL ::   patt1d   ! read 1d array real
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdatt0d  ! read character
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar    ! name of the variable
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   ivarid   ! NetCDF variable Id
+      INTEGER                         ::   isize    ! Attribute size
+      INTEGER                         ::   itype    ! Attribute type
+      LOGICAL                         ::   llok     ! temporary logical
+      LOGICAL                         ::   llatt     ! temporary logical
+      LOGICAL                         ::   lldata   ! temporary logical
+      CHARACTER(LEN=100)              ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      if90id = iom_file(kiomid)%nfid
+      IF( PRESENT(cdvar) ) THEN
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! is the variable in the file?
+         IF( .NOT. llok ) THEN
+            CALL ctl_warn('iom_nf90_putatt: no variable '//TRIM(cdvar)//' found'   &
+               &        , '                 no attribute '//cdatt//' written' )
+            RETURN
+         ENDIF
+      ELSE
+         ivarid = NF90_GLOBAL
+      ENDIF
+      llatt = NF90_Inquire_attribute(if90id, ivarid, cdatt, len = isize, xtype = itype ) == nf90_noerr
+      !
+      ! trick: irec used to know if the file is in define mode or not
+      lldata = iom_file(kiomid)%irec /= -1   ! default: go back in define mode if in data mode
+      IF( lldata .AND. llatt ) THEN          ! attribute already there. Do we really need to go back in define mode?
+         ! do we have the appropriate type?
+         IF(PRESENT( katt0d) .OR. PRESENT( katt1d))   llok = itype == NF90_INT
+         IF(PRESENT( patt0d) .OR. PRESENT( patt1d))   llok = itype == NF90_DOUBLE
+         IF(PRESENT(cdatt0d)                      )   llok = itype == NF90_CHAR
+         ! and do we have the appropriate size?
+         IF(PRESENT( katt0d))   llok = llok .AND. isize == 1
+         IF(PRESENT( katt1d))   llok = llok .AND. isize == SIZE(katt1d)
+         IF(PRESENT( patt0d))   llok = llok .AND. isize == 1
+         IF(PRESENT( patt1d))   llok = llok .AND. isize == SIZE(patt1d)
+         IF(PRESENT(cdatt0d))   llok = llok .AND. isize == LEN_TRIM(cdatt0d)
+         !
+         lldata = .NOT. llok
+      ENDIF
+      !
+      clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt)
+      IF(lldata)   CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ! leave data mode to define mode
+      !
+      IF(PRESENT( katt0d))   CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values =       katt0d) , clinfo)
+      IF(PRESENT( katt1d))   CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values =       katt1d) , clinfo)
+      IF(PRESENT( patt0d))   CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values =       patt0d) , clinfo)
+      IF(PRESENT( patt1d))   CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values =       patt1d) , clinfo)
+      IF(PRESENT(cdatt0d))   CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values = trim(cdatt0d)), clinfo)
+      !
+      IF(lldata)   CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo)   ! leave define mode to data mode
+      !
+   END SUBROUTINE iom_nf90_putatt
+
+
+   SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   &
+         &                                  pv_r0d, pv_r1d, pv_r2d, pv_r3d )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_nf90_rstput  ***
+      !!
+      !! ** Purpose : read the time axis cdvar in the file 
+      !!--------------------------------------------------------------------
+      INTEGER                     , INTENT(in)           ::   kt       ! ocean time-step
+      INTEGER                     , INTENT(in)           ::   kwrite   ! writing time-step
+      INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
+      INTEGER                     , INTENT(in)           ::   kvid     ! variable id
+      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
+      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
+      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
+      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
+      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
+      !
+      INTEGER               :: idims                ! number of dimension
+      INTEGER               :: idvar                ! variable id
+      INTEGER               :: jd                   ! dimension loop counter   
+      INTEGER               :: ix1, ix2, iy1, iy2   ! subdomain indexes   
+      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size  
+      INTEGER, DIMENSION(4) :: idimid               ! dimensions id
+      CHARACTER(LEN=256)    :: clinfo               ! info character
+      CHARACTER(LEN= 12), DIMENSION(5) :: cltmp     ! temporary character
+      INTEGER               :: if90id               ! nf90 file identifier
+      INTEGER               :: idmy                 ! dummy variable
+      INTEGER               :: itype                ! variable type
+      INTEGER, DIMENSION(4) :: ichunksz             ! NetCDF4 chunk sizes. Will be computed using
+      !                                             ! nn_nchunks_[i,j,k,t] namelist parameters
+      INTEGER               :: ichunkalg, ishuffle, ideflate, ideflate_level
+      !                                             ! NetCDF4 internally fixed parameters
+      LOGICAL               :: lchunk               ! logical switch to activate chunking and compression
+      !                                             ! when appropriate (currently chunking is applied to 4d fields only)
+      INTEGER               :: idlv                 ! local variable
+      INTEGER               :: idim3                ! id of the third dimension
+      !
+      INTEGER ::   nldi_save, nlei_save    !:patch before we remove periodicity and close boundaries in output files
+      INTEGER ::   nldj_save, nlej_save    !:
+      !---------------------------------------------------------------------
+      !
+      clinfo = '          iom_nf90_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      if90id = iom_file(kiomid)%nfid
+      !
+      ! use patch to force the writing off periodicity and close boundaries
+      ! without this, issue in some model decomposition
+      ! seb: patch before we remove periodicity and close boundaries in output files
+      nldi_save = nldi   ;   nlei_save = nlei
+      nldj_save = nldj   ;   nlej_save = nlej
+      IF( nimpp           ==      1 ) nldi = 1
+      IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi
+      IF( njmpp           ==      1 ) nldj = 1
+      IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj
+      !
+      ! define dimension variables if it is not already done
+      ! ==========================
+      IF( iom_file(kiomid)%nvars == 0 ) THEN
+         ! are we in define mode?
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
+         ENDIF
+         ! define the dimension variables if it is not already done
+         ! Warning: we must use the same character length in an array constructor (at least for gcc compiler)
+         cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter', 'numcat      ' /)   
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3    /), iom_file(kiomid)%nvid(3) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4    /), iom_file(kiomid)%nvid(4) ), clinfo)
+         ! update informations structure related the dimension variable we just added...
+         iom_file(kiomid)%nvars       = 4
+         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
+         iom_file(kiomid)%cn_var(1:4) = cltmp(1:4)
+         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /)
+         IF( NF90_INQ_DIMID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN   ! add a 5th variable corresponding to the 5th dimension
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(5)), NF90_FLOAT , (/ 5 /), iom_file(kiomid)%nvid(5) ), clinfo)
+            iom_file(kiomid)%nvars     = 5
+            iom_file(kiomid)%luld(5)   = .FALSE.
+            iom_file(kiomid)%cn_var(5) = cltmp(5)
+            iom_file(kiomid)%ndims(5)  = 1
+         ENDIF
+         ! trick: defined to 0 to say that dimension variables are defined but not yet written
+         iom_file(kiomid)%dimsz(1, 1)  = 0   
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
+      ENDIF
+      ! define the data if it is not already done
+      ! ===============
+      IF( kvid <= 0 ) THEN
+         !
+         ! NetCDF4 chunking and compression fixed settings
+         ichunkalg = 0
+         ishuffle = 1
+         ideflate = 1
+         ideflate_level = 1
+         !
+         idvar = iom_file(kiomid)%nvars + 1
+         ! are we in define mode?
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
+         ENDIF
+         ! variable definition
+         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0
+         ELSEIF( PRESENT(pv_r1d) ) THEN
+            IF( SIZE(pv_r1d,1) == jpk ) THEN   ;   idim3 = 3
+            ELSE                               ;   idim3 = 5
+            ENDIF
+                                              idims = 2   ;   idimid(1:idims) = (/idim3,4/)
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/)
+         ELSEIF( PRESENT(pv_r3d) ) THEN
+            IF( SIZE(pv_r3d,3) == jpk ) THEN   ;   idim3 = 3
+            ELSE                               ;   idim3 = 5
+            ENDIF
+                                              idims = 4   ;   idimid(1:idims) = (/1,2,idim3,4/)
+         ENDIF
+         IF( PRESENT(ktype) ) THEN   ! variable external type
+            SELECT CASE (ktype)
+            CASE (jp_r8)   ;   itype = NF90_DOUBLE
+            CASE (jp_r4)   ;   itype = NF90_FLOAT
+            CASE (jp_i4)   ;   itype = NF90_INT
+            CASE (jp_i2)   ;   itype = NF90_SHORT
+            CASE (jp_i1)   ;   itype = NF90_BYTE
+            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo)//' unknown variable type' )
+            END SELECT
+         ELSE
+            itype = NF90_DOUBLE
+         ENDIF
+         IF( PRESENT(pv_r0d) ) THEN
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype,                    &
+               &                              iom_file(kiomid)%nvid(idvar) ), clinfo )
+         ELSE
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, idimid(1:idims),   &
+               &                              iom_file(kiomid)%nvid(idvar) ), clinfo )
+         ENDIF
+         lchunk = .false.
+         IF( snc4set%luse .AND. idims == 4 )   lchunk = .true.
+         ! update informations structure related the new variable we want to add...
+         iom_file(kiomid)%nvars         = idvar
+         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
+         iom_file(kiomid)%scf(idvar)    = 1.
+         iom_file(kiomid)%ofs(idvar)    = 0.
+         iom_file(kiomid)%ndims(idvar)  = idims
+         IF( .NOT. PRESENT(pv_r0d) ) THEN   ;   iom_file(kiomid)%luld(idvar) = .TRUE.
+         ELSE                               ;   iom_file(kiomid)%luld(idvar) = .FALSE.
+         ENDIF
+         DO jd = 1, idims
+            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, idimid(jd), len = iom_file(kiomid)%dimsz(jd,idvar) ), clinfo)
+            IF ( lchunk ) ichunksz(jd) = iom_file(kiomid)%dimsz(jd,idvar)
+         END DO
+         IF ( lchunk ) THEN
+            ! Calculate chunk sizes by partitioning each dimension as requested in namnc4 namelist
+            ! Disallow very small chunk sizes and prevent chunk sizes larger than each individual dimension
+            ichunksz(1) = MIN( ichunksz(1),MAX( (ichunksz(1)-1)/snc4set%ni + 1 ,16 ) ) ! Suggested default nc4set%ni=4
+            ichunksz(2) = MIN( ichunksz(2),MAX( (ichunksz(2)-1)/snc4set%nj + 1 ,16 ) ) ! Suggested default nc4set%nj=2
+            ichunksz(3) = MIN( ichunksz(3),MAX( (ichunksz(3)-1)/snc4set%nk + 1 , 1 ) ) ! Suggested default nc4set%nk=6
+            ichunksz(4) = 1                                                            ! Do not allow chunks to span the
+            !                                                                          ! unlimited dimension
+            CALL iom_nf90_check(SET_NF90_DEF_VAR_CHUNKING(if90id, idvar, ichunkalg, ichunksz), clinfo)
+            CALL iom_nf90_check(SET_NF90_DEF_VAR_DEFLATE(if90id, idvar, ishuffle, ideflate, ideflate_level), clinfo)
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' chunked ok. Chunks sizes: ', ichunksz
+         ENDIF
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok'
+      ELSE
+         idvar = kvid
+      ENDIF
+      !
+      ! time step kwrite : write the variable
+      IF( kt == kwrite ) THEN
+         ! are we in write mode?
+         IF( iom_file(kiomid)%irec == -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = 0
+         ENDIF
+         ! on what kind of domain must the data be written?
+         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN
+            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar)
+            IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
+               ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
+            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN
+               ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
+            ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN
+               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
+            ELSE 
+               CALL ctl_stop( 'iom_nf90_rp0123d: should have been an impossible case...' )
+            ENDIF
+
+            ! write dimension variables if it is not already done
+            ! =============
+            ! trick: is defined to 0 => dimension variable are defined but not yet written
+            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN
+               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lon'     , idmy )         , clinfo )
+               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo )
+               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lat'     , idmy )         , clinfo )
+               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo )
+               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo )
+               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d       ), clinfo )
+               IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN
+                  CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo )
+               ENDIF
+               ! +++ WRONG VALUE: to be improved but not really useful...
+               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo )
+               CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo )   
+               ! update the values of the variables dimensions size
+               CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo )
+               CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo )
+               iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1)
+               CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo )
+               iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
+            ENDIF
+         ENDIF
+
+         ! write the data
+         ! =============
+         IF(     PRESENT(pv_r0d) ) THEN
+            CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r0d                    ), clinfo )
+         ELSEIF( PRESENT(pv_r1d) ) THEN
+            CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r1d(:)                 ), clinfo )
+         ELSEIF( PRESENT(pv_r2d) ) THEN
+            CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2,iy1:iy2)   ), clinfo )
+         ELSEIF( PRESENT(pv_r3d) ) THEN
+            CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2,iy1:iy2,:) ), clinfo )
+         ENDIF
+         ! add 1 to the size of the temporal dimension (not really useful...)
+         IF( iom_file(kiomid)%luld(idvar) )   iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar)    &
+               &                            = iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) + 1
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
+      ENDIF
+      !
+      nldi = nldi_save   ;   nlei = nlei_save
+      nldj = nldj_save   ;   nlej = nlej_save
+      !     
+   END SUBROUTINE iom_nf90_rp0123d
+
+
+   SUBROUTINE iom_nf90_check( kstatus, cdinfo )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_nf90_check  ***
+      !!
+      !! ** Purpose :   check nf90 errors
+      !!--------------------------------------------------------------------
+      INTEGER,          INTENT(in) :: kstatus
+      CHARACTER(LEN=*), INTENT(in) :: cdinfo
+      !---------------------------------------------------------------------
+      IF(kstatus /= nf90_noerr)   CALL ctl_stop( 'iom_nf90_check : '//TRIM(nf90_strerror(kstatus)), TRIM(cdinfo) )
+   END SUBROUTINE iom_nf90_check
+
+   !!======================================================================
+END MODULE iom_nf90
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom_nf90.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iom_nf90.f90	(revision 12100)
+++ 	(revision )
@@ -1,582 +1,0 @@
-MODULE iom_nf90
-   !!=====================================================================
-   !!                    ***  MODULE  iom_nf90 ***
-   !! Input/Output manager :  Library to read input files with NF90 (only fliocom module)
-   !!====================================================================
-   !! History :  9.0  ! 05 12  (J. Belier) Original code
-   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO
-   !!             "   ! 07 07  (D. Storkey) Changes to iom_nf90_gettime
-   !!--------------------------------------------------------------------
-   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes
-
-   !!--------------------------------------------------------------------
-   !!   iom_open       : open a file read only
-   !!   iom_close      : close a file or all files opened by iom
-   !!   iom_get        : read a field (interfaced to several routines)
-   !!   iom_gettime    : read the time axis kvid in the file
-   !!   iom_varid      : get the id of a variable in a file
-   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
-   !!--------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE lbclnk          ! lateal boundary condition / mpp exchanges
-   USE iom_def         ! iom variables definitions
-   USE netcdf          ! NetCDF library
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC iom_nf90_open, iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput
-   PUBLIC iom_nf90_getatt
-
-   INTERFACE iom_nf90_get
-      MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d
-   END INTERFACE
-   INTERFACE iom_nf90_getatt
-      MODULE PROCEDURE iom_nf90_intatt
-   END INTERFACE
-   INTERFACE iom_nf90_rstput
-      MODULE PROCEDURE iom_nf90_rp0123d
-   END INTERFACE
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: iom_nf90.F90 6140 2015-12-21 11:35:23Z timgraham $
-   !! Software governed by the CeCILL licence (./LICENSE)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar )
-      !!---------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_open  ***
-      !!
-      !! ** Purpose : open an input file with NF90
-      !!---------------------------------------------------------------------
-      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
-      INTEGER                , INTENT(  out)           ::   kiomid      ! nf90 identifier of the opened file
-      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file?
-      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
-      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
-
-      CHARACTER(LEN=256) ::   clinfo           ! info character
-      CHARACTER(LEN=256) ::   cltmp            ! temporary character
-      INTEGER            ::   iln              ! lengths of character
-      INTEGER            ::   istop            ! temporary storage of nstop
-      INTEGER            ::   if90id           ! nf90 identifier of the opened file
-      INTEGER            ::   idmy             ! dummy variable
-      INTEGER            ::   jl               ! loop variable
-      INTEGER            ::   ichunk           ! temporary storage of nn_chunksz
-      INTEGER            ::   imode            ! creation mode flag: NF90_CLOBBER or NF90_NOCLOBBER or NF90_HDF5
-      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5
-      LOGICAL            ::   llclobber        ! local definition of ln_clobber
-      !---------------------------------------------------------------------
-
-      clinfo = '                    iom_nf90_open ~~~  '
-      istop = nstop   ! store the actual value of nstop
-      IF( nn_chunksz > 0 ) THEN   ;   ichunk = nn_chunksz
-      ELSE                        ;   ichunk = NF90_SIZEHINT_DEFAULT
-      ENDIF
-      !
-      llclobber = ldwrt .AND. ln_clobber
-      IF( ldok .AND. .NOT. llclobber ) THEN      ! Open existing file...
-         !                 ! =============
-         IF( ldwrt ) THEN  ! ... in write mode
-            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode'
-            IF( snc4set%luse ) THEN
-               CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id ), clinfo)
-            ELSE
-               CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id, chunksize = ichunk ), clinfo)
-            ENDIF
-            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy                          ), clinfo)
-         ELSE              ! ... in read mode
-            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
-            CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo)
-         ENDIF
-      ELSE                                       ! the file does not exist (or we overwrite it)
-         !                 ! =============
-         iln = INDEX( cdname, '.nc' )
-         IF( ldwrt ) THEN  ! the file should be open in write mode so we create it...
-            IF( jpnij > 1 ) THEN
-               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc'
-               cdname = TRIM(cltmp)
-            ENDIF
-            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in WRITE mode'
-
-            IF( llclobber ) THEN   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_CLOBBER   )
-            ELSE                   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 
-            ENDIF
-            IF( snc4set%luse ) THEN
-               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' creating file: '//TRIM(cdname)//' in hdf5 (netcdf4) mode'
-               CALL GET_NF90_SYMBOL("NF90_HDF5", ihdf5)
-               IF( llclobber ) THEN   ;   imode = IOR(ihdf5, NF90_CLOBBER)
-               ELSE                   ;   imode = IOR(ihdf5, NF90_NOCLOBBER)
-               ENDIF
-               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id ), clinfo)
-            ELSE
-               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id, chunksize = ichunk ), clinfo)
-            ENDIF
-            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy                     ), clinfo)
-            ! define dimensions
-            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1)  , idmy ), clinfo)
-            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1)  , idmy ), clinfo)
-            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk           , idmy ), clinfo)
-            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', 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)
-         ELSE              ! the file should be open for read mode so it must exist...
-            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
-         ENDIF
-      ENDIF
-      ! start to fill file informations
-      ! =============
-      IF( istop == nstop ) THEN   ! no error within this routine
-!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
-         kiomid = 0
-         DO jl = jpmax_files, 1, -1
-            IF( iom_file(jl)%nfid == 0 )   kiomid = jl
-         ENDDO
-         iom_file(kiomid)%name   = TRIM(cdname)
-         iom_file(kiomid)%nfid   = if90id
-         iom_file(kiomid)%iolib  = jpnf90
-         iom_file(kiomid)%nvars  = 0
-         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode 
-         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo)
-         IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN
-           CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,     & 
-        &                                               name = iom_file(kiomid)%uldname,  &
-        &                                               len  = iom_file(kiomid)%lenuld ), clinfo )
-         ENDIF
-         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK'
-      ELSE
-         kiomid = 0               ! return error flag
-      ENDIF
-      !
-   END SUBROUTINE iom_nf90_open
-
-
-   SUBROUTINE iom_nf90_close( kiomid )
-      !!--------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_nf90_close  ***
-      !!
-      !! ** Purpose : close an input file with NF90
-      !!--------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
-      CHARACTER(LEN=100)  ::   clinfo   ! info character
-      !---------------------------------------------------------------------
-      !
-      clinfo = '      iom_nf90_close    , file: '//TRIM(iom_file(kiomid)%name)
-      CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo)
-      !    
-   END SUBROUTINE iom_nf90_close
-
-
-   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims )  
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  iom_varid  ***
-      !!
-      !! ** Purpose : get the id of a variable in a file with NF90
-      !!-----------------------------------------------------------------------
-      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
-      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
-      INTEGER              , INTENT(in   )           ::   kiv   ! 
-      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
-      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
-      !
-      INTEGER                        ::   iom_nf90_varid   ! iom variable Id
-      INTEGER                        ::   if90id           ! nf90 file identifier
-      INTEGER                        ::   ji               ! dummy loop index
-      INTEGER                        ::   ivarid           ! NetCDF  variable Id
-      INTEGER                        ::   i_nvd            ! number of dimension of the variable
-      INTEGER, DIMENSION(jpmax_dims) ::   idimid           ! dimension ids of the variable
-      LOGICAL                        ::   llok             ! ok  test
-      CHARACTER(LEN=100)             ::   clinfo           ! info character
-      !!-----------------------------------------------------------------------
-      clinfo = '          iom_nf90_varid, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
-      iom_nf90_varid = 0                    ! default definition
-      IF( PRESENT(kdimsz) ) kdimsz(:) = 0   ! default definition
-      if90id = iom_file(kiomid)%nfid        ! get back NetCDF file id
-      !
-      llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! does the variable exist in the file
-      IF( llok ) THEN
-         iom_nf90_varid = kiv
-         iom_file(kiomid)%nvars       = kiv
-         iom_file(kiomid)%nvid(kiv)   = ivarid
-         iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar)
-         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, ndims = i_nvd), clinfo)   ! number of dimensions
-         iom_file(kiomid)%ndims(kiv)  = i_nvd
-         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids
-         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value
-         iom_file(kiomid)%dimsz(:,kiv) = 0      ! reset dimsz in case previously used
-         DO ji = 1, i_nvd                       ! dimensions size
-            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)   
-            IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension? 
-         END DO
-         !---------- Deal with scale_factor and add_offset
-         llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr
-         IF( llok) THEN
-            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'scale_factor', iom_file(kiomid)%scf(kiv)), clinfo)
-         ELSE
-            iom_file(kiomid)%scf(kiv) = 1.
-         END IF
-         llok = NF90_Inquire_attribute(if90id, ivarid, 'add_offset') == nf90_noerr
-         IF( llok ) THEN
-            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', iom_file(kiomid)%ofs(kiv)), clinfo)
-         ELSE
-            iom_file(kiomid)%ofs(kiv) = 0.
-         END IF
-         ! return the simension size
-         IF( PRESENT(kdimsz) ) THEN 
-            IF( i_nvd == SIZE(kdimsz) ) THEN
-               kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,kiv)
-            ELSE
-               WRITE(ctmp1,*) i_nvd, SIZE(kdimsz)
-               CALL ctl_stop( TRIM(clinfo), 'error in kdimsz size'//TRIM(ctmp1) )
-            ENDIF
-         ENDIF
-         IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(kiv)
-      ELSE  
-         iom_nf90_varid = -1   !   variable not found, return error code: -1
-      ENDIF
-      !
-   END FUNCTION iom_nf90_varid
-
-
-   SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar, kstart )
-      !!-----------------------------------------------------------------------
-      !!                  ***  ROUTINE  iom_nf90_g0d  ***
-      !!
-      !! ** Purpose : read a scalar with NF90
-      !!-----------------------------------------------------------------------
-      INTEGER ,               INTENT(in   )            ::   kiomid   ! Identifier of the file
-      INTEGER ,               INTENT(in   )            ::   kvid     ! variable id
-      REAL(wp),               INTENT(  out)            ::   pvar     ! read field
-      INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart   ! start position of the reading in each axis
-      !
-      CHARACTER(LEN=100)      ::   clinfo   ! info character
-      !---------------------------------------------------------------------
-      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
-      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo )
-      ! 
-   END SUBROUTINE iom_nf90_g0d
-
-
-   SUBROUTINE iom_nf90_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   &
-         &                    pv_r1d, pv_r2d, pv_r3d )
-      !!-----------------------------------------------------------------------
-      !!                  ***  ROUTINE  iom_nf90_g123d  ***
-      !!
-      !! ** Purpose : read a 1D/2D/3D variable with NF90
-      !!
-      !! ** Method : read ONE record at each CALL
-      !!-----------------------------------------------------------------------
-      INTEGER                    , INTENT(in   )           ::   kiomid    ! iom identifier of the file
-      INTEGER                    , INTENT(in   )           ::   kvid      ! Name of the variable
-      INTEGER                    , INTENT(in   )           ::   knbdim    ! number of dimensions of the variable
-      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart    ! start position of the reading in each axis 
-      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis
-      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes
-      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case)
-      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case)
-      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case)
-      !
-      CHARACTER(LEN=100) ::   clinfo               ! info character
-      INTEGER            ::   if90id               ! nf90 identifier of the opened file
-      INTEGER            ::   ivid                 ! nf90 variable id
-      !---------------------------------------------------------------------
-      clinfo = 'iom_nf90_g123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
-      if90id = iom_file(kiomid)%nfid         ! get back NetCDF file id
-      ivid   = iom_file(kiomid)%nvid(kvid)   ! get back NetCDF var id
-      !
-      IF(     PRESENT(pv_r1d) ) THEN
-         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r1d(:                ), start = kstart(1:knbdim),   &
-            &                                                                       count = kcount(1:knbdim)), clinfo )
-      ELSEIF( PRESENT(pv_r2d) ) THEN
-         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim),   &
-            &                                                                       count = kcount(1:knbdim)), clinfo )
-      ELSEIF( PRESENT(pv_r3d) ) THEN
-         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim),   &
-            &                                                                       count = kcount(1:knbdim)), clinfo )
-      ENDIF
-      !
-   END SUBROUTINE iom_nf90_g123d
-
-
-   SUBROUTINE iom_nf90_intatt( kiomid, cdatt, pvar )
-      !!-----------------------------------------------------------------------
-      !!                  ***  ROUTINE  iom_nf90_intatt  ***
-      !!
-      !! ** Purpose : read an integer attribute with NF90
-      !!-----------------------------------------------------------------------
-      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
-      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
-      INTEGER         , INTENT(  out) ::   pvar     ! read field
-      !
-      INTEGER                         ::   if90id   ! temporary integer
-      LOGICAL                         ::   llok     ! temporary logical
-      CHARACTER(LEN=100)              ::   clinfo   ! info character
-      !---------------------------------------------------------------------
-      ! 
-      if90id = iom_file(kiomid)%nfid
-      llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr
-      IF( llok) THEN
-         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt)
-         CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pvar), clinfo)
-      ELSE
-         CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found')
-         pvar = -999
-      ENDIF
-      ! 
-   END SUBROUTINE iom_nf90_intatt
-
-
-   SUBROUTINE iom_nf90_gettime( kiomid, kvid, ptime, cdunits, cdcalendar )
-      !!--------------------------------------------------------------------
-      !!                   ***  SUBROUTINE iom_gettime  ***
-      !!
-      !! ** Purpose : read the time axis kvid in the file with NF90
-      !!--------------------------------------------------------------------
-      INTEGER                   , INTENT(in   ) ::   kiomid     ! file Identifier
-      INTEGER                   , INTENT(in   ) ::   kvid       ! variable id
-      REAL(wp), DIMENSION(:)    , INTENT(  out) ::   ptime      ! the time axis
-      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdunits    ! units attribute
-      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdcalendar ! calendar attribute
-      !
-      CHARACTER(LEN=100) ::   clinfo     ! info character
-      !---------------------------------------------------------------------
-      clinfo = 'iom_nf90_gettime, 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), ptime(:),   &
-            &                           start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /)), clinfo)
-      IF ( PRESENT(cdunits) ) THEN 
-         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "units", &
-            &                           values=cdunits), clinfo)
-      ENDIF
-      IF ( PRESENT(cdcalendar) ) THEN 
-         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "calendar", &
-            &                           values=cdcalendar), clinfo)
-      ENDIF
-      !
-   END SUBROUTINE iom_nf90_gettime
-
-
-   SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   &
-         &                               pv_r0d, pv_r1d, pv_r2d, pv_r3d )
-      !!--------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_nf90_rstput  ***
-      !!
-      !! ** Purpose : read the time axis cdvar in the file 
-      !!--------------------------------------------------------------------
-      INTEGER                     , INTENT(in)           ::   kt       ! ocean time-step
-      INTEGER                     , INTENT(in)           ::   kwrite   ! writing time-step
-      INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file 
-      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
-      INTEGER                     , INTENT(in)           ::   kvid     ! variable id
-      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
-      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
-      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
-      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
-      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
-      !
-      INTEGER               :: idims                ! number of dimension
-      INTEGER               :: idvar                ! variable id
-      INTEGER               :: jd                   ! dimension loop counter   
-      INTEGER               :: ix1, ix2, iy1, iy2   ! subdomain indexes   
-      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size  
-      INTEGER, DIMENSION(4) :: idimid               ! dimensions id
-      CHARACTER(LEN=256)    :: clinfo               ! info character
-      CHARACTER(LEN= 12), DIMENSION(4) :: cltmp     ! temporary character
-      INTEGER               :: if90id               ! nf90 file identifier
-      INTEGER               :: idmy                 ! dummy variable
-      INTEGER               :: itype                ! variable type
-      INTEGER, DIMENSION(4) :: ichunksz             ! NetCDF4 chunk sizes. Will be computed using
-                                                    ! nn_nchunks_[i,j,k,t] namelist parameters
-      INTEGER               :: ichunkalg, ishuffle,&
-                               ideflate, ideflate_level
-                                                    ! NetCDF4 internally fixed parameters
-      LOGICAL               :: lchunk               ! logical switch to activate chunking and compression
-                                                    ! when appropriate (currently chunking is applied to 4d fields only)
-      !---------------------------------------------------------------------
-      !
-      clinfo = '          iom_nf90_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
-      if90id = iom_file(kiomid)%nfid
-      !
-      ! define dimension variables if it is not already done
-      ! ==========================
-      IF( iom_file(kiomid)%nvars == 0 ) THEN
-         ! are we in define mode?
-         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
-            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
-         ENDIF
-         ! define the dimension variables if it is not already done
-         cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter' /)
-         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo)
-         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo)
-         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3    /), iom_file(kiomid)%nvid(3) ), clinfo)
-         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4    /), iom_file(kiomid)%nvid(4) ), clinfo)
-         ! update informations structure related the dimension variable we just added...
-         iom_file(kiomid)%nvars       = 4
-         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
-         iom_file(kiomid)%cn_var(1:4) = cltmp
-         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /)  
-         ! trick: defined to 0 to say that dimension variables are defined but not yet written
-         iom_file(kiomid)%dimsz(1, 1)  = 0   
-         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
-      ENDIF
-      ! define the data if it is not already done
-      ! ===============
-      IF( kvid <= 0 ) THEN
-         !
-         ! NetCDF4 chunking and compression fixed settings
-         ichunkalg = 0
-         ishuffle = 1
-         ideflate = 1
-         ideflate_level = 1
-         !
-         idvar = iom_file(kiomid)%nvars + 1
-         ! are we in define mode?
-         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
-            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
-         ENDIF
-         ! variable definition
-         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0
-         ELSEIF( PRESENT(pv_r1d) ) THEN   ;   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   ;   idims = 4   ;   idimid(1:idims) = (/1,2,3,4/)
-         ENDIF
-         IF( PRESENT(ktype) ) THEN   ! variable external type
-            SELECT CASE (ktype)
-            CASE (jp_r8)  ;   itype = NF90_DOUBLE
-            CASE (jp_r4)  ;   itype = NF90_FLOAT
-            CASE (jp_i4)  ;   itype = NF90_INT
-            CASE (jp_i2)  ;   itype = NF90_SHORT
-            CASE (jp_i1)  ;   itype = NF90_BYTE
-            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo)//' unknown variable type' )
-            END SELECT
-         ELSE
-            itype = NF90_DOUBLE
-         ENDIF
-         IF( PRESENT(pv_r0d) ) THEN
-            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype,                    &
-                 &                            iom_file(kiomid)%nvid(idvar) ), clinfo)
-         ELSE
-            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, idimid(1:idims),   &
-                 &                            iom_file(kiomid)%nvid(idvar) ), clinfo)
-         ENDIF
-         lchunk = .false.
-         IF( snc4set%luse .AND. idims.eq.4 ) lchunk = .true.
-         ! update informations structure related the new variable we want to add...
-         iom_file(kiomid)%nvars         = idvar
-         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
-         iom_file(kiomid)%scf(idvar)    = 1.
-         iom_file(kiomid)%ofs(idvar)    = 0.
-         iom_file(kiomid)%ndims(idvar)  = idims
-         IF( .NOT. PRESENT(pv_r0d) ) THEN   ;   iom_file(kiomid)%luld(idvar) = .TRUE.
-         ELSE                               ;   iom_file(kiomid)%luld(idvar) = .FALSE.
-         ENDIF
-         DO jd = 1, idims
-            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, idimid(jd), len = iom_file(kiomid)%dimsz(jd,idvar) ), clinfo)
-            IF ( lchunk ) ichunksz(jd) = iom_file(kiomid)%dimsz(jd,idvar)
-         END DO
-         IF ( lchunk ) THEN
-            ! Calculate chunk sizes by partitioning each dimension as requested in namnc4 namelist
-            ! Disallow very small chunk sizes and prevent chunk sizes larger than each individual dimension
-            ichunksz(1) = MIN( ichunksz(1),MAX( (ichunksz(1)-1)/snc4set%ni + 1 ,16 ) ) ! Suggested default nc4set%ni=4
-            ichunksz(2) = MIN( ichunksz(2),MAX( (ichunksz(2)-1)/snc4set%nj + 1 ,16 ) ) ! Suggested default nc4set%nj=2
-            ichunksz(3) = MIN( ichunksz(3),MAX( (ichunksz(3)-1)/snc4set%nk + 1 , 1 ) ) ! Suggested default nc4set%nk=6
-            ichunksz(4) = 1                                                            ! Do not allow chunks to span the
-                                                                                       ! unlimited dimension
-            CALL iom_nf90_check(SET_NF90_DEF_VAR_CHUNKING(if90id, idvar, ichunkalg, ichunksz), clinfo)
-            CALL iom_nf90_check(SET_NF90_DEF_VAR_DEFLATE(if90id, idvar, ishuffle, ideflate, ideflate_level), clinfo)
-            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' chunked ok. Chunks sizes: ', ichunksz
-         ENDIF
-         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok'
-      ELSE
-         idvar = kvid
-      ENDIF
-
-      ! time step kwrite : write the variable
-      IF( kt == kwrite ) THEN
-         ! are we in write mode?
-         IF( iom_file(kiomid)%irec == -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
-            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = 0
-         ENDIF
-         ! on what kind of domain must the data be written?
-         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN
-            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar)
-            IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
-               ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
-            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN
-               ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
-            ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN
-               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
-            ELSE 
-               CALL ctl_stop( 'iom_nf90_rp0123d: should have been an impossible case...' )
-            ENDIF
-
-            ! write dimension variables if it is not already done
-            ! =============
-            ! trick: is defined to 0 => dimension variable are defined but not yet written
-            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN
-               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lon'     , idmy ), clinfo)
-               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo)
-               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lat'     , idmy ), clinfo)
-               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo)
-               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo)
-               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_1d                ), clinfo)
-               ! +++ WRONG VALUE: to be improved but not really useful...
-               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo)
-               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo)   
-               ! update the values of the variables dimensions size
-               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo)
-               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo)
-               iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1)
-               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo)
-               iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension
-               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
-            ENDIF
-         ENDIF
-
-         ! write the data
-         ! =============
-         IF(     PRESENT(pv_r0d) ) THEN
-            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r0d                      ), clinfo)
-         ELSEIF( PRESENT(pv_r1d) ) THEN
-            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r1d(                  :) ), clinfo)
-         ELSEIF( PRESENT(pv_r2d) ) THEN
-            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2, iy1:iy2   ) ), clinfo)
-         ELSEIF( PRESENT(pv_r3d) ) THEN
-            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2, iy1:iy2, :) ), clinfo)
-         ENDIF
-         ! add 1 to the size of the temporal dimension (not really useful...)
-         IF( iom_file(kiomid)%luld(idvar) )   iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar)    &
-               &                            = iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) + 1
-         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
-      ENDIF
-      !     
-   END SUBROUTINE iom_nf90_rp0123d
-
-
-   SUBROUTINE iom_nf90_check( kstatus, cdinfo )
-      !!--------------------------------------------------------------------
-      !!                   ***  SUBROUTINE iom_nf90_check  ***
-      !!
-      !! ** Purpose :   check nf90 errors
-      !!--------------------------------------------------------------------
-      INTEGER,          INTENT(in) :: kstatus
-      CHARACTER(LEN=*), INTENT(in) :: cdinfo
-      !---------------------------------------------------------------------
-      IF(kstatus /= nf90_noerr)   CALL ctl_stop( 'iom_nf90_check : '//TRIM(nf90_strerror(kstatus)), TRIM(cdinfo) )
-   END SUBROUTINE iom_nf90_check
-
-   !!======================================================================
-END MODULE iom_nf90
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iscplhsb.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iscplhsb.f90	(revision 12100)
+++ 	(revision )
@@ -1,331 +1,0 @@
-MODULE iscplhsb
-   !!======================================================================
-   !!                       ***  MODULE  iscplhsb***
-   !! Ocean forcing: ice sheet/ocean coupling (conservation)
-   !!=====================================================================
-   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   iscpl_alloc    : variable allocation
-   !!   iscpl_hsb      : compute and store the input of heat/salt/volume 
-   !!                    into the system due to the coupling process
-   !!   iscpl_div      : correction of divergence to keep volume conservation
-   !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE domwri          ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE sbc_oce         ! surface boundary condition variables
-   USE oce             ! global tra/dyn variable
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE lib_fortran     ! MPP library
-   USE wrk_nemo        ! Memory allocation
-   USE lbclnk          !
-   USE domngb          !
-   USE iscplini
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   iscpl_div   
-   PUBLIC   iscpl_cons       
-   !! * Substitutions  
-   !!----------------------------------------------------------------------
-   !!                   ***  vectopt_loop_substitute  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
-   !!                allow unrolling of do-loop (useful with vector processors)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
-   !! Software governed by the CeCILL licence (./LICENSE)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE iscpl_cons(ptmask_b, psmask_b, pe3t_b, pts_flx, pvol_flx, prdt_iscpl)
-      !!---------------------------------------------------------------------- 
-      !!                   ***  ROUTINE iscpl_cons  ***
-      !! 
-      !! ** Purpose :   compute input into the system during the coupling step
-      !!                compute the correction term
-      !!                compute where the correction have to be applied
-      !! 
-      !! ** Method  :   compute tsn*e3t-tsb*e3tb and e3t-e3t_b
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: ptmask_b    !! mask before
-      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pe3t_b      !! scale factor before
-      REAL(wp), DIMENSION(:,:    ), INTENT(in ) :: psmask_b    !! mask before
-      REAL(wp), DIMENSION(:,:,:,:), INTENT(out) :: pts_flx     !! corrective flux to have tracer conservation
-      REAL(wp), DIMENSION(:,:,:  ), INTENT(out) :: pvol_flx    !! corrective flux to have volume conservation
-      REAL(wp),                     INTENT(in ) :: prdt_iscpl  !! coupling period 
-      !!
-      INTEGER :: ji, jj, jk                                    !! loop index
-      INTEGER :: jip1, jim1, jjp1, jjm1
-      !!
-      REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb
-      REAL(wp):: r1_rdtiscpl
-      REAL(wp):: zjip1_ratio  , zjim1_ratio  , zjjp1_ratio  , zjjm1_ratio
-      !!
-      REAL(wp):: zde3t, zdtem, zdsal
-      REAL(wp), DIMENSION(:,:), POINTER :: zdssh
-      !!
-      REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat
-      REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal
-      INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts
-      INTEGER :: jpts, npts
-
-      CALL wrk_alloc(jpi,jpj, zdssh )
-
-      ! get imbalance (volume heat and salt)
-      ! initialisation difference
-      zde3t = 0.0_wp; zdsal = 0.0_wp ; zdtem = 0.0_wp
-
-      ! initialisation correction term
-      pvol_flx(:,:,:  ) = 0.0_wp
-      pts_flx (:,:,:,:) = 0.0_wp
-      
-      r1_rdtiscpl = 1._wp / prdt_iscpl 
-
-      ! mask tsn and tsb 
-      tsb(:,:,:,jp_tem)=tsb(:,:,:,jp_tem)*ptmask_b(:,:,:); tsn(:,:,:,jp_tem)=tsn(:,:,:,jp_tem)*tmask(:,:,:);
-      tsb(:,:,:,jp_sal)=tsb(:,:,:,jp_sal)*ptmask_b(:,:,:); tsn(:,:,:,jp_sal)=tsn(:,:,:,jp_sal)*tmask(:,:,:);
-
-      !==============================================================================
-      ! diagnose the heat, salt and volume input and compute the correction variable
-      !==============================================================================
-
-      ! 
-      zdssh(:,:) = sshn(:,:) * ssmask(:,:) - sshb(:,:) * psmask_b(:,:)
-      IF (.NOT. ln_linssh ) zdssh = 0.0_wp ! already included in the levels by definition
-      
-      DO jk = 1,jpk-1
-         DO jj = 2,jpj-1
-            DO ji = 2,jpim1
-               IF (tmask_h(ji,jj) == 1._wp) THEN
-
-                  ! volume differences
-                  zde3t = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) - pe3t_b(ji,jj,jk) * ptmask_b(ji,jj,jk)
-
-                  ! heat diff
-                  zdtem = tsn(ji,jj,jk,jp_tem) * e3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   &
-                        - tsb(ji,jj,jk,jp_tem) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)
-                  ! salt diff
-                  zdsal = tsn(ji,jj,jk,jp_sal) * e3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   &
-                        - tsb(ji,jj,jk,jp_sal) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)
-               
-                  ! shh changes
-                  IF ( ptmask_b(ji,jj,jk) == 1._wp .OR. tmask(ji,jj,jk) == 1._wp ) THEN 
-                     zde3t = zde3t + zdssh(ji,jj) ! zdssh = 0 if vvl
-                     zdssh(ji,jj) = 0._wp
-                  END IF
-
-                  ! volume, heat and salt differences in each cell 
-                  pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * r1_rdtiscpl
-                  pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * r1_rdtiscpl 
-                  pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * r1_rdtiscpl
-
-                  ! case where we close a cell: check if the neighbour cells are wet 
-                  IF ( tmask(ji,jj,jk) == 0._wp .AND. ptmask_b(ji,jj,jk) == 1._wp ) THEN
-
-                     jip1=ji+1 ; jim1=ji-1 ; jjp1=jj+1 ; jjm1=jj-1 ;
-
-                     zsum =   e1e2t(ji  ,jjp1) * tmask(ji  ,jjp1,jk) + e1e2t(ji  ,jjm1) * tmask(ji  ,jjm1,jk) &
-                       &    + e1e2t(jim1,jj  ) * tmask(jim1,jj  ,jk) + e1e2t(jip1,jj  ) * tmask(jip1,jj  ,jk)
-
-                     IF ( zsum /= 0._wp ) THEN
-                        zjip1_ratio   = e1e2t(jip1,jj  ) * tmask(jip1,jj  ,jk) / zsum
-                        zjim1_ratio   = e1e2t(jim1,jj  ) * tmask(jim1,jj  ,jk) / zsum
-                        zjjp1_ratio   = e1e2t(ji  ,jjp1) * tmask(ji  ,jjp1,jk) / zsum
-                        zjjm1_ratio   = e1e2t(ji  ,jjm1) * tmask(ji  ,jjm1,jk) / zsum
-
-                        pvol_flx(ji  ,jjp1,jk       ) = pvol_flx(ji  ,jjp1,jk       ) + pvol_flx(ji,jj,jk       ) * zjjp1_ratio
-                        pvol_flx(ji  ,jjm1,jk       ) = pvol_flx(ji  ,jjm1,jk       ) + pvol_flx(ji,jj,jk       ) * zjjm1_ratio
-                        pvol_flx(jip1,jj  ,jk       ) = pvol_flx(jip1,jj  ,jk       ) + pvol_flx(ji,jj,jk       ) * zjip1_ratio
-                        pvol_flx(jim1,jj  ,jk       ) = pvol_flx(jim1,jj  ,jk       ) + pvol_flx(ji,jj,jk       ) * zjim1_ratio
-                        pts_flx (ji  ,jjp1,jk,jp_sal) = pts_flx (ji  ,jjp1,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjjp1_ratio
-                        pts_flx (ji  ,jjm1,jk,jp_sal) = pts_flx (ji  ,jjm1,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjjm1_ratio
-                        pts_flx (jip1,jj  ,jk,jp_sal) = pts_flx (jip1,jj  ,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjip1_ratio
-                        pts_flx (jim1,jj  ,jk,jp_sal) = pts_flx (jim1,jj  ,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjim1_ratio
-                        pts_flx (ji  ,jjp1,jk,jp_tem) = pts_flx (ji  ,jjp1,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjjp1_ratio
-                        pts_flx (ji  ,jjm1,jk,jp_tem) = pts_flx (ji  ,jjm1,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjjm1_ratio
-                        pts_flx (jip1,jj  ,jk,jp_tem) = pts_flx (jip1,jj  ,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjip1_ratio
-                        pts_flx (jim1,jj  ,jk,jp_tem) = pts_flx (jim1,jj  ,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjim1_ratio
-
-                        ! set to 0 the cell we distributed over neigbourg cells
-                        pvol_flx(ji,jj,jk       ) = 0._wp
-                        pts_flx (ji,jj,jk,jp_sal) = 0._wp
-                        pts_flx (ji,jj,jk,jp_tem) = 0._wp
-
-                     ELSE IF (zsum == 0._wp ) THEN
-                        ! case where we close a cell and no adjacent cell open
-                        ! check if the cell beneath is wet
-                        IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN
-                           pvol_flx(ji,jj,jk+1)       =  pvol_flx(ji,jj,jk+1)        + pvol_flx(ji,jj,jk)
-                           pts_flx (ji,jj,jk+1,jp_sal)=  pts_flx (ji,jj,jk+1,jp_sal) + pts_flx (ji,jj,jk,jp_sal)
-                           pts_flx (ji,jj,jk+1,jp_tem)=  pts_flx (ji,jj,jk+1,jp_tem) + pts_flx (ji,jj,jk,jp_tem)
-
-                           ! set to 0 the cell we distributed over neigbourg cells
-                           pvol_flx(ji,jj,jk       ) = 0._wp
-                           pts_flx (ji,jj,jk,jp_sal) = 0._wp
-                           pts_flx (ji,jj,jk,jp_tem) = 0._wp
-                        ELSE
-                        ! case no adjacent cell on the horizontal and on the vertical
-                           IF ( lwp ) THEN   ! JMM : cAution this warning may occur on any mpp subdomain but numout is only
-                                             ! open for narea== 1 (lwp=T)
-                           WRITE(numout,*) 'W A R N I N G iscpl: no adjacent cell on the vertical and horizontal'
-                           WRITE(numout,*) '                     ',mig(ji),' ',mjg(jj),' ',jk
-                           WRITE(numout,*) '                     ',ji,' ',jj,' ',jk,' ',narea
-                           WRITE(numout,*) ' we are now looking for the closest wet cell on the horizontal '
-                           ENDIF
-                        ! We deal with these points later.
-                        END IF
-                     END IF
-                  END IF
-               END IF
-            END DO
-         END DO
-      END DO
-
-      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1.)
-      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.)
-      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.)
-
-      ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point 
-      ! allocation and initialisation of the list of problematic point
-      ALLOCATE(inpts(jpnij))
-      inpts(:)=0
-
-      ! fill narea location with the number of problematic point
-      DO jk = 1,jpk-1
-         DO jj = 2,jpj-1
-            DO ji = 2,jpim1
-               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  &
-                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
-                  inpts(narea) = inpts(narea) + 1 
-               END IF
-            END DO
-         END DO
-      END DO
-
-      ! build array of total problematic point on each cpu (share to each cpu)
-      CALL mpp_max(inpts,jpnij) 
-
-      ! size of the new variable
-      npts  = SUM(inpts)    
-      
-      ! allocation of the coordinates, correction, index vector for the problematic points 
-      ALLOCATE(ixpts(npts), iypts(npts), izpts(npts), zcorr_vol(npts), zcorr_sal(npts), zcorr_tem(npts), zlon(npts), zlat(npts))
-      ixpts(:) = -9999 ; iypts(:) = -9999 ; izpts(:) = -9999 ; zlon(:) = -1.0e20_wp ; zlat(:) = -1.0e20_wp
-      zcorr_vol(:) = -1.0e20_wp
-      zcorr_sal(:) = -1.0e20_wp
-      zcorr_tem(:) = -1.0e20_wp
-
-      ! fill new variable
-      jpts = SUM(inpts(1:narea-1))
-      DO jk = 1,jpk-1
-         DO jj = 2,jpj-1
-            DO ji = 2,jpim1
-               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  &
-                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
-                  jpts = jpts + 1  ! positioning in the inpts vector for the area narea
-                  ixpts(jpts) = ji           ; iypts(jpts) = jj ; izpts(jpts) = jk
-                  zlon (jpts) = glamt(ji,jj) ; zlat (jpts) = gphit(ji,jj)
-                  zcorr_vol(jpts) = pvol_flx(ji,jj,jk)
-                  zcorr_sal(jpts) = pts_flx (ji,jj,jk,jp_sal)
-                  zcorr_tem(jpts) = pts_flx (ji,jj,jk,jp_tem)
-
-                  ! set flx to 0 (safer)
-                  pvol_flx(ji,jj,jk       ) = 0.0_wp
-                  pts_flx (ji,jj,jk,jp_sal) = 0.0_wp
-                  pts_flx (ji,jj,jk,jp_tem) = 0.0_wp
-               END IF
-            END DO
-         END DO
-      END DO
-
-      ! build array of total problematic point on each cpu (share to each cpu)
-      ! point coordinates
-      CALL mpp_max(zlat ,npts)
-      CALL mpp_max(zlon ,npts)
-      CALL mpp_max(izpts,npts)
-
-      ! correction values 
-      CALL mpp_max(zcorr_vol,npts)
-      CALL mpp_max(zcorr_sal,npts)
-      CALL mpp_max(zcorr_tem,npts)
-
-      ! put correction term in the closest cell          
-      DO jpts = 1,npts
-         CALL dom_ngb(zlon(jpts), zlat(jpts), ixpts(jpts), iypts(jpts),'T', izpts(jpts))
-         DO jj = mj0(iypts(jpts)),mj1(iypts(jpts))
-            DO ji = mi0(ixpts(jpts)),mi1(ixpts(jpts))
-               jk = izpts(jpts)
-
-               IF (tmask_h(ji,jj) == 1._wp) THEN
-                  ! correct the vol_flx in the closest cell
-                  pvol_flx(ji,jj,jk)        =  pvol_flx(ji,jj,jk       ) + zcorr_vol(jpts)
-                  pts_flx (ji,jj,jk,jp_sal) =  pts_flx (ji,jj,jk,jp_sal) + zcorr_sal(jpts)
-                  pts_flx (ji,jj,jk,jp_tem) =  pts_flx (ji,jj,jk,jp_tem) + zcorr_tem(jpts)
-
-                  ! set correction to 0
-                  zcorr_vol(jpts) = 0.0_wp
-                  zcorr_sal(jpts) = 0.0_wp
-                  zcorr_tem(jpts) = 0.0_wp
-               END IF
-            END DO
-         END DO
-      END DO
-
-      ! deallocate variables 
-      DEALLOCATE(inpts)
-      DEALLOCATE(ixpts, iypts, izpts, zcorr_vol, zcorr_sal, zcorr_tem, zlon, zlat)
-    
-      ! add contribution store on the hallo (lbclnk remove one of the contribution)
-      pvol_flx(:,:,:       ) = pvol_flx(:,:,:       ) * tmask(:,:,:)
-      pts_flx (:,:,:,jp_sal) = pts_flx (:,:,:,jp_sal) * tmask(:,:,:)
-      pts_flx (:,:,:,jp_tem) = pts_flx (:,:,:,jp_tem) * tmask(:,:,:)
-
-      ! compute sum over the halo and set it to 0.
-      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1._wp)
-      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp)
-      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp)
-
-      ! deallocate variables
-      CALL wrk_dealloc(jpi,jpj, zdssh ) 
-
-   END SUBROUTINE iscpl_cons
-
-   SUBROUTINE iscpl_div( phdivn )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE iscpl_div  ***
-      !!
-      !! ** Purpose :   update the horizontal divergenc
-      !!
-      !! ** Method  :
-      !!                CAUTION : iscpl is positive (inflow) and expressed in m/s
-      !!
-      !! ** Action  :   phdivn   increase by the iscpl correction term
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      !!----------------------------------------------------------------------
-      !
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + hdiv_iscpl(ji,jj,jk) / e3t_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      !
-   END SUBROUTINE iscpl_div
-
-END MODULE iscplhsb
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iscplini.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iscplini.f90	(revision 12100)
+++ 	(revision )
@@ -1,85 +1,0 @@
-MODULE iscplini
-   !!======================================================================
-   !!                       ***  MODULE  sbciscpl***
-   !! Ocean forcing:  river runoff
-   !!=====================================================================
-   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   iscpl_init     : initialisation routine (namelist)
-   !!   iscpl_alloc    : allocation of correction variables
-   !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE oce             ! global tra/dyn variable
-   USE lib_mpp         ! MPP library
-   USE lib_fortran     ! MPP library
-   USE in_out_manager  ! I/O manager
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   iscpl_init      
-   PUBLIC   iscpl_alloc 
-   !!                                                      !!* namsbc_iscpl namelist *
-   LOGICAL , PUBLIC                                        ::   ln_hsb
-   INTEGER , PUBLIC                                        ::   nn_fiscpl, nstp_iscpl
-   INTEGER , PUBLIC                                        ::   nn_drown
-   REAL(wp), PUBLIC                                        ::   rdt_iscpl
-   !!                                                      !!* namsbc_iscpl namelist *
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::   hdiv_iscpl
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   htsc_iscpl
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION iscpl_alloc()
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE sbc_iscpl_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( htsc_iscpl(jpi,jpj,jpk,jpts) , hdiv_iscpl(jpi,jpj,jpk) , STAT=iscpl_alloc )
-         !
-      IF( lk_mpp          )   CALL mpp_sum ( iscpl_alloc )
-      IF( iscpl_alloc > 0 )   CALL ctl_warn('iscpl_alloc: allocation of arrays failed')
-   END FUNCTION iscpl_alloc
-
-   SUBROUTINE iscpl_init()
-      INTEGER ::   ios           ! Local integer output status for namelist read
-      NAMELIST/namsbc_iscpl/nn_fiscpl,ln_hsb,nn_drown
-      !!----------------------------------------------------------------------
-      !                                   ! ============
-      !                                   !   Namelist
-      !                                   ! ============
-      !
-      nn_fiscpl = 0
-      ln_hsb    = .FALSE.
-      REWIND( numnam_ref )              ! Namelist namsbc_iscpl in reference namelist : Ice sheet coupling
-      READ  ( numnam_ref, namsbc_iscpl, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iscpl in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namsbc_iscpl in configuration namelist : Ice Sheet coupling
-      READ  ( numnam_cfg, namsbc_iscpl, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iscpl in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namsbc_iscpl )
-      !
-      nstp_iscpl=MIN(nn_fiscpl, nitend-nit000+1) ! the coupling period have to be less or egal than the total number of time step
-      rdt_iscpl = nstp_iscpl * rn_rdt
-      !
-      IF (lwp) THEN
-         WRITE(numout,*) 'iscpl_rst:'
-         WRITE(numout,*) '~~~~~~~~~'
-         WRITE(numout,*) ' coupling     flag (ln_iscpl )            = ', ln_iscpl
-         WRITE(numout,*) ' conservation flag (ln_hsb   )            = ', ln_hsb
-         WRITE(numout,*) ' nb of stp for cons (rn_fiscpl)           = ', nstp_iscpl
-         IF (nstp_iscpl .NE. nn_fiscpl) WRITE(numout,*) 'W A R N I N G: nb of stp for cons has been modified &
-            &                                           (larger than run length)'
-         WRITE(numout,*) ' coupling time step                       = ', rdt_iscpl
-         WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown
-      END IF
-
-   END SUBROUTINE iscpl_init
-
-END MODULE iscplini
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iscplrst.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/iscplrst.f90	(revision 12100)
+++ 	(revision )
@@ -1,451 +1,0 @@
-MODULE iscplrst
-   !!======================================================================
-   !!                       ***  MODULE  iscplrst***
-   !! Ocean forcing: update the restart file in case of ice sheet/ocean coupling
-   !!=====================================================================
-   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   iscpl_stp          : step management
-   !!   iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet
-   !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE domwri          ! ocean space and time domain
-   USE domvvl, ONLY : dom_vvl_interpol
-   USE phycst          ! physical constants
-   USE sbc_oce         ! surface boundary condition variables
-   USE oce             ! global tra/dyn variable
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O module
-   USE lib_mpp         ! MPP library
-   USE lib_fortran     ! MPP library
-   USE wrk_nemo        ! Memory allocation
-   USE lbclnk          ! communication
-   USE iscplini        ! ice sheet coupling: initialisation
-   USE iscplhsb        ! ice sheet coupling: conservation
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   iscpl_stp          ! step management 
-   !!
-   !! * Substitutions  
-   !!----------------------------------------------------------------------
-   !!                   ***  vectopt_loop_substitute  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
-   !!                allow unrolling of do-loop (useful with vector processors)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
-   !! Software governed by the CeCILL licence (./LICENSE)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE iscpl_stp
-      !!---------------------------------------------------------------------- 
-      !!                   ***  ROUTINE iscpl_stp  ***
-      !! 
-      !! ** Purpose : compute initialisation
-      !!              compute extrapolation of restart variable un, vn, tsn, sshn (wetting/drying)   
-      !!              compute correction term if needed
-      !! 
-      !!----------------------------------------------------------------------
-      INTEGER  ::   inum0
-      REAL(wp), DIMENSION(:,:  ), POINTER :: zsmask_b
-      REAL(wp), DIMENSION(:,:,:), POINTER :: ztmask_b, zumask_b, zvmask_b
-      REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t_b  , ze3u_b  , ze3v_b  
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zdepw_b
-      CHARACTER(20) :: cfile
-      !!----------------------------------------------------------------------
-
-      CALL wrk_alloc(jpi,jpj,jpk, ztmask_b, zumask_b, zvmask_b) ! mask before
-      CALL wrk_alloc(jpi,jpj,jpk, ze3t_b  , ze3u_b  , ze3v_b  ) ! e3   before
-      CALL wrk_alloc(jpi,jpj,jpk, zdepw_b )
-      CALL wrk_alloc(jpi,jpj,     zsmask_b                    )
-
-
-      !! get restart variable
-      CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b   ) ! need to extrapolate T/S
-      CALL iom_get( numror, jpdom_autoglo, 'umask'  , zumask_b   ) ! need to correct barotropic velocity
-      CALL iom_get( numror, jpdom_autoglo, 'vmask'  , zvmask_b   ) ! need to correct barotropic velocity
-      CALL iom_get( numror, jpdom_autoglo, 'smask'  , zsmask_b   ) ! need to correct barotropic velocity
-      CALL iom_get( numror, jpdom_autoglo, 'e3t_n'  , ze3t_b(:,:,:) )  ! need to compute temperature correction
-      CALL iom_get( numror, jpdom_autoglo, 'e3u_n'  , ze3u_b(:,:,:) )  ! need to correct barotropic velocity
-      CALL iom_get( numror, jpdom_autoglo, 'e3v_n'  , ze3v_b(:,:,:) )  ! need to correct barotropic velocity
-      CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl)
-
-      !! read namelist
-      CALL iscpl_init()
-
-      !!  ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl)
-      CALL iscpl_rst_interpol( ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b )
-
-      !! compute correction if conservation needed
-      IF ( ln_hsb ) THEN
-         IF( iscpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'rst_iscpl : unable to allocate rst_iscpl arrays' )
-         CALL iscpl_cons(ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl)
-      END IF
-         
-      !! print mesh/mask
-      IF( nmsh /= 0 .AND. ln_iscpl )   CALL dom_wri      ! Create a domain file
-
-      IF ( ln_hsb ) THEN
-         cfile='correction'
-         cfile = TRIM( cfile )
-         CALL iom_open  ( cfile, inum0, ldwrt = .TRUE., kiolib = jprstlib )
-         CALL iom_rstput( 0, 0, inum0, 'vol_cor', hdiv_iscpl(:,:,:) )
-         CALL iom_rstput( 0, 0, inum0, 'tem_cor', htsc_iscpl(:,:,:,jp_tem) )
-         CALL iom_rstput( 0, 0, inum0, 'sal_cor', htsc_iscpl(:,:,:,jp_sal) )
-         CALL iom_close ( inum0 )
-      END IF
-
-      CALL wrk_dealloc(jpi,jpj,jpk, ztmask_b,zumask_b,zvmask_b )  
-      CALL wrk_dealloc(jpi,jpj,jpk, ze3t_b  ,ze3u_b  ,ze3v_b   )  
-      CALL wrk_dealloc(jpi,jpj,jpk, zdepw_b                    )
-      CALL wrk_dealloc(jpi,jpj,     zsmask_b                   )
-
-      !! next step is an euler time step
-      neuler = 0
-
-      !! set _b and _n variables equal
-      tsb (:,:,:,:) = tsn (:,:,:,:)
-      ub  (:,:,:  ) = un  (:,:,:  )
-      vb  (:,:,:  ) = vn  (:,:,:  )
-      sshb(:,:    ) = sshn(:,:)
-
-      !! set _b and _n vertical scale factor equal
-      e3t_b (:,:,:) = e3t_n (:,:,:)
-      e3u_b (:,:,:) = e3u_n (:,:,:)
-      e3v_b (:,:,:) = e3v_n (:,:,:)
-
-      e3uw_b(:,:,:)  = e3uw_n(:,:,:)
-      e3vw_b(:,:,:)  = e3vw_n(:,:,:)
-      gdept_b(:,:,:)  = gdept_n(:,:,:)
-      gdepw_b(:,:,:) = gdepw_n(:,:,:)
-      hu_b (:,:) = hu_n(:,:)
-      hv_b (:,:) = hv_n(:,:)
-      r1_hu_b(:,:) = r1_hu_n(:,:)
-      r1_hv_b(:,:) = r1_hv_n(:,:)
-      !
-   END SUBROUTINE iscpl_stp
-   
-   SUBROUTINE iscpl_rst_interpol (ptmask_b, pumask_b, pvmask_b, psmask_b, pe3t_b, pe3u_b, pe3v_b, pdepw_b)
-      !!---------------------------------------------------------------------- 
-      !!                   ***  ROUTINE iscpl_rst_interpol  ***
-      !! 
-      !! ** Purpose :   compute new tn, sn, un, vn and sshn in case of evolving geometry of ice shelves 
-      !!                compute 2d fields of heat, salt and volume correction
-      !! 
-      !! ** Method  :   tn, sn : extrapolation from neigbourg cells
-      !!                un, vn : fill with 0 velocity and keep barotropic transport by modifing surface velocity or adjacent velocity
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: ptmask_b, pumask_b, pvmask_b    !! mask before
-      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pe3t_b  , pe3u_b  , pe3v_b      !! scale factor before
-      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pdepw_b                         !! depth w before
-      REAL(wp), DIMENSION(:,:    ), INTENT(in ) :: psmask_b                        !! mask before
-      !!
-      INTEGER :: ji, jj, jk, iz          !! loop index
-      INTEGER :: jip1, jim1, jjp1, jjm1, jkp1, jkm1
-      !!
-      REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb
-      REAL(wp):: zdz, zdzm1, zdzp1
-      !!
-      REAL(wp), DIMENSION(:,:    ), POINTER :: zdmask , zdsmask, zvcorr, zucorr, zde3t
-      REAL(wp), DIMENSION(:,:    ), POINTER :: zbub   , zbvb   , zbun  , zbvn
-      REAL(wp), DIMENSION(:,:    ), POINTER :: zssh0  , zssh1, zhu1, zhv1
-      REAL(wp), DIMENSION(:,:    ), POINTER :: zsmask0, zsmask1
-      REAL(wp), DIMENSION(:,:,:  ), POINTER :: ztmask0, ztmask1, ztrp
-      REAL(wp), DIMENSION(:,:,:  ), POINTER :: zwmaskn, zwmaskb, ztmp3d
-      REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0
-      !!----------------------------------------------------------------------
-
-      !! allocate variables
-      CALL wrk_alloc(jpi,jpj,jpk,2, zts0                                   )
-      CALL wrk_alloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp, ztmp3d        ) 
-      CALL wrk_alloc(jpi,jpj,jpk,   zwmaskn, zwmaskb                       ) 
-      CALL wrk_alloc(jpi,jpj,       zsmask0, zsmask1                       ) 
-      CALL wrk_alloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t) 
-      CALL wrk_alloc(jpi,jpj,       zbub   , zbvb    , zbun , zbvn         ) 
-      CALL wrk_alloc(jpi,jpj,       zssh0  , zssh1, zhu1, zhv1             ) 
-
-      !! mask value to be sure
-      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * ptmask_b(:,:,:)
-      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * ptmask_b(:,:,:)
-      
-      ! compute wmask
-      zwmaskn(:,:,1) = tmask   (:,:,1)
-      zwmaskb(:,:,1) = ptmask_b(:,:,1)
-      DO jk = 2,jpk
-         zwmaskn(:,:,jk) =  tmask  (:,:,jk) *  tmask  (:,:,jk-1)
-         zwmaskb(:,:,jk) = ptmask_b(:,:,jk) * ptmask_b(:,:,jk-1)
-      END DO
-           
-      ! compute new ssh if we open a full water column (average of the closest neigbourgs)  
-      sshb (:,:)=sshn(:,:)
-      zssh0(:,:)=sshn(:,:)
-      zsmask0(:,:) = psmask_b(:,:)
-      zsmask1(:,:) = psmask_b(:,:)
-      DO iz = 1,10    ! need to be tuned (configuration dependent) (OK for ISOMIP+)
-         zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:)
-         DO jj = 2,jpj-1
-            DO ji = 2, jpim1   ! vector opt.
-               jip1=ji+1; jim1=ji-1;
-               jjp1=jj+1; jjm1=jj-1;
-               summsk=(zsmask0(jip1,jj)+zsmask0(jim1,jj)+zsmask0(ji,jjp1)+zsmask0(ji,jjm1))
-               IF (zdsmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN
-                  sshn(ji,jj)=( zssh0(jip1,jj)*zsmask0(jip1,jj)     &
-                  &           + zssh0(jim1,jj)*zsmask0(jim1,jj)     &
-                  &           + zssh0(ji,jjp1)*zsmask0(ji,jjp1)     &
-                  &           + zssh0(ji,jjm1)*zsmask0(ji,jjm1))/summsk
-                  zsmask1(ji,jj)=1._wp
-               END IF
-            END DO
-         END DO
-         CALL lbc_lnk(sshn,'T',1._wp)
-         CALL lbc_lnk(zsmask1,'T',1._wp)
-         zssh0   = sshn
-         zsmask0 = zsmask1
-      END DO
-      sshn(:,:) = sshn(:,:) * ssmask(:,:)
-
-!=============================================================================
-!PM: Is this needed since introduction of VVL by default?
-      IF (.NOT.ln_linssh) THEN
-      ! Reconstruction of all vertical scale factors at now time steps
-      ! =============================================================================
-      ! Horizontal scale factor interpolations
-      ! --------------------------------------
-         DO jk = 1,jpk
-            DO jj=1,jpj
-               DO ji=1,jpi
-                  IF (tmask(ji,jj,1) == 0._wp .OR. ptmask_b(ji,jj,1) == 0._wp) THEN
-                     e3t_n(ji,jj,jk) = e3t_0(ji,jj,jk) * ( 1._wp + sshn(ji,jj) / ( ht_0(ji,jj) + 1._wp - ssmask(ji,jj) ) * tmask(ji,jj,jk) )
-                  ENDIF
-               END DO
-            END DO
-         END DO
-
-         CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
-         CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
-         CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
-
-      ! Vertical scale factor interpolations
-      ! ------------------------------------
-         CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
-         CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
-         CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
-
-      ! t- and w- points depth
-      ! ----------------------
-         gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
-         gdepw_n(:,:,1) = 0.0_wp
-         gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               DO jk = 2,mikt(ji,jj)-1
-                  gdept_n(ji,jj,jk) = gdept_0(ji,jj,jk)
-                  gdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
-                  gde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj)
-               END DO
-               IF (mikt(ji,jj) > 1) THEN
-                  jk = mikt(ji,jj)
-                  gdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * e3w_n(ji,jj,jk)
-                  gdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
-                  gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn   (ji,jj)
-               END IF
-               DO jk = mikt(ji,jj)+1, jpk
-                  gdept_n(ji,jj,jk) = gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)
-                  gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
-                  gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn (ji,jj)
-               END DO
-            END DO
-         END DO
-
-      ! t-, u- and v- water column thickness
-      ! ------------------------------------
-         ht_n(:,:) = 0._wp ; hu_n(:,:) = 0._wp ; hv_n(:,:) = 0._wp
-         DO jk = 1, jpkm1
-            hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
-            hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
-            ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
-         END DO
-         !                                        ! Inverse of the local depth
-         r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) * ssumask(:,:)
-         r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:)
-
-      END IF
-
-!=============================================================================
-! compute velocity
-! compute velocity in order to conserve barotropic velocity (modification by poderation of the scale factor).
-      ub(:,:,:)=un(:,:,:)
-      vb(:,:,:)=vn(:,:,:)
-      DO jk = 1,jpk
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               un(ji,jj,jk) = ub(ji,jj,jk)*pe3u_b(ji,jj,jk)*pumask_b(ji,jj,jk)/e3u_n(ji,jj,jk)*umask(ji,jj,jk);
-               vn(ji,jj,jk) = vb(ji,jj,jk)*pe3v_b(ji,jj,jk)*pvmask_b(ji,jj,jk)/e3v_n(ji,jj,jk)*vmask(ji,jj,jk);
-            END DO
-         END DO
-      END DO
-
-! compute new velocity if we close a cell (check barotropic velocity and change velocity over the water column)
-! compute barotropic velocity now and after 
-      ztrp(:,:,:) = ub(:,:,:)*pe3u_b(:,:,:); 
-      zbub(:,:)   = SUM(ztrp,DIM=3)
-      ztrp(:,:,:) = vb(:,:,:)*pe3v_b(:,:,:); 
-      zbvb(:,:)   = SUM(ztrp,DIM=3)
-      ztrp(:,:,:) = un(:,:,:)*e3u_n(:,:,:); 
-      zbun(:,:)   = SUM(ztrp,DIM=3)
-      ztrp(:,:,:) = vn(:,:,:)*e3v_n(:,:,:); 
-      zbvn(:,:)   = SUM(ztrp,DIM=3)
-
-      ! new water column
-      zhu1=0.0_wp ;
-      zhv1=0.0_wp ;
-      DO jk  = 1,jpk
-        zhu1(:,:) = zhu1(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
-        zhv1(:,:) = zhv1(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
-      END DO
-      
-      ! compute correction      
-      zucorr = 0._wp
-      zvcorr = 0._wp
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-            IF (zbun(ji,jj) /= zbub(ji,jj) .AND. zhu1(ji,jj) /= 0._wp ) THEN
-               zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/zhu1(ji,jj)
-            END IF
-            IF (zbvn(ji,jj) /= zbvb(ji,jj) .AND. zhv1(ji,jj) /= 0._wp ) THEN
-               zvcorr(ji,jj) = (zbvn(ji,jj) - zbvb(ji,jj))/zhv1(ji,jj)
-            END IF
-         END DO
-      END DO 
-      
-      ! update velocity
-      DO jk  = 1,jpk
-         un(:,:,jk)=(un(:,:,jk) - zucorr(:,:))*umask(:,:,jk)
-         vn(:,:,jk)=(vn(:,:,jk) - zvcorr(:,:))*vmask(:,:,jk)
-      END DO
-
-!=============================================================================
-      ! compute temp and salt
-      ! compute new tn and sn if we open a new cell
-      tsb (:,:,:,:) = tsn(:,:,:,:)
-      zts0(:,:,:,:) = tsn(:,:,:,:)
-      ztmask1(:,:,:) = ptmask_b(:,:,:)
-      ztmask0(:,:,:) = ptmask_b(:,:,:)
-      DO iz = 1,nn_drown ! resolution dependent (OK for ISOMIP+ case)
-          DO jk = 1,jpk-1
-              zdmask=tmask(:,:,jk)-ztmask0(:,:,jk);
-              DO jj = 2,jpj-1
-                 DO ji = 2,jpim1
-                      jip1=ji+1; jim1=ji-1;
-                      jjp1=jj+1; jjm1=jj-1;
-                      summsk= (ztmask0(jip1,jj  ,jk)+ztmask0(jim1,jj  ,jk)+ztmask0(ji  ,jjp1,jk)+ztmask0(ji  ,jjm1,jk))
-                      IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN
-                      !! horizontal basic extrapolation
-                         tsn(ji,jj,jk,1)=( zts0(jip1,jj  ,jk,1)*ztmask0(jip1,jj  ,jk) &
-                         &                +zts0(jim1,jj  ,jk,1)*ztmask0(jim1,jj  ,jk) &
-                         &                +zts0(ji  ,jjp1,jk,1)*ztmask0(ji  ,jjp1,jk) &
-                         &                +zts0(ji  ,jjm1,jk,1)*ztmask0(ji  ,jjm1,jk) ) / summsk
-                         tsn(ji,jj,jk,2)=( zts0(jip1,jj  ,jk,2)*ztmask0(jip1,jj  ,jk) &
-                         &                +zts0(jim1,jj  ,jk,2)*ztmask0(jim1,jj  ,jk) &
-                         &                +zts0(ji  ,jjp1,jk,2)*ztmask0(ji  ,jjp1,jk) &
-                         &                +zts0(ji  ,jjm1,jk,2)*ztmask0(ji  ,jjm1,jk) ) / summsk
-                         ztmask1(ji,jj,jk)=1
-                      ELSEIF (zdmask(ji,jj) == 1._wp .AND. summsk == 0._wp) THEN
-                      !! vertical extrapolation if horizontal extrapolation failed
-                         jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1)
-                         summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1))
-                         IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp ) THEN
-                            tsn(ji,jj,jk,1)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1)     &
-                            &                +zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1))/summsk
-                            tsn(ji,jj,jk,2)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1)     &
-                            &                +zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1))/summsk
-                            ztmask1(ji,jj,jk)=1._wp
-                         END IF
-                      END IF
-                  END DO
-              END DO
-          END DO
-          
-          CALL lbc_lnk(tsn(:,:,:,1),'T',1._wp)
-          CALL lbc_lnk(tsn(:,:,:,2),'T',1._wp)
-          CALL lbc_lnk(ztmask1,     'T',1._wp)
-
-          ! update
-          zts0(:,:,:,:) = tsn(:,:,:,:)
-          ztmask0 = ztmask1
-
-      END DO
-
-      ! mask new tsn field
-      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:)
-      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:)
-
-      ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask
-      !PM: Is this IF needed since change to VVL by default
-      IF (.NOT.ln_linssh) THEN
-         DO jk = 2,jpk-1
-            DO jj = 1,jpj
-               DO ji = 1,jpi
-                  IF (zwmaskn(ji,jj,jk) * zwmaskb(ji,jj,jk) == 1._wp .AND. (tmask(ji,jj,1)==0._wp .OR. ptmask_b(ji,jj,1)==0._wp) ) THEN
-                     !compute weight
-                     zdzp1 = MAX(0._wp,gdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk+1))
-                     zdz   =           gdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk  ) 
-                     zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk  ) - gdepw_n(ji,jj,jk  ))
-                     IF (zdz .LT. 0._wp) THEN 
-                        CALL ctl_stop( 'STOP', 'rst_iscpl : unable to compute the interpolation' )
-                     END IF
-                     tsn(ji,jj,jk,jp_tem) = ( zdzp1*tsb(ji,jj,jk+1,jp_tem)      &
-                        &                   + zdz  *tsb(ji,jj,jk  ,jp_tem)      &
-                        &                   + zdzm1*tsb(ji,jj,jk-1,jp_tem)      )/e3t_n(ji,jj,jk)
-                     tsn(ji,jj,jk,jp_sal) = ( zdzp1*tsb(ji,jj,jk+1,jp_sal)      &
-                        &                   + zdz  *tsb(ji,jj,jk  ,jp_sal)      &
-                        &                   + zdzm1*tsb(ji,jj,jk-1,jp_sal)      )/e3t_n(ji,jj,jk)
-                  END IF
-               END DO
-            END DO
-         END DO               
-      END IF
-
-      ! closed pool
-      ! -----------------------------------------------------------------------------------------
-      ! case we open a cell but no neigbour cells available to get an estimate of T and S
-      WHERE (tmask(:,:,:) == 1._wp .AND. tsn(:,:,:,2) == 0._wp) 
-         tsn(:,:,:,2) = -99._wp  ! Special value for closed pool (checking purpose in output.init)
-         tmask(:,:,:) = 0._wp    ! set mask to 0 to run
-         umask(:,:,:) = 0._wp
-         vmask(:,:,:) = 0._wp
-      END WHERE
-      
-      ! set mbkt and mikt to 1 in thiese location
-      WHERE (SUM(tmask,dim=3) == 0)
-         mbkt(:,:)=1 ; mbku(:,:)=1 ; mbkv(:,:)=1
-         mikt(:,:)=1 ; miku(:,:)=1 ; mikv(:,:)=1
-      END WHERE
-      ! -------------------------------------------------------------------------------------------
-      ! compute new tn and sn if we close cell 
-      ! nothing to do
-      ! 
-      ! deallocation tmp arrays
-      CALL wrk_dealloc(jpi,jpj,jpk,2, zts0                                   )
-      CALL wrk_dealloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp                ) 
-      CALL wrk_dealloc(jpi,jpj,jpk,   zwmaskn, zwmaskb , ztmp3d              ) 
-      CALL wrk_dealloc(jpi,jpj,       zsmask0, zsmask1                       ) 
-      CALL wrk_dealloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t) 
-      CALL wrk_dealloc(jpi,jpj,       zbub   , zbvb    , zbun  , zbvn        ) 
-      CALL wrk_dealloc(jpi,jpj,       zssh0  , zssh1  , zhu1 , zhv1          ) 
-
-   END SUBROUTINE iscpl_rst_interpol
-
-END MODULE iscplrst
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/istate.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/istate.f90	(revision 12100)
+++ 	(revision )
@@ -1,516 +1,0 @@
-MODULE istate
-   !!======================================================================
-   !!                     ***  MODULE  istate  ***
-   !! Ocean state   :  initial state setting
-   !!=====================================================================
-   !! History :  OPA  !  1989-12  (P. Andrich)  Original code
-   !!            5.0  !  1991-11  (G. Madec)  rewritting
-   !!            6.0  !  1996-01  (G. Madec)  terrain following coordinates
-   !!            8.0  !  2001-09  (M. Levy, M. Ben Jelloul)  istate_eel
-   !!            8.0  !  2001-09  (M. Levy, M. Ben Jelloul)  istate_uvg
-   !!   NEMO     1.0  !  2003-08  (G. Madec, C. Talandier)  F90: Free form, modules + EEL R5
-   !!             -   !  2004-05  (A. Koch-Larrouy)  istate_gyre 
-   !!            2.0  !  2006-07  (S. Masson)  distributed restart using iom
-   !!            3.3  !  2010-10  (C. Ethe) merge TRC-TRA
-   !!            3.4  !  2011-04  (G. Madec) Merge of dtatem and dtasal & suppression of tb,tn/sb,sn 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   istate_init   : initial state setting
-   !!   istate_tem    : analytical profile for initial Temperature
-   !!   istate_sal    : analytical profile for initial Salinity
-   !!   istate_eel    : initial state setting of EEL R5 configuration
-   !!   istate_gyre   : initial state setting of GYRE configuration
-   !!   istate_uvg    : initial velocity in geostropic balance
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers 
-   USE dom_oce         ! ocean space and time domain 
-   USE c1d             ! 1D vertical configuration
-   USE daymod          ! calendar
-   USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine)
-   USE ldftra          ! lateral physics: ocean active tracers
-   USE zdf_oce         ! ocean vertical physics
-   USE phycst          ! physical constants
-   USE dtatsd          ! data temperature and salinity   (dta_tsd routine)
-   USE dtauvd          ! data: U & V current             (dta_uvd routine)
-   USE domvvl          ! varying vertical mesh
-   USE iscplrst        ! ice sheet coupling
-   !
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O library
-   USE lib_mpp         ! MPP library
-   USE restart         ! restart
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   istate_init   ! routine called by step.F90
-
-   !! * Substitutions
-   !!----------------------------------------------------------------------
-   !!                   ***  vectopt_loop_substitute  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
-   !!                allow unrolling of do-loop (useful with vector processors)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
-   !! Software governed by the CeCILL licence (./LICENSE)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: istate.F90 6140 2015-12-21 11:35:23Z timgraham $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE istate_init
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE istate_init  ***
-      !! 
-      !! ** Purpose :   Initialization of the dynamics and tracer fields.
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('istate_init')
-      !
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-
-                     CALL dta_tsd_init        ! Initialisation of T & S input data
-      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data
-
-      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk
-      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk
-      tsa  (:,:,:,:) = 0._wp                                   ! set one for all to 0 at level jpk
-      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk
-
-      IF( ln_rstart ) THEN                    ! Restart from a file
-         !                                    ! -------------------
-         CALL rst_read                        ! Read the restart file
-         IF (ln_iscpl)       CALL iscpl_stp   ! extraloate restart to wet and dry
-         CALL day_init                        ! model calendar (using both namelist and restart infos)
-      ELSE
-         !                                    ! Start from rest
-         !                                    ! ---------------
-         numror = 0                              ! define numror = 0 -> no restart file to read
-         neuler = 0                              ! Set time-step indicator at nit000 (euler forward)
-         CALL day_init                           ! model calendar (using both namelist and restart infos)
-         !                                       ! Initialization of ocean to zero
-         !   before fields      !       now fields     
-         sshb (:,:)   = 0._wp   ;   sshn (:,:)   = 0._wp
-         ub   (:,:,:) = 0._wp   ;   un   (:,:,:) = 0._wp
-         vb   (:,:,:) = 0._wp   ;   vn   (:,:,:) = 0._wp  
-                                    hdivn(:,:,:) = 0._wp
-         !
-         IF( cp_cfg == 'eel' ) THEN
-            CALL istate_eel                      ! EEL   configuration : start from pre-defined U,V T-S fields
-         ELSEIF( cp_cfg == 'gyre' ) THEN         
-            CALL istate_gyre                     ! GYRE  configuration : start from pre-defined T-S fields
-         ELSE                                    ! Initial T-S, U-V fields read in files
-            IF ( ln_tsd_init ) THEN              ! read 3D T and S data at nit000
-               CALL dta_tsd( nit000, tsb )  
-               tsn(:,:,:,:) = tsb(:,:,:,:)
-               !
-            ELSE                                 ! Initial T-S fields defined analytically
-               CALL istate_t_s
-            ENDIF
-            IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000
-               CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd )
-               CALL dta_uvd( nit000, zuvd )
-               ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:)
-               vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:)
-               CALL wrk_dealloc( jpi,jpj,jpk,2,   zuvd )
-            ENDIF
-         ENDIF
-         !
-!!gm This is to be changed !!!!
-         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here
-         IF( .NOT.ln_linssh ) THEN
-            DO jk = 1, jpk
-               e3t_b(:,:,jk) = e3t_n(:,:,jk)
-            END DO
-         ENDIF
-!!gm 
-         ! 
-      ENDIF
-      ! 
-      ! Initialize "now" and "before" barotropic velocities:
-      ! Do it whatever the free surface method, these arrays being eventually used
-      !
-      un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp
-      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp
-      !
-!!gm  the use of umsak & vmask is not necessary belox as un, vn, ub, vb are always masked
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               un_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
-               vn_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
-               !
-               ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)
-               vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      !
-      un_b(:,:) = un_b(:,:) * r1_hu_n(:,:)
-      vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:)
-      !
-      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)
-      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('istate_init')
-      !
-   END SUBROUTINE istate_init
-
-
-   SUBROUTINE istate_t_s
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE istate_t_s  ***
-      !!   
-      !! ** Purpose :   Intialization of the temperature field with an 
-      !!      analytical profile or a file (i.e. in EEL configuration)
-      !!
-      !! ** Method  : - temperature: use Philander analytic profile
-      !!              - salinity   : use to a constant value 35.5
-      !!
-      !! References :  Philander ???
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk
-      REAL(wp) ::   zsal = 35.50_wp
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'istate_t_s : Philander s initial temperature profile'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~   and constant salinity (',zsal,' psu)'
-      !
-      DO jk = 1, jpk
-         tsn(:,:,jk,jp_tem) = (  ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((gdept_n(:,:,jk)-80.)/30.) )   &
-            &                + 10. * ( 5000. - gdept_n(:,:,jk) ) /5000.)  ) * tmask(:,:,jk)
-         tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem)
-      END DO
-      tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:)
-      tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
-      !
-   END SUBROUTINE istate_t_s
-
-
-   SUBROUTINE istate_eel
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE istate_eel  ***
-      !! 
-      !! ** Purpose :   Initialization of the dynamics and tracers for EEL R5
-      !!      configuration (channel with or without a topographic bump)
-      !!
-      !! ** Method  : - set temprature field
-      !!              - set salinity field
-      !!              - set velocity field including horizontal divergence
-      !!                and relative vorticity fields
-      !!----------------------------------------------------------------------
-      USE divhor     ! hor. divergence      (div_hor routine)
-      USE iom
-      !
-      INTEGER  ::   inum              ! temporary logical unit
-      INTEGER  ::   ji, jj, jk        ! dummy loop indices
-      INTEGER  ::   ijloc
-      REAL(wp) ::   zh1, zh2, zslope, zcst, zfcor   ! temporary scalars
-      REAL(wp) ::   zt1  = 15._wp                   ! surface temperature value (EEL R5)
-      REAL(wp) ::   zt2  =  5._wp                   ! bottom  temperature value (EEL R5)
-      REAL(wp) ::   zsal = 35.0_wp                  ! constant salinity (EEL R2, R5 and R6)
-      REAL(wp) ::   zueel = 0.1_wp                  ! constant uniform zonal velocity (EEL R5)
-      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zssh  ! initial ssh over the global domain
-      !!----------------------------------------------------------------------
-      !
-      SELECT CASE ( jp_cfg ) 
-         !                                              ! ====================
-         CASE ( 5 )                                     ! EEL R5 configuration
-            !                                           ! ====================
-            !
-            ! set temperature field with a linear profile
-            ! -------------------------------------------
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: linear temperature profile'
-            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-            !
-            zh1 = gdept_1d(  1  )
-            zh2 = gdept_1d(jpkm1)
-            !
-            zslope = ( zt1 - zt2 ) / ( zh1 - zh2 )
-            zcst   = ( zt1 * ( zh1 - zh2) - ( zt1 - zt2 ) * zh1 ) / ( zh1 - zh2 )
-            !
-            DO jk = 1, jpk
-               tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - gdept_n(:,:,jk) / 1000 ) ) * tmask(:,:,jk)
-               tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem)
-            END DO
-            !
-            ! set salinity field to a constant value
-            ! --------------------------------------
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
-            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-            !
-            tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:)
-            tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
-            !
-            ! set the dynamics: U,V, hdiv (and ssh if necessary)
-            ! ----------------
-            ! Start EEL5 configuration with barotropic geostrophic velocities 
-            ! according the sshb and sshn SSH imposed.
-            ! we assume a uniform grid (hence the use of e1t(1,1) for delta_y)
-            ! we use the Coriolis frequency at mid-channel.   
-            ub(:,:,:) = zueel * umask(:,:,:)
-            un(:,:,:) = ub(:,:,:)
-            ijloc = mj0(INT(jpjglo-1)/2)
-            zfcor = ff(1,ijloc)
-            !
-            DO jj = 1, jpjglo
-               zssh(:,jj) = - (FLOAT(jj)- FLOAT(jpjglo-1)/2.)*zueel*e1t(1,1)*zfcor/grav 
-            END DO
-            !
-            IF(lwp) THEN
-               WRITE(numout,*) ' Uniform zonal velocity for EEL R5:',zueel
-               WRITE(numout,*) ' Geostrophic SSH profile as a function of y:'
-               WRITE(numout,'(12(1x,f6.2))') zssh(1,:)
-            ENDIF
-            !
-            DO jj = 1, nlcj
-               DO ji = 1, nlci
-                  sshb(ji,jj) = zssh( mig(ji) , mjg(jj) ) * tmask(ji,jj,1)
-               END DO
-            END DO
-            sshb(nlci+1:jpi,      :   ) = 0.e0      ! set to zero extra mpp columns
-            sshb(      :   ,nlcj+1:jpj) = 0.e0      ! set to zero extra mpp rows
-            !
-            sshn(:,:) = sshb(:,:)                   ! set now ssh to the before value
-            !
-            IF( nn_rstssh /= 0 ) THEN  
-               nn_rstssh = 0                        ! hand-made initilization of ssh 
-               CALL ctl_warn( 'istate_eel: force nn_rstssh = 0' )
-            ENDIF
-            !
-!!gm  Check  here call to div_hor should not be necessary
-!!gm         div_hor call runoffs  not sure they are defined at that level
-            CALL div_hor( nit000 )                  ! horizontal divergence and relative vorticity (curl)
-            ! N.B. the vertical velocity will be computed from the horizontal divergence field
-            ! in istate by a call to wzv routine
-
-
-            !                                     ! ==========================
-         CASE ( 2 , 6 )                           ! EEL R2 or R6 configuration
-            !                                     ! ==========================
-            !
-            ! set temperature field with a NetCDF file
-            ! ----------------------------------------
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R2 or R6: read initial temperature in a NetCDF file'
-            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-            !
-            CALL iom_open ( 'eel.initemp', inum )
-            CALL iom_get ( inum, jpdom_data, 'initemp', tsb(:,:,:,jp_tem) ) ! read before temprature (tb)
-            CALL iom_close( inum )
-            !
-            tsn(:,:,:,jp_tem) = tsb(:,:,:,jp_tem)                            ! set nox temperature to tb
-            !
-            ! set salinity field to a constant value
-            ! --------------------------------------
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
-            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-            !
-            tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:)
-            tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
-            !
-            !                                    ! ===========================
-         CASE DEFAULT                            ! NONE existing configuration
-            !                                    ! ===========================
-            WRITE(ctmp1,*) 'EEL with a ', jp_cfg,' km resolution is not coded'
-            CALL ctl_stop( ctmp1 )
-            !
-      END SELECT
-      !
-   END SUBROUTINE istate_eel
-
-
-   SUBROUTINE istate_gyre
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE istate_gyre  ***
-      !! 
-      !! ** Purpose :   Initialization of the dynamics and tracers for GYRE
-      !!      configuration (double gyre with rotated domain)
-      !!
-      !! ** Method  : - set temprature field
-      !!              - set salinity   field
-      !!----------------------------------------------------------------------
-      INTEGER :: ji, jj, jk  ! dummy loop indices
-      INTEGER            ::   inum          ! temporary logical unit
-      INTEGER, PARAMETER ::   ntsinit = 0   ! (0/1) (analytical/input data files) T&S initialization
-      !!----------------------------------------------------------------------
-      !
-      SELECT CASE ( ntsinit)
-      !
-      CASE ( 0 )                  ! analytical T/S profil deduced from LEVITUS
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'istate_gyre : initial analytical T and S profil deduced from LEVITUS '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-         !
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  tsn(ji,jj,jk,jp_tem) = (  16. - 12. * TANH( (gdept_n(ji,jj,jk) - 400) / 700 )         )   &
-                       &           * (-TANH( (500-gdept_n(ji,jj,jk)) / 150 ) + 1) / 2               &
-                       &       + (      15. * ( 1. - TANH( (gdept_n(ji,jj,jk)-50.) / 1500.) )       &
-                       &                - 1.4 * TANH((gdept_n(ji,jj,jk)-100.) / 100.)               &    
-                       &                + 7.  * (1500. - gdept_n(ji,jj,jk)) / 1500.             )   & 
-                       &           * (-TANH( (gdept_n(ji,jj,jk) - 500) / 150) + 1) / 2
-                  tsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
-                  tsb(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem)
-
-                  tsn(ji,jj,jk,jp_sal) =  (  36.25 - 1.13 * TANH( (gdept_n(ji,jj,jk) - 305) / 460 )  )  &
-                     &              * (-TANH((500 - gdept_n(ji,jj,jk)) / 150) + 1) / 2          &
-                     &          + (  35.55 + 1.25 * (5000. - gdept_n(ji,jj,jk)) / 5000.         &
-                     &                - 1.62 * TANH( (gdept_n(ji,jj,jk) - 60.  ) / 650. )       &
-                     &                + 0.2  * TANH( (gdept_n(ji,jj,jk) - 35.  ) / 100. )       &
-                     &                + 0.2  * TANH( (gdept_n(ji,jj,jk) - 1000.) / 5000.)    )  &
-                     &              * (-TANH((gdept_n(ji,jj,jk) - 500) / 150) + 1) / 2 
-                  tsn(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
-                  tsb(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal)
-               END DO
-            END DO
-         END DO
-         !
-      CASE ( 1 )                  ! T/S data fields read in dta_tem.nc/data_sal.nc files
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'istate_gyre : initial T and S read from dta_tem.nc/data_sal.nc files'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-         IF(lwp) WRITE(numout,*) '              NetCDF FORMAT'
-
-         ! Read temperature field
-         ! ----------------------
-         CALL iom_open ( 'data_tem', inum )
-         CALL iom_get ( inum, jpdom_data, 'votemper', tsn(:,:,:,jp_tem) ) 
-         CALL iom_close( inum )
-
-         tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:) 
-         tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)
-
-         ! Read salinity field
-         ! -------------------
-         CALL iom_open ( 'data_sal', inum )
-         CALL iom_get ( inum, jpdom_data, 'vosaline', tsn(:,:,:,jp_sal) ) 
-         CALL iom_close( inum )
-
-         tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:) 
-         tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
-         !
-      END SELECT
-      !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '              Initial temperature and salinity profiles:'
-         WRITE(numout, "(9x,' level   gdept_1d   temperature   salinity   ')" )
-         WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_1d(jk), tsn(2,2,jk,jp_tem), tsn(2,2,jk,jp_sal), jk = 1, jpk )
-      ENDIF
-      !
-   END SUBROUTINE istate_gyre
-
-
-   SUBROUTINE istate_uvg
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE istate_uvg  ***
-      !!
-      !! ** Purpose :   Compute the geostrophic velocities from (tn,sn) fields
-      !!
-      !! ** Method  :   Using the hydrostatic hypothesis the now hydrostatic 
-      !!      pressure is computed by integrating the in-situ density from the
-      !!      surface to the bottom.
-      !!                 p=integral [ rau*g dz ]
-      !!----------------------------------------------------------------------
-      USE divhor          ! hor. divergence                       (div_hor routine)
-      USE lbclnk          ! ocean lateral boundary condition (or mpp link)
-      !
-      INTEGER ::   ji, jj, jk        ! dummy loop indices
-      REAL(wp) ::   zmsv, zphv, zmsu, zphu, zalfg     ! temporary scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprn
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zprn)
-      !
-      IF(lwp) WRITE(numout,*) 
-      IF(lwp) WRITE(numout,*) 'istate_uvg : Start from Geostrophy'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-
-      ! Compute the now hydrostatic pressure
-      ! ------------------------------------
-
-      zalfg = 0.5 * grav * rau0
-      
-      zprn(:,:,1) = zalfg * e3w_n(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value
-
-      DO jk = 2, jpkm1                                              ! Vertical integration from the surface
-         zprn(:,:,jk) = zprn(:,:,jk-1)   &
-            &         + zalfg * e3w_n(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) )
-      END DO  
-
-      ! Compute geostrophic balance
-      ! ---------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vertor opt.
-               zmsv = 1. / MAX(  umask(ji-1,jj+1,jk) + umask(ji  ,jj+1,jk)   &
-                               + umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk) , 1.  )
-               zphv = ( zprn(ji  ,jj+1,jk) - zprn(ji-1,jj+1,jk) ) * umask(ji-1,jj+1,jk) / e1u(ji-1,jj+1)   &
-                    + ( zprn(ji+1,jj+1,jk) - zprn(ji  ,jj+1,jk) ) * umask(ji  ,jj+1,jk) / e1u(ji  ,jj+1)   &
-                    + ( zprn(ji  ,jj  ,jk) - zprn(ji-1,jj  ,jk) ) * umask(ji-1,jj  ,jk) / e1u(ji-1,jj  )   &
-                    + ( zprn(ji+1,jj  ,jk) - zprn(ji  ,jj  ,jk) ) * umask(ji  ,jj  ,jk) / e1u(ji  ,jj  )
-               zphv = 1. / rau0 * zphv * zmsv * vmask(ji,jj,jk)
-
-               zmsu = 1. / MAX(  vmask(ji+1,jj  ,jk) + vmask(ji  ,jj  ,jk)   &
-                               + vmask(ji+1,jj-1,jk) + vmask(ji  ,jj-1,jk) , 1.  )
-               zphu = ( zprn(ji+1,jj+1,jk) - zprn(ji+1,jj  ,jk) ) * vmask(ji+1,jj  ,jk) / e2v(ji+1,jj  )   &
-                    + ( zprn(ji  ,jj+1,jk) - zprn(ji  ,jj  ,jk) ) * vmask(ji  ,jj  ,jk) / e2v(ji  ,jj  )   &
-                    + ( zprn(ji+1,jj  ,jk) - zprn(ji+1,jj-1,jk) ) * vmask(ji+1,jj-1,jk) / e2v(ji+1,jj-1)   &
-                    + ( zprn(ji  ,jj  ,jk) - zprn(ji  ,jj-1,jk) ) * vmask(ji  ,jj-1,jk) / e2v(ji  ,jj-1)
-               zphu = 1. / rau0 * zphu * zmsu * umask(ji,jj,jk)
-
-               ! Compute the geostrophic velocities
-               un(ji,jj,jk) = -2. * zphu / ( ff(ji,jj) + ff(ji  ,jj-1) )
-               vn(ji,jj,jk) =  2. * zphv / ( ff(ji,jj) + ff(ji-1,jj  ) )
-            END DO
-         END DO
-      END DO
-
-      IF(lwp) WRITE(numout,*) '         we force to zero bottom velocity'
-
-      ! Susbtract the bottom velocity (level jpk-1 for flat bottom case)
-      ! to have a zero bottom velocity
-
-      DO jk = 1, jpkm1
-         un(:,:,jk) = ( un(:,:,jk) - un(:,:,jpkm1) ) * umask(:,:,jk)
-         vn(:,:,jk) = ( vn(:,:,jk) - vn(:,:,jpkm1) ) * vmask(:,:,jk)
-      END DO
-
-      CALL lbc_lnk( un, 'U', -1. )
-      CALL lbc_lnk( vn, 'V', -1. )
-      
-      ub(:,:,:) = un(:,:,:)
-      vb(:,:,:) = vn(:,:,:)
-      
-      !
-!!gm  Check  here call to div_hor should not be necessary
-!!gm         div_hor call runoffs  not sure they are defined at that level
-      CALL div_hor( nit000 )            ! now horizontal divergence
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   zprn)
-      !
-   END SUBROUTINE istate_uvg
-
-   !!=====================================================================
-END MODULE istate
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_lnk_generic.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_lnk_generic.h90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_lnk_generic.h90	(revision 12101)
@@ -0,0 +1,117 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   define OPT_K(k)                 ,ipf
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   define OPT_K(k)                 
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#endif
+
+#if defined MULTI
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, cd_mpp, pval )
+      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+#else
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , cd_mpp, pval )
+#endif
+      CHARACTER(len=*)            , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp      ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval        ! background value (used at closed boundaries)
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh, jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl, ipf      ! dimension of the input array
+      REAL(wp) ::   zland
+      LOGICAL  ::   ll_nfd
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      ll_nfd    = jperio==3 .OR. jperio==4 .OR. jperio==5 .OR. jperio==6
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! zero by default
+      ENDIF
+
+      ! ------------------------------- !
+      !   standard boundary treatment   !    ! CAUTION: semi-column notation is often impossible
+      ! ------------------------------- !
+      !
+      IF( .NOT. PRESENT( cd_mpp ) ) THEN  !==  standard close or cyclic treatment  ==!
+         !
+         DO jf = 1, ipf                   ! number of arrays to be treated
+            !
+            !                                ! East-West boundaries
+            IF( l_Iperio ) THEN                   !* cyclic
+               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
+               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN( 1 ,:,:,:,jf) = zland    ! east except F-point
+                                               ARRAY_IN(jpi,:,:,:,jf) = zland    ! west
+            ENDIF
+            !                                ! North-South boundaries
+            IF( l_Jperio ) THEN                   !* cyclic
+               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf)
+               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,   2  ,:,:,jf)
+            ELSEIF( ll_nfd ) THEN                  !* north fold
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:, 1 ,:,:,jf) = zland    ! south except F-point
+               CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )                       ! north fold treatment         
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:, 1 ,:,:,jf) = zland    ! south except F-point
+                                               ARRAY_IN(:,jpj,:,:,jf) = zland    ! north
+            ENDIF
+            !
+         END DO
+         !
+      ENDIF
+      !
+   END SUBROUTINE ROUTINE_LNK
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef OPT_K
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_lnk_multi_generic.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_lnk_multi_generic.h90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_lnk_multi_generic.h90	(revision 12101)
@@ -0,0 +1,76 @@
+#if defined DIM_2d
+#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j)
+#   define PTR_TYPE              TYPE(PTR_2D)
+#   define PTR_ptab              pt2d
+#endif
+#if defined DIM_3d
+#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k)
+#   define PTR_TYPE              TYPE(PTR_3D)
+#   define PTR_ptab              pt3d
+#endif
+#if defined DIM_4d
+#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k,l)
+#   define PTR_TYPE              TYPE(PTR_4D)
+#   define PTR_ptab              pt4d
+#endif
+   SUBROUTINE ROUTINE_MULTI( cdname                                                    &
+      &                    , pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3   &
+      &                    , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6   &
+      &                    , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*)   ,                   INTENT(in   ) ::   cdname  ! name of the calling subroutine
+      ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) ::   pt1     ! arrays on which the lbc is applied
+      ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) ::   pt2  ,  pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9
+      CHARACTER(len=1)                     , INTENT(in   ) ::   cdna1   ! nature of pt2D. array grid-points
+      CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) ::   cdna2,  cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9
+      REAL(wp)                             , INTENT(in   ) ::   psgn1   ! sign used across the north fold
+      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   psgn2,  psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9   
+      CHARACTER(len=3)   , OPTIONAL        , INTENT(in   ) ::   cd_mpp  ! fill the overlap area only
+      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   pval    ! background value (used at closed boundaries)
+      !!
+      INTEGER                         ::   kfld        ! number of elements that will be attributed
+      PTR_TYPE         , DIMENSION(9) ::   ptab_ptr    ! pointer array
+      CHARACTER(len=1) , DIMENSION(9) ::   cdna_ptr    ! nature of ptab_ptr grid-points
+      REAL(wp)         , DIMENSION(9) ::   psgn_ptr    ! sign used across the north fold boundary
+      !!---------------------------------------------------------------------
+      !
+      kfld = 0          ! initial array of pointer size
+      !
+      !                 ! Load the first array
+      CALL ROUTINE_LOAD( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      !
+      !                 ! Look if more arrays are added
+      IF( PRESENT(psgn2) )   CALL ROUTINE_LOAD( pt2, cdna2, psgn2, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn3) )   CALL ROUTINE_LOAD( pt3, cdna3, psgn3, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn4) )   CALL ROUTINE_LOAD( pt4, cdna4, psgn4, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn5) )   CALL ROUTINE_LOAD( pt5, cdna5, psgn5, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn6) )   CALL ROUTINE_LOAD( pt6, cdna6, psgn6, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn7) )   CALL ROUTINE_LOAD( pt7, cdna7, psgn7, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn8) )   CALL ROUTINE_LOAD( pt8, cdna8, psgn8, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn9) )   CALL ROUTINE_LOAD( pt9, cdna9, psgn9, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      !
+      CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval )
+      !
+   END SUBROUTINE ROUTINE_MULTI
+
+
+   SUBROUTINE ROUTINE_LOAD( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      !!---------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:)   , TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied
+      CHARACTER(len=1)              , INTENT(in   ) ::   cdna       ! nature of pt2d array grid-points
+      REAL(wp)                      , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
+      PTR_TYPE        , DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers
+      CHARACTER(len=1), DIMENSION(:), INTENT(inout) ::   cdna_ptr   ! nature of pt2d_array array grid-points
+      REAL(wp)        , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
+      INTEGER                       , INTENT(inout) ::   kfld       ! number of elements that has been attributed
+      !!---------------------------------------------------------------------
+      !
+      kfld                    =  kfld + 1
+      ptab_ptr(kfld)%PTR_ptab => ptab
+      cdna_ptr(kfld)          =  cdna
+      psgn_ptr(kfld)          =  psgn
+      !
+   END SUBROUTINE ROUTINE_LOAD
+#undef ARRAY_TYPE
+#undef PTR_TYPE
+#undef PTR_ptab
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_nfd_ext_generic.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_nfd_ext_generic.h90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_nfd_ext_generic.h90	(revision 12101)
@@ -0,0 +1,157 @@
+!                          !==  IN: ptab is an array  ==!
+#define NAT_IN(k)                cd_nat
+#define SGN_IN(k)                psgn
+#define F_SIZE(ptab)             1
+#if defined DIM_2d
+#   define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#   define K_SIZE(ptab)          1
+#   define L_SIZE(ptab)          1
+#endif
+#define ARRAY_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kextj )
+      !!----------------------------------------------------------------------
+      INTEGER          , INTENT(in   ) ::   kextj       ! extra halo width at north fold, declared before its use in ARRAY_TYPE
+      ARRAY_TYPE(:,1-kextj:,:,:,:)                      ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh,  jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl,     ipf   ! dimension of the input array
+      INTEGER  ::   ijt, iju, ipjm1
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      !
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ipj = nlcj       ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction
+      END SELECT
+      !
+      ipjm1 = ipj-1
+
+      !
+      DO jf = 1, ipf                      ! Loop on the number of arrays to be treated
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf)  )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO jh = 0, kextj
+                  DO ji = 2, jpiglo
+                     ijt = jpiglo-ji+2
+                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
+                  END DO
+                  ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-2-jh,:,:,jf)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO jh = 0, kextj
+                  DO ji = 2, jpiglo-1
+                     iju = jpiglo-ji+1
+                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
+                  END DO
+                 ARRAY_IN(   1  ,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-2-jh,:,:,jf)
+                 ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-2-jh,:,:,jf) 
+               END DO
+               DO ji = jpiglo/2, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO jh = 0, kextj
+                  DO ji = 2, jpiglo
+                     ijt = jpiglo-ji+2
+                     ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
+                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-3-jh,:,:,jf)
+                  END DO
+                  ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-3-jh,:,:,jf) 
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO jh = 0, kextj
+                  DO ji = 1, jpiglo-1
+                     iju = jpiglo-ji+1
+                     ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
+                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-3-jh,:,:,jf)
+                  END DO
+               END DO
+               DO jh = 0, kextj
+                  ARRAY_IN(   1  ,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-3-jh,:,:,jf)
+                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-3-jh,:,:,jf)
+               END DO
+            END SELECT
+            !
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf)  )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO jh = 0, kextj
+                  DO ji = 1, jpiglo
+                     ijt = jpiglo-ji+1
+                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-1-jh,:,:,jf)
+                  END DO
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO jh = 0, kextj
+                  DO ji = 1, jpiglo-1
+                     iju = jpiglo-ji
+                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-1-jh,:,:,jf)
+                  END DO
+                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-2,ipj-1-jh,:,:,jf)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO jh = 0, kextj
+                  DO ji = 1, jpiglo
+                     ijt = jpiglo-ji+1
+                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
+                  END DO
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO jh = 0, kextj
+                  DO ji = 1, jpiglo-1
+                     iju = jpiglo-ji
+                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
+                  END DO
+                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-2,ipj-2-jh,:,:,jf)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
+               END DO
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( NAT_IN(jf) )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               ARRAY_IN(:,  1:1-kextj  ,:,:,jf) = 0._wp
+               ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp
+            CASE ( 'F' )                               ! F-point
+               ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      END DO
+      !
+   END SUBROUTINE ROUTINE_NFD
+
+#undef ARRAY_TYPE
+#undef ARRAY_IN
+#undef NAT_IN
+#undef SGN_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_nfd_generic.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_nfd_generic.h90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_nfd_generic.h90	(revision 12101)
@@ -0,0 +1,175 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+!                          !==  IN: ptab is an array  ==!
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#endif
+
+#if defined MULTI
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
+      INTEGER          , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+#else
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn       )
+#endif
+      ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh,  jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl,     ipf   ! dimension of the input array
+      INTEGER  ::   ijt, iju, ipjm1
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      !
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ipj = nlcj       ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction
+      END SELECT
+      ipjm1 = ipj-1
+
+      !
+      DO jf = 1, ipf                      ! Loop on the number of arrays to be treated
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf)  )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
+               END DO
+               ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-2,:,:,jf)
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
+               END DO
+               ARRAY_IN(   1  ,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-2,:,:,jf)
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-2,:,:,jf) 
+               DO ji = jpiglo/2, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
+                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-3,:,:,jf)
+               END DO
+               ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-3,:,:,jf) 
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
+                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-3,:,:,jf)
+               END DO
+               ARRAY_IN(   1  ,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-3,:,:,jf)
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-3,:,:,jf) 
+            END SELECT
+            !
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf)  )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-1,:,:,jf)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-1,:,:,jf)
+               END DO
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-2,ipj-1,:,:,jf)
+            CASE ( 'V' )                               ! V-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
+               END DO
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)   * ARRAY_IN(jpiglo-2,ipj-2,:,:,jf)
+               DO ji = jpiglo/2+1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
+               END DO
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( NAT_IN(jf) )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               ARRAY_IN(:, 1 ,:,:,jf) = 0._wp
+               ARRAY_IN(:,ipj,:,:,jf) = 0._wp
+            CASE ( 'F' )                               ! F-point
+               ARRAY_IN(:,ipj,:,:,jf) = 0._wp
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      END DO
+      !
+   END SUBROUTINE ROUTINE_NFD
+
+#undef ARRAY_TYPE
+#undef ARRAY_IN
+#undef NAT_IN
+#undef SGN_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_nfd_nogather_generic.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_nfd_nogather_generic.h90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbc_nfd_nogather_generic.h90	(revision 12101)
@@ -0,0 +1,360 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#   define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D),INTENT(inout)::ptab2(f)
+#   define J_SIZE(ptab2)            SIZE(ptab2(1)%pt4d,2)
+#   define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt4d(i,j,k,l)
+#else
+!                          !==  IN: ptab is an array  ==!
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#   define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k,l)
+#   define J_SIZE(ptab2)             SIZE(ptab2,2)
+#   define ARRAY_TYPE(i,j,k,l,f)     REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#   define ARRAY2_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f)
+#endif
+
+   SUBROUTINE ROUTINE_NFD( ptab, ptab2, cd_nat, psgn, kfld )
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose :   lateral boundary condition : North fold treatment
+      !!                without allgather exchanges. 
+      !!
+      !!----------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied
+      ARRAY2_TYPE(:,:,:,:,:)                            ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
+      !
+      INTEGER  ::    ji,  jj,   jk,     jl,   jh,  jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf        ! dimension of the input array
+      INTEGER  ::   ijt, iju, ijpj, ijpjp1, ijta, ijua, jia, startloop, endloop
+      LOGICAL  ::   l_fast_exchanges
+      !!----------------------------------------------------------------------
+      ipj = J_SIZE(ptab2)  ! 2nd dimension of input array
+      ipk = K_SIZE(ptab)   ! 3rd dimension of output array
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      ! Security check for further developments
+      IF ( ipf > 1 ) THEN
+        write(6,*) 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation' 
+        write(6,*) 'You should not be there...' 
+        STOP
+      ENDIF
+      !
+      ijpj   = 1    ! index of first modified line 
+      ijpjp1 = 2    ! index + 1
+      
+      ! 2nd dimension determines exchange speed
+      IF (ipj == 1 ) THEN
+        l_fast_exchanges = .TRUE.
+      ELSE
+        l_fast_exchanges = .FALSE.
+      ENDIF
+      !
+      DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf) )
+            !
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               IF ( nimpp /= 1 ) THEN   ;   startloop = 1
+               ELSE                     ;   startloop = 2
+               ENDIF
+               !
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = startloop, nlci
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               IF( nimpp == 1 ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     ARRAY_IN(1,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-2,jk,jl,jf)
+                  END DO; END DO
+               ENDIF
+               !
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  IF( nimpp >= jpiglo/2+1 ) THEN
+                     startloop = 1
+                  ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
+                     startloop = jpiglo/2+1 - nimpp + 1
+                  ELSE
+                     startloop = nlci + 1
+                  ENDIF
+                  IF( startloop <= nlci ) THEN
+                     DO jl = 1, ipl; DO jk = 1, ipk
+                        DO ji = startloop, nlci
+                           ijt  = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                           jia  = ji + nimpp - 1
+                           ijta = jpiglo - jia + 2
+                           IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN
+                              ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,nlcj-1,jk,jl,jf)
+                           ELSE
+                              ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf)
+                           ENDIF
+                        END DO
+                     END DO; END DO
+                  ENDIF
+               ENDIF
+
+            CASE ( 'U' )                                     ! U-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               IF (nimpp .eq. 1) THEN
+                  ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf)
+               ENDIF
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                  ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf)
+               ENDIF
+               !
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                     endloop = nlci
+                  ELSE
+                     endloop = nlci - 1
+                  ENDIF
+                  IF( nimpp >= jpiglo/2 ) THEN
+                     startloop = 1
+                     ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN
+                     startloop = jpiglo/2 - nimpp + 1
+                  ELSE
+                     startloop = endloop + 1
+                  ENDIF
+                  IF( startloop <= endloop ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     DO ji = startloop, endloop
+                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        jia = ji + nimpp - 1
+                        ijua = jpiglo - jia + 1
+                        IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN
+                           ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,nlcj-1,jk,jl,jf)
+                        ELSE
+                           ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf)
+                        ENDIF
+                     END DO
+                  END DO; END DO
+                  ENDIF
+               ENDIF
+               !
+            CASE ( 'V' )                                     ! V-point
+               IF( nimpp /= 1 ) THEN
+                 startloop = 1
+               ELSE
+                 startloop = 2
+               ENDIF
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     DO ji = startloop, nlci
+                        ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                        ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf)
+                     END DO
+                  END DO; END DO
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = startloop, nlci
+                     ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               IF (nimpp .eq. 1) THEN
+                  ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-3,:,:,jf)
+               ENDIF
+            CASE ( 'F' )                                     ! F-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     DO ji = 1, endloop
+                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf)
+                     END DO
+                  END DO; END DO
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               IF (nimpp .eq. 1) THEN
+                  ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-3,:,:,jf)
+                  IF ( .NOT. l_fast_exchanges ) &
+                     ARRAY_IN(1,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf)
+               ENDIF
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                  ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-3,:,:,jf)
+                  IF ( .NOT. l_fast_exchanges ) &
+                     ARRAY_IN(nlci,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf)
+               ENDIF
+               !
+            END SELECT
+            !
+         CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf) )
+            CASE ( 'T' , 'W' )                               ! T-, W-point
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = 1, nlci
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               !
+            CASE ( 'U' )                                     ! U-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-1,jk,jl,jf)
+                  END DO; END DO
+               ENDIF
+               !
+            CASE ( 'V' )                                     ! V-point
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = 1, nlci
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  IF( nimpp >= jpiglo/2+1 ) THEN
+                     startloop = 1
+                  ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
+                     startloop = jpiglo/2+1 - nimpp + 1
+                  ELSE
+                     startloop = nlci + 1
+                  ENDIF
+                  IF( startloop <= nlci ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     DO ji = startloop, nlci
+                        ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf)
+                     END DO
+                  END DO; END DO
+                  ENDIF
+               ENDIF
+               !
+            CASE ( 'F' )                               ! F-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                     ARRAY_IN(ji,nlcj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-2,jk,jl,jf)
+                  END DO; END DO
+               ENDIF
+               !
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                     endloop = nlci
+                  ELSE
+                     endloop = nlci - 1
+                  ENDIF
+                  IF( nimpp >= jpiglo/2+1 ) THEN
+                     startloop = 1
+                  ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
+                     startloop = jpiglo/2+1 - nimpp + 1
+                  ELSE
+                     startloop = endloop + 1
+                  ENDIF
+                  IF( startloop <= endloop ) THEN
+                     DO jl = 1, ipl; DO jk = 1, ipk
+                        DO ji = startloop, endloop
+                           iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                           ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf)
+                        END DO
+                     END DO; END DO
+                  ENDIF
+               ENDIF
+               !
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            WRITE(*,*) 'lbc_nfd_nogather_generic: You should not have seen this print! error?', npolj
+            !
+         END SELECT     !  npolj
+         !
+      END DO            ! End jf loop
+   END SUBROUTINE ROUTINE_NFD
+#undef ARRAY_TYPE
+#undef ARRAY_IN
+#undef NAT_IN
+#undef SGN_IN
+#undef J_SIZE
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef ARRAY2_TYPE
+#undef ARRAY2_IN
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbclnk.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbclnk.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbclnk.F90	(revision 12101)
@@ -0,0 +1,284 @@
+MODULE lbclnk
+   !!======================================================================
+   !!                       ***  MODULE  lbclnk  ***
+   !! NEMO        : lateral boundary conditions
+   !!=====================================================================
+   !! History :  OPA  ! 1997-06  (G. Madec)  Original code
+   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
+   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment  
+   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco)  optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case  
+   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi  
+   !!            4.0  ! 2017-03  (G. Madec) automatique allocation of array size (use with any 3rd dim size)
+   !!             -   ! 2017-04  (G. Madec) remove duplicated routines (lbc_lnk_2d_9, lbc_lnk_2d_multiple, lbc_lnk_3d_gather)
+   !!             -   ! 2017-05  (G. Madec) create generic.h90 files to generate all lbc and north fold routines
+   !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!           define the generic interfaces of lib_mpp routines
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk       : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
+   !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean dynamics and tracers   
+   USE lib_mpp        ! distributed memory computing library
+   USE lbcnfd         ! north fold
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE   mpp_lnk_2d      , mpp_lnk_3d      , mpp_lnk_4d
+   END INTERFACE
+   INTERFACE lbc_lnk_ptr
+      MODULE PROCEDURE   mpp_lnk_2d_ptr  , mpp_lnk_3d_ptr  , mpp_lnk_4d_ptr
+   END INTERFACE
+   INTERFACE lbc_lnk_multi
+      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi
+   END INTERFACE
+   !
+   INTERFACE lbc_bdy_lnk
+      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d
+   END INTERFACE
+   !
+   INTERFACE lbc_lnk_icb
+      MODULE PROCEDURE mpp_lnk_2d_icb
+   END INTERFACE
+
+   PUBLIC   lbc_lnk       ! ocean/ice lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
+   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
+   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: lbclnk.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                              shared memory computing
+   !!----------------------------------------------------------------------
+   !!                routines setting the appropriate values
+   !!         on first and last row and column of the global domain
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh
+   !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh
+   !!   lbc_lnk       : generic interface for lbc_lnk_3d and lbc_lnk_2d
+   !!   lbc_lnk_3d    : set the lateral boundary condition on a 3D variable on ocean mesh
+   !!   lbc_lnk_2d    : set the lateral boundary condition on a 2D variable on ocean mesh
+   !!   lbc_bdy_lnk   : set the lateral BDY boundary condition
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain 
+   USE in_out_manager ! I/O manager
+   USE lbcnfd         ! north fold
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE   lbc_lnk_2d      , lbc_lnk_3d      , lbc_lnk_4d
+   END INTERFACE
+   INTERFACE lbc_lnk_ptr
+      MODULE PROCEDURE   lbc_lnk_2d_ptr  , lbc_lnk_3d_ptr  , lbc_lnk_4d_ptr
+   END INTERFACE
+   INTERFACE lbc_lnk_multi
+      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi
+   END INTERFACE
+   !
+   INTERFACE lbc_bdy_lnk
+      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d, lbc_bdy_lnk_4d
+   END INTERFACE
+   !
+   INTERFACE lbc_lnk_icb
+      MODULE PROCEDURE lbc_lnk_2d_icb
+   END INTERFACE
+   
+   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
+   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
+   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: lbclnk.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   !!======================================================================
+   !!   Default option                           3D shared memory computing
+   !!======================================================================
+   !!          routines setting land point, or east-west cyclic,
+   !!             or north-south cyclic, or north fold values
+   !!         on first and last row and column of the global domain
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine lbc_lnk_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in lbc_lnk_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kfld   :   optional, number of pt3d arrays
+   !!                cd_mpp :   optional, fill the overlap area only
+   !!                pval   :   optional, background value (used at closed boundaries)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_LNK           lbc_lnk_2d
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           lbc_lnk_2d_ptr
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_LNK           lbc_lnk_3d
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           lbc_lnk_3d_ptr
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_LNK           lbc_lnk_4d
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           lbc_lnk_4d_ptr
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_4d
+   
+   !!======================================================================
+   !!   identical routines in both C1D and shared memory computing
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine lbc_bdy_lnk_(2,3,4)d  ***
+   !!
+   !!   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
+   !!   to maintain the same interface with regards to the mpp case
+   !!----------------------------------------------------------------------
+   
+   SUBROUTINE lbc_bdy_lnk_4d( cdname, pt4d, cd_type, psgn, ib_bdy )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)          , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pt4d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                   , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
+      CALL lbc_lnk_4d( cdname, pt4d, cd_type, psgn)
+   END SUBROUTINE lbc_bdy_lnk_4d
+
+   SUBROUTINE lbc_bdy_lnk_3d( cdname, pt3d, cd_type, psgn, ib_bdy )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)          , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                   , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
+      CALL lbc_lnk_3d( cdname, pt3d, cd_type, psgn)
+   END SUBROUTINE lbc_bdy_lnk_3d
+
+
+   SUBROUTINE lbc_bdy_lnk_2d( cdname, pt2d, cd_type, psgn, ib_bdy )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)        , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                 , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
+      CALL lbc_lnk_2d( cdname, pt2d, cd_type, psgn)
+   END SUBROUTINE lbc_bdy_lnk_2d
+
+
+!!gm  This routine should be removed with an optional halos size added in argument of generic routines
+
+   SUBROUTINE lbc_lnk_2d_icb( cdname, pt2d, cd_type, psgn, ki, kj )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)        , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                 , INTENT(in   ) ::   ki, kj    ! sizes of extra halo (not needed in non-mpp)
+      !!----------------------------------------------------------------------
+      CALL lbc_lnk_2d( cdname, pt2d, cd_type, psgn )
+   END SUBROUTINE lbc_lnk_2d_icb
+!!gm end
+
+#endif
+
+   !!======================================================================
+   !!   identical routines in both distributed and shared memory computing
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!                   ***   load_ptr_(2,3,4)d   ***
+   !!
+   !!   * Dummy Argument :
+   !!       in    ==>   ptab       ! array to be loaded (2D, 3D or 4D)
+   !!                   cd_nat     ! nature of pt2d array grid-points
+   !!                   psgn       ! sign used across the north fold boundary
+   !!       inout <=>   ptab_ptr   ! array of 2D, 3D or 4D pointers
+   !!                   cdna_ptr   ! nature of ptab array grid-points
+   !!                   psgn_ptr   ! sign used across the north fold boundary
+   !!                   kfld       ! number of elements that has been attributed
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!                  ***   lbc_lnk_(2,3,4)d_multi   ***
+   !!                     ***   load_ptr_(2,3,4)d   ***
+   !!
+   !!   * Argument : dummy argument use in lbc_lnk_multi_... routines
+   !!
+   !!----------------------------------------------------------------------
+
+#  define DIM_2d
+#     define ROUTINE_MULTI          lbc_lnk_2d_multi
+#     define ROUTINE_LOAD           load_ptr_2d
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_2d
+
+
+#  define DIM_3d
+#     define ROUTINE_MULTI          lbc_lnk_3d_multi
+#     define ROUTINE_LOAD           load_ptr_3d
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_3d
+
+
+#  define DIM_4d
+#     define ROUTINE_MULTI          lbc_lnk_4d_multi
+#     define ROUTINE_LOAD           load_ptr_4d
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_4d
+
+   !!======================================================================
+END MODULE lbclnk
+
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbclnk.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbclnk.f90	(revision 12100)
+++ 	(revision )
@@ -1,63 +1,0 @@
-MODULE lbclnk
-   !!======================================================================
-   !!                       ***  MODULE  lbclnk  ***
-   !! Ocean        : lateral boundary conditions
-   !!=====================================================================
-   !! History :  OPA  ! 1997-06  (G. Madec)  Original code
-   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
-   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment  
-   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk
-   !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case  
-   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi  
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'             MPI massively parallel processing library
-   !!----------------------------------------------------------------------
-   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
-   !!   lbc_sum      : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp
-   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
-   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
-   !!----------------------------------------------------------------------
-   USE lib_mpp        ! distributed memory computing library
-
-   INTERFACE lbc_lnk_multi
-      MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple
-   END INTERFACE
-   !
-   INTERFACE lbc_lnk
-      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
-   END INTERFACE
-   !
-   INTERFACE lbc_sum
-      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d
-   END INTERFACE
-   !
-   INTERFACE lbc_bdy_lnk
-      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
-   END INTERFACE
-   !
-   INTERFACE lbc_lnk_e
-      MODULE PROCEDURE mpp_lnk_2d_e
-   END INTERFACE
-   !
-   INTERFACE lbc_lnk_icb
-      MODULE PROCEDURE mpp_lnk_2d_icb
-   END INTERFACE
-
-   PUBLIC   lbc_lnk       ! ocean lateral boundary conditions
-   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions
-   PUBLIC   lbc_sum
-   PUBLIC   lbc_lnk_e     !
-   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
-   PUBLIC   lbc_lnk_icb   !
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: lbclnk.F90 6493 2016-04-22 13:52:52Z mathiot $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-
-   !!======================================================================
-END MODULE lbclnk
-
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbcnfd.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbcnfd.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbcnfd.F90	(revision 12101)
@@ -0,0 +1,168 @@
+MODULE lbcnfd
+   !!======================================================================
+   !!                       ***  MODULE  lbcnfd  ***
+   !! Ocean        : north fold  boundary conditions
+   !!======================================================================
+   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
+   !!            3.5  ! 2013-07  (I. Epicoco, S. Mocavero - CMCC) MPP optimization
+   !!            4.0  ! 2017-04  (G. Madec) automatique allocation of array argument (use any 3rd dimension)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   lbc_nfd       : generic interface for lbc_nfd_3d and lbc_nfd_2d routines
+   !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd)
+   !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
+   !!   lbc_nfd_nogather       : generic interface for lbc_nfd_nogather_3d and 
+   !!                            lbc_nfd_nogather_2d routines (designed for use
+   !!                            with ln_nnogather to avoid global width arrays
+   !!                            mpi all gather operations)
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain 
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_nfd
+      MODULE PROCEDURE   lbc_nfd_2d    , lbc_nfd_3d    , lbc_nfd_4d
+      MODULE PROCEDURE   lbc_nfd_2d_ptr, lbc_nfd_3d_ptr, lbc_nfd_4d_ptr
+      MODULE PROCEDURE   lbc_nfd_2d_ext
+   END INTERFACE
+   !
+   INTERFACE lbc_nfd_nogather
+!                        ! Currently only 4d array version is needed
+     MODULE PROCEDURE   lbc_nfd_nogather_2d    , lbc_nfd_nogather_3d
+     MODULE PROCEDURE   lbc_nfd_nogather_4d
+     MODULE PROCEDURE   lbc_nfd_nogather_2d_ptr, lbc_nfd_nogather_3d_ptr
+!     MODULE PROCEDURE   lbc_nfd_nogather_4d_ptr
+   END INTERFACE
+
+   TYPE, PUBLIC ::   PTR_2D   !: array of 2D pointers (also used in lib_mpp)
+      REAL(wp), DIMENSION (:,:)    , POINTER ::   pt2d
+   END TYPE PTR_2D
+   TYPE, PUBLIC ::   PTR_3D   !: array of 3D pointers (also used in lib_mpp)
+      REAL(wp), DIMENSION (:,:,:)  , POINTER ::   pt3d
+   END TYPE PTR_3D
+   TYPE, PUBLIC ::   PTR_4D   !: array of 4D pointers (also used in lib_mpp)
+      REAL(wp), DIMENSION (:,:,:,:), POINTER ::   pt4d
+   END TYPE PTR_4D
+
+   PUBLIC   lbc_nfd            ! north fold conditions
+   PUBLIC   lbc_nfd_nogather   ! north fold conditions (no allgather case)
+
+   INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !:
+   INTEGER, PUBLIC                       ::   nsndto, nfsloop, nfeloop   !:
+   INTEGER, PUBLIC, DIMENSION (jpmaxngh) ::   isendto                    !: processes to which communicate
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: lbcnfd.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine lbc_nfd_(2,3,4)d  ***
+   !!----------------------------------------------------------------------
+   !!
+   !! ** Purpose :   lateral boundary condition 
+   !!                North fold treatment without processor exchanges. 
+   !!
+   !! ** Method  :   
+   !!
+   !! ** Action  :   ptab with updated values along the north fold
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           lbc_nfd_2d
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_2d_ptr
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  2D array with extra haloes  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           lbc_nfd_2d_ext
+#     include "lbc_nfd_ext_generic.h90"
+#     undef ROUTINE_NFD
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_NFD           lbc_nfd_3d
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_3d_ptr
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_NFD           lbc_nfd_4d
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_4d_ptr
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_4d
+   !
+   !  lbc_nfd_nogather routines
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           lbc_nfd_nogather_2d
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_nogather_2d_ptr
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_NFD           lbc_nfd_nogather_3d
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_nogather_3d_ptr
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_NFD           lbc_nfd_nogather_4d
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+!#     define MULTI
+!#     define ROUTINE_NFD           lbc_nfd_nogather_4d_ptr
+!#     include "lbc_nfd_nogather_generic.h90"
+!#     undef ROUTINE_NFD
+!#     undef MULTI
+#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+
+
+   !!======================================================================
+END MODULE lbcnfd
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbcnfd.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lbcnfd.f90	(revision 12100)
+++ 	(revision )
@@ -1,971 +1,0 @@
-MODULE lbcnfd
-   !!======================================================================
-   !!                       ***  MODULE  lbcnfd  ***
-   !! Ocean        : north fold  boundary conditions
-   !!======================================================================
-   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
-   !!            3.5  ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   lbc_nfd       : generic interface for lbc_nfd_3d and lbc_nfd_2d routines
-   !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd)
-   !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
-   !!   mpp_lbc_nfd_3d    : North fold treatment for a 3D arrays optimized for MPP
-   !!   mpp_lbc_nfd_2d    : North fold treatment for a 2D arrays optimized for MPP
-   !!----------------------------------------------------------------------
-   USE dom_oce        ! ocean space and time domain 
-   USE in_out_manager ! I/O manager
-
-   IMPLICIT NONE
-   PRIVATE
-
-   INTERFACE lbc_nfd
-      MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d
-   END INTERFACE
-   !
-   INTERFACE mpp_lbc_nfd
-      MODULE PROCEDURE   mpp_lbc_nfd_3d, mpp_lbc_nfd_2d
-   END INTERFACE
-
-   PUBLIC   lbc_nfd       ! north fold conditions
-   PUBLIC   mpp_lbc_nfd   ! north fold conditions (parallel case)
-
-   INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !:
-   INTEGER, PUBLIC                       ::   nsndto, nfsloop, nfeloop   !:
-   INTEGER, PUBLIC, DIMENSION (jpmaxngh) ::   isendto                    !: processes to which communicate
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: lbcnfd.F90 6140 2015-12-21 11:35:23Z timgraham $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine lbc_nfd_3d  ***
-      !!
-      !! ** Purpose :   3D lateral boundary condition : North fold treatment
-      !!              without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt3d with updated values along the north fold
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                        !   = T , U , V , F , W points
-      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                        !   = -1. , the sign is changed if north fold boundary
-      !                                                        !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the boundary condition is applied
-      !
-      INTEGER  ::   ji, jk
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
-      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
-      END SELECT
-      ijpjm1 = ijpj-1
-
-      DO jk = 1, jpk
-         !
-         SELECT CASE ( npolj )
-         !
-         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-               END DO
-               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-2,jk)
-               DO ji = jpiglo/2+1, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
-               END DO
-               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-2,jk)
-               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-2,jk) 
-               DO ji = jpiglo/2, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
-               END DO
-            CASE ( 'V' )                               ! V-point
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
-               END DO
-               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-3,jk) 
-            CASE ( 'F' )                               ! F-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
-               END DO
-               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-3,jk)
-               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-3,jk) 
-            END SELECT
-            !
-         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
-               END DO
-               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-1,jk)
-            CASE ( 'V' )                               ! V-point
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-               END DO
-               DO ji = jpiglo/2+1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
-               END DO
-            CASE ( 'F' )                               ! F-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
-               END DO
-               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-2,jk)
-               DO ji = jpiglo/2+1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
-               END DO
-            END SELECT
-            !
-         CASE DEFAULT                           ! *  closed : the code probably never go through
-            !
-            SELECT CASE ( cd_type)
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d(:, 1  ,jk) = 0.e0
-               pt3d(:,ijpj,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3d(:,ijpj,jk) = 0.e0
-            END SELECT
-            !
-         END SELECT     !  npolj
-         !
-      END DO
-      !
-   END SUBROUTINE lbc_nfd_3d
-
-
-   SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine lbc_nfd_2d  ***
-      !!
-      !! ** Purpose :   2D lateral boundary condition : North fold treatment
-      !!       without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt2d with updated values along the north fold
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                      ! = T , U , V , F , W points
-      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                      !   = -1. , the sign is changed if north fold boundary
-      !                                                      !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied
-      INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos
-      !
-      INTEGER  ::   ji, jl, ipr2dj
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
-      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
-      END SELECT
-      !
-      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos
-         ipr2dj = pr2dj
-         IF( jpni > 1 )   ijpj = ijpj + ipr2dj
-      ELSE
-         ipr2dj = 0 
-      ENDIF
-      !
-      ijpjm1 = ijpj-1
-
-
-      SELECT CASE ( npolj )
-      !
-      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
-         !
-         SELECT CASE ( cd_type )
-         !
-         CASE ( 'T' , 'W' )                               ! T- , W-points
-            DO jl = 0, ipr2dj
-               DO ji = 2, jpiglo
-                  ijt=jpiglo-ji+2
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
-               END DO
-            END DO
-            pt2d(1,ijpj)   = psgn * pt2d(3,ijpj-2)
-            DO ji = jpiglo/2+1, jpiglo
-               ijt=jpiglo-ji+2
-               pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)
-            END DO
-         CASE ( 'U' )                                     ! U-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
-               END DO
-            END DO
-            pt2d(   1  ,ijpj  ) = psgn * pt2d(    2   ,ijpj-2)
-            pt2d(jpiglo,ijpj  ) = psgn * pt2d(jpiglo-1,ijpj-2)
-            pt2d(1     ,ijpj-1) = psgn * pt2d(jpiglo  ,ijpj-1)   
-            DO ji = jpiglo/2, jpiglo-1
-               iju = jpiglo-ji+1
-               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
-            END DO
-         CASE ( 'V' )                                     ! V-point
-            DO jl = -1, ipr2dj
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-3-jl)
-               END DO
-            END DO
-            pt2d( 1 ,ijpj)   = psgn * pt2d( 3 ,ijpj-3) 
-         CASE ( 'F' )                                     ! F-point
-            DO jl = -1, ipr2dj
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)
-               END DO
-            END DO
-            pt2d(   1  ,ijpj)   = psgn * pt2d(    2   ,ijpj-3)
-            pt2d(jpiglo,ijpj)   = psgn * pt2d(jpiglo-1,ijpj-3)
-            pt2d(jpiglo,ijpj-1) = psgn * pt2d(jpiglo-1,ijpj-2)      
-            pt2d(   1  ,ijpj-1) = psgn * pt2d(    2   ,ijpj-2)      
-         CASE ( 'I' )                                     ! ice U-V point (I-point)
-            DO jl = 0, ipr2dj
-               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
-               DO ji = 3, jpiglo
-                  iju = jpiglo - ji + 3
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'J' )                                     ! first ice U-V point
-            DO jl =0, ipr2dj
-               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
-               DO ji = 3, jpiglo
-                  iju = jpiglo - ji + 3
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'K' )                                     ! second ice U-V point
-            DO jl =0, ipr2dj
-               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
-               DO ji = 3, jpiglo
-                  iju = jpiglo - ji + 3
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
-         END SELECT
-         !
-      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
-         !
-         SELECT CASE ( cd_type )
-         CASE ( 'T' , 'W' )                               ! T-, W-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'U' )                                     ! U-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
-            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-1)
-         CASE ( 'V' )                                     ! V-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
-               END DO
-            END DO
-            DO ji = jpiglo/2+1, jpiglo
-               ijt = jpiglo-ji+1
-               pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
-            END DO
-         CASE ( 'F' )                               ! F-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
-               END DO
-            END DO
-            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-2)
-            DO ji = jpiglo/2+1, jpiglo-1
-               iju = jpiglo-ji
-               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
-            END DO
-         CASE ( 'I' )                                  ! ice U-V point (I-point)
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
-            DO jl = 0, ipr2dj
-               DO ji = 2 , jpiglo-1
-                  ijt = jpiglo - ji + 2
-                  pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )
-               END DO
-            END DO
-         CASE ( 'J' )                                  ! first ice U-V point
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
-            DO jl = 0, ipr2dj
-               DO ji = 2 , jpiglo-1
-                  ijt = jpiglo - ji + 2
-                  pt2d(ji,ijpj+jl)= pt2d(ji,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'K' )                                  ! second ice U-V point
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
-            DO jl = 0, ipr2dj
-               DO ji = 2 , jpiglo-1
-                  ijt = jpiglo - ji + 2
-                  pt2d(ji,ijpj+jl)= pt2d(ijt,ijpj-1-jl)
-               END DO
-            END DO
-         END SELECT
-         !
-      CASE DEFAULT                           ! *  closed : the code probably never go through
-         !
-         SELECT CASE ( cd_type)
-         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         CASE ( 'F' )                                   ! F-point
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         CASE ( 'I' )                                   ! ice U-V point
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         CASE ( 'J' )                                   ! first ice U-V point
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         CASE ( 'K' )                                   ! second ice U-V point
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         END SELECT
-         !
-      END SELECT
-      !
-   END SUBROUTINE lbc_nfd_2d
-
-
-   SUBROUTINE mpp_lbc_nfd_3d( pt3dl, pt3dr, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lbc_nfd_3d  ***
-      !!
-      !! ** Purpose :   3D lateral boundary condition : North fold treatment
-      !!              without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt3d with updated values along the north fold
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                        !   = T , U , V , F , W points
-      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                        !   = -1. , the sign is changed if north fold boundary
-      !                                                        !   =  1. , the sign is kept    if north fold boundary
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3dl     ! 3D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pt3dr     ! 3D array on which the boundary condition is applied
-      !
-      INTEGER  ::   ji, jk
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
-      !!----------------------------------------------------------------------
-      !
-      SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
-      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
-      END SELECT
-      ijpjm1 = ijpj-1
-
-         !
-         SELECT CASE ( npolj )
-         !
-         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               IF (nimpp .ne. 1) THEN
-                 startloop = 1
-               ELSE
-                 startloop = 2
-               ENDIF
-
-               DO jk = 1, jpk
-                  DO ji = startloop, nlci
-                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
-                  END DO
-                  IF(nimpp .eq. 1) THEN
-                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk)
-                  ENDIF
-               END DO
-
-               IF(nimpp .ge. (jpiglo/2+1)) THEN
-                 startloop = 1
-               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-                 startloop = jpiglo/2+1 - nimpp + 1
-               ELSE
-                 startloop = nlci + 1
-               ENDIF
-               IF(startloop .le. nlci) THEN
-                 DO jk = 1, jpk
-                    DO ji = startloop, nlci
-                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                       jia = ji + nimpp - 1
-                       ijta = jpiglo - jia + 2
-                       IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
-                          pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijta-nimpp+1,ijpjm1,jk)
-                       ELSE
-                          pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
-                       ENDIF
-                    END DO
-                 END DO
-               ENDIF
-
-
-            CASE ( 'U' )                               ! U-point
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk)
-                  END DO
-                  IF(nimpp .eq. 1) THEN
-                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-2,jk)
-                  ENDIF
-                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk)
-                  ENDIF
-               END DO
-
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               IF(nimpp .ge. (jpiglo/2)) THEN
-                  startloop = 1
-               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
-                  startloop = jpiglo/2 - nimpp + 1
-               ELSE
-                  startloop = endloop + 1
-               ENDIF
-               IF (startloop .le. endloop) THEN
-                 DO jk = 1, jpk
-                    DO ji = startloop, endloop
-                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                      jia = ji + nimpp - 1
-                      ijua = jpiglo - jia + 1
-                      IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
-                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijua-nimpp+1,ijpjm1,jk)
-                      ELSE
-                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)
-                      ENDIF
-                    END DO
-                 END DO
-               ENDIF
-
-            CASE ( 'V' )                               ! V-point
-               IF (nimpp .ne. 1) THEN
-                  startloop = 1
-               ELSE
-                  startloop = 2
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = startloop, nlci
-                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
-                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(ijt,ijpj-3,jk)
-                  END DO
-                  IF(nimpp .eq. 1) THEN
-                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk)
-                  ENDIF
-               END DO
-            CASE ( 'F' )                               ! F-point
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk)
-                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(iju,ijpj-3,jk)
-                  END DO
-                  IF(nimpp .eq. 1) THEN
-                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-3,jk)
-                  ENDIF
-                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk)
-                  ENDIF
-               END DO
-            END SELECT
-            !
-
-         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO jk = 1, jpk
-                  DO ji = 1, nlci
-                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'U' )                               ! U-point
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk)
-                  END DO
-                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk)
-                  ENDIF
-               END DO
-
-            CASE ( 'V' )                               ! V-point
-               DO jk = 1, jpk
-                  DO ji = 1, nlci
-                     ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
-                  END DO
-               END DO
-
-               IF(nimpp .ge. (jpiglo/2+1)) THEN
-                  startloop = 1
-               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-                  startloop = jpiglo/2+1 - nimpp + 1
-               ELSE
-                  startloop = nlci + 1
-               ENDIF
-               IF(startloop .le. nlci) THEN
-                 DO jk = 1, jpk
-                    DO ji = startloop, nlci
-                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                       pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
-                    END DO
-                 END DO
-               ENDIF
-
-            CASE ( 'F' )                               ! F-point
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-                     pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk)
-                  END DO
-                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk)
-                  ENDIF
-               END DO
-
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               IF(nimpp .ge. (jpiglo/2+1)) THEN
-                  startloop = 1
-               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-                  startloop = jpiglo/2+1 - nimpp + 1
-               ELSE
-                  startloop = endloop + 1
-               ENDIF
-               IF (startloop .le. endloop) THEN
-                  DO jk = 1, jpk
-                     DO ji = startloop, endloop
-                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)
-                     END DO
-                  END DO
-               ENDIF
-
-            END SELECT
-
-         CASE DEFAULT                           ! *  closed : the code probably never go through
-            !
-            SELECT CASE ( cd_type)
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3dl(:, 1  ,jk) = 0.e0
-               pt3dl(:,ijpj,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3dl(:,ijpj,jk) = 0.e0
-            END SELECT
-            !
-         END SELECT     !  npolj
-         !
-      !
-   END SUBROUTINE mpp_lbc_nfd_3d
-
-
-   SUBROUTINE mpp_lbc_nfd_2d( pt2dl, pt2dr, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lbc_nfd_2d  ***
-      !!
-      !! ** Purpose :   2D lateral boundary condition : North fold treatment
-      !!       without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt2d with updated values along the north fold
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                      ! = T , U , V , F , W points
-      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                      !   = -1. , the sign is changed if north fold boundary
-      !                                                      !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2dl     ! 2D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pt2dr     ! 2D array on which the boundary condition is applied
-      !
-      INTEGER  ::   ji
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
-      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
-      END SELECT
-      !
-      ijpjm1 = ijpj-1
-
-
-      SELECT CASE ( npolj )
-      !
-      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
-         !
-         SELECT CASE ( cd_type )
-         !
-         CASE ( 'T' , 'W' )                               ! T- , W-points
-            IF (nimpp .ne. 1) THEN
-              startloop = 1
-            ELSE
-              startloop = 2
-            ENDIF
-            DO ji = startloop, nlci
-              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
-            END DO
-            IF (nimpp .eq. 1) THEN
-              pt2dl(1,ijpj)   = psgn * pt2dl(3,ijpj-2)
-            ENDIF
-
-            IF(nimpp .ge. (jpiglo/2+1)) THEN
-               startloop = 1
-            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-               startloop = jpiglo/2+1 - nimpp + 1
-            ELSE
-               startloop = nlci + 1
-            ENDIF
-            DO ji = startloop, nlci
-               ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-               jia = ji + nimpp - 1
-               ijta = jpiglo - jia + 2
-               IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
-                  pt2dl(ji,ijpjm1) = psgn * pt2dl(ijta-nimpp+1,ijpjm1)
-               ELSE
-                  pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
-               ENDIF
-            END DO
-
-         CASE ( 'U' )                                     ! U-point
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            DO ji = 1, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
-            END DO
-
-            IF (nimpp .eq. 1) THEN
-              pt2dl(   1  ,ijpj  ) = psgn * pt2dl(    2   ,ijpj-2)
-              pt2dl(1     ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1)
-            ENDIF
-            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-              pt2dl(nlci,ijpj  ) = psgn * pt2dl(nlci-1,ijpj-2)
-            ENDIF
-
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            IF(nimpp .ge. (jpiglo/2)) THEN
-               startloop = 1
-            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
-               startloop = jpiglo/2 - nimpp + 1
-            ELSE
-               startloop = endloop + 1
-            ENDIF
-            DO ji = startloop, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               jia = ji + nimpp - 1
-               ijua = jpiglo - jia + 1
-               IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
-                  pt2dl(ji,ijpjm1) = psgn * pt2dl(ijua-nimpp+1,ijpjm1)
-               ELSE
-                  pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
-               ENDIF
-            END DO
-
-         CASE ( 'V' )                                     ! V-point
-            IF (nimpp .ne. 1) THEN
-              startloop = 1
-            ELSE
-              startloop = 2
-            ENDIF
-            DO ji = startloop, nlci
-              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-              pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1)
-              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2)
-            END DO
-            IF (nimpp .eq. 1) THEN
-              pt2dl( 1 ,ijpj)   = psgn * pt2dl( 3 ,ijpj-3) 
-            ENDIF
-
-         CASE ( 'F' )                                     ! F-point
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            DO ji = 1, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1)
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2)
-            END DO
-            IF (nimpp .eq. 1) THEN
-              pt2dl(   1  ,ijpj)   = psgn * pt2dl(    2   ,ijpj-3)
-              pt2dl(   1  ,ijpj-1) = psgn * pt2dl(    2   ,ijpj-2)
-            ENDIF
-            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-              pt2dl(nlci,ijpj)   = psgn * pt2dl(nlci-1,ijpj-3)
-              pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2) 
-            ENDIF
-
-         CASE ( 'I' )                                     ! ice U-V point (I-point)
-            IF (nimpp .ne. 1) THEN
-               startloop = 1
-            ELSE
-               startloop = 3
-               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
-            ENDIF
-            DO ji = startloop, nlci
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-
-         CASE ( 'J' )                                     ! first ice U-V point
-            IF (nimpp .ne. 1) THEN
-               startloop = 1
-            ELSE
-               startloop = 3
-               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
-            ENDIF
-            DO ji = startloop, nlci
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-
-         CASE ( 'K' )                                     ! second ice U-V point
-            IF (nimpp .ne. 1) THEN
-               startloop = 1
-            ELSE
-               startloop = 3
-               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
-            ENDIF
-            DO ji = startloop, nlci
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-
-         END SELECT
-         !
-      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
-         !
-         SELECT CASE ( cd_type )
-         CASE ( 'T' , 'W' )                               ! T-, W-point
-            DO ji = 1, nlci
-               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1)
-            END DO
-
-         CASE ( 'U' )                                     ! U-point
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            DO ji = 1, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-               pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1)
-            ENDIF
-
-         CASE ( 'V' )                                     ! V-point
-            DO ji = 1, nlci
-               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
-            END DO
-            IF(nimpp .ge. (jpiglo/2+1)) THEN
-               startloop = 1
-            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-               startloop = jpiglo/2+1 - nimpp + 1
-            ELSE
-               startloop = nlci + 1
-            ENDIF
-            DO ji = startloop, nlci
-               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
-            END DO
-
-         CASE ( 'F' )                               ! F-point
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            DO ji = 1, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
-            END DO
-            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2)
-            ENDIF
-
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            IF(nimpp .ge. (jpiglo/2+1)) THEN
-               startloop = 1
-            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-               startloop = jpiglo/2+1 - nimpp + 1
-            ELSE
-               startloop = endloop + 1
-            ENDIF
-
-            DO ji = startloop, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-
-         CASE ( 'I' )                                  ! ice U-V point (I-point)
-               IF (nimpp .ne. 1) THEN
-                  startloop = 1
-               ELSE
-                  startloop = 2
-               ENDIF
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO ji = startloop , endloop
-                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                  pt2dl(ji,ijpj)= 0.5 * (pt2dr(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1))
-               END DO
-
-         CASE ( 'J' )                                  ! first ice U-V point
-               IF (nimpp .ne. 1) THEN
-                  startloop = 1
-               ELSE
-                  startloop = 2
-               ENDIF
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO ji = startloop , endloop
-                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                  pt2dl(ji,ijpj) = pt2dr(ji,ijpjm1)
-               END DO
-
-         CASE ( 'K' )                                  ! second ice U-V point
-               IF (nimpp .ne. 1) THEN
-                  startloop = 1
-               ELSE
-                  startloop = 2
-               ENDIF
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO ji = startloop, endloop
-                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                  pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1)
-               END DO
-
-         END SELECT
-         !
-      CASE DEFAULT                           ! *  closed : the code probably never go through
-         !
-         SELECT CASE ( cd_type)
-         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
-            pt2dl(:, 1     ) = 0.e0
-            pt2dl(:,ijpj) = 0.e0
-         CASE ( 'F' )                                   ! F-point
-            pt2dl(:,ijpj) = 0.e0
-         CASE ( 'I' )                                   ! ice U-V point
-            pt2dl(:, 1     ) = 0.e0
-            pt2dl(:,ijpj) = 0.e0
-         CASE ( 'J' )                                   ! first ice U-V point
-            pt2dl(:, 1     ) = 0.e0
-            pt2dl(:,ijpj) = 0.e0
-         CASE ( 'K' )                                   ! second ice U-V point
-            pt2dl(:, 1     ) = 0.e0
-            pt2dl(:,ijpj) = 0.e0
-         END SELECT
-         !
-      END SELECT
-      !
-   END SUBROUTINE mpp_lbc_nfd_2d
-
-   !!======================================================================
-END MODULE lbcnfd
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_cray.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_cray.f90	(revision 12100)
+++ 	(revision )
@@ -1,34 +1,0 @@
-!  Cray subroutines or functions used by OPA model and possibly 
-!  not found on other platforms.
-!
-!  check their existence
-!  
-!  wheneq
-!!----------------------------------------------------------------------
-!!  OPA 9.0 , LOCEAN-IPSL (2005) 
-!! $Id: lib_cray.f90 3680 2012-11-27 14:42:24Z rblod $ 
-!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-!!----------------------------------------------------------------------
-SUBROUTINE lib_cray
-      WRITE(*,*) 'lib_cray: You should not have seen this print! error?'
-END SUBROUTINE lib_cray
-
-SUBROUTINE wheneq ( i, x, j, t, ind, nn )
-        IMPLICIT NONE
-
-        INTEGER , INTENT (  in ) :: i, j
-        INTEGER , INTENT ( out ) :: nn
-        REAL    , INTENT (  in ), DIMENSION (1+(i-1)*j) :: x
-        REAL    , INTENT (  in ) :: t
-        INTEGER , INTENT ( out ), DIMENSION (1+(i-1)*j) :: ind
-        INTEGER :: n, k
-        nn = 0
-        DO n = 1, i
-          k = 1 + (n-1) * j
-          IF ( x ( k) == t ) THEN 
-              nn = nn + 1
-              ind (nn) = k
-          ENDIF
-        END DO 
-
-END SUBROUTINE wheneq
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_fortran.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_fortran.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_fortran.F90	(revision 12101)
@@ -0,0 +1,489 @@
+MODULE lib_fortran
+   !!======================================================================
+   !!                       ***  MODULE  lib_fortran  ***
+   !! Fortran utilities:  includes some low levels fortran functionality
+   !!======================================================================
+   !! History :  3.2  !  2010-05  (M. Dunphy, R. Benshila)  Original code
+   !!            3.4  !  2013-06  (C. Rousset)  add glob_min, glob_max 
+   !!                                           + 3d dim. of input is fexible (jpk, jpl...) 
+   !!            4.0  !  2016-06  (T. Lovato)  double precision global sum by default 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   glob_sum    : generic interface for global masked summation over
+   !!                 the interior domain for 1 or 2 2D or 3D arrays
+   !!                 it works only for T points
+   !!   SIGN        : generic interface for SIGN to overwrite f95 behaviour
+   !!                 of intrinsinc sign function
+   !!----------------------------------------------------------------------
+   USE par_oce         ! Ocean parameter
+   USE dom_oce         ! ocean domain
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing
+   USE lbclnk          ! ocean lateral boundary conditions
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   glob_sum      ! used in many places (masked with tmask_i)
+   PUBLIC   glob_sum_full ! used in many places (masked with tmask_h, ie only over the halos)
+   PUBLIC   local_sum     ! used in trcrad, local operation before glob_sum_delay
+   PUBLIC   sum3x3        ! used in trcrad, do a sum over 3x3 boxes
+   PUBLIC   DDPDD         ! also used in closea module
+   PUBLIC   glob_min, glob_max
+#if defined key_nosignedzero
+   PUBLIC SIGN
+#endif
+
+   INTERFACE glob_sum
+      MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d
+   END INTERFACE
+   INTERFACE glob_sum_full
+      MODULE PROCEDURE glob_sum_full_2d, glob_sum_full_3d
+   END INTERFACE
+   INTERFACE local_sum
+      MODULE PROCEDURE local_sum_2d, local_sum_3d
+   END INTERFACE
+   INTERFACE sum3x3
+      MODULE PROCEDURE sum3x3_2d, sum3x3_3d
+   END INTERFACE
+   INTERFACE glob_min
+      MODULE PROCEDURE glob_min_2d, glob_min_3d
+   END INTERFACE
+   INTERFACE glob_max
+      MODULE PROCEDURE glob_max_2d, glob_max_3d
+   END INTERFACE
+
+#if defined key_nosignedzero
+   INTERFACE SIGN
+      MODULE PROCEDURE SIGN_SCALAR, SIGN_ARRAY_1D, SIGN_ARRAY_2D, SIGN_ARRAY_3D,   &
+         &             SIGN_ARRAY_1D_A, SIGN_ARRAY_2D_A, SIGN_ARRAY_3D_A,          &
+         &             SIGN_ARRAY_1D_B, SIGN_ARRAY_2D_B, SIGN_ARRAY_3D_B
+   END INTERFACE
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: lib_fortran.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#  define GLOBSUM_CODE
+
+#     define DIM_1d
+#     define FUNCTION_GLOBSUM           glob_sum_1d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBSUM
+#     undef DIM_1d
+
+#     define DIM_2d
+#     define OPERATION_GLOBSUM
+#     define FUNCTION_GLOBSUM           glob_sum_2d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBSUM
+#     undef OPERATION_GLOBSUM
+#     define OPERATION_FULL_GLOBSUM
+#     define FUNCTION_GLOBSUM           glob_sum_full_2d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBSUM
+#     undef OPERATION_FULL_GLOBSUM
+#     undef DIM_2d
+
+#     define DIM_3d
+#     define OPERATION_GLOBSUM
+#     define FUNCTION_GLOBSUM           glob_sum_3d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBSUM
+#     undef OPERATION_GLOBSUM
+#     define OPERATION_FULL_GLOBSUM
+#     define FUNCTION_GLOBSUM           glob_sum_full_3d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBSUM
+#     undef OPERATION_FULL_GLOBSUM
+#     undef DIM_3d
+
+#  undef GLOBSUM_CODE
+
+
+#  define GLOBMINMAX_CODE
+
+#     define DIM_2d
+#     define OPERATION_GLOBMIN
+#     define FUNCTION_GLOBMINMAX           glob_min_2d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBMINMAX
+#     undef OPERATION_GLOBMIN
+#     define OPERATION_GLOBMAX
+#     define FUNCTION_GLOBMINMAX           glob_max_2d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBMINMAX
+#     undef OPERATION_GLOBMAX
+#     undef DIM_2d
+
+#     define DIM_3d
+#     define OPERATION_GLOBMIN
+#     define FUNCTION_GLOBMINMAX           glob_min_3d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBMINMAX
+#     undef OPERATION_GLOBMIN
+#     define OPERATION_GLOBMAX
+#     define FUNCTION_GLOBMINMAX           glob_max_3d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBMINMAX
+#     undef OPERATION_GLOBMAX
+#     undef DIM_3d
+#  undef GLOBMINMAX_CODE
+
+!                          ! FUNCTION local_sum !
+
+   FUNCTION local_sum_2d( ptab )
+      !!----------------------------------------------------------------------
+      REAL(wp),  INTENT(in   ) ::   ptab(:,:) ! array on which operation is applied
+      COMPLEX(wp)              ::  local_sum_2d
+      !
+      !!-----------------------------------------------------------------------
+      !
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj    ! dummy loop indices
+      INTEGER    ::   ipi, ipj  ! dimensions
+      !!-----------------------------------------------------------------------
+      !
+      ipi = SIZE(ptab,1)   ! 1st dimension
+      ipj = SIZE(ptab,2)   ! 2nd dimension
+      !
+      ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated
+
+      DO jj = 1, ipj
+         DO ji = 1, ipi
+            ztmp =  ptab(ji,jj) * tmask_i(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+         END DO
+      END DO
+      !
+      local_sum_2d = ctmp
+       
+   END FUNCTION local_sum_2d
+
+   FUNCTION local_sum_3d( ptab )
+      !!----------------------------------------------------------------------
+      REAL(wp),  INTENT(in   ) ::   ptab(:,:,:) ! array on which operation is applied
+      COMPLEX(wp)              ::  local_sum_3d
+      !
+      !!-----------------------------------------------------------------------
+      !
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      INTEGER    ::   ipi, ipj, ipk    ! dimensions
+      !!-----------------------------------------------------------------------
+      !
+      ipi = SIZE(ptab,1)   ! 1st dimension
+      ipj = SIZE(ptab,2)   ! 2nd dimension
+      ipk = SIZE(ptab,3)   ! 3rd dimension
+      !
+      ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated
+
+      DO jk = 1, ipk
+        DO jj = 1, ipj
+          DO ji = 1, ipi
+             ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj)
+             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+          END DO
+        END DO
+      END DO
+      !
+      local_sum_3d = ctmp
+       
+   END FUNCTION local_sum_3d
+
+!                          ! FUNCTION sum3x3 !
+
+   SUBROUTINE sum3x3_2d( p2d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  routine sum3x3_2d  ***
+      !!
+      !! ** Purpose : sum over 3x3 boxes
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION (:,:), INTENT(inout) ::   p2d
+      !
+      INTEGER ::   ji, ji2, jj, jj2     ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF( SIZE(p2d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the first dimension is not equal to jpi' ) 
+      IF( SIZE(p2d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the second dimension is not equal to jpj' ) 
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi 
+            IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box
+               ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
+               jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box
+               IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain
+                  p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2))
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )
+      IF( nbondi /= -1 ) THEN
+         IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:)
+         IF( MOD(mig(    1), 3) == 2 )   p2d(    2,:) = p2d(    1,:)
+      ENDIF
+      IF( nbondi /=  1 ) THEN
+         IF( MOD(mig(jpi-2), 3) == 1 )   p2d(  jpi,:) = p2d(jpi-1,:)
+         IF( MOD(mig(jpi-2), 3) == 0 )   p2d(jpi-1,:) = p2d(  jpi,:)
+      ENDIF
+      IF( nbondj /= -1 ) THEN
+         IF( MOD(mjg(    1), 3) == 1 )   p2d(:,    1) = p2d(:,    2)
+         IF( MOD(mjg(    1), 3) == 2 )   p2d(:,    2) = p2d(:,    1)
+      ENDIF
+      IF( nbondj /=  1 ) THEN
+         IF( MOD(mjg(jpj-2), 3) == 1 )   p2d(:,  jpj) = p2d(:,jpj-1)
+         IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj)
+      ENDIF
+      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )
+
+   END SUBROUTINE sum3x3_2d
+
+   SUBROUTINE sum3x3_3d( p3d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  routine sum3x3_3d  ***
+      !!
+      !! ** Purpose : sum over 3x3 boxes
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION (:,:,:), INTENT(inout) ::   p3d
+      !
+      INTEGER ::   ji, ji2, jj, jj2, jn     ! dummy loop indices
+      INTEGER ::   ipn                      ! Third dimension size
+      !!----------------------------------------------------------------------
+      !
+      IF( SIZE(p3d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the first dimension is not equal to jpi' ) 
+      IF( SIZE(p3d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the second dimension is not equal to jpj' ) 
+      ipn = SIZE(p3d,3)
+      !
+      DO jn = 1, ipn
+         DO jj = 1, jpj
+            DO ji = 1, jpi 
+               IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box
+                  ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
+                  jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box
+                  IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain
+                     p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn))
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. )
+      IF( nbondi /= -1 ) THEN
+         IF( MOD(mig(    1), 3) == 1 )   p3d(    1,:,:) = p3d(    2,:,:)
+         IF( MOD(mig(    1), 3) == 2 )   p3d(    2,:,:) = p3d(    1,:,:)
+      ENDIF
+      IF( nbondi /=  1 ) THEN
+         IF( MOD(mig(jpi-2), 3) == 1 )   p3d(  jpi,:,:) = p3d(jpi-1,:,:)
+         IF( MOD(mig(jpi-2), 3) == 0 )   p3d(jpi-1,:,:) = p3d(  jpi,:,:)
+      ENDIF
+      IF( nbondj /= -1 ) THEN
+         IF( MOD(mjg(    1), 3) == 1 )   p3d(:,    1,:) = p3d(:,    2,:)
+         IF( MOD(mjg(    1), 3) == 2 )   p3d(:,    2,:) = p3d(:,    1,:)
+      ENDIF
+      IF( nbondj /=  1 ) THEN
+         IF( MOD(mjg(jpj-2), 3) == 1 )   p3d(:,  jpj,:) = p3d(:,jpj-1,:)
+         IF( MOD(mjg(jpj-2), 3) == 0 )   p3d(:,jpj-1,:) = p3d(:,  jpj,:)
+      ENDIF
+      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. )
+
+   END SUBROUTINE sum3x3_3d
+
+
+   SUBROUTINE DDPDD( ydda, yddb )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE DDPDD ***
+      !!
+      !! ** Purpose : Add a scalar element to a sum
+      !!
+      !!
+      !! ** Method  : The code uses the compensated summation with doublet
+      !!              (sum,error) emulated useing complex numbers. ydda is the
+      !!               scalar to add to the summ yddb
+      !!
+      !! ** Action  : This does only work for MPI.
+      !!
+      !! References : Using Acurate Arithmetics to Improve Numerical
+      !!              Reproducibility and Sability in Parallel Applications
+      !!              Yun HE and Chris H. Q. DING, Journal of Supercomputing 18, 259-277, 2001
+      !!----------------------------------------------------------------------
+      COMPLEX(wp), INTENT(in   ) ::   ydda
+      COMPLEX(wp), INTENT(inout) ::   yddb
+      !
+      REAL(wp) :: zerr, zt1, zt2  ! local work variables
+      !!-----------------------------------------------------------------------
+      !
+      ! Compute ydda + yddb using Knuth's trick.
+      zt1  = REAL(ydda) + REAL(yddb)
+      zerr = zt1 - REAL(ydda)
+      zt2  = ( (REAL(yddb) - zerr) + (REAL(ydda) - (zt1 - zerr)) )   &
+         &   + AIMAG(ydda)         + AIMAG(yddb)
+      !
+      ! The result is t1 + t2, after normalization.
+      yddb = CMPLX( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1), wp )
+      !
+   END SUBROUTINE DDPDD
+
+#if defined key_nosignedzero
+   !!----------------------------------------------------------------------
+   !!   'key_nosignedzero'                                         F90 SIGN
+   !!----------------------------------------------------------------------
+
+   FUNCTION SIGN_SCALAR( pa, pb )
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_SCALAR  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb          ! input
+      REAL(wp) :: SIGN_SCALAR    ! result
+      !!-----------------------------------------------------------------------
+      IF ( pb >= 0.e0) THEN   ;   SIGN_SCALAR = ABS(pa)
+      ELSE                    ;   SIGN_SCALAR =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_SCALAR
+
+
+   FUNCTION SIGN_ARRAY_1D( pa, pb )
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_1D  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb(:)                   ! input
+      REAL(wp) :: SIGN_ARRAY_1D(SIZE(pb,1))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_1D = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_1D =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_1D
+
+
+   FUNCTION SIGN_ARRAY_2D(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_2D  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb(:,:)      ! input
+      REAL(wp) :: SIGN_ARRAY_2D(SIZE(pb,1),SIZE(pb,2))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_2D = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_2D =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_2D
+
+   FUNCTION SIGN_ARRAY_3D(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_3D  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb(:,:,:)      ! input
+      REAL(wp) :: SIGN_ARRAY_3D(SIZE(pb,1),SIZE(pb,2),SIZE(pb,3))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_3D = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_3D =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_3D
+
+
+   FUNCTION SIGN_ARRAY_1D_A(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_1D_A  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:),pb(:)      ! input
+      REAL(wp) :: SIGN_ARRAY_1D_A(SIZE(pb,1))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_1D_A = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_1D_A =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_1D_A
+
+
+   FUNCTION SIGN_ARRAY_2D_A(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_2D_A  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:),pb(:,:)      ! input
+      REAL(wp) :: SIGN_ARRAY_2D_A(SIZE(pb,1),SIZE(pb,2))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_2D_A = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_2D_A =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_2D_A
+
+
+   FUNCTION SIGN_ARRAY_3D_A(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_3D_A  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:,:),pb(:,:,:)  ! input
+      REAL(wp) :: SIGN_ARRAY_3D_A(SIZE(pb,1),SIZE(pb,2),SIZE(pb,3)) ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_3D_A = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_3D_A =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_3D_A
+
+
+   FUNCTION SIGN_ARRAY_1D_B(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_1D_B  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:),pb      ! input
+      REAL(wp) :: SIGN_ARRAY_1D_B(SIZE(pa,1))  ! result
+      !!-----------------------------------------------------------------------
+      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_1D_B = ABS(pa)
+      ELSE                    ;   SIGN_ARRAY_1D_B =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_ARRAY_1D_B
+
+
+   FUNCTION SIGN_ARRAY_2D_B(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_2D_B  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:),pb      ! input
+      REAL(wp) :: SIGN_ARRAY_2D_B(SIZE(pa,1),SIZE(pa,2))  ! result
+      !!-----------------------------------------------------------------------
+      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_2D_B = ABS(pa)
+      ELSE                    ;   SIGN_ARRAY_2D_B =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_ARRAY_2D_B
+
+
+   FUNCTION SIGN_ARRAY_3D_B(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_3D_B  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:,:),pb      ! input
+      REAL(wp) :: SIGN_ARRAY_3D_B(SIZE(pa,1),SIZE(pa,2),SIZE(pa,3))  ! result
+      !!-----------------------------------------------------------------------
+      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_3D_B = ABS(pa)
+      ELSE                    ;   SIGN_ARRAY_3D_B =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_ARRAY_3D_B
+#endif
+
+   !!======================================================================
+END MODULE lib_fortran
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_fortran.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_fortran.f90	(revision 12100)
+++ 	(revision )
@@ -1,556 +1,0 @@
-MODULE lib_fortran
-   !!======================================================================
-   !!                       ***  MODULE  lib_fortran  ***
-   !! Fortran utilities:  includes some low levels fortran functionality
-   !!======================================================================
-   !! History :  3.2  !  2010-05  (M. Dunphy, R. Benshila)  Original code
-   !!            3.4  !  2013-06  (C. Rousset)  add glob_min, glob_max 
-   !!                                           + 3d dim. of input is fexible (jpk, jpl...) 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   glob_sum    : generic interface for global masked summation over
-   !!                 the interior domain for 1 or 2 2D or 3D arrays
-   !!                 it works only for T points
-   !!   SIGN        : generic interface for SIGN to overwrite f95 behaviour
-   !!                 of intrinsinc sign function
-   !!----------------------------------------------------------------------
-   USE par_oce         ! Ocean parameter
-   USE dom_oce         ! ocean domain
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distributed memory computing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   glob_sum      ! used in many places (masked with tmask_i)
-   PUBLIC   glob_sum_full ! used in many places (masked with tmask_h, ie omly over the halos)
-   PUBLIC   DDPDD         ! also used in closea module
-   PUBLIC   glob_min, glob_max
-
-   PUBLIC SIGN
-
-
-   INTERFACE glob_sum
-      MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d, &
-         &             glob_sum_2d_a, glob_sum_3d_a
-   END INTERFACE
-   INTERFACE glob_sum_full
-      MODULE PROCEDURE glob_sum_full_2d, glob_sum_full_3d
-   END INTERFACE
-   INTERFACE glob_min
-      MODULE PROCEDURE glob_min_2d, glob_min_3d,glob_min_2d_a, glob_min_3d_a 
-   END INTERFACE
-   INTERFACE glob_max
-      MODULE PROCEDURE glob_max_2d, glob_max_3d,glob_max_2d_a, glob_max_3d_a 
-   END INTERFACE
-
-
-   INTERFACE SIGN
-      MODULE PROCEDURE SIGN_SCALAR, SIGN_ARRAY_1D, SIGN_ARRAY_2D, SIGN_ARRAY_3D,   &
-         &             SIGN_ARRAY_1D_A, SIGN_ARRAY_2D_A, SIGN_ARRAY_3D_A,          &
-         &             SIGN_ARRAY_1D_B, SIGN_ARRAY_2D_B, SIGN_ARRAY_3D_B
-   END INTERFACE
-
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: lib_fortran.F90 6140 2015-12-21 11:35:23Z timgraham $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-
-   ! --- SUM ---
-
-   FUNCTION glob_sum_1d( ptab, kdim )
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_sum_1D  ***
-      !!
-      !! ** Purpose : perform a masked sum on the inner global domain of a 1D array
-      !!-----------------------------------------------------------------------
-      INTEGER :: kdim
-      REAL(wp), INTENT(in), DIMENSION(kdim) ::   ptab        ! input 1D array
-      REAL(wp)                              ::   glob_sum_1d ! global sum
-      !!-----------------------------------------------------------------------
-      !
-      glob_sum_1d = SUM( ptab(:) )
-      IF( lk_mpp )   CALL mpp_sum( glob_sum_1d )
-      !
-   END FUNCTION glob_sum_1d
-
-   FUNCTION glob_sum_2d( ptab )
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_sum_2D  ***
-      !!
-      !! ** Purpose : perform a masked sum on the inner global domain of a 2D array
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array
-      REAL(wp)                             ::   glob_sum_2d   ! global masked sum
-      !!-----------------------------------------------------------------------
-      !
-      glob_sum_2d = SUM( ptab(:,:)*tmask_i(:,:) )
-      IF( lk_mpp )   CALL mpp_sum( glob_sum_2d )
-      !
-   END FUNCTION glob_sum_2d
-
-
-   FUNCTION glob_sum_3d( ptab )
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_sum_3D  ***
-      !!
-      !! ** Purpose : perform a masked sum on the inner global domain of a 3D array
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array
-      REAL(wp)                               ::   glob_sum_3d   ! global masked sum
-      !!
-      INTEGER :: jk
-      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
-      !!-----------------------------------------------------------------------
-      !
-      ijpk = SIZE(ptab,3)
-      !
-      glob_sum_3d = 0.e0
-      DO jk = 1, ijpk
-         glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i(:,:) )
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( glob_sum_3d )
-      !
-   END FUNCTION glob_sum_3d
-
-
-   FUNCTION glob_sum_2d_a( ptab1, ptab2 )
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_sum_2D _a ***
-      !!
-      !! ** Purpose : perform a masked sum on the inner global domain of two 2D array
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array
-      REAL(wp)            , DIMENSION(2)   ::   glob_sum_2d_a   ! global masked sum
-      !!-----------------------------------------------------------------------
-      !
-      glob_sum_2d_a(1) = SUM( ptab1(:,:)*tmask_i(:,:) )
-      glob_sum_2d_a(2) = SUM( ptab2(:,:)*tmask_i(:,:) )
-      IF( lk_mpp )   CALL mpp_sum( glob_sum_2d_a, 2 )
-      !
-   END FUNCTION glob_sum_2d_a
-
-
-   FUNCTION glob_sum_3d_a( ptab1, ptab2 )
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_sum_3D_a ***
-      !!
-      !! ** Purpose : perform a masked sum on the inner global domain of two 3D array
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array
-      REAL(wp)            , DIMENSION(2)     ::   glob_sum_3d_a   ! global masked sum
-      !!
-      INTEGER :: jk
-      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
-      !!-----------------------------------------------------------------------
-      !
-      ijpk = SIZE(ptab1,3)
-      !
-      glob_sum_3d_a(:) = 0.e0
-      DO jk = 1, ijpk
-         glob_sum_3d_a(1) = glob_sum_3d_a(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) )
-         glob_sum_3d_a(2) = glob_sum_3d_a(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) )
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( glob_sum_3d_a, 2 )
-      !
-   END FUNCTION glob_sum_3d_a
-
-   FUNCTION glob_sum_full_2d( ptab )
-      !!----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_sum_full_2d ***
-      !!
-      !! ** Purpose : perform a sum in calling DDPDD routine (nomask)
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab
-      REAL(wp)                             ::   glob_sum_full_2d   ! global sum
-      !!
-      !!-----------------------------------------------------------------------
-      !
-      glob_sum_full_2d = SUM( ptab(:,:) * tmask_h(:,:) )
-      IF( lk_mpp )   CALL mpp_sum( glob_sum_full_2d )
-      !
-   END FUNCTION glob_sum_full_2d
-
-   FUNCTION glob_sum_full_3d( ptab )
-      !!----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_sum_full_3d ***
-      !!
-      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine (nomask)
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab
-      REAL(wp)                               ::   glob_sum_full_3d   ! global sum
-      !!
-      INTEGER    ::   ji, jj, jk   ! dummy loop indices
-      INTEGER    ::   ijpk ! local variables: size of ptab
-      !!-----------------------------------------------------------------------
-      !
-      ijpk = SIZE(ptab,3)
-      !
-      glob_sum_full_3d = 0.e0
-      DO jk = 1, ijpk
-         glob_sum_full_3d = glob_sum_full_3d + SUM( ptab(:,:,jk) * tmask_h(:,:) )
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( glob_sum_full_3d )
-      !
-   END FUNCTION glob_sum_full_3d
-
-
-
-   ! --- MIN ---
-   FUNCTION glob_min_2d( ptab ) 
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_min_2D  ***
-      !!
-      !! ** Purpose : perform a masked min on the inner global domain of a 2D array
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array
-      REAL(wp)                             ::   glob_min_2d   ! global masked min
-      !!-----------------------------------------------------------------------
-      !
-      glob_min_2d = MINVAL( ptab(:,:)*tmask_i(:,:) )
-      IF( lk_mpp )   CALL mpp_min( glob_min_2d )
-      !
-   END FUNCTION glob_min_2d
- 
-   FUNCTION glob_min_3d( ptab ) 
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_min_3D  ***
-      !!
-      !! ** Purpose : perform a masked min on the inner global domain of a 3D array
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array
-      REAL(wp)                               ::   glob_min_3d   ! global masked min
-      !!
-      INTEGER :: jk
-      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
-      !!-----------------------------------------------------------------------
-      !
-      ijpk = SIZE(ptab,3)
-      !
-      glob_min_3d = MINVAL( ptab(:,:,1)*tmask_i(:,:) )
-      DO jk = 2, ijpk
-         glob_min_3d = MIN( glob_min_3d, MINVAL( ptab(:,:,jk)*tmask_i(:,:) ) )
-      END DO
-      IF( lk_mpp )   CALL mpp_min( glob_min_3d )
-      !
-   END FUNCTION glob_min_3d
-
-
-   FUNCTION glob_min_2d_a( ptab1, ptab2 ) 
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_min_2D _a ***
-      !!
-      !! ** Purpose : perform a masked min on the inner global domain of two 2D array
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array
-      REAL(wp)            , DIMENSION(2)   ::   glob_min_2d_a   ! global masked min
-      !!-----------------------------------------------------------------------
-      !             
-      glob_min_2d_a(1) = MINVAL( ptab1(:,:)*tmask_i(:,:) )
-      glob_min_2d_a(2) = MINVAL( ptab2(:,:)*tmask_i(:,:) )
-      IF( lk_mpp )   CALL mpp_min( glob_min_2d_a, 2 )
-      !
-   END FUNCTION glob_min_2d_a
- 
- 
-   FUNCTION glob_min_3d_a( ptab1, ptab2 ) 
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_min_3D_a ***
-      !!
-      !! ** Purpose : perform a masked min on the inner global domain of two 3D array
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array
-      REAL(wp)            , DIMENSION(2)     ::   glob_min_3d_a   ! global masked min
-      !!
-      INTEGER :: jk
-      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
-      !!-----------------------------------------------------------------------
-      !
-      ijpk = SIZE(ptab1,3)
-      !
-      glob_min_3d_a(1) = MINVAL( ptab1(:,:,1)*tmask_i(:,:) )
-      glob_min_3d_a(2) = MINVAL( ptab2(:,:,1)*tmask_i(:,:) )
-      DO jk = 2, ijpk
-         glob_min_3d_a(1) = MIN( glob_min_3d_a(1), MINVAL( ptab1(:,:,jk)*tmask_i(:,:) ) )
-         glob_min_3d_a(2) = MIN( glob_min_3d_a(2), MINVAL( ptab2(:,:,jk)*tmask_i(:,:) ) )
-      END DO
-      IF( lk_mpp )   CALL mpp_min( glob_min_3d_a, 2 )
-      !
-   END FUNCTION glob_min_3d_a
-
-   ! --- MAX ---
-   FUNCTION glob_max_2d( ptab ) 
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_max_2D  ***
-      !!
-      !! ** Purpose : perform a masked max on the inner global domain of a 2D array
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array
-      REAL(wp)                             ::   glob_max_2d   ! global masked max
-      !!-----------------------------------------------------------------------
-      !
-      glob_max_2d = MAXVAL( ptab(:,:)*tmask_i(:,:) )
-      IF( lk_mpp )   CALL mpp_max( glob_max_2d )
-      !
-   END FUNCTION glob_max_2d
- 
-   FUNCTION glob_max_3d( ptab ) 
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_max_3D  ***
-      !!
-      !! ** Purpose : perform a masked max on the inner global domain of a 3D array
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array
-      REAL(wp)                               ::   glob_max_3d   ! global masked max
-      !!
-      INTEGER :: jk
-      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
-      !!-----------------------------------------------------------------------
-      !
-      ijpk = SIZE(ptab,3)
-      !
-      glob_max_3d = MAXVAL( ptab(:,:,1)*tmask_i(:,:) )
-      DO jk = 2, ijpk
-         glob_max_3d = MAX( glob_max_3d, MAXVAL( ptab(:,:,jk)*tmask_i(:,:) ) )
-      END DO
-      IF( lk_mpp )   CALL mpp_max( glob_max_3d )
-      !
-   END FUNCTION glob_max_3d
-
-
-   FUNCTION glob_max_2d_a( ptab1, ptab2 ) 
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_max_2D _a ***
-      !!
-      !! ** Purpose : perform a masked max on the inner global domain of two 2D array
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array
-      REAL(wp)            , DIMENSION(2)   ::   glob_max_2d_a   ! global masked max
-      !!-----------------------------------------------------------------------
-      !             
-      glob_max_2d_a(1) = MAXVAL( ptab1(:,:)*tmask_i(:,:) )
-      glob_max_2d_a(2) = MAXVAL( ptab2(:,:)*tmask_i(:,:) )
-      IF( lk_mpp )   CALL mpp_max( glob_max_2d_a, 2 )
-      !
-   END FUNCTION glob_max_2d_a
- 
- 
-   FUNCTION glob_max_3d_a( ptab1, ptab2 ) 
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_max_3D_a ***
-      !!
-      !! ** Purpose : perform a masked max on the inner global domain of two 3D array
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array
-      REAL(wp)            , DIMENSION(2)     ::   glob_max_3d_a   ! global masked max
-      !!
-      INTEGER :: jk
-      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
-      !!-----------------------------------------------------------------------
-      !
-      ijpk = SIZE(ptab1,3)
-      !
-      glob_max_3d_a(1) = MAXVAL( ptab1(:,:,1)*tmask_i(:,:) )
-      glob_max_3d_a(2) = MAXVAL( ptab2(:,:,1)*tmask_i(:,:) )
-      DO jk = 2, ijpk
-         glob_max_3d_a(1) = MAX( glob_max_3d_a(1), MAXVAL( ptab1(:,:,jk)*tmask_i(:,:) ) )
-         glob_max_3d_a(2) = MAX( glob_max_3d_a(2), MAXVAL( ptab2(:,:,jk)*tmask_i(:,:) ) )
-      END DO
-      IF( lk_mpp )   CALL mpp_max( glob_max_3d_a, 2 )
-      !
-   END FUNCTION glob_max_3d_a
-
-
-   SUBROUTINE DDPDD( ydda, yddb )
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE DDPDD ***
-      !!
-      !! ** Purpose : Add a scalar element to a sum
-      !!
-      !!
-      !! ** Method  : The code uses the compensated summation with doublet
-      !!              (sum,error) emulated useing complex numbers. ydda is the
-      !!               scalar to add to the summ yddb
-      !!
-      !! ** Action  : This does only work for MPI.
-      !!
-      !! References : Using Acurate Arithmetics to Improve Numerical
-      !!              Reproducibility and Sability in Parallel Applications
-      !!              Yun HE and Chris H. Q. DING, Journal of Supercomputing 18, 259-277, 2001
-      !!----------------------------------------------------------------------
-      COMPLEX(wp), INTENT(in   ) ::   ydda
-      COMPLEX(wp), INTENT(inout) ::   yddb
-      !
-      REAL(wp) :: zerr, zt1, zt2  ! local work variables
-      !!-----------------------------------------------------------------------
-      !
-      ! Compute ydda + yddb using Knuth's trick.
-      zt1  = REAL(ydda) + REAL(yddb)
-      zerr = zt1 - REAL(ydda)
-      zt2  = ( (REAL(yddb) - zerr) + (REAL(ydda) - (zt1 - zerr)) )   &
-         &   + AIMAG(ydda)         + AIMAG(yddb)
-      !
-      ! The result is t1 + t2, after normalization.
-      yddb = CMPLX( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1), wp )
-      !
-   END SUBROUTINE DDPDD
-
-   !!----------------------------------------------------------------------
-   !!   'key_nosignedzero'                                         F90 SIGN
-   !!----------------------------------------------------------------------
-
-   FUNCTION SIGN_SCALAR( pa, pb )
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION SIGN_SCALAR  ***
-      !!
-      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
-      !!-----------------------------------------------------------------------
-      REAL(wp) :: pa,pb          ! input
-      REAL(wp) :: SIGN_SCALAR    ! result
-      !!-----------------------------------------------------------------------
-      IF ( pb >= 0.e0) THEN   ;   SIGN_SCALAR = ABS(pa)
-      ELSE                    ;   SIGN_SCALAR =-ABS(pa)
-      ENDIF
-   END FUNCTION SIGN_SCALAR
-
-
-   FUNCTION SIGN_ARRAY_1D( pa, pb )
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION SIGN_ARRAY_1D  ***
-      !!
-      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
-      !!-----------------------------------------------------------------------
-      REAL(wp) :: pa,pb(:)                   ! input
-      REAL(wp) :: SIGN_ARRAY_1D(SIZE(pb,1))  ! result
-      !!-----------------------------------------------------------------------
-      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_1D = ABS(pa)
-      ELSEWHERE              ;   SIGN_ARRAY_1D =-ABS(pa)
-      END WHERE
-   END FUNCTION SIGN_ARRAY_1D
-
-
-   FUNCTION SIGN_ARRAY_2D(pa,pb)
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION SIGN_ARRAY_2D  ***
-      !!
-      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
-      !!-----------------------------------------------------------------------
-      REAL(wp) :: pa,pb(:,:)      ! input
-      REAL(wp) :: SIGN_ARRAY_2D(SIZE(pb,1),SIZE(pb,2))  ! result
-      !!-----------------------------------------------------------------------
-      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_2D = ABS(pa)
-      ELSEWHERE              ;   SIGN_ARRAY_2D =-ABS(pa)
-      END WHERE
-   END FUNCTION SIGN_ARRAY_2D
-
-   FUNCTION SIGN_ARRAY_3D(pa,pb)
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION SIGN_ARRAY_3D  ***
-      !!
-      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
-      !!-----------------------------------------------------------------------
-      REAL(wp) :: pa,pb(:,:,:)      ! input
-      REAL(wp) :: SIGN_ARRAY_3D(SIZE(pb,1),SIZE(pb,2),SIZE(pb,3))  ! result
-      !!-----------------------------------------------------------------------
-      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_3D = ABS(pa)
-      ELSEWHERE              ;   SIGN_ARRAY_3D =-ABS(pa)
-      END WHERE
-   END FUNCTION SIGN_ARRAY_3D
-
-
-   FUNCTION SIGN_ARRAY_1D_A(pa,pb)
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION SIGN_ARRAY_1D_A  ***
-      !!
-      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
-      !!-----------------------------------------------------------------------
-      REAL(wp) :: pa(:),pb(:)      ! input
-      REAL(wp) :: SIGN_ARRAY_1D_A(SIZE(pb,1))  ! result
-      !!-----------------------------------------------------------------------
-      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_1D_A = ABS(pa)
-      ELSEWHERE              ;   SIGN_ARRAY_1D_A =-ABS(pa)
-      END WHERE
-   END FUNCTION SIGN_ARRAY_1D_A
-
-
-   FUNCTION SIGN_ARRAY_2D_A(pa,pb)
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION SIGN_ARRAY_2D_A  ***
-      !!
-      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
-      !!-----------------------------------------------------------------------
-      REAL(wp) :: pa(:,:),pb(:,:)      ! input
-      REAL(wp) :: SIGN_ARRAY_2D_A(SIZE(pb,1),SIZE(pb,2))  ! result
-      !!-----------------------------------------------------------------------
-      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_2D_A = ABS(pa)
-      ELSEWHERE              ;   SIGN_ARRAY_2D_A =-ABS(pa)
-      END WHERE
-   END FUNCTION SIGN_ARRAY_2D_A
-
-
-   FUNCTION SIGN_ARRAY_3D_A(pa,pb)
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION SIGN_ARRAY_3D_A  ***
-      !!
-      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
-      !!-----------------------------------------------------------------------
-      REAL(wp) :: pa(:,:,:),pb(:,:,:)  ! input
-      REAL(wp) :: SIGN_ARRAY_3D_A(SIZE(pb,1),SIZE(pb,2),SIZE(pb,3)) ! result
-      !!-----------------------------------------------------------------------
-      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_3D_A = ABS(pa)
-      ELSEWHERE              ;   SIGN_ARRAY_3D_A =-ABS(pa)
-      END WHERE
-   END FUNCTION SIGN_ARRAY_3D_A
-
-
-   FUNCTION SIGN_ARRAY_1D_B(pa,pb)
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION SIGN_ARRAY_1D_B  ***
-      !!
-      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
-      !!-----------------------------------------------------------------------
-      REAL(wp) :: pa(:),pb      ! input
-      REAL(wp) :: SIGN_ARRAY_1D_B(SIZE(pa,1))  ! result
-      !!-----------------------------------------------------------------------
-      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_1D_B = ABS(pa)
-      ELSE                    ;   SIGN_ARRAY_1D_B =-ABS(pa)
-      ENDIF
-   END FUNCTION SIGN_ARRAY_1D_B
-
-
-   FUNCTION SIGN_ARRAY_2D_B(pa,pb)
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION SIGN_ARRAY_2D_B  ***
-      !!
-      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
-      !!-----------------------------------------------------------------------
-      REAL(wp) :: pa(:,:),pb      ! input
-      REAL(wp) :: SIGN_ARRAY_2D_B(SIZE(pa,1),SIZE(pa,2))  ! result
-      !!-----------------------------------------------------------------------
-      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_2D_B = ABS(pa)
-      ELSE                    ;   SIGN_ARRAY_2D_B =-ABS(pa)
-      ENDIF
-   END FUNCTION SIGN_ARRAY_2D_B
-
-
-   FUNCTION SIGN_ARRAY_3D_B(pa,pb)
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION SIGN_ARRAY_3D_B  ***
-      !!
-      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
-      !!-----------------------------------------------------------------------
-      REAL(wp) :: pa(:,:,:),pb      ! input
-      REAL(wp) :: SIGN_ARRAY_3D_B(SIZE(pa,1),SIZE(pa,2),SIZE(pa,3))  ! result
-      !!-----------------------------------------------------------------------
-      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_3D_B = ABS(pa)
-      ELSE                    ;   SIGN_ARRAY_3D_B =-ABS(pa)
-      ENDIF
-   END FUNCTION SIGN_ARRAY_3D_B
-
-   !!======================================================================
-END MODULE lib_fortran
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_fortran_generic.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_fortran_generic.h90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_fortran_generic.h90	(revision 12101)
@@ -0,0 +1,139 @@
+#if defined GLOBSUM_CODE
+!                          ! FUNCTION FUNCTION_GLOBSUM !
+#   if defined DIM_1d
+#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define ARRAY_IN(i,j,k)   ptab(i)
+#      define ARRAY2_IN(i,j,k)  ptab2(i)
+#      define J_SIZE(ptab)      1
+#      define K_SIZE(ptab)      1
+#      define MASK_ARRAY(i,j)   1.
+#   endif
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define ARRAY_IN(i,j,k)   ptab(i,j)
+#      define ARRAY2_IN(i,j,k)  ptab2(i,j)
+#      define J_SIZE(ptab)      SIZE(ptab,2)
+#      define K_SIZE(ptab)      1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
+#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k)
+#      define J_SIZE(ptab)      SIZE(ptab,2)
+#      define K_SIZE(ptab)      SIZE(ptab,3)
+#   endif
+#   if defined OPERATION_GLOBSUM
+#      define MASK_ARRAY(i,j)   tmask_i(i,j)
+#   endif
+#   if defined OPERATION_FULL_GLOBSUM
+#      define MASK_ARRAY(i,j)   tmask_h(i,j)
+#   endif
+
+   FUNCTION FUNCTION_GLOBSUM( cdname, ptab )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine
+      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied
+      REAL(wp)   ::  FUNCTION_GLOBSUM
+      !
+      !!-----------------------------------------------------------------------
+      !
+      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      INTEGER    ::   ipi, ipj, ipk    ! dimensions
+      !!-----------------------------------------------------------------------
+      !
+      ipi = SIZE(ptab,1)   ! 1st dimension
+      ipj = J_SIZE(ptab)   ! 2nd dimension
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      !
+      ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated
+   
+      DO jk = 1, ipk
+        DO jj = 1, ipj
+          DO ji = 1, ipi
+             ztmp =  ARRAY_IN(ji,jj,jk) * MASK_ARRAY(ji,jj)
+             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+          END DO
+        END DO
+      END DO
+      CALL mpp_sum( cdname, ctmp )   ! sum over the global domain
+      FUNCTION_GLOBSUM = REAL(ctmp,wp)
+
+   END FUNCTION FUNCTION_GLOBSUM
+
+#undef ARRAY_TYPE
+#undef ARRAY2_TYPE
+#undef ARRAY_IN
+#undef ARRAY2_IN
+#undef J_SIZE
+#undef K_SIZE
+#undef MASK_ARRAY
+!
+# endif
+#if defined GLOBMINMAX_CODE
+!                          ! FUNCTION FUNCTION_GLOBMINMAX !
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define ARRAY_IN(i,j,k)   ptab(i,j)
+#      define ARRAY2_IN(i,j,k)  ptab2(i,j)
+#      define K_SIZE(ptab)      1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
+#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k)
+#      define K_SIZE(ptab)      SIZE(ptab,3)
+#   endif
+#   if defined OPERATION_GLOBMIN
+#      define SCALAR_OPERATION min
+#      define ARRAY_OPERATION minval
+#      define MPP_OPERATION mpp_min
+#   endif
+#   if defined OPERATION_GLOBMAX
+#      define SCALAR_OPERATION max
+#      define ARRAY_OPERATION maxval
+#      define MPP_OPERATION mpp_max
+#   endif
+
+   FUNCTION FUNCTION_GLOBMINMAX( cdname, ptab )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine
+      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied
+      REAL(wp)   ::  FUNCTION_GLOBMINMAX
+      !
+      !!-----------------------------------------------------------------------
+      !
+      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   jk       ! dummy loop indices
+      INTEGER    ::   ipk      ! dimensions
+      !!-----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      !
+      ztmp = ARRAY_OPERATION( ARRAY_IN(:,:,1)*tmask_i(:,:) )
+      DO jk = 2, ipk
+         ztmp = SCALAR_OPERATION(ztmp, ARRAY_OPERATION( ARRAY_IN(:,:,jk)*tmask_i(:,:) ))
+      ENDDO
+
+      CALL MPP_OPERATION( cdname, ztmp)
+
+      FUNCTION_GLOBMINMAX = ztmp
+
+
+   END FUNCTION FUNCTION_GLOBMINMAX
+
+#undef ARRAY_TYPE
+#undef ARRAY2_TYPE
+#undef ARRAY_IN
+#undef ARRAY2_IN
+#undef K_SIZE
+#undef SCALAR_OPERATION
+#undef ARRAY_OPERATION
+#undef MPP_OPERATION
+# endif
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_mpp.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_mpp.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_mpp.F90	(revision 12101)
@@ -0,0 +1,2082 @@
+MODULE lib_mpp
+   !!======================================================================
+   !!                       ***  MODULE  lib_mpp  ***
+   !! Ocean numerics:  massively parallel processing library
+   !!=====================================================================
+   !! History :  OPA  !  1994  (M. Guyon, J. Escobar, M. Imbard)  Original code
+   !!            7.0  !  1997  (A.M. Treguier)  SHMEM additions
+   !!            8.0  !  1998  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
+   !!                 !  1998  (J.M. Molines) Open boundary conditions
+   !!   NEMO     1.0  !  2003  (J.M. Molines, G. Madec)  F90, free form
+   !!                 !  2003  (J.M. Molines) add mpp_ini_north(_3d,_2d)
+   !!             -   !  2004  (R. Bourdalle Badie)  isend option in mpi
+   !!                 !  2004  (J.M. Molines) minloc, maxloc
+   !!             -   !  2005  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
+   !!             -   !  2005  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
+   !!             -   !  2005  (R. Benshila, G. Madec)  add extra halo case
+   !!             -   !  2008  (R. Benshila) add mpp_ini_ice
+   !!            3.2  !  2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
+   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl
+   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager
+   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add mpp_lnk_bdy_3d/2d routines to optimize the BDY comm.
+   !!            3.5  !  2013  (C. Ethe, G. Madec)  message passing arrays as local variables 
+   !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations
+   !!            3.6  !  2015  (O. Tintó and M. Castrillo - BSC) Added '_multiple' case for 2D lbc and max
+   !!            4.0  !  2017  (G. Madec) automatique allocation of array argument (use any 3rd dimension)
+   !!             -   !  2017  (G. Madec) create generic.h90 files to generate all lbc and north fold routines
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ctl_stop      : update momentum and tracer Kz from a tke scheme
+   !!   ctl_warn      : initialization, namelist read, and parameters control
+   !!   ctl_opn       : Open file and check if required file is available.
+   !!   ctl_nam       : Prints informations when an error occurs while reading a namelist
+   !!   get_unit      : give the index of an unused logical unit
+   !!----------------------------------------------------------------------
+#if   defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!   lib_mpp_alloc : allocate mpp arrays
+   !!   mynode        : indentify the processor unit
+   !!   mpp_lnk       : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d)
+   !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb)
+   !!   mpprecv       :
+   !!   mppsend       :
+   !!   mppscatter    :
+   !!   mppgather     :
+   !!   mpp_min       : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
+   !!   mpp_max       : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real
+   !!   mpp_sum       : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
+   !!   mpp_minloc    :
+   !!   mpp_maxloc    :
+   !!   mppsync       :
+   !!   mppstop       :
+   !!   mpp_ini_north : initialisation of north fold
+   !!   mpp_lbc_north_icb : alternative to mpp_nfd for extra outer halo with icebergs
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE lbcnfd         ! north fold treatment
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE mpp_nfd
+      MODULE PROCEDURE   mpp_nfd_2d    , mpp_nfd_3d    , mpp_nfd_4d
+      MODULE PROCEDURE   mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr
+   END INTERFACE
+
+   ! Interface associated to the mpp_lnk_... routines is defined in lbclnk
+   PUBLIC   mpp_lnk_2d    , mpp_lnk_3d    , mpp_lnk_4d
+   PUBLIC   mpp_lnk_2d_ptr, mpp_lnk_3d_ptr, mpp_lnk_4d_ptr
+   !
+!!gm  this should be useless
+   PUBLIC   mpp_nfd_2d    , mpp_nfd_3d    , mpp_nfd_4d
+   PUBLIC   mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr
+!!gm end
+   !
+   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam
+   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
+   PUBLIC   mpp_ini_north
+   PUBLIC   mpp_lnk_2d_icb
+   PUBLIC   mpp_lbc_north_icb
+   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
+   PUBLIC   mpp_delay_max, mpp_delay_sum, mpp_delay_rcv
+   PUBLIC   mppscatter, mppgather
+   PUBLIC   mpp_ini_znl
+   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
+   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d
+   
+   !! * Interfaces
+   !! define generic interface for these routine as they are called sometimes
+   !! with scalar arguments instead of array arguments, which causes problems
+   !! for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ
+   INTERFACE mpp_min
+      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+   END INTERFACE
+   INTERFACE mpp_max
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
+   END INTERFACE
+   INTERFACE mpp_sum
+      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real,   &
+         &             mppsum_realdd, mppsum_a_realdd
+   END INTERFACE
+   INTERFACE mpp_minloc
+      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+   END INTERFACE
+   INTERFACE mpp_maxloc
+      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+   END INTERFACE
+
+   !! ========================= !!
+   !!  MPI  variable definition !!
+   !! ========================= !!
+!$AGRIF_DO_NOT_TREAT
+   INCLUDE 'mpif.h'
+!$AGRIF_END_DO_NOT_TREAT
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag
+
+   INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2)
+
+   INTEGER, PUBLIC ::   mppsize        ! number of process
+   INTEGER, PUBLIC ::   mpprank        ! process number  [ 0 - size-1 ]
+!$AGRIF_DO_NOT_TREAT
+   INTEGER, PUBLIC ::   mpi_comm_oce   ! opa local communicator
+!$AGRIF_END_DO_NOT_TREAT
+
+   INTEGER :: MPI_SUMDD
+
+   ! variables used for zonal integration
+   INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average
+   LOGICAL, PUBLIC ::   l_znl_root      !: True on the 'left'most processor on the same row
+   INTEGER         ::   ngrp_znl        !  group ID for the znl processors
+   INTEGER         ::   ndim_rank_znl   !  number of processors on the same zonal average
+   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
+
+   ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM)
+   INTEGER, PUBLIC ::   ngrp_world        !: group ID for the world processors
+   INTEGER, PUBLIC ::   ngrp_opa          !: group ID for the opa processors
+   INTEGER, PUBLIC ::   ngrp_north        !: group ID for the northern processors (to be fold)
+   INTEGER, PUBLIC ::   ncomm_north       !: communicator made by the processors belonging to ngrp_north
+   INTEGER, PUBLIC ::   ndim_rank_north   !: number of 'sea' processor in the northern line (can be /= jpni !)
+   INTEGER, PUBLIC ::   njmppmax          !: value of njmpp for the processors of the northern line
+   INTEGER, PUBLIC ::   north_root        !: number (in the comm_opa) of proc 0 in the northern comm
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   !: dimension ndim_rank_north
+
+   ! Type of send : standard, buffered, immediate
+   CHARACTER(len=1), PUBLIC ::   cn_mpi_send        !: type od mpi send/recieve (S=standard, B=bsend, I=isend)
+   LOGICAL         , PUBLIC ::   l_isend = .FALSE.  !: isend use indicator (T if cn_mpi_send='I')
+   INTEGER         , PUBLIC ::   nn_buffer          !: size of the buffer in case of mpi_bsend
+
+   ! Communications summary report
+   CHARACTER(len=400), DIMENSION(:), ALLOCATABLE ::   crname_lbc                   !: names of lbc_lnk calling routines
+   CHARACTER(len=400), DIMENSION(:), ALLOCATABLE ::   crname_glb                   !: names of global comm calling routines
+   CHARACTER(len=400), DIMENSION(:), ALLOCATABLE ::   crname_dlg                   !: names of delayed global comm calling routines
+   INTEGER, PUBLIC                               ::   ncom_stp = 0                 !: copy of time step # istp
+   INTEGER, PUBLIC                               ::   ncom_fsbc = 1                !: copy of sbc time step # nn_fsbc
+   INTEGER, PUBLIC                               ::   ncom_dttrc = 1               !: copy of top time step # nn_dttrc
+   INTEGER, PUBLIC                               ::   ncom_freq                    !: frequency of comm diagnostic
+   INTEGER, PUBLIC , DIMENSION(:,:), ALLOCATABLE ::   ncomm_sequence               !: size of communicated arrays (halos)
+   INTEGER, PARAMETER, PUBLIC                    ::   ncom_rec_max = 3000          !: max number of communication record
+   INTEGER, PUBLIC                               ::   n_sequence_lbc = 0           !: # of communicated arraysvia lbc
+   INTEGER, PUBLIC                               ::   n_sequence_glb = 0           !: # of global communications
+   INTEGER, PUBLIC                               ::   n_sequence_dlg = 0           !: # of delayed global communications
+   INTEGER, PUBLIC                               ::   numcom = -1                  !: logical unit for communicaton report
+   LOGICAL, PUBLIC                               ::   l_full_nf_update = .TRUE.    !: logical for a full (2lines) update of bc at North fold report
+   INTEGER,                    PARAMETER, PUBLIC ::   nbdelay = 2       !: number of delayed operations
+   !: name (used as id) of allreduce-delayed operations
+   ! Warning: we must use the same character length in an array constructor (at least for gcc compiler)
+   CHARACTER(len=32), DIMENSION(nbdelay), PUBLIC ::   c_delaylist = (/ 'cflice', 'fwb   ' /)
+   !: component name where the allreduce-delayed operation is performed
+   CHARACTER(len=3),  DIMENSION(nbdelay), PUBLIC ::   c_delaycpnt = (/ 'ICE'   , 'OCE' /)
+   TYPE, PUBLIC ::   DELAYARR
+      REAL(   wp), POINTER, DIMENSION(:) ::  z1d => NULL()
+      COMPLEX(wp), POINTER, DIMENSION(:) ::  y1d => NULL()
+   END TYPE DELAYARR
+   TYPE( DELAYARR ), DIMENSION(nbdelay), PUBLIC  ::   todelay              
+   INTEGER,          DIMENSION(nbdelay), PUBLIC  ::   ndelayid = -1     !: mpi request id of the delayed operations
+
+   ! timing summary report
+   REAL(wp), DIMENSION(2), PUBLIC ::  waiting_time = 0._wp
+   REAL(wp)              , PUBLIC ::  compute_time = 0._wp, elapsed_time = 0._wp
+   
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend
+
+   LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms
+   LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: lib_mpp.F90 10538 2019-01-17 10:41:10Z clem $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref, kumnam_cfg, kumond, kstop, localComm )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mynode  ***
+      !!
+      !! ** Purpose :   Find processor unit
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt        !
+      CHARACTER(len=*)             , INTENT(in   ) ::   ldname       !
+      INTEGER                      , INTENT(in   ) ::   kumnam_ref   ! logical unit for reference namelist
+      INTEGER                      , INTENT(in   ) ::   kumnam_cfg   ! logical unit for configuration namelist
+      INTEGER                      , INTENT(inout) ::   kumond       ! logical unit for namelist output
+      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator
+      INTEGER         , OPTIONAL   , INTENT(in   ) ::   localComm    !
+      !
+      INTEGER ::   mynode, ierr, code, ji, ii, ios
+      LOGICAL ::   mpi_was_called
+      !
+      NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, ln_nnogather
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      WRITE(ldtxt(ii),*)                                                                  ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                    ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~ '                                                        ;   ii = ii + 1
+      !
+      REWIND( kumnam_ref )              ! Namelist nammpp in reference namelist: mpi variables
+      READ  ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp )
+      !
+      REWIND( kumnam_cfg )              ! Namelist nammpp in configuration namelist: mpi variables
+      READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp )
+      !
+      !                              ! control print
+      WRITE(ldtxt(ii),*) '   Namelist nammpp'                                             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      mpi send type          cn_mpi_send = ', cn_mpi_send       ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      size exported buffer   nn_buffer   = ', nn_buffer,' bytes';   ii = ii + 1
+      !
+      IF( jpni < 1 .OR. jpnj < 1  ) THEN
+         WRITE(ldtxt(ii),*) '      jpni and jpnj will be calculated automatically' ;   ii = ii + 1
+      ELSE
+         WRITE(ldtxt(ii),*) '      processor grid extent in i         jpni = ',jpni       ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj       ;   ii = ii + 1
+      ENDIF
+
+      WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; ii = ii + 1
+
+      CALL mpi_initialized ( mpi_was_called, code )
+      IF( code /= MPI_SUCCESS ) THEN
+         DO ji = 1, SIZE(ldtxt)
+            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+         END DO
+         WRITE(*, cform_err)
+         WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+
+      IF( mpi_was_called ) THEN
+         !
+         SELECT CASE ( cn_mpi_send )
+         CASE ( 'S' )                ! Standard mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1
+         CASE ( 'B' )                ! Buffer mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'              ;   ii = ii + 1
+            IF( Agrif_Root() )   CALL mpi_init_oce( ldtxt, ii, ierr )
+         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1
+            l_isend = .TRUE.
+         CASE DEFAULT
+            WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1
+            kstop = kstop + 1
+         END SELECT
+         !
+      ELSEIF ( PRESENT(localComm) .AND. .NOT. mpi_was_called ) THEN
+         WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1
+         kstop = kstop + 1
+      ELSE
+         SELECT CASE ( cn_mpi_send )
+         CASE ( 'S' )                ! Standard mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1
+            CALL mpi_init( ierr )
+         CASE ( 'B' )                ! Buffer mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'              ;   ii = ii + 1
+            IF( Agrif_Root() )   CALL mpi_init_oce( ldtxt, ii, ierr )
+         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1
+            l_isend = .TRUE.
+            CALL mpi_init( ierr )
+         CASE DEFAULT
+            WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1
+            kstop = kstop + 1
+         END SELECT
+         !
+      ENDIF
+
+      IF( PRESENT(localComm) ) THEN
+         IF( Agrif_Root() ) THEN
+            mpi_comm_oce = localComm
+         ENDIF
+      ELSE
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_oce, code)
+         IF( code /= MPI_SUCCESS ) THEN
+            DO ji = 1, SIZE(ldtxt)
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF
+
+#if defined key_agrif
+      IF( Agrif_Root() ) THEN
+         CALL Agrif_MPI_Init(mpi_comm_oce)
+      ELSE
+         CALL Agrif_MPI_set_grid_comm(mpi_comm_oce)
+      ENDIF
+#endif
+
+      CALL mpi_comm_rank( mpi_comm_oce, mpprank, ierr )
+      CALL mpi_comm_size( mpi_comm_oce, mppsize, ierr )
+      mynode = mpprank
+
+      IF( mynode == 0 ) THEN
+         CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+         WRITE(kumond, nammpp)      
+      ENDIF
+      !
+      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr)
+      !
+   END FUNCTION mynode
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine mpp_lnk_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in mpp_lnk_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kfld   :   optional, number of pt3d arrays
+   !!                cd_mpp :   optional, fill the overlap area only
+   !!                pval   :   optional, background value (used at closed boundaries)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_LNK           mpp_lnk_2d
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_2d_ptr
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_LNK           mpp_lnk_3d
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_3d_ptr
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_LNK           mpp_lnk_4d
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_4d_ptr
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine mpp_nfd_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in mpp_nfd_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kfld   :   optional, number of pt3d arrays
+   !!                cd_mpp :   optional, fill the overlap area only
+   !!                pval   :   optional, background value (used at closed boundaries)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           mpp_nfd_2d
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_2d_ptr
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_NFD           mpp_nfd_3d
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_3d_ptr
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_NFD           mpp_nfd_4d
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_4d_ptr
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_4d
+
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine mpp_lnk_bdy_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in mpp_lnk_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kb_bdy :   BDY boundary set
+   !!                kfld   :   optional, number of pt3d arrays
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_BDY           mpp_lnk_bdy_2d
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_BDY           mpp_lnk_bdy_3d
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_BDY           mpp_lnk_bdy_4d
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+   !!
+   !!   load_array  &   mpp_lnk_2d_9    à generaliser a 3D et 4D
+   
+   
+   !!    mpp_lnk_sum_2d et 3D   ====>>>>>>   à virer du code !!!!
+   
+   
+   !!----------------------------------------------------------------------
+
+
+
+   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsend  ***
+      !!
+      !! ** Purpose :   Send messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
+      INTEGER , INTENT(in   ) ::   kbytes     ! size of the array pmess
+      INTEGER , INTENT(in   ) ::   kdest      ! receive process number
+      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message
+      INTEGER , INTENT(in   ) ::   md_req     ! argument for isend
+      !!
+      INTEGER ::   iflag
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( cn_mpi_send )
+      CASE ( 'S' )                ! Standard mpi send (blocking)
+         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce        , iflag )
+      CASE ( 'B' )                ! Buffer mpi send (blocking)
+         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce        , iflag )
+      CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+         ! be carefull, one more argument here : the mpi request identifier..
+         CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce, md_req, iflag )
+      END SELECT
+      !
+   END SUBROUTINE mppsend
+
+
+   SUBROUTINE mpprecv( ktyp, pmess, kbytes, ksource )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpprecv  ***
+      !!
+      !! ** Purpose :   Receive messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
+      INTEGER , INTENT(in   ) ::   kbytes     ! suze of the array pmess
+      INTEGER , INTENT(in   ) ::   ktyp       ! Tag of the recevied message
+      INTEGER, OPTIONAL, INTENT(in) :: ksource    ! source process number
+      !!
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      INTEGER :: use_source
+      !!----------------------------------------------------------------------
+      !
+      ! If a specific process number has been passed to the receive call,
+      ! use that one. Default is to use mpi_any_source
+      use_source = mpi_any_source
+      IF( PRESENT(ksource) )   use_source = ksource
+      !
+      CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_oce, istatus, iflag )
+      !
+   END SUBROUTINE mpprecv
+
+
+   SUBROUTINE mppgather( ptab, kp, pio )
+      !!----------------------------------------------------------------------
+      !!                   ***  routine mppgather  ***
+      !!
+      !! ** Purpose :   Transfert between a local subdomain array and a work
+      !!     array which is distributed following the vertical level.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)      , INTENT(in   ) ::   ptab   ! subdomain input array
+      INTEGER                           , INTENT(in   ) ::   kp     ! record length
+      REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT(  out) ::   pio    ! subdomain input array
+      !!
+      INTEGER :: itaille, ierror   ! temporary integer
+      !!---------------------------------------------------------------------
+      !
+      itaille = jpi * jpj
+      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   &
+         &                            mpi_double_precision, kp , mpi_comm_oce, ierror )
+      !
+   END SUBROUTINE mppgather
+
+
+   SUBROUTINE mppscatter( pio, kp, ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppscatter  ***
+      !!
+      !! ** Purpose :   Transfert between awork array which is distributed
+      !!      following the vertical level and the local subdomain array.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::   pio    ! output array
+      INTEGER                             ::   kp     ! Tag (not used with MPI
+      REAL(wp), DIMENSION(jpi,jpj)        ::   ptab   ! subdomain array input
+      !!
+      INTEGER :: itaille, ierror   ! temporary integer
+      !!---------------------------------------------------------------------
+      !
+      itaille = jpi * jpj
+      !
+      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   &
+         &                            mpi_double_precision, kp  , mpi_comm_oce, ierror )
+      !
+   END SUBROUTINE mppscatter
+
+   
+   SUBROUTINE mpp_delay_sum( cdname, cdelay, y_in, pout, ldlast, kcom )
+     !!----------------------------------------------------------------------
+      !!                   ***  routine mpp_delay_sum  ***
+      !!
+      !! ** Purpose :   performed delayed mpp_sum, the result is received on next call
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   )               ::   cdname  ! name of the calling subroutine
+      CHARACTER(len=*), INTENT(in   )               ::   cdelay  ! name (used as id) of the delayed operation
+      COMPLEX(wp),      INTENT(in   ), DIMENSION(:) ::   y_in
+      REAL(wp),         INTENT(  out), DIMENSION(:) ::   pout
+      LOGICAL,          INTENT(in   )               ::   ldlast  ! true if this is the last time we call this routine
+      INTEGER,          INTENT(in   ), OPTIONAL     ::   kcom
+      !!
+      INTEGER ::   ji, isz
+      INTEGER ::   idvar
+      INTEGER ::   ierr, ilocalcomm
+      COMPLEX(wp), ALLOCATABLE, DIMENSION(:) ::   ytmp
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_oce
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+
+      isz = SIZE(y_in)
+      
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_dlg = .TRUE. )
+
+      idvar = -1
+      DO ji = 1, nbdelay
+         IF( TRIM(cdelay) == TRIM(c_delaylist(ji)) ) idvar = ji
+      END DO
+      IF ( idvar == -1 )   CALL ctl_stop( 'STOP',' mpp_delay_sum : please add a new delayed exchange for '//TRIM(cdname) )
+
+      IF ( ndelayid(idvar) == 0 ) THEN         ! first call    with restart: %z1d defined in iom_delay_rst
+         !                                       --------------------------
+         IF ( SIZE(todelay(idvar)%z1d) /= isz ) THEN                  ! Check dimension coherence
+            IF(lwp) WRITE(numout,*) ' WARNING: the nb of delayed variables in restart file is not the model one'
+            DEALLOCATE(todelay(idvar)%z1d)
+            ndelayid(idvar) = -1                                      ! do as if we had no restart
+         ELSE
+            ALLOCATE(todelay(idvar)%y1d(isz))
+            todelay(idvar)%y1d(:) = CMPLX(todelay(idvar)%z1d(:), 0., wp)   ! create %y1d, complex variable needed by mpi_sumdd
+         END IF
+      ENDIF
+      
+      IF( ndelayid(idvar) == -1 ) THEN         ! first call without restart: define %y1d and %z1d from y_in with blocking allreduce
+         !                                       --------------------------
+         ALLOCATE(todelay(idvar)%z1d(isz), todelay(idvar)%y1d(isz))   ! allocate also %z1d as used for the restart
+         CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr )   ! get %y1d
+         todelay(idvar)%z1d(:) = REAL(todelay(idvar)%y1d(:), wp)      ! define %z1d from %y1d
+      ENDIF
+
+      IF( ndelayid(idvar) > 0 )   CALL mpp_delay_rcv( idvar )         ! make sure %z1d is received
+
+      ! send back pout from todelay(idvar)%z1d defined at previous call
+      pout(:) = todelay(idvar)%z1d(:)
+
+      ! send y_in into todelay(idvar)%y1d with a non-blocking communication
+#if defined key_mpi2
+      IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
+      CALL  mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ndelayid(idvar), ierr )
+      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
+#else
+      CALL mpi_iallreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ndelayid(idvar), ierr )
+#endif
+
+   END SUBROUTINE mpp_delay_sum
+
+   
+   SUBROUTINE mpp_delay_max( cdname, cdelay, p_in, pout, ldlast, kcom )
+      !!----------------------------------------------------------------------
+      !!                   ***  routine mpp_delay_max  ***
+      !!
+      !! ** Purpose :   performed delayed mpp_max, the result is received on next call
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   )                 ::   cdname  ! name of the calling subroutine
+      CHARACTER(len=*), INTENT(in   )                 ::   cdelay  ! name (used as id) of the delayed operation
+      REAL(wp),         INTENT(in   ), DIMENSION(:)   ::   p_in    ! 
+      REAL(wp),         INTENT(  out), DIMENSION(:)   ::   pout    ! 
+      LOGICAL,          INTENT(in   )                 ::   ldlast  ! true if this is the last time we call this routine
+      INTEGER,          INTENT(in   ), OPTIONAL       ::   kcom
+      !!
+      INTEGER ::   ji, isz
+      INTEGER ::   idvar
+      INTEGER ::   ierr, ilocalcomm
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_oce
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+
+      isz = SIZE(p_in)
+
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_dlg = .TRUE. )
+
+      idvar = -1
+      DO ji = 1, nbdelay
+         IF( TRIM(cdelay) == TRIM(c_delaylist(ji)) ) idvar = ji
+      END DO
+      IF ( idvar == -1 )   CALL ctl_stop( 'STOP',' mpp_delay_max : please add a new delayed exchange for '//TRIM(cdname) )
+
+      IF ( ndelayid(idvar) == 0 ) THEN         ! first call    with restart: %z1d defined in iom_delay_rst
+         !                                       --------------------------
+         IF ( SIZE(todelay(idvar)%z1d) /= isz ) THEN                  ! Check dimension coherence
+            IF(lwp) WRITE(numout,*) ' WARNING: the nb of delayed variables in restart file is not the model one'
+            DEALLOCATE(todelay(idvar)%z1d)
+            ndelayid(idvar) = -1                                      ! do as if we had no restart
+         END IF
+      ENDIF
+
+      IF( ndelayid(idvar) == -1 ) THEN         ! first call without restart: define %z1d from p_in with a blocking allreduce
+         !                                       --------------------------
+         ALLOCATE(todelay(idvar)%z1d(isz))
+         CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr )   ! get %z1d
+      ENDIF
+
+      IF( ndelayid(idvar) > 0 )   CALL mpp_delay_rcv( idvar )         ! make sure %z1d is received
+
+      ! send back pout from todelay(idvar)%z1d defined at previous call
+      pout(:) = todelay(idvar)%z1d(:)
+
+      ! send p_in into todelay(idvar)%z1d with a non-blocking communication
+#if defined key_mpi2
+      IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
+      CALL  mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )
+      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
+#else
+      CALL mpi_iallreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )
+#endif
+
+   END SUBROUTINE mpp_delay_max
+
+   
+   SUBROUTINE mpp_delay_rcv( kid )
+      !!----------------------------------------------------------------------
+      !!                   ***  routine mpp_delay_rcv  ***
+      !!
+      !! ** Purpose :  force barrier for delayed mpp (needed for restart) 
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,INTENT(in   )      ::  kid 
+      INTEGER ::   ierr
+      !!----------------------------------------------------------------------
+      IF( ndelayid(kid) /= -2 ) THEN  
+#if ! defined key_mpi2
+         IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
+         CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr )                        ! make sure todelay(kid) is received
+         IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
+#endif
+         IF( ASSOCIATED(todelay(kid)%y1d) )   todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp)  ! define %z1d from %y1d
+         ndelayid(kid) = -2   ! add flag to know that mpi_wait was already called on kid
+      ENDIF
+   END SUBROUTINE mpp_delay_rcv
+
+   
+   !!----------------------------------------------------------------------
+   !!    ***  mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real  ***
+   !!   
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_MAX
+#  define INTEGER_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmax_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmax_a_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef INTEGER_TYPE
+!
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmax_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmax_a_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_MAX
+   !!----------------------------------------------------------------------
+   !!    ***  mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real  ***
+   !!   
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_MIN
+#  define INTEGER_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmin_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmin_a_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef INTEGER_TYPE
+!
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmin_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmin_a_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_MIN
+
+   !!----------------------------------------------------------------------
+   !!    ***  mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real  ***
+   !!   
+   !!   Global sum of 1D array or a variable (integer, real or complex)
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_SUM
+#  define INTEGER_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef INTEGER_TYPE
+!
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_SUM
+
+#  define OPERATION_SUM_DD
+#  define COMPLEX_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_realdd
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_realdd
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef COMPLEX_TYPE
+#  undef OPERATION_SUM_DD
+
+   !!----------------------------------------------------------------------
+   !!    ***  mpp_minloc2d, mpp_minloc3d, mpp_maxloc2d, mpp_maxloc3d
+   !!   
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_MINLOC
+#  define DIM_2d
+#     define ROUTINE_LOC           mpp_minloc2d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_2d
+#  define DIM_3d
+#     define ROUTINE_LOC           mpp_minloc3d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_3d
+#  undef OPERATION_MINLOC
+
+#  define OPERATION_MAXLOC
+#  define DIM_2d
+#     define ROUTINE_LOC           mpp_maxloc2d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_2d
+#  define DIM_3d
+#     define ROUTINE_LOC           mpp_maxloc3d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_3d
+#  undef OPERATION_MAXLOC
+
+   SUBROUTINE mppsync()
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsync  ***
+      !!
+      !! ** Purpose :   Massively parallel processors, synchroneous
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER :: ierror
+      !!-----------------------------------------------------------------------
+      !
+      CALL mpi_barrier( mpi_comm_oce, ierror )
+      !
+   END SUBROUTINE mppsync
+
+
+   SUBROUTINE mppstop( ldfinal, ld_force_abort ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppstop  ***
+      !!
+      !! ** purpose :   Stop massively parallel processors method
+      !!
+      !!----------------------------------------------------------------------
+      LOGICAL, OPTIONAL, INTENT(in) :: ldfinal    ! source process number
+      LOGICAL, OPTIONAL, INTENT(in) :: ld_force_abort    ! source process number
+      LOGICAL ::   llfinal, ll_force_abort
+      INTEGER ::   info
+      !!----------------------------------------------------------------------
+      llfinal = .FALSE.
+      IF( PRESENT(ldfinal) ) llfinal = ldfinal
+      ll_force_abort = .FALSE.
+      IF( PRESENT(ld_force_abort) ) ll_force_abort = ld_force_abort
+      !
+      IF(ll_force_abort) THEN
+         CALL mpi_abort( MPI_COMM_WORLD )
+      ELSE
+         CALL mppsync
+         CALL mpi_finalize( info )
+      ENDIF
+      IF( .NOT. llfinal ) STOP 123456
+      !
+   END SUBROUTINE mppstop
+
+
+   SUBROUTINE mpp_comm_free( kcom )
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kcom
+      !!
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      CALL MPI_COMM_FREE(kcom, ierr)
+      !
+   END SUBROUTINE mpp_comm_free
+
+
+   SUBROUTINE mpp_ini_znl( kumout )
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_znl  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for computing zonal sum
+      !!
+      !! ** Method  : - Look for processors in the same row
+      !!              - Put their number in nrank_znl
+      !!              - Create group for the znl processors
+      !!              - Create a communicator for znl processors
+      !!              - Determine if processor should write znl files
+      !!
+      !! ** output
+      !!      ndim_rank_znl = number of processors on the same row
+      !!      ngrp_znl = group ID for the znl processors
+      !!      ncomm_znl = communicator for the ice procs.
+      !!      n_znl_root = number (in the world) of proc 0 in the ice comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical units
+      !
+      INTEGER :: jproc      ! dummy loop integer
+      INTEGER :: ierr, ii   ! local integer
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kwork
+      !!----------------------------------------------------------------------
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_oce   : ', mpi_comm_oce
+      !
+      ALLOCATE( kwork(jpnij), STAT=ierr )
+      IF( ierr /= 0 ) THEN
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mpp_ini_znl : failed to allocate 1D array of length jpnij'
+         CALL mppstop
+      ENDIF
+
+      IF( jpnj == 1 ) THEN
+         ngrp_znl  = ngrp_world
+         ncomm_znl = mpi_comm_oce
+      ELSE
+         !
+         CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_oce, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - kwork pour njmpp : ', kwork
+         !-$$        CALL flush(numout)
+         !
+         ! Count number of processors on the same row
+         ndim_rank_znl = 0
+         DO jproc=1,jpnij
+            IF ( kwork(jproc) == njmpp ) THEN
+               ndim_rank_znl = ndim_rank_znl + 1
+            ENDIF
+         END DO
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ndim_rank_znl : ', ndim_rank_znl
+         !-$$        CALL flush(numout)
+         ! Allocate the right size to nrank_znl
+         IF (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl)
+         ALLOCATE(nrank_znl(ndim_rank_znl))
+         ii = 0
+         nrank_znl (:) = 0
+         DO jproc=1,jpnij
+            IF ( kwork(jproc) == njmpp) THEN
+               ii = ii + 1
+               nrank_znl(ii) = jproc -1
+            ENDIF
+         END DO
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - nrank_znl : ', nrank_znl
+         !-$$        CALL flush(numout)
+
+         ! Create the opa group
+         CALL MPI_COMM_GROUP(mpi_comm_oce,ngrp_opa,ierr)
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_opa : ', ngrp_opa
+         !-$$        CALL flush(numout)
+
+         ! Create the znl group from the opa group
+         CALL MPI_GROUP_INCL  ( ngrp_opa, ndim_rank_znl, nrank_znl, ngrp_znl, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_znl ', ngrp_znl
+         !-$$        CALL flush(numout)
+
+         ! Create the znl communicator from the opa communicator, ie the pool of procs in the same row
+         CALL MPI_COMM_CREATE ( mpi_comm_oce, ngrp_znl, ncomm_znl, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ncomm_znl ', ncomm_znl
+         !-$$        CALL flush(numout)
+         !
+      END IF
+
+      ! Determines if processor if the first (starting from i=1) on the row
+      IF ( jpni == 1 ) THEN
+         l_znl_root = .TRUE.
+      ELSE
+         l_znl_root = .FALSE.
+         kwork (1) = nimpp
+         CALL mpp_min ( 'lib_mpp', kwork(1), kcom = ncomm_znl)
+         IF ( nimpp == kwork(1)) l_znl_root = .TRUE.
+      END IF
+
+      DEALLOCATE(kwork)
+
+   END SUBROUTINE mpp_ini_znl
+
+
+   SUBROUTINE mpp_ini_north
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_north  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for north folding
+      !!      condition together with global variables needed in the mpp folding
+      !!
+      !! ** Method  : - Look for northern processors
+      !!              - Put their number in nrank_north
+      !!              - Create groups for the world processors and the north processors
+      !!              - Create a communicator for northern processors
+      !!
+      !! ** output
+      !!      njmppmax = njmpp for northern procs
+      !!      ndim_rank_north = number of processors in the northern line
+      !!      nrank_north (ndim_rank_north) = number  of the northern procs.
+      !!      ngrp_world = group ID for the world processors
+      !!      ngrp_north = group ID for the northern processors
+      !!      ncomm_north = communicator for the northern procs.
+      !!      north_root = number (in the world) of proc 0 in the northern comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   ierr
+      INTEGER ::   jjproc
+      INTEGER ::   ii, ji
+      !!----------------------------------------------------------------------
+      !
+      njmppmax = MAXVAL( njmppt )
+      !
+      ! Look for how many procs on the northern boundary
+      ndim_rank_north = 0
+      DO jjproc = 1, jpnij
+         IF( njmppt(jjproc) == njmppmax )   ndim_rank_north = ndim_rank_north + 1
+      END DO
+      !
+      ! Allocate the right size to nrank_north
+      IF (ALLOCATED (nrank_north)) DEALLOCATE(nrank_north)
+      ALLOCATE( nrank_north(ndim_rank_north) )
+
+      ! Fill the nrank_north array with proc. number of northern procs.
+      ! Note : the rank start at 0 in MPI
+      ii = 0
+      DO ji = 1, jpnij
+         IF ( njmppt(ji) == njmppmax   ) THEN
+            ii=ii+1
+            nrank_north(ii)=ji-1
+         END IF
+      END DO
+      !
+      ! create the world group
+      CALL MPI_COMM_GROUP( mpi_comm_oce, ngrp_world, ierr )
+      !
+      ! Create the North group from the world group
+      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_north, nrank_north, ngrp_north, ierr )
+      !
+      ! Create the North communicator , ie the pool of procs in the north group
+      CALL MPI_COMM_CREATE( mpi_comm_oce, ngrp_north, ncomm_north, ierr )
+      !
+   END SUBROUTINE mpp_ini_north
+
+
+   SUBROUTINE mpi_init_oce( ldtxt, ksft, code )
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_init.opa  ***
+      !!
+      !! ** Purpose :: export and attach a MPI buffer for bsend
+      !!
+      !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment
+      !!            but classical mpi_init
+      !!
+      !! History :: 01/11 :: IDRIS initial version for IBM only
+      !!            08/04 :: R. Benshila, generalisation
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt
+      INTEGER                      , INTENT(inout) ::   ksft
+      INTEGER                      , INTENT(  out) ::   code
+      INTEGER                                      ::   ierr, ji
+      LOGICAL                                      ::   mpi_was_called
+      !!---------------------------------------------------------------------
+      !
+      CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization
+      IF ( code /= MPI_SUCCESS ) THEN
+         DO ji = 1, SIZE(ldtxt)
+            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+         END DO
+         WRITE(*, cform_err)
+         WRITE(*, *) ' lib_mpp: Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+      !
+      IF( .NOT. mpi_was_called ) THEN
+         CALL mpi_init( code )
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_oce, code )
+         IF ( code /= MPI_SUCCESS ) THEN
+            DO ji = 1, SIZE(ldtxt)
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF
+      !
+      IF( nn_buffer > 0 ) THEN
+         WRITE(ldtxt(ksft),*) 'mpi_bsend, buffer allocation of  : ', nn_buffer   ;   ksft = ksft + 1
+         ! Buffer allocation and attachment
+         ALLOCATE( tampon(nn_buffer), stat = ierr )
+         IF( ierr /= 0 ) THEN
+            DO ji = 1, SIZE(ldtxt)
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in ALLOCATE', ierr
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         END IF
+         CALL mpi_buffer_attach( tampon, nn_buffer, code )
+      ENDIF
+      !
+   END SUBROUTINE mpi_init_oce
+
+
+   SUBROUTINE DDPDD_MPI( ydda, yddb, ilen, itype )
+      !!---------------------------------------------------------------------
+      !!   Routine DDPDD_MPI: used by reduction operator MPI_SUMDD
+      !!
+      !!   Modification of original codes written by David H. Bailey
+      !!   This subroutine computes yddb(i) = ydda(i)+yddb(i)
+      !!---------------------------------------------------------------------
+      INTEGER                     , INTENT(in)    ::   ilen, itype
+      COMPLEX(wp), DIMENSION(ilen), INTENT(in)    ::   ydda
+      COMPLEX(wp), DIMENSION(ilen), INTENT(inout) ::   yddb
+      !
+      REAL(wp) :: zerr, zt1, zt2    ! local work variables
+      INTEGER  :: ji, ztmp           ! local scalar
+      !!---------------------------------------------------------------------
+      !
+      ztmp = itype   ! avoid compilation warning
+      !
+      DO ji=1,ilen
+      ! Compute ydda + yddb using Knuth's trick.
+         zt1  = real(ydda(ji)) + real(yddb(ji))
+         zerr = zt1 - real(ydda(ji))
+         zt2  = ((real(yddb(ji)) - zerr) + (real(ydda(ji)) - (zt1 - zerr))) &
+                + aimag(ydda(ji)) + aimag(yddb(ji))
+
+         ! The result is zt1 + zt2, after normalization.
+         yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp )
+      END DO
+      !
+   END SUBROUTINE DDPDD_MPI
+
+
+   SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, kextj)
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_icb  ***
+      !!
+      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
+      !!              in mpp configuration in case of jpn1 > 1 and for 2d
+      !!              array with outer extra halo
+      !!
+      !! ** Method  :   North fold condition and mpp with more than one proc
+      !!              in i-direction require a specific treatment. We gather
+      !!              the 4+kextj northern lines of the global domain on 1
+      !!              processor and apply lbc north-fold on this sub array.
+      !!              Then we scatter the north fold array back to the processors.
+      !!              This routine accounts for an extra halo with icebergs
+      !!              and assumes ghost rows and columns have been suppressed.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
+      !                                                     !   = T ,  U , V , F or W -points
+      REAL(wp)                , INTENT(in   ) ::   psgn     ! = -1. the sign change across the
+      !!                                                    ! north fold, =  1. otherwise
+      INTEGER                 , INTENT(in   ) ::   kextj    ! Extra halo width at north fold
+      !
+      INTEGER ::   ji, jj, jr
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ipj, ij, iproc
+      !
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
+      !!----------------------------------------------------------------------
+      !
+      ipj=4
+      ALLOCATE(        ztab_e(jpiglo, 1-kextj:ipj+kextj)       ,       &
+     &            znorthloc_e(jpimax, 1-kextj:ipj+kextj)       ,       &
+     &          znorthgloio_e(jpimax, 1-kextj:ipj+kextj,jpni)    )
+      !
+      ztab_e(:,:)      = 0._wp
+      znorthloc_e(:,:) = 0._wp
+      !
+      ij = 1 - kextj
+      ! put the last ipj+2*kextj lines of pt2d into znorthloc_e 
+      DO jj = jpj - ipj + 1 - kextj , jpj + kextj
+         znorthloc_e(1:jpi,ij)=pt2d(1:jpi,jj)
+         ij = ij + 1
+      END DO
+      !
+      itaille = jpimax * ( ipj + 2*kextj )
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      CALL MPI_ALLGATHER( znorthloc_e(1,1-kextj)    , itaille, MPI_DOUBLE_PRECISION,    &
+         &                znorthgloio_e(1,1-kextj,1), itaille, MPI_DOUBLE_PRECISION,    &
+         &                ncomm_north, ierr )
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      DO jr = 1, ndim_rank_north            ! recover the global north array
+         iproc = nrank_north(jr) + 1
+         ildi = nldit (iproc)
+         ilei = nleit (iproc)
+         iilb = nimppt(iproc)
+         DO jj = 1-kextj, ipj+kextj
+            DO ji = ildi, ilei
+               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)
+            END DO
+         END DO
+      END DO
+
+      ! 2. North-Fold boundary conditions
+      ! ----------------------------------
+      CALL lbc_nfd( ztab_e(:,1-kextj:ipj+kextj), cd_type, psgn, kextj )
+
+      ij = 1 - kextj
+      !! Scatter back to pt2d
+      DO jj = jpj - ipj + 1 - kextj , jpj + kextj
+         DO ji= 1, jpi
+            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)
+         END DO
+         ij  = ij +1
+      END DO
+      !
+      DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e )
+      !
+   END SUBROUTINE mpp_lbc_north_icb
+
+
+   SUBROUTINE mpp_lnk_2d_icb( cdname, pt2d, cd_type, psgn, kexti, kextj )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_icb  ***
+      !!
+      !! ** Purpose :   Message passing management for 2d array (with extra halo for icebergs)
+      !!                This routine receives a (1-kexti:jpi+kexti,1-kexti:jpj+kextj)
+      !!                array (usually (0:jpi+1, 0:jpj+1)) from lbc_lnk_icb calls.
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    jpi    : first dimension of the local subdomain
+      !!                    jpj    : second dimension of the local subdomain
+      !!                    kexti  : number of columns for extra outer halo
+      !!                    kextj  : number of rows for extra outer halo
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)                                        , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      REAL(wp), DIMENSION(1-kexti:jpi+kexti,1-kextj:jpj+kextj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                        , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      REAL(wp)                                                , INTENT(in   ) ::   psgn     ! sign used across the north fold
+      INTEGER                                                 , INTENT(in   ) ::   kexti    ! extra i-halo width
+      INTEGER                                                 , INTENT(in   ) ::   kextj    ! extra j-halo width
+      !
+      INTEGER  ::   jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
+      INTEGER  ::   ipreci, iprecj             !   -       -
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!
+      REAL(wp), DIMENSION(1-kexti:jpi+kexti,nn_hls+kextj,2) ::   r2dns, r2dsn
+      REAL(wp), DIMENSION(1-kextj:jpj+kextj,nn_hls+kexti,2) ::   r2dwe, r2dew
+      !!----------------------------------------------------------------------
+
+      ipreci = nn_hls + kexti      ! take into account outer extra 2D overlap area
+      iprecj = nn_hls + kextj
+
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, 1, 1, 1, ld_lbc = .TRUE. )
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! Order matters Here !!!!
+      !
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( l_Iperio ) THEN
+         pt2d(1-kexti:     1   ,:) = pt2d(jpim1-kexti: jpim1 ,:)       ! east
+         pt2d(  jpi  :jpi+kexti,:) = pt2d(     2     :2+kexti,:)       ! west
+         !
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-kexti   :nn_hls   ,:) = 0._wp    ! east except at F-point
+                                      pt2d(jpi-nn_hls+1:jpi+kexti,:) = 0._wp    ! west
+      ENDIF
+      !                                      ! North-South boundaries
+      IF( l_Jperio ) THEN                         !* cyclic (only with no mpp j-split)
+         pt2d(:,1-kextj:     1   ) = pt2d(:,jpjm1-kextj:  jpjm1)       ! north
+         pt2d(:,  jpj  :jpj+kextj) = pt2d(:,     2     :2+kextj)       ! south
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(:,  1-kextj   :nn_hls   ) = 0._wp    ! north except at F-point
+                                      pt2d(:,jpj-nn_hls+1:jpj+kextj) = 0._wp    ! south
+      ENDIF
+      !
+
+      ! north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+                   CASE ( 1 )     ;   CALL lbc_nfd          ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
+                   CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
+         END SELECT
+         !
+      ENDIF
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = jpi-nreci-kexti
+         DO jl = 1, ipreci
+            r2dew(:,jl,1) = pt2d(nn_hls+jl,:)
+            r2dwe(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = ipreci * ( jpj + 2*kextj )
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea )
+         CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = jpi - nn_hls
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, ipreci
+            pt2d(iihom+jl,:) = r2dew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, ipreci
+            pt2d(jl-kexti,:) = r2dwe(:,jl,2)
+            pt2d(iihom+jl,:) = r2dew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, ipreci
+            pt2d(jl-kexti,:) = r2dwe(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = jpj-nrecj-kextj
+         DO jl = 1, iprecj
+            r2dsn(:,jl,1) = pt2d(:,ijhom +jl)
+            r2dns(:,jl,1) = pt2d(:,nn_hls+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = iprecj * ( jpi + 2*kexti )
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono )
+         CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = jpj - nn_hls
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, iprecj
+            pt2d(:,ijhom+jl) = r2dns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-kextj) = r2dsn(:,jl,2)
+            pt2d(:,ijhom+jl) = r2dns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-kextj) = r2dsn(:,jl,2)
+         END DO
+      END SELECT
+      !
+   END SUBROUTINE mpp_lnk_2d_icb
+
+
+   SUBROUTINE mpp_report( cdname, kpk, kpl, kpf, ld_lbc, ld_glb, ld_dlg )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_report  ***
+      !!
+      !! ** Purpose :   report use of mpp routines per time-setp
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),           INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      INTEGER         , OPTIONAL, INTENT(in   ) ::   kpk, kpl, kpf
+      LOGICAL         , OPTIONAL, INTENT(in   ) ::   ld_lbc, ld_glb, ld_dlg
+      !!
+      LOGICAL ::   ll_lbc, ll_glb, ll_dlg
+      INTEGER ::    ji,  jj,  jk,  jh, jf   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      ll_lbc = .FALSE.
+      IF( PRESENT(ld_lbc) ) ll_lbc = ld_lbc
+      ll_glb = .FALSE.
+      IF( PRESENT(ld_glb) ) ll_glb = ld_glb
+      ll_dlg = .FALSE.
+      IF( PRESENT(ld_dlg) ) ll_dlg = ld_dlg
+      !
+      ! find the smallest common frequency: default = frequency product, if multiple, choose the larger of the 2 frequency
+      IF( ncom_dttrc /= 1 )   CALL ctl_stop( 'STOP', 'mpp_report, ncom_dttrc /= 1 not coded...' ) 
+      ncom_freq = ncom_fsbc
+      !
+      IF ( ncom_stp == nit000+ncom_freq ) THEN   ! avoid to count extra communications in potential initializations at nit000
+         IF( ll_lbc ) THEN
+            IF( .NOT. ALLOCATED(ncomm_sequence) ) ALLOCATE( ncomm_sequence(ncom_rec_max,2) )
+            IF( .NOT. ALLOCATED(    crname_lbc) ) ALLOCATE(     crname_lbc(ncom_rec_max  ) )
+            n_sequence_lbc = n_sequence_lbc + 1
+            IF( n_sequence_lbc > ncom_rec_max ) CALL ctl_stop( 'STOP', 'lib_mpp, increase ncom_rec_max' )   ! deadlock
+            crname_lbc(n_sequence_lbc) = cdname     ! keep the name of the calling routine
+            ncomm_sequence(n_sequence_lbc,1) = kpk*kpl   ! size of 3rd and 4th dimensions
+            ncomm_sequence(n_sequence_lbc,2) = kpf       ! number of arrays to be treated (multi)
+         ENDIF
+         IF( ll_glb ) THEN
+            IF( .NOT. ALLOCATED(crname_glb) ) ALLOCATE( crname_glb(ncom_rec_max) )
+            n_sequence_glb = n_sequence_glb + 1
+            IF( n_sequence_glb > ncom_rec_max ) CALL ctl_stop( 'STOP', 'lib_mpp, increase ncom_rec_max' )   ! deadlock
+            crname_glb(n_sequence_glb) = cdname     ! keep the name of the calling routine
+         ENDIF
+         IF( ll_dlg ) THEN
+            IF( .NOT. ALLOCATED(crname_dlg) ) ALLOCATE( crname_dlg(ncom_rec_max) )
+            n_sequence_dlg = n_sequence_dlg + 1
+            IF( n_sequence_dlg > ncom_rec_max ) CALL ctl_stop( 'STOP', 'lib_mpp, increase ncom_rec_max' )   ! deadlock
+            crname_dlg(n_sequence_dlg) = cdname     ! keep the name of the calling routine
+         ENDIF
+      ELSE IF ( ncom_stp == nit000+2*ncom_freq ) THEN
+         CALL ctl_opn( numcom, 'communication_report.txt', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+         WRITE(numcom,*) ' '
+         WRITE(numcom,*) ' ------------------------------------------------------------'
+         WRITE(numcom,*) ' Communication pattern report (second oce+sbc+top time step):'
+         WRITE(numcom,*) ' ------------------------------------------------------------'
+         WRITE(numcom,*) ' '
+         WRITE(numcom,'(A,I4)') ' Exchanged halos : ', n_sequence_lbc
+         jj = 0; jk = 0; jf = 0; jh = 0
+         DO ji = 1, n_sequence_lbc
+            IF ( ncomm_sequence(ji,1) .GT. 1 ) jk = jk + 1
+            IF ( ncomm_sequence(ji,2) .GT. 1 ) jf = jf + 1
+            IF ( ncomm_sequence(ji,1) .GT. 1 .AND. ncomm_sequence(ji,2) .GT. 1 ) jj = jj + 1
+            jh = MAX (jh, ncomm_sequence(ji,1)*ncomm_sequence(ji,2))
+         END DO
+         WRITE(numcom,'(A,I3)') ' 3D Exchanged halos : ', jk
+         WRITE(numcom,'(A,I3)') ' Multi arrays exchanged halos : ', jf
+         WRITE(numcom,'(A,I3)') '   from which 3D : ', jj
+         WRITE(numcom,'(A,I10)') ' Array max size : ', jh*jpi*jpj
+         WRITE(numcom,*) ' '
+         WRITE(numcom,*) ' lbc_lnk called'
+         jj = 1
+         DO ji = 2, n_sequence_lbc
+            IF( crname_lbc(ji-1) /= crname_lbc(ji) ) THEN
+               WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_lbc(ji-1))
+               jj = 0
+            END IF
+            jj = jj + 1 
+         END DO
+         WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_lbc(n_sequence_lbc))
+         WRITE(numcom,*) ' '
+         IF ( n_sequence_glb > 0 ) THEN
+            WRITE(numcom,'(A,I4)') ' Global communications : ', n_sequence_glb
+            jj = 1
+            DO ji = 2, n_sequence_glb
+               IF( crname_glb(ji-1) /= crname_glb(ji) ) THEN
+                  WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_glb(ji-1))
+                  jj = 0
+               END IF
+               jj = jj + 1 
+            END DO
+            WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_glb(n_sequence_glb))
+            DEALLOCATE(crname_glb)
+         ELSE
+            WRITE(numcom,*) ' No MPI global communication '
+         ENDIF
+         WRITE(numcom,*) ' '
+         IF ( n_sequence_dlg > 0 ) THEN
+            WRITE(numcom,'(A,I4)') ' Delayed global communications : ', n_sequence_dlg
+            jj = 1
+            DO ji = 2, n_sequence_dlg
+               IF( crname_dlg(ji-1) /= crname_dlg(ji) ) THEN
+                  WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_dlg(ji-1))
+                  jj = 0
+               END IF
+               jj = jj + 1 
+            END DO
+            WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_dlg(n_sequence_dlg))
+            DEALLOCATE(crname_dlg)
+         ELSE
+            WRITE(numcom,*) ' No MPI delayed global communication '
+         ENDIF
+         WRITE(numcom,*) ' '
+         WRITE(numcom,*) ' -----------------------------------------------'
+         WRITE(numcom,*) ' '
+         DEALLOCATE(ncomm_sequence)
+         DEALLOCATE(crname_lbc)
+      ENDIF
+   END SUBROUTINE mpp_report
+
+   
+   SUBROUTINE tic_tac (ld_tic, ld_global)
+
+    LOGICAL,           INTENT(IN) :: ld_tic
+    LOGICAL, OPTIONAL, INTENT(IN) :: ld_global
+    REAL(wp), DIMENSION(2), SAVE :: tic_wt
+    REAL(wp),               SAVE :: tic_ct = 0._wp
+    INTEGER :: ii
+
+    IF( ncom_stp <= nit000 ) RETURN
+    IF( ncom_stp == nitend ) RETURN
+    ii = 1
+    IF( PRESENT( ld_global ) ) THEN
+       IF( ld_global ) ii = 2
+    END IF
+    
+    IF ( ld_tic ) THEN
+       tic_wt(ii) = MPI_Wtime()                                                    ! start count tic->tac (waiting time)
+       IF ( tic_ct > 0.0_wp ) compute_time = compute_time + MPI_Wtime() - tic_ct   ! cumulate count tac->tic
+    ELSE
+       waiting_time(ii) = waiting_time(ii) + MPI_Wtime() - tic_wt(ii)              ! cumulate count tic->tac
+       tic_ct = MPI_Wtime()                                                        ! start count tac->tic (waiting time)
+    ENDIF
+    
+   END SUBROUTINE tic_tac
+
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case:            Dummy module        share memory computing
+   !!----------------------------------------------------------------------
+   USE in_out_manager
+
+   INTERFACE mpp_sum
+      MODULE PROCEDURE mppsum_int, mppsum_a_int, mppsum_real, mppsum_a_real, mppsum_realdd, mppsum_a_realdd
+   END INTERFACE
+   INTERFACE mpp_max
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
+   END INTERFACE
+   INTERFACE mpp_min
+      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+   END INTERFACE
+   INTERFACE mpp_minloc
+      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+   END INTERFACE
+   INTERFACE mpp_maxloc
+      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+   END INTERFACE
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
+   LOGICAL, PUBLIC            ::   ln_nnogather          !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used)
+   INTEGER, PUBLIC            ::   mpi_comm_oce          ! opa local communicator
+
+   INTEGER, PARAMETER, PUBLIC               ::   nbdelay = 0   ! make sure we don't enter loops: DO ji = 1, nbdelay
+   CHARACTER(len=32), DIMENSION(1), PUBLIC  ::   c_delaylist = 'empty'
+   CHARACTER(len=32), DIMENSION(1), PUBLIC  ::   c_delaycpnt = 'empty'
+   LOGICAL, PUBLIC                          ::   l_full_nf_update = .TRUE.
+   TYPE ::   DELAYARR
+      REAL(   wp), POINTER, DIMENSION(:) ::  z1d => NULL()
+      COMPLEX(wp), POINTER, DIMENSION(:) ::  y1d => NULL()
+   END TYPE DELAYARR
+   TYPE( DELAYARR ), DIMENSION(1), PUBLIC  ::   todelay              
+   INTEGER,  PUBLIC, DIMENSION(1)           ::   ndelayid = -1
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION lib_mpp_alloc(kumout)          ! Dummy function
+      INTEGER, INTENT(in) ::   kumout
+      lib_mpp_alloc = 0
+   END FUNCTION lib_mpp_alloc
+
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value)
+      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      CHARACTER(len=*),DIMENSION(:) ::   ldtxt
+      CHARACTER(len=*) ::   ldname
+      INTEGER ::   kumnam_ref, knumnam_cfg , kumond , kstop
+      IF( PRESENT( localComm ) ) mpi_comm_oce = localComm
+      function_value = 0
+      IF( .FALSE. )   ldtxt(:) = 'never done'
+      CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+   END FUNCTION mynode
+
+   SUBROUTINE mppsync                       ! Dummy routine
+   END SUBROUTINE mppsync
+
+   !!----------------------------------------------------------------------
+   !!    ***  mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real  ***
+   !!   
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_MAX
+#  define INTEGER_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmax_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmax_a_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef INTEGER_TYPE
+!
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmax_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmax_a_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_MAX
+   !!----------------------------------------------------------------------
+   !!    ***  mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real  ***
+   !!   
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_MIN
+#  define INTEGER_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmin_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmin_a_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef INTEGER_TYPE
+!
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmin_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmin_a_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_MIN
+
+   !!----------------------------------------------------------------------
+   !!    ***  mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real  ***
+   !!   
+   !!   Global sum of 1D array or a variable (integer, real or complex)
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_SUM
+#  define INTEGER_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef INTEGER_TYPE
+!
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_SUM
+
+#  define OPERATION_SUM_DD
+#  define COMPLEX_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_realdd
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_realdd
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef COMPLEX_TYPE
+#  undef OPERATION_SUM_DD
+
+   !!----------------------------------------------------------------------
+   !!    ***  mpp_minloc2d, mpp_minloc3d, mpp_maxloc2d, mpp_maxloc3d
+   !!   
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_MINLOC
+#  define DIM_2d
+#     define ROUTINE_LOC           mpp_minloc2d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_2d
+#  define DIM_3d
+#     define ROUTINE_LOC           mpp_minloc3d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_3d
+#  undef OPERATION_MINLOC
+
+#  define OPERATION_MAXLOC
+#  define DIM_2d
+#     define ROUTINE_LOC           mpp_maxloc2d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_2d
+#  define DIM_3d
+#     define ROUTINE_LOC           mpp_maxloc3d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_3d
+#  undef OPERATION_MAXLOC
+
+   SUBROUTINE mpp_delay_sum( cdname, cdelay, y_in, pout, ldlast, kcom )
+      CHARACTER(len=*), INTENT(in   )               ::   cdname  ! name of the calling subroutine
+      CHARACTER(len=*), INTENT(in   )               ::   cdelay  ! name (used as id) of the delayed operation
+      COMPLEX(wp),      INTENT(in   ), DIMENSION(:) ::   y_in
+      REAL(wp),         INTENT(  out), DIMENSION(:) ::   pout
+      LOGICAL,          INTENT(in   )               ::   ldlast  ! true if this is the last time we call this routine
+      INTEGER,          INTENT(in   ), OPTIONAL     ::   kcom
+      !
+      pout(:) = REAL(y_in(:), wp)
+   END SUBROUTINE mpp_delay_sum
+
+   SUBROUTINE mpp_delay_max( cdname, cdelay, p_in, pout, ldlast, kcom )
+      CHARACTER(len=*), INTENT(in   )               ::   cdname  ! name of the calling subroutine
+      CHARACTER(len=*), INTENT(in   )               ::   cdelay  ! name (used as id) of the delayed operation
+      REAL(wp),         INTENT(in   ), DIMENSION(:) ::   p_in
+      REAL(wp),         INTENT(  out), DIMENSION(:) ::   pout
+      LOGICAL,          INTENT(in   )               ::   ldlast  ! true if this is the last time we call this routine
+      INTEGER,          INTENT(in   ), OPTIONAL     ::   kcom
+      !
+      pout(:) = p_in(:)
+   END SUBROUTINE mpp_delay_max
+
+   SUBROUTINE mpp_delay_rcv( kid )
+      INTEGER,INTENT(in   )      ::  kid 
+      WRITE(*,*) 'mpp_delay_rcv: You should not have seen this print! error?', kid
+   END SUBROUTINE mpp_delay_rcv
+   
+   SUBROUTINE mppstop( ldfinal, ld_force_abort )
+      LOGICAL, OPTIONAL, INTENT(in) :: ldfinal    ! source process number
+      LOGICAL, OPTIONAL, INTENT(in) :: ld_force_abort    ! source process number
+      STOP      ! non MPP case, just stop the run
+   END SUBROUTINE mppstop
+
+   SUBROUTINE mpp_ini_znl( knum )
+      INTEGER :: knum
+      WRITE(*,*) 'mpp_ini_znl: You should not have seen this print! error?', knum
+   END SUBROUTINE mpp_ini_znl
+
+   SUBROUTINE mpp_comm_free( kcom )
+      INTEGER :: kcom
+      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom
+   END SUBROUTINE mpp_comm_free
+   
+#endif
+
+   !!----------------------------------------------------------------------
+   !!   All cases:         ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam   routines
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5 ,   &
+      &                 cd6, cd7, cd8, cd9, cd10 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE  stop_opa  ***
+      !!
+      !! ** Purpose :   print in ocean.outpput file a error message and
+      !!                increment the error number (nstop) by one.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
+      !!----------------------------------------------------------------------
+      !
+      nstop = nstop + 1
+
+      ! force to open ocean.output file
+      IF( numout == 6 ) CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+       
+      WRITE(numout,cform_err)
+      IF( PRESENT(cd1 ) )   WRITE(numout,*) TRIM(cd1)
+      IF( PRESENT(cd2 ) )   WRITE(numout,*) TRIM(cd2)
+      IF( PRESENT(cd3 ) )   WRITE(numout,*) TRIM(cd3)
+      IF( PRESENT(cd4 ) )   WRITE(numout,*) TRIM(cd4)
+      IF( PRESENT(cd5 ) )   WRITE(numout,*) TRIM(cd5)
+      IF( PRESENT(cd6 ) )   WRITE(numout,*) TRIM(cd6)
+      IF( PRESENT(cd7 ) )   WRITE(numout,*) TRIM(cd7)
+      IF( PRESENT(cd8 ) )   WRITE(numout,*) TRIM(cd8)
+      IF( PRESENT(cd9 ) )   WRITE(numout,*) TRIM(cd9)
+      IF( PRESENT(cd10) )   WRITE(numout,*) TRIM(cd10)
+
+                               CALL FLUSH(numout    )
+      IF( numstp     /= -1 )   CALL FLUSH(numstp    )
+      IF( numrun     /= -1 )   CALL FLUSH(numrun    )
+      IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice)
+      !
+      IF( cd1 == 'STOP' ) THEN
+         WRITE(numout,*)  'huge E-R-R-O-R : immediate stop'
+         CALL mppstop(ld_force_abort = .true.)
+      ENDIF
+      !
+   END SUBROUTINE ctl_stop
+
+
+   SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5,   &
+      &                 cd6, cd7, cd8, cd9, cd10 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE  stop_warn  ***
+      !!
+      !! ** Purpose :   print in ocean.outpput file a error message and
+      !!                increment the warning number (nwarn) by one.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
+      !!----------------------------------------------------------------------
+      !
+      nwarn = nwarn + 1
+      IF(lwp) THEN
+         WRITE(numout,cform_war)
+         IF( PRESENT(cd1 ) ) WRITE(numout,*) TRIM(cd1)
+         IF( PRESENT(cd2 ) ) WRITE(numout,*) TRIM(cd2)
+         IF( PRESENT(cd3 ) ) WRITE(numout,*) TRIM(cd3)
+         IF( PRESENT(cd4 ) ) WRITE(numout,*) TRIM(cd4)
+         IF( PRESENT(cd5 ) ) WRITE(numout,*) TRIM(cd5)
+         IF( PRESENT(cd6 ) ) WRITE(numout,*) TRIM(cd6)
+         IF( PRESENT(cd7 ) ) WRITE(numout,*) TRIM(cd7)
+         IF( PRESENT(cd8 ) ) WRITE(numout,*) TRIM(cd8)
+         IF( PRESENT(cd9 ) ) WRITE(numout,*) TRIM(cd9)
+         IF( PRESENT(cd10) ) WRITE(numout,*) TRIM(cd10)
+      ENDIF
+      CALL FLUSH(numout)
+      !
+   END SUBROUTINE ctl_warn
+
+
+   SUBROUTINE ctl_opn( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctl_opn  ***
+      !!
+      !! ** Purpose :   Open file and check if required file is available.
+      !!
+      !! ** Method  :   Fortan open
+      !!----------------------------------------------------------------------
+      INTEGER          , INTENT(  out) ::   knum      ! logical unit to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdstat    ! disposition specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdform    ! formatting specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdacce    ! access specifier
+      INTEGER          , INTENT(in   ) ::   klengh    ! record length
+      INTEGER          , INTENT(in   ) ::   kout      ! number of logical units for write
+      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
+      INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number
+      !
+      CHARACTER(len=80) ::   clfile
+      INTEGER           ::   iost
+      !!----------------------------------------------------------------------
+      !
+      ! adapt filename
+      ! ----------------
+      clfile = TRIM(cdfile)
+      IF( PRESENT( karea ) ) THEN
+         IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1
+      ENDIF
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() )   clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile)
+      knum=Agrif_Get_Unit()
+#else
+      knum=get_unit()
+#endif
+      IF( TRIM(cdfile) == '/dev/null' )   clfile = TRIM(cdfile)   ! force the use of /dev/null
+      !
+      iost=0
+      IF( cdacce(1:6) == 'DIRECT' )  THEN         ! cdacce has always more than 6 characters
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh         , ERR=100, IOSTAT=iost )
+      ELSE IF( TRIM(cdstat) == 'APPEND' )  THEN   ! cdstat can have less than 6 characters
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS='UNKNOWN', POSITION='APPEND', ERR=100, IOSTAT=iost )
+      ELSE
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost )
+      ENDIF
+      IF( iost /= 0 .AND. TRIM(clfile) == '/dev/null' ) &   ! for windows
+         &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost )   
+      IF( iost == 0 ) THEN
+         IF(ldwp) THEN
+            WRITE(kout,*) '     file   : ', TRIM(clfile),' open ok'
+            WRITE(kout,*) '     unit   = ', knum
+            WRITE(kout,*) '     status = ', cdstat
+            WRITE(kout,*) '     form   = ', cdform
+            WRITE(kout,*) '     access = ', cdacce
+            WRITE(kout,*)
+         ENDIF
+      ENDIF
+100   CONTINUE
+      IF( iost /= 0 ) THEN
+         IF(ldwp) THEN
+            WRITE(kout,*)
+            WRITE(kout,*) ' ===>>>> : bad opening file: ', TRIM(clfile)
+            WRITE(kout,*) ' =======   ===  '
+            WRITE(kout,*) '           unit   = ', knum
+            WRITE(kout,*) '           status = ', cdstat
+            WRITE(kout,*) '           form   = ', cdform
+            WRITE(kout,*) '           access = ', cdacce
+            WRITE(kout,*) '           iostat = ', iost
+            WRITE(kout,*) '           we stop. verify the file '
+            WRITE(kout,*)
+         ELSE  !!! Force writing to make sure we get the information - at least once - in this violent STOP!!
+            WRITE(*,*)
+            WRITE(*,*) ' ===>>>> : bad opening file: ', TRIM(clfile)
+            WRITE(*,*) ' =======   ===  '
+            WRITE(*,*) '           unit   = ', knum
+            WRITE(*,*) '           status = ', cdstat
+            WRITE(*,*) '           form   = ', cdform
+            WRITE(*,*) '           access = ', cdacce
+            WRITE(*,*) '           iostat = ', iost
+            WRITE(*,*) '           we stop. verify the file '
+            WRITE(*,*)
+         ENDIF
+         CALL FLUSH( kout ) 
+         STOP 'ctl_opn bad opening'
+      ENDIF
+      !
+   END SUBROUTINE ctl_opn
+
+
+   SUBROUTINE ctl_nam ( kios, cdnam, ldwp )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctl_nam  ***
+      !!
+      !! ** Purpose :   Informations when error while reading a namelist
+      !!
+      !! ** Method  :   Fortan open
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(inout) ::   kios    ! IO status after reading the namelist
+      CHARACTER(len=*), INTENT(in   ) ::   cdnam   ! group name of namelist for which error occurs
+      CHARACTER(len=5)                ::   clios   ! string to convert iostat in character for print
+      LOGICAL         , INTENT(in   ) ::   ldwp    ! boolean term for print
+      !!----------------------------------------------------------------------
+      !
+      WRITE (clios, '(I5.0)')   kios
+      IF( kios < 0 ) THEN         
+         CALL ctl_warn( 'end of record or file while reading namelist '   &
+            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
+      ENDIF
+      !
+      IF( kios > 0 ) THEN
+         CALL ctl_stop( 'misspelled variable in namelist '   &
+            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
+      ENDIF
+      kios = 0
+      RETURN
+      !
+   END SUBROUTINE ctl_nam
+
+
+   INTEGER FUNCTION get_unit()
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  get_unit  ***
+      !!
+      !! ** Purpose :   return the index of an unused logical unit
+      !!----------------------------------------------------------------------
+      LOGICAL :: llopn
+      !!----------------------------------------------------------------------
+      !
+      get_unit = 15   ! choose a unit that is big enough then it is not already used in NEMO
+      llopn = .TRUE.
+      DO WHILE( (get_unit < 998) .AND. llopn )
+         get_unit = get_unit + 1
+         INQUIRE( unit = get_unit, opened = llopn )
+      END DO
+      IF( (get_unit == 999) .AND. llopn ) THEN
+         CALL ctl_stop( 'get_unit: All logical units until 999 are used...' )
+         get_unit = -1
+      ENDIF
+      !
+   END FUNCTION get_unit
+
+   !!----------------------------------------------------------------------
+END MODULE lib_mpp
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_mpp.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/lib_mpp.f90	(revision 12100)
+++ 	(revision )
@@ -1,4166 +1,0 @@
-MODULE lib_mpp
-   !!======================================================================
-   !!                       ***  MODULE  lib_mpp  ***
-   !! Ocean numerics:  massively parallel processing library
-   !!=====================================================================
-   !! History :  OPA  !  1994  (M. Guyon, J. Escobar, M. Imbard)  Original code
-   !!            7.0  !  1997  (A.M. Treguier)  SHMEM additions
-   !!            8.0  !  1998  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
-   !!                 !  1998  (J.M. Molines) Open boundary conditions
-   !!   NEMO     1.0  !  2003  (J.-M. Molines, G. Madec)  F90, free form
-   !!                 !  2003  (J.M. Molines) add mpp_ini_north(_3d,_2d)
-   !!             -   !  2004  (R. Bourdalle Badie)  isend option in mpi
-   !!                 !  2004  (J.M. Molines) minloc, maxloc
-   !!             -   !  2005  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
-   !!             -   !  2005  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
-   !!             -   !  2005  (R. Benshila, G. Madec)  add extra halo case
-   !!             -   !  2008  (R. Benshila) add mpp_ini_ice
-   !!            3.2  !  2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
-   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl
-   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager
-   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add 'mpp_lnk_bdy_3d', 'mpp_lnk_obc_3d', 
-   !!                          'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update
-   !!                          the mppobc routine to optimize the BDY and OBC communications
-   !!            3.5  !  2013  ( C. Ethe, G. Madec ) message passing arrays as local variables 
-   !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations
-   !!            3.6  !  2015 (O. Tintó and M. Castrillo - BSC) Added 'mpp_lnk_2d_multiple', 'mpp_lbc_north_2d_multiple', 'mpp_max_multiple' 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   ctl_stop      : update momentum and tracer Kz from a tke scheme
-   !!   ctl_warn      : initialization, namelist read, and parameters control
-   !!   ctl_opn       : Open file and check if required file is available.
-   !!   ctl_nam       : Prints informations when an error occurs while reading a namelist
-   !!   get_unit      : give the index of an unused logical unit
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'             MPI massively parallel processing library
-   !!----------------------------------------------------------------------
-   !!   lib_mpp_alloc : allocate mpp arrays
-   !!   mynode        : indentify the processor unit
-   !!   mpp_lnk       : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d)
-   !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays
-   !!   mpp_lnk_e     : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e)
-   !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb)
-   !!   mpprecv       :
-   !!   mppsend       :   SUBROUTINE mpp_ini_znl
-   !!   mppscatter    :
-   !!   mppgather     :
-   !!   mpp_min       : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
-   !!   mpp_max       : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real
-   !!   mpp_sum       : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
-   !!   mpp_minloc    :
-   !!   mpp_maxloc    :
-   !!   mppsync       :
-   !!   mppstop       :
-   !!   mpp_ini_north : initialisation of north fold
-   !!   mpp_lbc_north : north fold processors gathering
-   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo
-   !!   mpp_lbc_north_icb : variant of mpp_lbc_north for extra outer halo with icebergs
-   !!----------------------------------------------------------------------
-   USE dom_oce        ! ocean space and time domain
-   USE lbcnfd         ! north fold treatment
-   USE in_out_manager ! I/O manager
-   USE wrk_nemo       ! work arrays
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam
-   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
-   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e
-   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
-   PUBLIC   mpp_max_multiple
-   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
-   PUBLIC   mpp_lnk_2d_9 , mpp_lnk_2d_multiple 
-   PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d
-   PUBLIC   mppscatter, mppgather
-   PUBLIC   mpp_ini_ice, mpp_ini_znl
-   PUBLIC   mppsize
-   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
-   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
-   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb
-   PUBLIC   mpprank
-
-   TYPE arrayptr
-      REAL , DIMENSION (:,:),  POINTER :: pt2d
-   END TYPE arrayptr
-   PUBLIC   arrayptr
-   
-   !! * Interfaces
-   !! define generic interface for these routine as they are called sometimes
-   !! with scalar arguments instead of array arguments, which causes problems
-   !! for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ
-   INTERFACE mpp_min
-      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
-   END INTERFACE
-   INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
-   END INTERFACE
-   INTERFACE mpp_sum
-      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real,   &
-                       mppsum_realdd, mppsum_a_realdd
-   END INTERFACE
-   INTERFACE mpp_lbc_north
-      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d
-   END INTERFACE
-   INTERFACE mpp_minloc
-      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
-   END INTERFACE
-   INTERFACE mpp_maxloc
-      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
-   END INTERFACE
-
-   INTERFACE mpp_max_multiple
-      MODULE PROCEDURE mppmax_real_multiple
-   END INTERFACE
-
-   !! ========================= !!
-   !!  MPI  variable definition !!
-   !! ========================= !!
-!$AGRIF_DO_NOT_TREAT
-   INCLUDE 'mpif.h'
-!$AGRIF_END_DO_NOT_TREAT
-
-   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag
-
-   INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2)
-
-   INTEGER ::   mppsize        ! number of process
-   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ]
-!$AGRIF_DO_NOT_TREAT
-   INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator
-!$AGRIF_END_DO_NOT_TREAT
-
-   INTEGER :: MPI_SUMDD
-
-   ! variables used in case of sea-ice
-   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in limthd)
-   INTEGER ::   ngrp_iworld     !  group ID for the world processors (for rheology)
-   INTEGER ::   ngrp_ice        !  group ID for the ice processors (for rheology)
-   INTEGER ::   ndim_rank_ice   !  number of 'ice' processors
-   INTEGER ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm
-   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_ice     ! dimension ndim_rank_ice
-
-   ! variables used for zonal integration
-   INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average
-   LOGICAL, PUBLIC ::   l_znl_root      ! True on the 'left'most processor on the same row
-   INTEGER ::   ngrp_znl        ! group ID for the znl processors
-   INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average
-   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
-
-   ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM)
-   INTEGER, PUBLIC ::   ngrp_world        ! group ID for the world processors
-   INTEGER, PUBLIC ::   ngrp_opa          ! group ID for the opa processors
-   INTEGER, PUBLIC ::   ngrp_north        ! group ID for the northern processors (to be fold)
-   INTEGER, PUBLIC ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north
-   INTEGER, PUBLIC ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !)
-   INTEGER, PUBLIC ::   njmppmax          ! value of njmpp for the processors of the northern line
-   INTEGER, PUBLIC ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
-   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PUBLIC ::   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
-
-   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
-   INTEGER, PUBLIC                                  ::   ityp
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: lib_mpp.F90 6490 2016-04-20 14:55:58Z mcastril $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-
-   FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mynode  ***
-      !!
-      !! ** Purpose :   Find processor unit
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt        !
-      CHARACTER(len=*)             , INTENT(in   ) ::   ldname       !
-      INTEGER                      , INTENT(in   ) ::   kumnam_ref   ! logical unit for reference namelist
-      INTEGER                      , INTENT(in   ) ::   kumnam_cfg   ! logical unit for configuration namelist
-      INTEGER                      , INTENT(inout) ::   kumond       ! logical unit for namelist output
-      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator
-      INTEGER         , OPTIONAL   , INTENT(in   ) ::   localComm    !
-      !
-      INTEGER ::   mynode, ierr, code, ji, ii, ios
-      LOGICAL ::   mpi_was_called
-      !
-      NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij, 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(jpnij < 1)THEN
-         ! If jpnij is not specified in namelist then we calculate it - this
-         ! means there will be no land cutting out.
-         jpnij = jpni * jpnj
-      END IF
-
-      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
-         WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij 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
-         WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij      ;   ii = ii + 1
-      END IF
-
-      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_opa( 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
-      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
-         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_opa( ldtxt, ii, ierr )
-         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1
-            l_isend = .TRUE.
-            CALL mpi_init( ierr )
-         CASE DEFAULT
-            WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1
-            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1
-            kstop = kstop + 1
-         END SELECT
-         !
-      ENDIF
-
-      IF( PRESENT(localComm) ) THEN
-         IF( Agrif_Root() ) THEN
-            mpi_comm_opa = localComm
-         ENDIF
-      ELSE
-         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, 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
-
-
-
-
-
-
-
-
-
-      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
-      CALL mpi_comm_size( mpi_comm_opa, 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
-
-
-   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    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
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      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             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
-      !!----------------------------------------------------------------------
-      
-      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
-         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
-
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0._wp     ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
-         !
-         ! WARNING ptab is defined only between nld and nle
-         DO jk = 1, jpk
-            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)
-               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
-               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
-            END DO
-            DO ji = nlci+1, jpi                 ! added column(s) (full)
-               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
-               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
-               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
-            END DO
-         END DO
-         !
-      ELSE                              ! standard close or cyclic treatment
-         !
-         !                                   ! East-West boundaries
-         !                                        !* Cyclic east-west
-         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            ptab( 1 ,:,:) = ptab(jpim1,:,:)
-            ptab(jpi,:,:) = ptab(  2  ,:,:)
-         ELSE                                     !* closed
-            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
-                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
-         ENDIF
-         !                                   ! North-South boundaries (always closed)
-         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
-                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
-         !
-      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 = nlci-nreci
-         DO jl = 1, jpreci
-            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt3we(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), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = zt3we(:,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 = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt3sn(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), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl,:) = zt3sn(:,jl,:,2)
-         END DO
-      END SELECT
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
-      !
-   END SUBROUTINE mpp_lnk_3d
-
-
-   SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d_multiple  ***
-      !!
-      !! ** Purpose :   Message passing management for multiple 2d arrays
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    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=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
-      !                                                               ! = T , U , V , F , W and I points
-      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
-      !                                                               ! =  1. , the sign is kept
-      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, jl   ! dummy loop indices
-      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      INTEGER :: num_fields
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
-      REAL(wp) ::   zland
-      INTEGER , DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat       ! for key_mpi_isend
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  &
-         &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   )
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0._wp     ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !
-      !First Array
-      DO ii = 1 , num_fields
-         IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
-            !
-            ! WARNING pt2d is defined only between nld and nle
-            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-               pt2d_array(ii)%pt2d(nldi  :nlei  , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej)
-               pt2d_array(ii)%pt2d(1     :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi     , nlej)
-               pt2d_array(ii)%pt2d(nlei+1:nlci  , jj) = pt2d_array(ii)%pt2d(     nlei, nlej) 
-            END DO
-            DO ji = nlci+1, jpi                 ! added column(s) (full)
-               pt2d_array(ii)%pt2d(ji, nldj  :nlej  ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej)
-               pt2d_array(ii)%pt2d(ji, 1     :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj     )
-               pt2d_array(ii)%pt2d(ji, nlej+1:jpj   ) = pt2d_array(ii)%pt2d(nlei,      nlej)
-            END DO
-            !
-         ELSE                              ! standard close or cyclic treatment
-            !
-            !                                   ! East-West boundaries
-            IF( nbondi == 2 .AND.   &                ! Cyclic east-west
-               &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-               pt2d_array(ii)%pt2d(  1  , : ) = pt2d_array(ii)%pt2d( jpim1, : )                                    ! west
-               pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d(   2  , : )                                    ! east
-            ELSE                                     ! closed
-               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(            1 : jpreci,:) = zland    ! south except F-point
-                                                   pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north
-            ENDIF
-            !                                   ! North-South boundaries (always closed)
-               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(:,             1:jprecj ) = zland    ! south except F-point
-                                                   pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north
-            !
-         ENDIF
-      END DO
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      DO ii = 1 , num_fields
-         SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-            iihom = nlci-nreci
-            DO jl = 1, jpreci
-               zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : )
-               zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : )
-            END DO
-         END SELECT
-      END DO
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
-         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*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, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-
-      DO ii = 1 , num_fields
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            DO jl = 1, jpreci
-               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
-            END DO
-         CASE ( 0 )
-            DO jl = 1, jpreci
-               pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii)
-               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
-            END DO
-         CASE ( 1 )
-            DO jl = 1, jpreci
-               pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii)
-            END DO
-         END SELECT
-      END DO
-      
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      !First Array
-      DO ii = 1 , num_fields
-         IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-            ijhom = nlcj-nrecj
-            DO jl = 1, jprecj
-               zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl )
-               zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl )
-            END DO
-         ENDIF
-      END DO
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
-         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*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, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-
-      DO ii = 1 , num_fields
-         !First Array
-         SELECT CASE ( nbondj )
-         CASE ( -1 )
-            DO jl = 1, jprecj
-               pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii )
-            END DO
-         CASE ( 0 )
-            DO jl = 1, jprecj
-               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii)
-               pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii )
-            END DO
-         CASE ( 1 )
-            DO jl = 1, jprecj
-               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii )
-            END DO
-         END SELECT
-      END DO
-      
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-         !First Array
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   
-             DO ii = 1 , num_fields  
-                       CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp
-             END DO
-         CASE DEFAULT   ;   CALL mpp_lbc_north_2d_multiple( pt2d_array, type_array, psgn_array, num_fields )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-        !
-      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
-      !
-   END SUBROUTINE mpp_lnk_2d_multiple
-
-   
-   SUBROUTINE load_array( pt2d, cd_type, psgn, pt2d_array, type_array, psgn_array, num_fields )
-      !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied
-      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points
-      REAL(wp)                            , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary
-      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array
-      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
-      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
-      INTEGER                            , INTENT (inout) :: num_fields 
-      !!---------------------------------------------------------------------
-      num_fields = num_fields + 1
-      pt2d_array(num_fields)%pt2d => pt2d
-      type_array(num_fields)      =  cd_type
-      psgn_array(num_fields)      =  psgn
-   END SUBROUTINE load_array
-   
-   
-   SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
-      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
-      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
-      !!---------------------------------------------------------------------
-      ! Second 2D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA    
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
-      ! define the nature of ptab array grid-points
-      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
-      ! =-1 the sign change across the north fold boundary
-      REAL(wp)                                      , INTENT(in   ) ::   psgnA    
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI   
-      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)
-      !!
-      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array 
-      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
-      INTEGER :: num_fields
-      !!---------------------------------------------------------------------
-      !
-      num_fields = 0
-      !
-      ! Load the first array
-      CALL load_array( pt2dA, cd_typeA, psgnA, pt2d_array, type_array, psgn_array, num_fields )
-      !
-      ! Look if more arrays are added
-      IF( PRESENT(psgnB) )   CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnC) )   CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnD) )   CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnE) )   CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnF) )   CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnG) )   CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnH) )   CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnI) )   CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields)
-      !
-      CALL mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, num_fields, cd_mpp,pval )
-      !
-   END SUBROUTINE mpp_lnk_2d_9
-
-
-   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for 2d array
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    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
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      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, jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)     ::   ml_stat       ! for key_mpi_isend
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
-         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0._wp     ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !
-      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
-         !
-         ! WARNING pt2d is defined only between nld and nle
-         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)
-            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej)
-            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej)
-         END DO
-         DO ji = nlci+1, jpi                 ! added column(s) (full)
-            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej)
-            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     )
-            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej)
-         END DO
-         !
-      ELSE                              ! standard close or cyclic treatment
-         !
-         !                                   ! East-West boundaries
-         IF( nbondi == 2 .AND.   &                ! Cyclic east-west
-            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west
-            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east
-         ELSE                                     ! closed
-            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
-                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
-         ENDIF
-         !                                   ! North-South boundaries (always closed)
-            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
-                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
-         !
-      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 = nlci-nreci
-         DO jl = 1, jpreci
-            zt2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            zt2we(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt2we(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, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = zt2we(:,jl,2)
-            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = zt2we(:,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 = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            zt2ns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt2sn(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, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = zt2sn(:,jl,2)
-            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = zt2sn(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
-      !
-   END SUBROUTINE mpp_lnk_2d
-
-
-   SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for two 3D arrays
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    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
-      !!
-      !! ** Action  :   ptab1 and ptab2  with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER  ::   jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      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(:,:,:,:,:), ALLOCATABLE ::   zt4ns, zt4sn   ! 2 x 3d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ew, zt4we   ! 2 x 3d for east-west & west-east
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) ,    &
-         &      zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) )
-      !
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                      ! East-West boundaries
-      !                                           !* Cyclic east-west
-      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         ptab1( 1 ,:,:) = ptab1(jpim1,:,:)
-         ptab1(jpi,:,:) = ptab1(  2  ,:,:)
-         ptab2( 1 ,:,:) = ptab2(jpim1,:,:)
-         ptab2(jpi,:,:) = ptab2(  2  ,:,:)
-      ELSE                                        !* closed
-         IF( .NOT. cd_type1 == 'F' )   ptab1(     1       :jpreci,:,:) = 0.e0    ! south except at F-point
-         IF( .NOT. cd_type2 == 'F' )   ptab2(     1       :jpreci,:,:) = 0.e0
-                                       ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0    ! north
-                                       ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0
-      ENDIF
-
-
-      !                                      ! North-South boundaries
-      IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point
-      IF( .NOT. cd_type2 == 'F' )   ptab2(:,     1       :jprecj,:) = 0.e0
-                                    ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0    ! north
-                                    ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
-
-
-      ! 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 = nlci-nreci
-         DO jl = 1, jpreci
-            zt4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
-            zt4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
-            zt4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
-            zt4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk *2
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt4we(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, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2)
-            ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2)
-            ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = zt4we(:,jl,:,2,2)
-            ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = zt4we(:,jl,:,2,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 = nlcj - nrecj
-         DO jl = 1, jprecj
-            zt4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
-            zt4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
-            zt4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
-            zt4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk * 2
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt4sn(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, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2)
-            ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab1(:,jl      ,:) = zt4sn(:,jl,:,1,2)
-            ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2)
-            ptab2(:,jl      ,:) = zt4sn(:,jl,:,2,2)
-            ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab1(:,jl,:) = zt4sn(:,jl,:,1,2)
-            ptab2(:,jl,:) = zt4sn(:,jl,:,2,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      IF( npolj /= 0 ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )
-            CALL lbc_nfd      ( ptab1, cd_type1, psgn )   ! only for northern procs.
-            CALL lbc_nfd      ( ptab2, cd_type2, psgn )
-         CASE DEFAULT
-            CALL mpp_lbc_north( ptab1, cd_type1, psgn )   ! for all northern procs.
-            CALL mpp_lbc_north (ptab2, cd_type2, psgn)
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt4ns, zt4sn, zt4ew, zt4we )
-      !
-   END SUBROUTINE mpp_lnk_3d_gather
-
-
-   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d_e  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for 2d array (with halo)
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    jpri   : number of rows for extra outer halo
-      !!                    jprj   : number of columns 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
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER                                             , INTENT(in   ) ::   jpri
-      INTEGER                                             , INTENT(in   ) ::   jprj
-      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
-      CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
-      !                                                                                 ! = T , U , V , F , W and I points
-      REAL(wp)                                            , INTENT(in   ) ::   psgn     ! =-1 the sign change across the
-      !!                                                                                ! north boundary, =  1. otherwise
-      INTEGER  ::   jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ipreci, iprecj             ! temporary integers
-      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-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns
-      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn
-      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe
-      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew
-      !!----------------------------------------------------------------------
-
-      ipreci = jpreci + jpri      ! take into account outer extra 2D overlap area
-      iprecj = jprecj + jprj
-
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      ! Order matters Here !!!!
-      !
-      !                                      !* North-South boundaries (always colsed)
-      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0.e0    ! south except at F-point
-                                   pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0    ! north
-
-      !                                      ! East-West boundaries
-      !                                           !* Cyclic east-west
-      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east
-         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west
-         !
-      ELSE                                        !* closed
-         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
-                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
-      ENDIF
-      !
-
-      ! north fold treatment
-      ! -----------------------
-      IF( npolj /= 0 ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
-         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               )
-         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 = nlci-nreci-jpri
-         DO jl = 1, ipreci
-            r2dew(:,jl,1) = pt2d(jpreci+jl,:)
-            r2dwe(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = ipreci * ( jpj + 2*jprj)
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
-         CALL mpprecv( 2, r2dwe(1-jprj,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-jprj,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      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-jpri,:) = r2dwe(:,jl,2)
-            pt2d( iihom+jl,:) = r2dew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, ipreci
-            pt2d(jl-jpri,:) = 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 = nlcj-nrecj-jprj
-         DO jl = 1, iprecj
-            r2dsn(:,jl,1) = pt2d(:,ijhom +jl)
-            r2dns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = iprecj * ( jpi + 2*jpri )
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
-         CALL mpprecv( 4, r2dsn(1-jpri,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-jpri,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-      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-jprj) = r2dsn(:,jl,2)
-            pt2d(:,ijhom+jl ) = r2dns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, iprecj
-            pt2d(:,jl-jprj) = r2dsn(:,jl,2)
-         END DO
-      END SELECT
-      !
-   END SUBROUTINE mpp_lnk_2d_e
-
-   SUBROUTINE mpp_lnk_sum_3d( ptab, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_sum_3d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement (sum the overlap region)
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    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
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      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             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
-
-      !!----------------------------------------------------------------------
-      
-      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
-         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
-
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-      iihom = nlci-jpreci
-         DO jl = 1, jpreci
-            zt3ew(:,jl,:,1) = ptab(jl      ,:,:) ; ptab(jl      ,:,:) = 0.0_wp
-            zt3we(:,jl,:,1) = ptab(iihom+jl,:,:) ; ptab(iihom+jl,:,:) = 0.0_wp 
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt3we(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), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write lateral conditions
-      iihom = nlci-nreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = ptab(iihom+jl,:,:) + zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)
-            ptab(iihom +jl,:,:) = ptab(iihom +jl,:,:) + zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read lateral conditions
-         ijhom = nlcj-jprecj
-         DO jl = 1, jprecj
-            zt3sn(:,jl,:,1) = ptab(:,ijhom+jl,:) ; ptab(:,ijhom+jl,:) = 0.0_wp
-            zt3ns(:,jl,:,1) = ptab(:,jl      ,:) ; ptab(:,jl      ,:) = 0.0_wp
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt3sn(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), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write lateral conditions
-      ijhom = nlcj-nrecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = ptab(:,ijhom+jl,:) + zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl,:,2)
-            ptab(:,ijhom +jl,:) = ptab(:,ijhom +jl,:) + zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl   ,:,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
-      !
-   END SUBROUTINE mpp_lnk_sum_3d
-
-   SUBROUTINE mpp_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_sum_2d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for 2d array (sum the overlap region)
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    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
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      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, jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-
-      !!----------------------------------------------------------------------
-
-      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
-         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
-
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci - jpreci
-         DO jl = 1, jpreci
-            zt2ew(:,jl,1) = pt2d(jl       ,:) ; pt2d(jl       ,:) = 0.0_wp
-            zt2we(:,jl,1) = pt2d(iihom +jl,:) ; pt2d(iihom +jl,:) = 0.0_wp
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt2we(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, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write lateral conditions
-      iihom = nlci-nreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = pt2d(iihom+jl,:) + zt2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)
-            pt2d(iihom +jl,:) = pt2d(iihom +jl,:) + zt2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read lateral conditions
-         ijhom = nlcj - jprecj
-         DO jl = 1, jprecj
-            zt2sn(:,jl,1) = pt2d(:,ijhom +jl) ; pt2d(:,ijhom +jl) = 0.0_wp
-            zt2ns(:,jl,1) = pt2d(:,jl       ) ; pt2d(:,jl       ) = 0.0_wp
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt2sn(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, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write lateral conditions
-      ijhom = nlcj-nrecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = pt2d(:,ijhom+jl) + zt2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)
-            pt2d(:,ijhom +jl) = pt2d(:,ijhom +jl) + zt2ns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
-      !
-   END SUBROUTINE mpp_lnk_sum_2d
-
-   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsend  ***
-      !!
-      !! ** Purpose :   Send messag passing array
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
-      INTEGER , INTENT(in   ) ::   kbytes     ! size of the array pmess
-      INTEGER , INTENT(in   ) ::   kdest      ! receive process number
-      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message
-      INTEGER , INTENT(in   ) ::   md_req     ! argument for isend
-      !!
-      INTEGER ::   iflag
-      !!----------------------------------------------------------------------
-      !
-      SELECT CASE ( cn_mpi_send )
-      CASE ( 'S' )                ! Standard mpi send (blocking)
-         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
-      CASE ( 'B' )                ! Buffer mpi send (blocking)
-         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , 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_opa, md_req, iflag )
-      END SELECT
-      !
-   END SUBROUTINE mppsend
-
-
-   SUBROUTINE mpprecv( ktyp, pmess, kbytes, ksource )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpprecv  ***
-      !!
-      !! ** Purpose :   Receive messag passing array
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
-      INTEGER , INTENT(in   ) ::   kbytes     ! suze of the array pmess
-      INTEGER , INTENT(in   ) ::   ktyp       ! Tag of the recevied message
-      INTEGER, OPTIONAL, INTENT(in) :: ksource    ! source process number
-      !!
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-      INTEGER :: use_source
-      !!----------------------------------------------------------------------
-      !
-      ! If a specific process number has been passed to the receive call,
-      ! use that one. Default is to use mpi_any_source
-      use_source = mpi_any_source
-      IF( PRESENT(ksource) )   use_source = ksource
-      !
-      CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_opa, istatus, iflag )
-      !
-   END SUBROUTINE mpprecv
-
-
-   SUBROUTINE mppgather( ptab, kp, pio )
-      !!----------------------------------------------------------------------
-      !!                   ***  routine mppgather  ***
-      !!
-      !! ** Purpose :   Transfert between a local subdomain array and a work
-      !!     array which is distributed following the vertical level.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj)      , INTENT(in   ) ::   ptab   ! subdomain input array
-      INTEGER                           , INTENT(in   ) ::   kp     ! record length
-      REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT(  out) ::   pio    ! subdomain input array
-      !!
-      INTEGER :: itaille, ierror   ! temporary integer
-      !!---------------------------------------------------------------------
-      !
-      itaille = jpi * jpj
-      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   &
-         &                            mpi_double_precision, kp , mpi_comm_opa, ierror )
-      !
-   END SUBROUTINE mppgather
-
-
-   SUBROUTINE mppscatter( pio, kp, ptab )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppscatter  ***
-      !!
-      !! ** Purpose :   Transfert between awork array which is distributed
-      !!      following the vertical level and the local subdomain array.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::   pio    ! output array
-      INTEGER                             ::   kp     ! Tag (not used with MPI
-      REAL(wp), DIMENSION(jpi,jpj)        ::   ptab   ! subdomain array input
-      !!
-      INTEGER :: itaille, ierror   ! temporary integer
-      !!---------------------------------------------------------------------
-      !
-      itaille = jpi * jpj
-      !
-      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   &
-         &                            mpi_double_precision, kp  , mpi_comm_opa, ierror )
-      !
-   END SUBROUTINE mppscatter
-
-
-   SUBROUTINE mppmax_a_int( ktab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_a_int  ***
-      !!
-      !! ** Purpose :   Find maximum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                  ::   kdim   ! size of array
-      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array
-      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   !
-      !
-      INTEGER :: ierror, localcomm   ! temporary integer
-      INTEGER, DIMENSION(kdim) ::   iwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, localcomm, ierror )
-      !
-      ktab(:) = iwork(:)
-      !
-   END SUBROUTINE mppmax_a_int
-
-
-   SUBROUTINE mppmax_int( ktab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_int  ***
-      !!
-      !! ** Purpose :   Find maximum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(inout)           ::   ktab   ! ???
-      INTEGER, INTENT(in   ), OPTIONAL ::   kcom   ! ???
-      !
-      INTEGER ::   ierror, iwork, localcomm   ! temporary integer
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror )
-      !
-      ktab = iwork
-      !
-   END SUBROUTINE mppmax_int
-
-
-   SUBROUTINE mppmin_a_int( ktab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_a_int  ***
-      !!
-      !! ** Purpose :   Find minimum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT( in  )                  ::   kdim   ! size of array
-      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array
-      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom   ! input array
-      !!
-      INTEGER ::   ierror, localcomm   ! temporary integer
-      INTEGER, DIMENSION(kdim) ::   iwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, localcomm, ierror )
-      !
-      ktab(:) = iwork(:)
-      !
-   END SUBROUTINE mppmin_a_int
-
-
-   SUBROUTINE mppmin_int( ktab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_int  ***
-      !!
-      !! ** Purpose :   Find minimum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(inout) ::   ktab      ! ???
-      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
-      !!
-      INTEGER ::  ierror, iwork, localcomm
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror )
-      !
-      ktab = iwork
-      !
-   END SUBROUTINE mppmin_int
-
-
-   SUBROUTINE mppsum_a_int( ktab, kdim )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_int  ***
-      !!
-      !! ** Purpose :   Global integer sum, 1D array case
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in   )                   ::   kdim   ! ???
-      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab   ! ???
-      !
-      INTEGER :: ierror
-      INTEGER, DIMENSION (kdim) ::  iwork
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
-      !
-      ktab(:) = iwork(:)
-      !
-   END SUBROUTINE mppsum_a_int
-
-
-   SUBROUTINE mppsum_int( ktab )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppsum_int  ***
-      !!
-      !! ** Purpose :   Global integer sum
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(inout) ::   ktab
-      !!
-      INTEGER :: ierror, iwork
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
-      !
-      ktab = iwork
-      !
-   END SUBROUTINE mppsum_int
-
-
-   SUBROUTINE mppmax_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppmax_a_real  ***
-      !!
-      !! ** Purpose :   Maximum
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                  ::   kdim
-      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
-      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
-      !
-      INTEGER :: ierror, localcomm
-      REAL(wp), DIMENSION(kdim) ::  zwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppmax_a_real
-
-
-   SUBROUTINE mppmax_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_real  ***
-      !!
-      !! ** Purpose :   Maximum
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab   ! ???
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
-      !!
-      INTEGER  ::   ierror, localcomm
-      REAL(wp) ::   zwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppmax_real
-
-   SUBROUTINE mppmax_real_multiple( ptab, NUM , kcom  )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_real  ***
-      !!
-      !! ** Purpose :   Maximum
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:) ,  INTENT(inout)           ::   ptab   ! ???
-      INTEGER , INTENT(in   )           ::   NUM
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
-      !!
-      INTEGER  ::   ierror, localcomm
-      REAL(wp) , POINTER , DIMENSION(:) ::   zwork
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc(NUM , zwork)
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, NUM, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab = zwork
-      CALL wrk_dealloc(NUM , zwork)
-      !
-   END SUBROUTINE mppmax_real_multiple
-
-
-   SUBROUTINE mppmin_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppmin_a_real  ***
-      !!
-      !! ** Purpose :   Minimum of REAL, array case
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                  ::   kdim
-      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
-      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
-      !!
-      INTEGER :: ierror, localcomm
-      REAL(wp), DIMENSION(kdim) ::   zwork
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppmin_a_real
-
-
-   SUBROUTINE mppmin_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_real  ***
-      !!
-      !! ** Purpose :   minimum of REAL, scalar case
-      !!
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab        !
-      INTEGER , INTENT(in   ), OPTIONAL :: kcom
-      !!
-      INTEGER  ::   ierror
-      REAL(wp) ::   zwork
-      INTEGER :: localcomm
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppmin_real
-
-
-   SUBROUTINE mppsum_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_real  ***
-      !!
-      !! ** Purpose :   global sum, REAL ARRAY argument case
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER , INTENT( in )                     ::   kdim      ! size of ptab
-      REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array
-      INTEGER , INTENT( in ), OPTIONAL           :: kcom
-      !!
-      INTEGER                   ::   ierror    ! temporary integer
-      INTEGER                   ::   localcomm
-      REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppsum_a_real
-
-
-   SUBROUTINE mppsum_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_real  ***
-      !!
-      !! ** Purpose :   global sum, SCALAR argument case
-      !!
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab   ! input scalar
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom
-      !!
-      INTEGER  ::   ierror, localcomm
-      REAL(wp) ::   zwork
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppsum_real
-
-
-   SUBROUTINE mppsum_realdd( ytab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_realdd ***
-      !!
-      !! ** Purpose :   global sum in Massively Parallel Processing
-      !!                SCALAR argument case for double-double precision
-      !!
-      !!-----------------------------------------------------------------------
-      COMPLEX(wp), INTENT(inout)           ::   ytab    ! input scalar
-      INTEGER    , INTENT(in   ), OPTIONAL ::   kcom
-      !
-      INTEGER     ::   ierror
-      INTEGER     ::   localcomm
-      COMPLEX(wp) ::   zwork
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      ! reduce local sums into global sum
-      CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror )
-      ytab = zwork
-      !
-   END SUBROUTINE mppsum_realdd
-
-
-   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_realdd  ***
-      !!
-      !! ** Purpose :   global sum in Massively Parallel Processing
-      !!                COMPLEX ARRAY case for double-double precision
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER                     , INTENT(in   ) ::   kdim   ! size of ytab
-      COMPLEX(wp), DIMENSION(kdim), INTENT(inout) ::   ytab   ! input array
-      INTEGER    , OPTIONAL       , INTENT(in   ) ::   kcom
-      !
-      INTEGER:: ierror, localcomm    ! local integer
-      COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror )
-      ytab(:) = zwork(:)
-      !
-   END SUBROUTINE mppsum_a_realdd
-
-
-   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj )
-      !!------------------------------------------------------------------------
-      !!             ***  routine mpp_minloc  ***
-      !!
-      !! ** Purpose :   Compute the global minimum of an array ptab
-      !!              and also give its global position
-      !!
-      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
-      !!
-      !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab    ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask   ! Local mask
-      REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab
-      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame
-      !
-      INTEGER :: ierror
-      INTEGER , DIMENSION(2)   ::   ilocs
-      REAL(wp) ::   zmin   ! local minimum
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
-      !!-----------------------------------------------------------------------
-      !
-      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 )
-      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 )
-      !
-      ki = ilocs(1) + nimpp - 1
-      kj = ilocs(2) + njmpp - 1
-      !
-      zain(1,:)=zmin
-      zain(2,:)=ki+10000.*kj
-      !
-      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
-      !
-      pmin = zaout(1,1)
-      kj = INT(zaout(2,1)/10000.)
-      ki = INT(zaout(2,1) - 10000.*kj )
-      !
-   END SUBROUTINE mpp_minloc2d
-
-
-   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj ,kk)
-      !!------------------------------------------------------------------------
-      !!             ***  routine mpp_minloc  ***
-      !!
-      !! ** Purpose :   Compute the global minimum of an array ptab
-      !!              and also give its global position
-      !!
-      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
-      !!
-      !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
-      REAL(wp)                         , INTENT(  out) ::   pmin         ! Global minimum of ptab
-      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
-      !!
-      INTEGER  ::   ierror
-      REAL(wp) ::   zmin     ! local minimum
-      INTEGER , DIMENSION(3)   ::   ilocs
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
-      !!-----------------------------------------------------------------------
-      !
-      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
-      !
-      ki = ilocs(1) + nimpp - 1
-      kj = ilocs(2) + njmpp - 1
-      kk = ilocs(3)
-      !
-      zain(1,:)=zmin
-      zain(2,:)=ki+10000.*kj+100000000.*kk
-      !
-      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
-      !
-      pmin = zaout(1,1)
-      kk   = INT( zaout(2,1) / 100000000. )
-      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
-      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
-      !
-   END SUBROUTINE mpp_minloc3d
-
-
-   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
-      !!------------------------------------------------------------------------
-      !!             ***  routine mpp_maxloc  ***
-      !!
-      !! ** Purpose :   Compute the global maximum of an array ptab
-      !!              and also give its global position
-      !!
-      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
-      !!
-      !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab     ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask    ! Local mask
-      REAL(wp)                     , INTENT(  out) ::   pmax     ! Global maximum of ptab
-      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of maximum in global frame
-      !!
-      INTEGER  :: ierror
-      INTEGER, DIMENSION (2)   ::   ilocs
-      REAL(wp) :: zmax   ! local maximum
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
-      !!-----------------------------------------------------------------------
-      !
-      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 )
-      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 )
-      !
-      ki = ilocs(1) + nimpp - 1
-      kj = ilocs(2) + njmpp - 1
-      !
-      zain(1,:) = zmax
-      zain(2,:) = ki + 10000. * kj
-      !
-      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
-      !
-      pmax = zaout(1,1)
-      kj   = INT( zaout(2,1) / 10000.     )
-      ki   = INT( zaout(2,1) - 10000.* kj )
-      !
-   END SUBROUTINE mpp_maxloc2d
-
-
-   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
-      !!------------------------------------------------------------------------
-      !!             ***  routine mpp_maxloc  ***
-      !!
-      !! ** Purpose :  Compute the global maximum of an array ptab
-      !!              and also give its global position
-      !!
-      !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
-      !!
-      !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
-      REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab
-      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
-      !!
-      REAL(wp) :: zmax   ! local maximum
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
-      INTEGER , DIMENSION(3)   ::   ilocs
-      INTEGER :: ierror
-      !!-----------------------------------------------------------------------
-      !
-      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
-      !
-      ki = ilocs(1) + nimpp - 1
-      kj = ilocs(2) + njmpp - 1
-      kk = ilocs(3)
-      !
-      zain(1,:)=zmax
-      zain(2,:)=ki+10000.*kj+100000000.*kk
-      !
-      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
-      !
-      pmax = zaout(1,1)
-      kk   = INT( zaout(2,1) / 100000000. )
-      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
-      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
-      !
-   END SUBROUTINE mpp_maxloc3d
-
-
-   SUBROUTINE mppsync()
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsync  ***
-      !!
-      !! ** Purpose :   Massively parallel processors, synchroneous
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER :: ierror
-      !!-----------------------------------------------------------------------
-      !
-      CALL mpi_barrier( mpi_comm_opa, ierror )
-      !
-   END SUBROUTINE mppsync
-
-
-   SUBROUTINE mppstop
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppstop  ***
-      !!
-      !! ** purpose :   Stop massively parallel processors method
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER ::   info
-      !!----------------------------------------------------------------------
-      !
-      CALL mppsync
-      CALL mpi_finalize( info )
-      !
-   END SUBROUTINE mppstop
-
-
-   SUBROUTINE mpp_comm_free( kcom )
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kcom
-      !!
-      INTEGER :: ierr
-      !!----------------------------------------------------------------------
-      !
-      CALL MPI_COMM_FREE(kcom, ierr)
-      !
-   END SUBROUTINE mpp_comm_free
-
-
-   SUBROUTINE mpp_ini_ice( pindic, kumout )
-      !!----------------------------------------------------------------------
-      !!               ***  routine mpp_ini_ice  ***
-      !!
-      !! ** Purpose :   Initialize special communicator for ice areas
-      !!      condition together with global variables needed in the ddmpp folding
-      !!
-      !! ** Method  : - Look for ice processors in ice routines
-      !!              - Put their number in nrank_ice
-      !!              - Create groups for the world processors and the ice processors
-      !!              - Create a communicator for ice processors
-      !!
-      !! ** output
-      !!      njmppmax = njmpp for northern procs
-      !!      ndim_rank_ice = number of processors with ice
-      !!      nrank_ice (ndim_rank_ice) = ice processors
-      !!      ngrp_iworld = group ID for the world processors
-      !!      ngrp_ice = group ID for the ice processors
-      !!      ncomm_ice = communicator for the ice procs.
-      !!      n_ice_root = number (in the world) of proc 0 in the ice comm.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   pindic
-      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical unit
-      !!
-      INTEGER :: jjproc
-      INTEGER :: ii, ierr
-      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kice
-      INTEGER, ALLOCATABLE, DIMENSION(:) ::   zwork
-      !!----------------------------------------------------------------------
-      !
-      ! Since this is just an init routine and these arrays are of length jpnij
-      ! then don't use wrk_nemo module - just allocate and deallocate.
-      ALLOCATE( kice(jpnij), zwork(jpnij), STAT=ierr )
-      IF( ierr /= 0 ) THEN
-         WRITE(kumout, cform_err)
-         WRITE(kumout,*) 'mpp_ini_ice : failed to allocate 2, 1D arrays (jpnij in length)'
-         CALL mppstop
-      ENDIF
-
-      ! Look for how many procs with sea-ice
-      !
-      kice = 0
-      DO jjproc = 1, jpnij
-         IF( jjproc == narea .AND. pindic .GT. 0 )   kice(jjproc) = 1
-      END DO
-      !
-      zwork = 0
-      CALL MPI_ALLREDUCE( kice, zwork, jpnij, mpi_integer, mpi_sum, mpi_comm_opa, ierr )
-      ndim_rank_ice = SUM( zwork )
-
-      ! Allocate the right size to nrank_north
-      IF( ALLOCATED ( nrank_ice ) )   DEALLOCATE( nrank_ice )
-      ALLOCATE( nrank_ice(ndim_rank_ice) )
-      !
-      ii = 0
-      nrank_ice = 0
-      DO jjproc = 1, jpnij
-         IF( zwork(jjproc) == 1) THEN
-            ii = ii + 1
-            nrank_ice(ii) = jjproc -1
-         ENDIF
-      END DO
-
-      ! Create the world group
-      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_iworld, ierr )
-
-      ! Create the ice group from the world group
-      CALL MPI_GROUP_INCL( ngrp_iworld, ndim_rank_ice, nrank_ice, ngrp_ice, ierr )
-
-      ! Create the ice communicator , ie the pool of procs with sea-ice
-      CALL MPI_COMM_CREATE( mpi_comm_opa, ngrp_ice, ncomm_ice, ierr )
-
-      ! Find proc number in the world of proc 0 in the north
-      ! The following line seems to be useless, we just comment & keep it as reminder
-      ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_iworld,n_ice_root,ierr)
-      !
-      CALL MPI_GROUP_FREE(ngrp_ice, ierr)
-      CALL MPI_GROUP_FREE(ngrp_iworld, ierr)
-
-      DEALLOCATE(kice, zwork)
-      !
-   END SUBROUTINE mpp_ini_ice
-
-
-   SUBROUTINE mpp_ini_znl( kumout )
-      !!----------------------------------------------------------------------
-      !!               ***  routine mpp_ini_znl  ***
-      !!
-      !! ** Purpose :   Initialize special communicator for computing zonal sum
-      !!
-      !! ** Method  : - Look for processors in the same row
-      !!              - Put their number in nrank_znl
-      !!              - Create group for the znl processors
-      !!              - Create a communicator for znl processors
-      !!              - Determine if processor should write znl files
-      !!
-      !! ** output
-      !!      ndim_rank_znl = number of processors on the same row
-      !!      ngrp_znl = group ID for the znl processors
-      !!      ncomm_znl = communicator for the ice procs.
-      !!      n_znl_root = number (in the world) of proc 0 in the ice comm.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical units
-      !
-      INTEGER :: jproc      ! dummy loop integer
-      INTEGER :: ierr, ii   ! local integer
-      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kwork
-      !!----------------------------------------------------------------------
-      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world
-      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world
-      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_opa   : ', mpi_comm_opa
-      !
-      ALLOCATE( kwork(jpnij), STAT=ierr )
-      IF( ierr /= 0 ) THEN
-         WRITE(kumout, cform_err)
-         WRITE(kumout,*) 'mpp_ini_znl : failed to allocate 1D array of length jpnij'
-         CALL mppstop
-      ENDIF
-
-      IF( jpnj == 1 ) THEN
-         ngrp_znl  = ngrp_world
-         ncomm_znl = mpi_comm_opa
-      ELSE
-         !
-         CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_opa, ierr )
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - kwork pour njmpp : ', kwork
-         !-$$        CALL flush(numout)
-         !
-         ! Count number of processors on the same row
-         ndim_rank_znl = 0
-         DO jproc=1,jpnij
-            IF ( kwork(jproc) == njmpp ) THEN
-               ndim_rank_znl = ndim_rank_znl + 1
-            ENDIF
-         END DO
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ndim_rank_znl : ', ndim_rank_znl
-         !-$$        CALL flush(numout)
-         ! Allocate the right size to nrank_znl
-         IF (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl)
-         ALLOCATE(nrank_znl(ndim_rank_znl))
-         ii = 0
-         nrank_znl (:) = 0
-         DO jproc=1,jpnij
-            IF ( kwork(jproc) == njmpp) THEN
-               ii = ii + 1
-               nrank_znl(ii) = jproc -1
-            ENDIF
-         END DO
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - nrank_znl : ', nrank_znl
-         !-$$        CALL flush(numout)
-
-         ! Create the opa group
-         CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_opa,ierr)
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_opa : ', ngrp_opa
-         !-$$        CALL flush(numout)
-
-         ! Create the znl group from the opa group
-         CALL MPI_GROUP_INCL  ( ngrp_opa, ndim_rank_znl, nrank_znl, ngrp_znl, ierr )
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_znl ', ngrp_znl
-         !-$$        CALL flush(numout)
-
-         ! Create the znl communicator from the opa communicator, ie the pool of procs in the same row
-         CALL MPI_COMM_CREATE ( mpi_comm_opa, ngrp_znl, ncomm_znl, ierr )
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ncomm_znl ', ncomm_znl
-         !-$$        CALL flush(numout)
-         !
-      END IF
-
-      ! Determines if processor if the first (starting from i=1) on the row
-      IF ( jpni == 1 ) THEN
-         l_znl_root = .TRUE.
-      ELSE
-         l_znl_root = .FALSE.
-         kwork (1) = nimpp
-         CALL mpp_min ( kwork(1), kcom = ncomm_znl)
-         IF ( nimpp == kwork(1)) l_znl_root = .TRUE.
-      END IF
-
-      DEALLOCATE(kwork)
-
-   END SUBROUTINE mpp_ini_znl
-
-
-   SUBROUTINE mpp_ini_north
-      !!----------------------------------------------------------------------
-      !!               ***  routine mpp_ini_north  ***
-      !!
-      !! ** Purpose :   Initialize special communicator for north folding
-      !!      condition together with global variables needed in the mpp folding
-      !!
-      !! ** Method  : - Look for northern processors
-      !!              - Put their number in nrank_north
-      !!              - Create groups for the world processors and the north processors
-      !!              - Create a communicator for northern processors
-      !!
-      !! ** output
-      !!      njmppmax = njmpp for northern procs
-      !!      ndim_rank_north = number of processors in the northern line
-      !!      nrank_north (ndim_rank_north) = number  of the northern procs.
-      !!      ngrp_world = group ID for the world processors
-      !!      ngrp_north = group ID for the northern processors
-      !!      ncomm_north = communicator for the northern procs.
-      !!      north_root = number (in the world) of proc 0 in the northern comm.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER ::   ierr
-      INTEGER ::   jjproc
-      INTEGER ::   ii, ji
-      !!----------------------------------------------------------------------
-      !
-      njmppmax = MAXVAL( njmppt )
-      !
-      ! Look for how many procs on the northern boundary
-      ndim_rank_north = 0
-      DO jjproc = 1, jpnij
-         IF( njmppt(jjproc) == njmppmax )   ndim_rank_north = ndim_rank_north + 1
-      END DO
-      !
-      ! Allocate the right size to nrank_north
-      IF (ALLOCATED (nrank_north)) DEALLOCATE(nrank_north)
-      ALLOCATE( nrank_north(ndim_rank_north) )
-
-      ! Fill the nrank_north array with proc. number of northern procs.
-      ! Note : the rank start at 0 in MPI
-      ii = 0
-      DO ji = 1, jpnij
-         IF ( njmppt(ji) == njmppmax   ) THEN
-            ii=ii+1
-            nrank_north(ii)=ji-1
-         END IF
-      END DO
-      !
-      ! create the world group
-      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr )
-      !
-      ! Create the North group from the world group
-      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_north, nrank_north, ngrp_north, ierr )
-      !
-      ! Create the North communicator , ie the pool of procs in the north group
-      CALL MPI_COMM_CREATE( mpi_comm_opa, ngrp_north, ncomm_north, ierr )
-      !
-   END SUBROUTINE mpp_ini_north
-
-
-   SUBROUTINE mpp_lbc_north_3d( pt3d, cd_type, psgn )
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_3d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
-      !!              in mpp configuration in case of jpn1 > 1
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather
-      !!              the 4 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.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the b.c. is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      !                                                              !   = T ,  U , V , F or W  gridpoints
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr, jk
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      INTEGER, DIMENSION (jpmaxngh)          ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
-      INTEGER                                ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
-      !                                                              ! Workspace for message transfers avoiding mpi_allgather
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk      
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr
-
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk), zfoldwk(jpi,4,jpk), znorthgloio(jpi,4,jpk,jpni) )
-      ALLOCATE( ztabl(jpi,4,jpk), ztabr(jpi*jpmaxngh, 4, jpk) ) 
-
-      ijpj   = 4
-      ijpjm1 = 3
-      !
-      znorthloc(:,:,:) = 0
-      DO jk = 1, jpk
-         DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d
-            ij = jj - nlcj + ijpj
-            znorthloc(:,ij,jk) = pt3d(:,jj,jk)
-         END DO
-      END DO
-      !
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * jpk * ijpj
-
-      IF ( l_north_nogather ) THEN
-         !
-        ztabr(:,:,:) = 0
-        ztabl(:,:,:) = 0
-
-        DO jk = 1, jpk
-           DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
-              ij = jj - nlcj + ijpj
-              DO ji = nfsloop, nfeloop
-                 ztabl(ji,ij,jk) = pt3d(ji,jj,jk)
-              END DO
-           END DO
-        END DO
-
-         DO jr = 1,nsndto
-            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
-            ENDIF
-         END DO
-         DO jr = 1,nsndto
-            iproc = nfipproc(isendto(jr),jpnj)
-            IF(iproc .ne. -1) THEN
-               ilei = nleit (iproc+1)
-               ildi = nldit (iproc+1)
-               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
-            ENDIF
-            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
-              CALL mpprecv(5, zfoldwk, itaille, iproc)
-              DO jk = 1, jpk
-                 DO jj = 1, ijpj
-                    DO ji = ildi, ilei
-                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)
-                    END DO
-                 END DO
-              END DO
-           ELSE IF (iproc .eq. (narea-1)) THEN
-              DO jk = 1, jpk
-                 DO jj = 1, ijpj
-                    DO ji = ildi, ilei
-                       ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk)
-                    END DO
-                 END DO
-              END DO
-           ENDIF
-         END DO
-         IF (l_isend) THEN
-            DO jr = 1,nsndto
-               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
-               ENDIF    
-            END DO
-         ENDIF
-         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition
-         DO jk = 1, jpk
-            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
-               ij = jj - nlcj + ijpj
-               DO ji= 1, nlci
-                  pt3d(ji,jj,jk) = ztabl(ji,ij,jk)
-               END DO
-            END DO
-         END DO
-         !
-
-      ELSE
-         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
-            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-         !
-         ztab(:,:,:) = 0.e0
-         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 jk = 1, jpk
-               DO jj = 1, ijpj
-                  DO ji = ildi, ilei
-                    ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)
-                  END DO
-               END DO
-            END DO
-         END DO
-         CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
-         !
-         DO jk = 1, jpk
-            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
-               ij = jj - nlcj + ijpj
-               DO ji= 1, nlci
-                  pt3d(ji,jj,jk) = ztab(ji+nimpp-1,ij,jk)
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-      !
-      ! The ztab array has been either:
-      !  a. Fully populated by the mpi_allgather operation or
-      !  b. Had the active points for this domain and northern neighbours populated
-      !     by peer to peer exchanges
-      ! Either way the array may be folded by lbc_nfd and the result for the span of
-      ! this domain will be identical.
-      !
-      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
-      DEALLOCATE( ztabl, ztabr ) 
-      !
-   END SUBROUTINE mpp_lbc_north_3d
-
-
-   SUBROUTINE mpp_lbc_north_2d( pt2d, cd_type, psgn)
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_2d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
-      !!              in mpp configuration in case of jpn1 > 1 (for 2d array )
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather
-      !!              the 4 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.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 2D array on which the b.c. is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points
-      !                                                          !   = T ,  U , V , F or W  gridpoints
-      REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
-      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
-      !                                                              ! Workspace for message transfers avoiding mpi_allgather
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztab
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk      
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   :: znorthgloio
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztabl, ztabr
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( ztab(jpiglo,4), znorthloc(jpi,4), zfoldwk(jpi,4), znorthgloio(jpi,4,jpni) )
-      ALLOCATE( ztabl(jpi,4), ztabr(jpi*jpmaxngh, 4) ) 
-      !
-      ijpj   = 4
-      ijpjm1 = 3
-      !
-      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d
-         ij = jj - nlcj + ijpj
-         znorthloc(:,ij) = pt2d(:,jj)
-      END DO
-
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * ijpj
-      IF ( l_north_nogather ) THEN
-         !
-         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
-         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange
-         !
-         ztabr(:,:) = 0
-         ztabl(:,:) = 0
-
-         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
-            ij = jj - nlcj + ijpj
-              DO ji = nfsloop, nfeloop
-               ztabl(ji,ij) = pt2d(ji,jj)
-            END DO
-         END DO
-
-         DO jr = 1,nsndto
-            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-               CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr))
-            ENDIF
-         END DO
-         DO jr = 1,nsndto
-            iproc = nfipproc(isendto(jr),jpnj)
-            IF(iproc .ne. -1) THEN
-               ilei = nleit (iproc+1)
-               ildi = nldit (iproc+1)
-               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
-            ENDIF
-            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
-              CALL mpprecv(5, zfoldwk, itaille, iproc)
-              DO jj = 1, ijpj
-                 DO ji = ildi, ilei
-                    ztabr(iilb+ji,jj) = zfoldwk(ji,jj)
-                 END DO
-              END DO
-            ELSE IF (iproc .eq. (narea-1)) THEN
-              DO jj = 1, ijpj
-                 DO ji = ildi, ilei
-                    ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj)
-                 END DO
-              END DO
-            ENDIF
-         END DO
-         IF (l_isend) THEN
-            DO jr = 1,nsndto
-               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
-               ENDIF
-            END DO
-         ENDIF
-         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition
-         !
-         DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-            ij = jj - nlcj + ijpj
-            DO ji = 1, nlci
-               pt2d(ji,jj) = ztabl(ji,ij)
-            END DO
-         END DO
-         !
-      ELSE
-         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,        &
-            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-         !
-         ztab(:,:) = 0.e0
-         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, ijpj
-               DO ji = ildi, ilei
-                  ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
-               END DO
-            END DO
-         END DO
-         CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
-         !
-         DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-            ij = jj - nlcj + ijpj
-            DO ji = 1, nlci
-               pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
-            END DO
-         END DO
-         !
-      ENDIF
-      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
-      DEALLOCATE( ztabl, ztabr ) 
-      !
-   END SUBROUTINE mpp_lbc_north_2d
-
-   SUBROUTINE mpp_lbc_north_2d_multiple( pt2d_array, cd_type, psgn, num_fields)
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_2d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
-      !!              in mpp configuration in case of jpn1 > 1
-      !!              (for multiple 2d arrays )
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather
-      !!              the 4 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.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER ,  INTENT (in   ) ::   num_fields  ! number of variables contained in pt2d
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
-      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points
-      !                                                          !   = T ,  U , V , F or W  gridpoints
-      REAL(wp), DIMENSION(:), INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr, jk
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
-      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
-      !                                                              ! Workspace for message transfers avoiding mpi_allgather
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields), znorthgloio(jpi,4,num_fields,jpni) )   ! expanded to 3 dimensions
-      ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) )
-      !
-      ijpj   = 4
-      ijpjm1 = 3
-      !
-      
-      DO jk = 1, num_fields
-         DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d (for every variable)
-            ij = jj - nlcj + ijpj
-            znorthloc(:,ij,jk) = pt2d_array(jk)%pt2d(:,jj)
-         END DO
-      END DO
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * ijpj
-                                                                  
-      IF ( l_north_nogather ) THEN
-         !
-         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
-         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange
-         !
-         ztabr(:,:,:) = 0
-         ztabl(:,:,:) = 0
-
-         DO jk = 1, num_fields
-            DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
-               ij = jj - nlcj + ijpj
-               DO ji = nfsloop, nfeloop
-                  ztabl(ji,ij,jk) = pt2d_array(jk)%pt2d(ji,jj)
-               END DO
-            END DO
-         END DO
-
-         DO jr = 1,nsndto
-            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-               CALL mppsend(5, znorthloc, itaille*num_fields, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) ! Buffer expanded "num_fields" times
-            ENDIF
-         END DO
-         DO jr = 1,nsndto
-            iproc = nfipproc(isendto(jr),jpnj)
-            IF(iproc .ne. -1) THEN
-               ilei = nleit (iproc+1)
-               ildi = nldit (iproc+1)
-               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
-            ENDIF
-            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
-              CALL mpprecv(5, zfoldwk, itaille*num_fields, iproc) ! Buffer expanded "num_fields" times
-              DO jk = 1 , num_fields
-                 DO jj = 1, ijpj
-                    DO ji = ildi, ilei
-                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)       ! Modified to 3D
-                    END DO
-                 END DO
-              END DO
-            ELSE IF (iproc .eq. (narea-1)) THEN
-              DO jk = 1, num_fields
-                 DO jj = 1, ijpj
-                    DO ji = ildi, ilei
-                          ztabr(iilb+ji,jj,jk) = pt2d_array(jk)%pt2d(ji,nlcj-ijpj+jj)       ! Modified to 3D
-                    END DO
-                 END DO
-              END DO
-            ENDIF
-         END DO
-         IF (l_isend) THEN
-            DO jr = 1,nsndto
-               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
-               ENDIF
-            END DO
-         ENDIF
-         !
-         DO ji = 1, num_fields     ! Loop to manage 3D variables
-            CALL mpp_lbc_nfd( ztabl(:,:,ji), ztabr(:,:,ji), cd_type(ji), psgn(ji) )  ! North fold boundary condition
-         END DO
-         !
-         DO jk = 1, num_fields
-            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-               ij = jj - nlcj + ijpj
-               DO ji = 1, nlci
-                  pt2d_array(jk)%pt2d(ji,jj) = ztabl(ji,ij,jk)       ! Modified to 3D
-               END DO
-            END DO
-         END DO
-         
-         !
-      ELSE
-         !
-         CALL MPI_ALLGATHER( znorthloc  , itaille*num_fields, MPI_DOUBLE_PRECISION,        &
-            &                znorthgloio, itaille*num_fields, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-         !
-         ztab(:,:,:) = 0.e0
-         DO jk = 1, num_fields
-            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, ijpj
-                  DO ji = ildi, ilei
-                     ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)
-                  END DO
-               END DO
-            END DO
-         END DO
-         
-         DO ji = 1, num_fields
-            CALL lbc_nfd( ztab(:,:,ji), cd_type(ji), psgn(ji) )   ! North fold boundary condition
-         END DO
-         !
-         DO jk = 1, num_fields
-            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-               ij = jj - nlcj + ijpj
-               DO ji = 1, nlci
-                  pt2d_array(jk)%pt2d(ji,jj) = ztab(ji+nimpp-1,ij,jk)
-               END DO
-            END DO
-         END DO
-         !
-         !
-      ENDIF
-      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
-      DEALLOCATE( ztabl, ztabr )
-      !
-   END SUBROUTINE mpp_lbc_north_2d_multiple
-
-   SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn)
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_2d  ***
-      !!
-      !! ** 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+2*jpr2dj 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.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), 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 ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ij, iproc
-      !
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
-
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) )
-
-      !
-      ijpj=4
-      ztab_e(:,:) = 0.e0
-
-      ij=0
-      ! put in znorthloc_e the last 4 jlines of pt2d
-      DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
-         ij = ij + 1
-         DO ji = 1, jpi
-            znorthloc_e(ji,ij)=pt2d(ji,jj)
-         END DO
-      END DO
-      !
-      itaille = jpi * ( ijpj + 2 * jpr2dj )
-      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    &
-         &                znorthgloio_e(1,1,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, ijpj+2*jpr2dj
-            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(:,:), cd_type, psgn, pr2dj = jpr2dj )
-
-      ij = jpr2dj
-      !! Scatter back to pt2d
-      DO jj = nlcj - ijpj + 1 , nlcj +jpr2dj
-      ij  = ij +1
-         DO ji= 1, nlci
-            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)
-         END DO
-      END DO
-      !
-      DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e )
-      !
-   END SUBROUTINE mpp_lbc_north_e
-
-
-   SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_bdy_3d  ***
-      !!
-      !! ** Purpose :   Message passing management
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries 
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi_bdy : mark for "east-west local boundary"
-      !!                    nbondj_bdy : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
-      !
-      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! local integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland                      ! local scalar
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
-         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
-
-      zland = 0._wp
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                   ! East-West boundaries
-      !                                        !* Cyclic east-west
-      IF( nbondi == 2) THEN
-         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
-            ptab( 1 ,:,:) = ptab(jpim1,:,:)
-            ptab(jpi,:,:) = ptab(  2  ,:,:)
-         ELSE
-            IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
-            ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
-         ENDIF
-      ELSEIF(nbondi == -1) THEN
-         IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
-      ELSEIF(nbondi == 1) THEN
-         ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
-      ENDIF                                     !* closed
-
-      IF (nbondj == 2 .OR. nbondj == -1) THEN
-        IF( .NOT. cd_type == 'F' )   ptab(:,1:jprecj,:) = zland       ! south except F-point
-      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
-        ptab(:,nlcj-jprecj+1:jpj,:) = zland       ! north
-      ENDIF
-      !
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-      END SELECT
-      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-      CASE ( 0 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-      CASE ( 1 )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-      END SELECT
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         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 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
-      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(      jl,:,:) = zt3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(      jl,:,:) = zt3we(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
-      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-      END SELECT
-      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-      CASE ( 0 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-      CASE ( 1 )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-      END SELECT
-      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         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 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
-      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl,:) = zt3sn(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we  )
-      !
-   END SUBROUTINE mpp_lnk_bdy_3d
-
-
-   SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_bdy_2d  ***
-      !!
-      !! ** Purpose :   Message passing management
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries 
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi_bdy : mark for "east-west local boundary"
-      !!                    nbondj_bdy : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      INTEGER                     , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
-      !
-      INTEGER  ::   ji, jj, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! local integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-      !!----------------------------------------------------------------------
-
-      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
-         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
-
-      zland = 0._wp
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                   ! East-West boundaries
-      !                                      !* Cyclic east-west
-      IF( nbondi == 2 ) THEN
-         IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
-            ptab( 1 ,:) = ptab(jpim1,:)
-            ptab(jpi,:) = ptab(  2  ,:)
-         ELSE
-            IF(.NOT.cd_type == 'F' )  ptab(     1       :jpreci,:) = zland    ! south except F-point
-                                      ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
-         ENDIF
-      ELSEIF(nbondi == -1) THEN
-         IF( .NOT.cd_type == 'F' )    ptab(     1       :jpreci,:) = zland    ! south except F-point
-      ELSEIF(nbondi == 1) THEN
-                                      ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
-      ENDIF
-      !                                      !* closed
-      IF( nbondj == 2 .OR. nbondj == -1 ) THEN
-         IF( .NOT.cd_type == 'F' )    ptab(:,     1       :jprecj) = zland    ! south except F-point
-      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
-                                      ptab(:,nlcj-jprecj+1:jpj   ) = zland    ! north
-      ENDIF
-      !
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt2ew(:,jl,1) = ptab(jpreci+jl,:)
-            zt2we(:,jl,1) = ptab(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-      END SELECT
-      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-      CASE ( 0 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-      CASE ( 1 )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-      END SELECT
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         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 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
-      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:) = zt2we(:,jl,2)
-            ptab(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:) = zt2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt2sn(:,jl,1) = ptab(:,ijhom +jl)
-            zt2ns(:,jl,1) = ptab(:,jprecj+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-      END SELECT
-      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-      CASE ( 0 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-      CASE ( 1 )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-      END SELECT
-      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         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 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
-      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jl      ) = zt2sn(:,jl,2)
-            ptab(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl) = zt2sn(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we  )
-      !
-   END SUBROUTINE mpp_lnk_bdy_2d
-
-
-   SUBROUTINE mpi_init_opa( 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_opa, 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_opa
-
-   SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype)
-      !!---------------------------------------------------------------------
-      !!   Routine DDPDD_MPI: used by reduction operator MPI_SUMDD
-      !!
-      !!   Modification of original codes written by David H. Bailey
-      !!   This subroutine computes yddb(i) = ydda(i)+yddb(i)
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in)                         :: ilen, itype
-      COMPLEX(wp), DIMENSION(ilen), INTENT(in)     :: ydda
-      COMPLEX(wp), DIMENSION(ilen), INTENT(inout)  :: yddb
-      !
-      REAL(wp) :: zerr, zt1, zt2    ! local work variables
-      INTEGER :: ji, ztmp           ! local scalar
-
-      ztmp = itype   ! avoid compilation warning
-
-      DO ji=1,ilen
-      ! Compute ydda + yddb using Knuth's trick.
-         zt1  = real(ydda(ji)) + real(yddb(ji))
-         zerr = zt1 - real(ydda(ji))
-         zt2  = ((real(yddb(ji)) - zerr) + (real(ydda(ji)) - (zt1 - zerr))) &
-                + aimag(ydda(ji)) + aimag(yddb(ji))
-
-         ! The result is zt1 + zt2, after normalization.
-         yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp )
-      END DO
-
-   END SUBROUTINE DDPDD_MPI
-
-
-   SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, pr2dj)
-      !!---------------------------------------------------------------------
-      !!                   ***  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+2*jpr2dj 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 version accounts for an extra halo with icebergs.
-      !!
-      !!----------------------------------------------------------------------
-      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, OPTIONAL       , INTENT(in   ) ::   pr2dj
-      !
-      INTEGER ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ij, iproc, ipr2dj
-      !
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
-      !!----------------------------------------------------------------------
-      !
-      ijpj=4
-      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos
-         ipr2dj = pr2dj
-      ELSE
-         ipr2dj = 0
-      ENDIF
-      ALLOCATE( ztab_e(jpiglo,4+2*ipr2dj), znorthloc_e(jpi,4+2*ipr2dj), znorthgloio_e(jpi,4+2*ipr2dj,jpni) )
-      !
-      ztab_e(:,:) = 0._wp
-      !
-      ij = 0
-      ! put in znorthloc_e the last 4 jlines of pt2d
-      DO jj = nlcj - ijpj + 1 - ipr2dj, nlcj +ipr2dj
-         ij = ij + 1
-         DO ji = 1, jpi
-            znorthloc_e(ji,ij)=pt2d(ji,jj)
-         END DO
-      END DO
-      !
-      itaille = jpi * ( ijpj + 2 * ipr2dj )
-      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    &
-         &                znorthgloio_e(1,1,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, ijpj+2*ipr2dj
-            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(:,:), cd_type, psgn, pr2dj = ipr2dj )
-
-      ij = ipr2dj
-      !! Scatter back to pt2d
-      DO jj = nlcj - ijpj + 1 , nlcj +ipr2dj
-      ij  = ij +1
-         DO ji= 1, nlci
-            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)
-         END DO
-      END DO
-      !
-      DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e )
-      !
-   END SUBROUTINE mpp_lbc_north_icb
-
-
-   SUBROUTINE mpp_lnk_2d_icb( pt2d, cd_type, psgn, jpri, jprj )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d_icb  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for 2d array (with extra halo and icebergs)
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    jpri   : number of rows for extra outer halo
-      !!                    jprj   : number of columns 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
-      !!----------------------------------------------------------------------
-      INTEGER                                             , INTENT(in   ) ::   jpri
-      INTEGER                                             , INTENT(in   ) ::   jprj
-      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
-      CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
-      !                                                                                 ! = T , U , V , F , W and I points
-      REAL(wp)                                            , INTENT(in   ) ::   psgn     ! =-1 the sign change across the
-      !!                                                                                ! north boundary, =  1. otherwise
-      INTEGER  ::   jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ipreci, iprecj             ! temporary integers
-      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-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns
-      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn
-      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe
-      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew
-      !!----------------------------------------------------------------------
-
-      ipreci = jpreci + jpri      ! take into account outer extra 2D overlap area
-      iprecj = jprecj + jprj
-
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      ! Order matters Here !!!!
-      !
-      !                                      ! East-West boundaries
-      !                                           !* Cyclic east-west
-      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east
-         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west
-         !
-      ELSE                                        !* closed
-         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
-                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
-      ENDIF
-      !
-
-      ! north fold treatment
-      ! -----------------------
-      IF( npolj /= 0 ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
-         CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj)  , cd_type, psgn , pr2dj=jprj  )
-         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 = nlci-nreci-jpri
-         DO jl = 1, ipreci
-            r2dew(:,jl,1) = pt2d(jpreci+jl,:)
-            r2dwe(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = ipreci * ( jpj + 2*jprj)
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
-         CALL mpprecv( 2, r2dwe(1-jprj,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-jprj,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      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-jpri,:) = r2dwe(:,jl,2)
-            pt2d( iihom+jl,:) = r2dew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, ipreci
-            pt2d(jl-jpri,:) = 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 = nlcj-nrecj-jprj
-         DO jl = 1, iprecj
-            r2dsn(:,jl,1) = pt2d(:,ijhom +jl)
-            r2dns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = iprecj * ( jpi + 2*jpri )
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
-         CALL mpprecv( 4, r2dsn(1-jpri,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-jpri,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-      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-jprj) = r2dsn(:,jl,2)
-            pt2d(:,ijhom+jl ) = r2dns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, iprecj
-            pt2d(:,jl-jprj) = r2dsn(:,jl,2)
-         END DO
-      END SELECT
-
-   END SUBROUTINE mpp_lnk_2d_icb
-   
-
-   !!----------------------------------------------------------------------
-   !!   All cases:         ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam   routines
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5 ,   &
-      &                 cd6, cd7, cd8, cd9, cd10 )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE  stop_opa  ***
-      !!
-      !! ** Purpose :   print in ocean.outpput file a error message and
-      !!                increment the error number (nstop) by one.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
-      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
-      !!----------------------------------------------------------------------
-      !
-      nstop = nstop + 1
-      IF(lwp) THEN
-         WRITE(numout,cform_err)
-         IF( PRESENT(cd1 ) )   WRITE(numout,*) cd1
-         IF( PRESENT(cd2 ) )   WRITE(numout,*) cd2
-         IF( PRESENT(cd3 ) )   WRITE(numout,*) cd3
-         IF( PRESENT(cd4 ) )   WRITE(numout,*) cd4
-         IF( PRESENT(cd5 ) )   WRITE(numout,*) cd5
-         IF( PRESENT(cd6 ) )   WRITE(numout,*) cd6
-         IF( PRESENT(cd7 ) )   WRITE(numout,*) cd7
-         IF( PRESENT(cd8 ) )   WRITE(numout,*) cd8
-         IF( PRESENT(cd9 ) )   WRITE(numout,*) cd9
-         IF( PRESENT(cd10) )   WRITE(numout,*) cd10
-      ENDIF
-                               CALL FLUSH(numout    )
-      IF( numstp     /= -1 )   CALL FLUSH(numstp    )
-      IF( numsol     /= -1 )   CALL FLUSH(numsol    )
-      IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice)
-      !
-      IF( cd1 == 'STOP' ) THEN
-         IF(lwp) WRITE(numout,*)  'huge E-R-R-O-R : immediate stop'
-         CALL mppstop()
-      ENDIF
-      !
-   END SUBROUTINE ctl_stop
-
-
-   SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5,   &
-      &                 cd6, cd7, cd8, cd9, cd10 )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE  stop_warn  ***
-      !!
-      !! ** Purpose :   print in ocean.outpput file a error message and
-      !!                increment the warning number (nwarn) by one.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
-      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
-      !!----------------------------------------------------------------------
-      !
-      nwarn = nwarn + 1
-      IF(lwp) THEN
-         WRITE(numout,cform_war)
-         IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1
-         IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2
-         IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3
-         IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4
-         IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5
-         IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6
-         IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7
-         IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8
-         IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9
-         IF( PRESENT(cd10) ) WRITE(numout,*) cd10
-      ENDIF
-      CALL FLUSH(numout)
-      !
-   END SUBROUTINE ctl_warn
-
-
-   SUBROUTINE ctl_opn( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ctl_opn  ***
-      !!
-      !! ** Purpose :   Open file and check if required file is available.
-      !!
-      !! ** Method  :   Fortan open
-      !!----------------------------------------------------------------------
-      INTEGER          , INTENT(  out) ::   knum      ! logical unit to open
-      CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open
-      CHARACTER(len=*) , INTENT(in   ) ::   cdstat    ! disposition specifier
-      CHARACTER(len=*) , INTENT(in   ) ::   cdform    ! formatting specifier
-      CHARACTER(len=*) , INTENT(in   ) ::   cdacce    ! access specifier
-      INTEGER          , INTENT(in   ) ::   klengh    ! record length
-      INTEGER          , INTENT(in   ) ::   kout      ! number of logical units for write
-      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
-      INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number
-      !
-      CHARACTER(len=80) ::   clfile
-      INTEGER           ::   iost
-      !!----------------------------------------------------------------------
-      !
-      ! adapt filename
-      ! ----------------
-      clfile = TRIM(cdfile)
-      IF( PRESENT( karea ) ) THEN
-         IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1
-      ENDIF
-      knum=get_unit()
-      !
-      iost=0
-      IF( cdacce(1:6) == 'DIRECT' )  THEN
-         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
-      ELSE
-         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat             , ERR=100, IOSTAT=iost )
-      ENDIF
-      IF( iost == 0 ) THEN
-         IF(ldwp) THEN
-            WRITE(kout,*) '     file   : ', clfile,' open ok'
-            WRITE(kout,*) '     unit   = ', knum
-            WRITE(kout,*) '     status = ', cdstat
-            WRITE(kout,*) '     form   = ', cdform
-            WRITE(kout,*) '     access = ', cdacce
-            WRITE(kout,*)
-         ENDIF
-      ENDIF
-100   CONTINUE
-      IF( iost /= 0 ) THEN
-         IF(ldwp) THEN
-            WRITE(kout,*)
-            WRITE(kout,*) ' ===>>>> : bad opening file: ', 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,*)
-         ENDIF
-         STOP 'ctl_opn bad opening'
-      ENDIF
-      !
-   END SUBROUTINE ctl_opn
-
-
-   SUBROUTINE ctl_nam ( kios, cdnam, ldwp )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ctl_nam  ***
-      !!
-      !! ** Purpose :   Informations when error while reading a namelist
-      !!
-      !! ** Method  :   Fortan open
-      !!----------------------------------------------------------------------
-      INTEGER         , INTENT(inout) ::   kios    ! IO status after reading the namelist
-      CHARACTER(len=*), INTENT(in   ) ::   cdnam   ! group name of namelist for which error occurs
-      CHARACTER(len=4)                ::   clios   ! string to convert iostat in character for print
-      LOGICAL         , INTENT(in   ) ::   ldwp    ! boolean term for print
-      !!----------------------------------------------------------------------
-      !
-      WRITE (clios, '(I4.0)')   kios
-      IF( kios < 0 ) THEN         
-         CALL ctl_warn( 'end of record or file while reading namelist '   &
-            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
-      ENDIF
-      !
-      IF( kios > 0 ) THEN
-         CALL ctl_stop( 'misspelled variable in namelist '   &
-            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
-      ENDIF
-      kios = 0
-      RETURN
-      !
-   END SUBROUTINE ctl_nam
-
-
-   INTEGER FUNCTION get_unit()
-      !!----------------------------------------------------------------------
-      !!                  ***  FUNCTION  get_unit  ***
-      !!
-      !! ** Purpose :   return the index of an unused logical unit
-      !!----------------------------------------------------------------------
-      LOGICAL :: llopn
-      !!----------------------------------------------------------------------
-      !
-      get_unit = 15   ! choose a unit that is big enough then it is not already used in NEMO
-      llopn = .TRUE.
-      DO WHILE( (get_unit < 998) .AND. llopn )
-         get_unit = get_unit + 1
-         INQUIRE( unit = get_unit, opened = llopn )
-      END DO
-      IF( (get_unit == 999) .AND. llopn ) THEN
-         CALL ctl_stop( 'get_unit: All logical units until 999 are used...' )
-         get_unit = -1
-      ENDIF
-      !
-   END FUNCTION get_unit
-
-   !!----------------------------------------------------------------------
-END MODULE lib_mpp
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mathelp.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mathelp.f90	(revision 12100)
+++ 	(revision )
@@ -1,3122 +1,0 @@
-MODULE mathelp
-!-
-!$Id: mathelp.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
-!-
-  PRIVATE
-  PUBLIC :: mathop,moycum,buildop
-!-
-  INTERFACE mathop
-    MODULE PROCEDURE mathop_r11,mathop_r21,mathop_r31
-  END INTERFACE
-!-
-!- Variables used to detect and identify the operations
-!-
-  CHARACTER(LEN=80),SAVE :: &
- &  seps='( ) , + - / * ^', ops = '+ - * / ^', mima = 'min max'
-  CHARACTER(LEN=250),SAVE :: &
- &  funcs = 'sin cos tan asin acos atan exp log sqrt chs abs '&
- & //'cels kelv deg rad gather scatter fill coll undef only ident'
-  CHARACTER(LEN=120),SAVE :: &
- &  indexfu = 'gather, scatter, fill, coll, undef, only'
-!---------------------------------------------------------------------
-CONTAINS
-!===
-SUBROUTINE buildop (c_str,ex_topps,topp,fill_val,opps,scal,nbops)
-!---------------------------------------------------------------------
-!- This subroutine decomposes the input string in the elementary
-!- functions which need to be applied to the vector of data.
-!- This vector is represented by X in the string.
-!- This subroutine is the driver of the decomposition and gets
-!- the time operation but then call decoop for the other operations
-!-
-!- INPUT
-!-
-!- c_str    : String containing the operations
-!- ex_toops : Time operations that can be expected within the string
-!- fill_val :
-!-
-!- OUTPUT
-!-
-!- topp   : Time operation
-!- opps   :
-!- scal   :
-!- nbops  :
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*),INTENT(IN) :: c_str,ex_topps
-  CHARACTER(LEN=*),INTENT(OUT) :: topp
-  CHARACTER(LEN=*),DIMENSION(:),INTENT(OUT) :: opps
-  REAL,INTENT(IN) :: fill_val
-  REAL,DIMENSION(:),INTENT(OUT) :: scal
-  INTEGER,INTENT(OUT) :: nbops
-!-
-  CHARACTER(LEN=LEN(c_str)) :: str,new_str
-  INTEGER :: leng,ind_opb,ind_clb
-!-
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
-  IF (check) WRITE(*,*) 'buildop : Some preliminary cleaning'
-!-
-  str = c_str
-  leng = LEN_TRIM(str)
-  IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN
-    str = str(2:leng-1)
-    leng = leng-2
-  ENDIF
-!-
-  IF (check) &
- &  WRITE(*,*) 'buildop : Starting to test the various options'
-!-
-  IF (leng <= 5 .AND. INDEX(ex_topps,str(1:leng)) > 0) THEN
-    IF (check) WRITE(*,*) 'buildop : Time operation only'
-    nbops = 0
-    topp = str(1:leng)
-  ELSE
-    IF (check) THEN
-      WRITE(*,*) 'buildop : Time operation and something else'
-    ENDIF
-!--
-    ind_opb = INDEX(str(1:leng),'(')
-    IF (ind_opb > 0) THEN
-      IF (INDEX(ex_topps,str(1:ind_opb-1)) > 0) THEN
-        IF (check) THEN
-          WRITE(*,'(2a)') &
- &          ' buildop : Extract time operation from : ',str
-        ENDIF
-        topp = str(1:ind_opb-1)
-        ind_clb = INDEX(str(1:leng),')',BACK=.TRUE.)
-        new_str = str(ind_opb+1:ind_clb-1)
-        IF (check) THEN
-          WRITE(*,'(2a,2I3)') &
- &          ' buildop : Call decoop ',new_str,ind_opb,ind_clb
-        ENDIF
-        CALL decoop (new_str,fill_val,opps,scal,nbops)
-      ELSE
-        CALL ipslerr(3,'buildop', &
- &        'time operation does not exist',str(1:ind_opb-1),' ')
-      ENDIF
-    ELSE
-      CALL ipslerr(3,'buildop', &
- &      'some long operation exists but wihout parenthesis', &
- &      str(1:leng),' ')
-    ENDIF
-  ENDIF
-!-
-  IF (check) THEN
-    DO leng=1,nbops
-      WRITE(*,*) &
- &      'buildop : i -- opps, scal : ',leng,opps(leng),scal(leng)
-    ENDDO
-  ENDIF
-!---------------------
-END SUBROUTINE buildop
-!===
-SUBROUTINE decoop (pstr,fill_val,opps,scal,nbops)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*),INTENT(IN) :: pstr
-  REAL,INTENT(IN) :: fill_val
-  CHARACTER(LEN=*),DIMENSION(:),INTENT(OUT) :: opps
-  REAL,DIMENSION(:),INTENT(OUT) :: scal
-  INTEGER,INTENT(OUT) :: nbops
-!-
-  CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char
-  INTEGER,DIMENSION(2) :: f_pos,s_pos
-  CHARACTER(LEN=20) :: opp_str,scal_str
-  CHARACTER(LEN=LEN(pstr)) :: str
-  INTEGER :: nbsep,nbops_max,xpos,leng,ppos,epos,int_tmp
-  CHARACTER(LEN=3) :: tl,dl
-  CHARACTER(LEN=10) :: fmt
-!-
-  LOGICAL :: check = .FALSE.,prio
-!---------------------------------------------------------------------
-  IF (check) WRITE(*,'(2A)') ' decoop : Incoming string : ',pstr
-!-
-  str = pstr; nbops = 0;
-!-
-  CALL findsep (str,nbsep,f_char,f_pos,s_char,s_pos)
-  IF (check) WRITE(*,*) 'decoop : Out of findsep',nbsep
-!-
-  nbops_max = min(SIZE(opps),SIZE(scal))
-!-
-  DO WHILE (nbsep > 0)
-    IF (nbops >= nbops_max) THEN
-      CALL ipslerr(3,'decoop','Expression too complex',TRIM(str),' ')
-    ENDIF
-!--
-    xpos = INDEX(str,'X')
-    leng = LEN_TRIM(str)
-    nbops = nbops+1
-!--
-    IF (check) THEN
-      WRITE(*,*) 'decoop : str   -> ',TRIM(str)
-      WRITE(*,*) 'decoop : nbops -> ',nbops
-      WRITE(*,*) s_char(1),'-',f_char(1),'|',f_char(2),'-',s_char(2)
-      WRITE(*,*) s_pos(1),'-',f_pos(1),'|',f_pos(2),'-',s_pos(2)
-    ENDIF
-!---
-!-- Start the analysis of the syntax. 3 types of constructs
-!-- are recognized.  They are scanned sequentialy
-!---
-    IF (nbsep == 1) THEN
-      IF (check) WRITE(*,*) 'decoop : Only one operation'
-      IF (INDEX(ops,f_char(1)) > 0) THEN
-!------ Type : scal+X
-        IF (f_char(1) == '-' .OR. f_char(1) == '/') THEN
-          opp_str = f_char(1)//'I'
-        ELSE
-          opp_str = f_char(1)
-        ENDIF
-        scal_str = str(s_pos(1)+1:f_pos(1)-1)
-        str = 'X'
-      ELSE IF (INDEX(ops,f_char(2)) > 0) THEN
-!------ Type : X+scal
-        opp_str = f_char(2)
-        scal_str = str(f_pos(2)+1:s_pos(2)-1)
-        str = 'X'
-      ELSE
-        CALL ipslerr(3,'decoop', &
- &        'Unknown operations of type X+scal',f_char(1),pstr)
-      ENDIF
-    ELSE
-      IF (check) WRITE(*,*) 'decoop : More complex operation'
-      IF ( f_char(1) == '(' .AND. f_char(2) == ')' ) THEN
-!------ Type : sin(X)
-        opp_str = str(s_pos(1)+1:f_pos(1)-1)
-        scal_str = '?'
-        str = str(1:s_pos(1))//'X'//str(f_pos(2)+1:leng)
-      ELSE IF (    (f_char(1) == '(' .AND. f_char(2) == ',')&
- &             .OR.(f_char(1) == ',' .AND. f_char(2) == ')')) THEN
-!------ Type : max(X,scal) or max(scal,X)
-        IF (f_char(1) == '(' .AND. s_char(2) == ')') THEN
-!-------- Type : max(X,scal)
-          opp_str = str(f_pos(1)-3:f_pos(1)-1)
-          scal_str = str(f_pos(2)+1:s_pos(2)-1)
-          str = str(1:f_pos(1)-4)//'X'//str(s_pos(2)+1:leng)
-        ELSE IF (f_char(1) == ',' .AND. s_char(1) == '(') THEN
-!-------- Type : max(scal,X)
-          opp_str = str(s_pos(1)-3:s_pos(1)-1)
-          scal_str = str(s_pos(1)+1:f_pos(1)-1)
-          str = str(1:s_pos(1)-4)//'X'//str(f_pos(2)+1:leng)
-        ELSE
-          CALL ipslerr(3,'decoop','Syntax error 1',str,' ')
-        ENDIF
-      ELSE
-        prio = (f_char(2) == '*').OR.(f_char(2) == '^')
-        IF (     (INDEX(ops,f_char(1)) > 0) &
- &          .AND.(xpos-f_pos(1) == 1).AND.(.NOT.prio) ) THEN
-!-------- Type : ... scal+X ...
-          IF (f_char(1) == '-' .OR. f_char(1) == '/') THEN
-            opp_str = f_char(1)//'I'
-          ELSE
-            opp_str = f_char(1)
-          ENDIF
-          scal_str = str(s_pos(1)+1:f_pos(1)-1)
-          str = str(1:s_pos(1))//'X'//str(f_pos(1)+2:leng)
-        ELSE IF (     (INDEX(ops,f_char(2)) > 0) &
- &               .AND.(f_pos(2)-xpos == 1) ) THEN
-!-------- Type : ... X+scal ...
-          opp_str = f_char(2)
-          scal_str = str(f_pos(2)+1:s_pos(2)-1)
-          str = str(1:f_pos(2)-2)//'X'//str(s_pos(2):leng)
-        ELSE
-          CALL ipslerr(3,'decoop','Syntax error 2',str,' ')
-        ENDIF
-      ENDIF
-    ENDIF
-!---
-    IF (check) WRITE(*,*) 'decoop : Finished syntax,str = ',TRIM(str)
-!---
-!-- Now that the different components of the operation are identified
-!-- we transform them into what is going to be used in the program
-!---
-    IF (INDEX(scal_str,'?') > 0) THEN
-      IF (INDEX(funcs,opp_str(1:LEN_TRIM(opp_str))) > 0) THEN
-        opps(nbops) = opp_str(1:LEN_TRIM(opp_str))
-        scal(nbops) = fill_val
-      ELSE
-        CALL ipslerr(3,'decoop', &
- &        'Unknown function',opp_str(1:LEN_TRIM(opp_str)),' ')
-      ENDIF
-    ELSE
-      leng = LEN_TRIM(opp_str)
-      IF (INDEX(mima,opp_str(1:leng)) > 0) THEN
-        opps(nbops) = 'fu'//opp_str(1:leng)
-      ELSE
-        IF (INDEX(opp_str(1:leng),'+') > 0) THEN
-          opps(nbops) = 'add'
-        ELSE IF (INDEX(opp_str(1:leng),'-I') > 0) THEN
-          opps(nbops) = 'subi'
-        ELSE IF (INDEX(opp_str(1:leng),'-') > 0) THEN
-          opps(nbops) = 'sub'
-        ELSE IF (INDEX(opp_str(1:leng),'*') > 0) THEN
-          opps(nbops) = 'mult'
-        ELSE IF (INDEX(opp_str(1:leng),'/') > 0) THEN
-          opps(nbops) = 'div'
-        ELSE IF (INDEX(opp_str(1:leng),'/I') > 0) THEN
-          opps(nbops) = 'divi'
-        ELSE IF (INDEX(opp_str(1:leng),'^') > 0) THEN
-          opps(nbops) = 'power'
-        ELSE
-          CALL ipslerr(3,'decoop', &
- &          'Unknown operation',opp_str(1:leng),' ')
-        ENDIF
-      ENDIF
-!-----
-      leng = LEN_TRIM(scal_str)
-      ppos = INDEX(scal_str,'.')
-      epos = INDEX(scal_str,'e')
-      IF (epos == 0) epos = INDEX(scal_str,'E')
-!-----
-!---- Try to catch a few errors
-!-----
-      IF (INDEX(ops,scal_str) > 0) THEN
-        CALL ipslerr(3,'decoop', &
- &        'Strange scalar you have here ',scal_str,pstr)
-      ENDIF
-      IF (epos > 0) THEN
-        WRITE(tl,'(I3.3)') leng
-        WRITE(dl,'(I3.3)') epos-ppos-1
-        fmt='(e'//tl//'.'//dl//')'
-        READ(scal_str,fmt) scal(nbops)
-      ELSE IF (ppos > 0) THEN
-        WRITE(tl,'(I3.3)') leng
-        WRITE(dl,'(I3.3)') leng-ppos
-        fmt='(f'//tl//'.'//dl//')'
-        READ(scal_str,fmt) scal(nbops)
-      ELSE
-        WRITE(tl,'(I3.3)') leng
-        fmt = '(I'//tl//')'
-        READ(scal_str,fmt) int_tmp
-        scal(nbops) = REAL(int_tmp)
-      ENDIF
-    ENDIF
-    IF (check) WRITE(*,*) 'decoop : Finished interpretation'
-    CALL findsep(str,nbsep,f_char,f_pos,s_char,s_pos)
-  ENDDO
-!--------------------
-END SUBROUTINE decoop
-!===
-SUBROUTINE findsep (str,nbsep,f_char,f_pos,s_char,s_pos)
-!---------------------------------------------------------------------
-!- Subroutine finds all separators in a given string
-!- It returns the following information about str :
-!-   f_char : The first separation character
-!-            (1 for before and 2 for after)
-!-   f_pos  : The position of the first separator
-!-   s_char : The second separation character
-!-            (1 for before and 2 for after)
-!-   s_pos  : The position of the second separator
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*),INTENT(INOUT) :: str
-  INTEGER :: nbsep
-  CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char
-  INTEGER,DIMENSION(2) :: f_pos,s_pos
-!-
-  CHARACTER(LEN=10) :: str_tmp
-  LOGICAL :: f_found,s_found
-  INTEGER :: ind,xpos,leng,i
-!-
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
-  IF (check) WRITE(*,*) 'findsep : call cleanstr: ',TRIM(str)
-!-
-  CALL cleanstr(str)
-!-
-  IF (check) WRITE(*,*) 'findsep : out of cleanstr: ',TRIM(str)
-!-
-  xpos = INDEX(str,'X')
-  leng = LEN_TRIM(str)
-!-
-  f_pos(1:2) = (/ 0,leng+1 /)
-  f_char(1:2) = (/ '?','?' /)
-  s_pos(1:2) = (/ 0,leng+1 /)
-  s_char(1:2) = (/ '?','?' /)
-!-
-  nbsep = 0
-!-
-  f_found = .FALSE.
-  s_found = .FALSE.
-  IF (xpos > 1) THEN
-    DO i=xpos-1,1,-1
-      ind = INDEX(seps,str(i:i))
-      IF (ind > 0) THEN
-        IF (.NOT.f_found) THEN
-          f_char(1) = str(i:i)
-          f_pos(1) = i
-          nbsep = nbsep+1
-          f_found = .TRUE.
-        ELSE IF (.NOT.s_found) THEN
-          s_char(1) = str(i:i)
-          s_pos(1) = i
-          nbsep = nbsep+1
-          s_found = .TRUE.
-        ENDIF
-      ENDIF
-    ENDDO
-  ENDIF
-!-
-  f_found = .FALSE.
-  s_found = .FALSE.
-  IF (xpos < leng) THEN
-    DO i=xpos+1,leng
-      ind = INDEX(seps,str(i:i))
-      IF (ind > 0) THEN
-        IF (.NOT.f_found) THEN
-          f_char(2) = str(i:i)
-          f_pos(2) = i
-          nbsep = nbsep+1
-          f_found = .TRUE.
-        ELSE IF (.NOT.s_found) THEN
-          s_char(2) = str(i:i)
-          s_pos(2) = i
-          nbsep = nbsep+1
-          s_found = .TRUE.
-        ENDIF
-      ENDIF
-    ENDDO
-  ENDIF
-!-
-  IF (nbsep > 4) THEN
-    WRITE(str_tmp,'("number :",I3)') nbsep
-    CALL ipslerr(3,'findsep', &
- &    'How can I find that many separators',str_tmp,TRIM(str))
-  ENDIF
-!-
-  IF (check) WRITE(*,*) 'Finished findsep : ',nbsep,leng
-!---------------------
-END SUBROUTINE findsep
-!===
-SUBROUTINE cleanstr(str)
-!---------------------------------------------------------------------
-!- We clean up the string by taking out the extra () and puting
-!- everything in lower case except for the X describing the variable
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*),INTENT(INOUT) :: str
-!-
-  INTEGER :: ind,leng,ic,it
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
-  leng = LEN_TRIM(str)
-  CALL strlowercase(str)
-!-
-  ind = INDEX(str,'x')
-  IF (check) THEN
-    WRITE (*,*) 'cleanstr 1.0 : ind = ',ind, &
-&               ' str = ',str(1:leng),'---'
-  ENDIF
-!-
-! If the character before the x is not a letter then we can assume
-! that it is the variable and promote it to a capital letter
-!-
-  DO WHILE (ind > 0)
-    ic = 0
-    IF (ind > 1) ic = IACHAR(str(ind-1:ind-1))
-    IF (ic < 97 .OR. ic > 122) THEN
-      str(ind:ind) = 'X'
-    ENDIF
-    it = INDEX(str(ind+1:leng),'x')
-    IF (it > 0) THEN
-      ind = ind+it
-    ELSE
-      ind = it
-    ENDIF
-  ENDDO
-!-
-  IF (check) WRITE (*,*) 'cleanstr 2.0 : str = ',str(1:leng),'---'
-!-
-  IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN
-    str = str(2:leng-1)
-  ENDIF
-!-
-  IF (check) WRITE (*,*) 'cleanstr 3.0 : str = ',str(1:leng),'---'
-!-
-  leng = LEN_TRIM(str)
-  ind = INDEX(str,'((X))')
-  IF (ind > 0) THEN
-    str=str(1:ind-1)//'(X)'//str(ind+5:leng)//'  '
-  ENDIF
-!-
-  IF (check) WRITE (*,*) 'cleanstr 4.0 : str = ',str(1:leng),'---'
-!-
-  leng = LEN_TRIM(str)
-  ind = INDEX(str,'(X)')
-  IF (ind > 0 .AND. ind+3 < leng) THEN
-    IF (      (INDEX(seps,str(ind-1:ind-1)) > 0) &
- &      .AND. (INDEX(seps,str(ind+3:ind+3)) > 0) ) THEN
-      str=str(1:ind-1)//'X'//str(ind+3:leng)//'  '
-    ENDIF
-  ENDIF
-!-
-  IF (check) WRITE (*,*) 'cleanstr 5.0 : str = ',str(1:leng),'---'
-!-
-  leng = LEN_TRIM(str)
-  ind = INDEX(str(1:leng),' ')
-  DO WHILE (ind > 0)
-    str=str(1:ind-1)//str(ind+1:leng)//' '
-    leng = LEN_TRIM(str)
-    ind = INDEX(str(1:leng),' ')
-  ENDDO
-!-
-  IF (check) WRITE (*,*) 'cleanstr 6.0 : str = ',str(1:leng),'---'
-!----------------------
-END SUBROUTINE cleanstr
-!===
-!===
-SUBROUTINE mathop_r11 &
- &  (fun,nb,work_in,miss_val,nb_index,nindex,scal,nb_max,work_out)
-!---------------------------------------------------------------------
-!- This subroutines gives an interface to the various operation
-!- which are allowed. The interface is general enough to allow its use
-!- for other cases.
-!-
-!- INPUT
-!-
-!- fun      : function to be applied to the vector of data
-!- nb       : Length of input vector
-!- work_in  : Input vector of data (REAL)
-!- miss_val : The value of the missing data flag (it has to be a
-!-            maximum value, in f90 : huge( a real ))
-!- nb_index : Length of index vector
-!- nindex   : Vector of indices
-!- scal     : A scalar value for vector/scalar operations
-!- nb_max   : maximum length of output vector
-!-
-!- OUTPUT
-!-
-!- nb_max   : Actual length of output variable
-!- work_out : Output vector after the operation was applied
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=7) :: fun
-  INTEGER :: nb,nb_max,nb_index
-  INTEGER :: nindex(nb_index)
-  REAL :: work_in(nb),scal,miss_val
-  REAL :: work_out(nb_max)
-!-
-  INTEGER :: ierr
-!-
-  INTRINSIC SIN,COS,TAN,ASIN,ACOS,ATAN,EXP,LOG,SQRT,ABS
-!---------------------------------------------------------------------
-  ierr = 0
-!-
-  IF (scal >= miss_val-1.) THEN
-    IF (INDEX(indexfu,fun(1:LEN_TRIM(fun))) == 0) THEN
-      SELECT CASE (fun)
-      CASE('sin')
-        ierr = ma_sin_r11(nb,work_in,nb_max,work_out)
-      CASE('cos')
-        ierr = ma_cos_r11(nb,work_in,nb_max,work_out)
-      CASE('tan')
-        ierr = ma_tan_r11(nb,work_in,nb_max,work_out)
-      CASE('asin')
-        ierr = ma_asin_r11(nb,work_in,nb_max,work_out)
-      CASE('acos')
-        ierr = ma_acos_r11(nb,work_in,nb_max,work_out)
-      CASE('atan')
-        ierr = ma_atan_r11(nb,work_in,nb_max,work_out)
-      CASE('exp')
-        ierr = ma_exp_r11(nb,work_in,nb_max,work_out)
-      CASE('log')
-        ierr = ma_log_r11(nb,work_in,nb_max,work_out)
-      CASE('sqrt')
-        ierr = ma_sqrt_r11(nb,work_in,nb_max,work_out)
-      CASE('chs')
-        ierr = ma_chs_r11(nb,work_in,nb_max,work_out)
-      CASE('abs')
-        ierr = ma_abs_r11(nb,work_in,nb_max,work_out)
-      CASE('cels')
-        ierr = ma_cels_r11(nb,work_in,nb_max,work_out)
-      CASE('kelv')
-        ierr = ma_kelv_r11(nb,work_in,nb_max,work_out)
-      CASE('deg')
-        ierr = ma_deg_r11(nb,work_in,nb_max,work_out)
-      CASE('rad')
-        ierr = ma_rad_r11(nb,work_in,nb_max,work_out)
-      CASE('ident')
-        ierr = ma_ident_r11(nb,work_in,nb_max,work_out)
-      CASE DEFAULT
-        CALL ipslerr(3,"mathop", &
- &        'scalar variable undefined and no indexing', &
- &        'but still unknown function',fun)
-      END SELECT
-      IF (ierr > 0) THEN
-        CALL ipslerr(3,"mathop", &
- &        'Error while executing a simple function',fun,' ')
-      ENDIF
-    ELSE
-      SELECT CASE (fun)
-      CASE('gather')
-        ierr = ma_fugath_r11(nb,work_in,nb_index,nindex, &
-&                            miss_val,nb_max,work_out)
-      CASE('scatter')
-        IF (nb_index > nb) THEN
-          work_out(1:nb_max) = miss_val
-          ierr=1
-        ELSE
-          ierr = ma_fuscat_r11(nb,work_in,nb_index,nindex, &
-&                              miss_val,nb_max,work_out)
-        ENDIF
-      CASE('coll')
-        ierr = ma_fucoll_r11(nb,work_in,nb_index,nindex, &
-&                            miss_val,nb_max,work_out)
-      CASE('fill')
-        ierr = ma_fufill_r11(nb,work_in,nb_index,nindex, &
-&                            miss_val,nb_max,work_out)
-      CASE('undef')
-        ierr = ma_fuundef_r11(nb,work_in,nb_index,nindex, &
-&                            miss_val,nb_max,work_out)
-      CASE('only')
-        ierr = ma_fuonly_r11(nb,work_in,nb_index,nindex, &
-&                            miss_val,nb_max,work_out)
-      CASE DEFAULT
-        CALL ipslerr(3,"mathop", &
- &        'scalar variable undefined and indexing',&
- &        'was requested but with unknown function',fun)
-      END SELECT
-      IF (ierr > 0) THEN
-        CALL ipslerr(3,"mathop_r11", &
- &        'Error while executing an indexing function',fun,' ')
-      ENDIF
-    ENDIF
-  ELSE
-    SELECT CASE (fun)
-    CASE('fumin')
-      ierr = ma_fumin_r11(nb,work_in,scal,nb_max,work_out)
-    CASE('fumax')
-      ierr = ma_fumax_r11(nb,work_in,scal,nb_max,work_out)
-    CASE('add')
-      ierr = ma_add_r11(nb,work_in,scal,nb_max,work_out)
-    CASE('subi')
-      ierr = ma_subi_r11(nb,work_in,scal,nb_max,work_out)
-    CASE('sub')
-      ierr = ma_sub_r11(nb,work_in,scal,nb_max,work_out)
-    CASE('mult')
-      ierr = ma_mult_r11(nb,work_in,scal,nb_max,work_out)
-    CASE('div')
-      ierr = ma_div_r11(nb,work_in,scal,nb_max,work_out)
-    CASE('divi')
-      ierr = ma_divi_r11(nb,work_in,scal,nb_max,work_out)
-    CASE('power')
-      ierr = ma_power_r11(nb,work_in,scal,nb_max,work_out)
-    CASE DEFAULT
-      CALL ipslerr(3,"mathop", &
- &      'Unknown operation with a scalar',fun,' ')
-    END SELECT
-    IF (ierr > 0) THEN
-      CALL ipslerr(3,"mathop", &
- &      'Error while executing a scalar function',fun,' ')
-    ENDIF
-  ENDIF
-!------------------------
-END SUBROUTINE mathop_r11
-!-
-!=== FUNCTIONS (only one argument)
-!-
-INTEGER FUNCTION ma_sin_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = SIN(x(i))
-  ENDDO
-!-
-  nbo = nb
-  ma_sin_r11 = 0
-!----------------------
-END FUNCTION ma_sin_r11
-!===
-INTEGER FUNCTION ma_cos_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = COS(x(i))
-  ENDDO
-!-
-  nbo = nb
-  ma_cos_r11 = 0
-!----------------------
-END FUNCTION ma_cos_r11
-!===
-INTEGER FUNCTION ma_tan_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = TAN(x(i))
-  ENDDO
-!-
-  nbo = nb
-  ma_tan_r11 = 0
-!----------------------
-END FUNCTION ma_tan_r11
-!===
-INTEGER FUNCTION ma_asin_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = ASIN(x(i))
-  ENDDO
-!-
-  nbo = nb
-  ma_asin_r11 = 0
-!-----------------------
-END FUNCTION ma_asin_r11
-!===
-INTEGER FUNCTION ma_acos_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = ACOS(x(i))
-  ENDDO
-!-
-  nbo = nb
-  ma_acos_r11 = 0
-!-----------------------
-END FUNCTION ma_acos_r11
-!===
-INTEGER FUNCTION ma_atan_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = ATAN(x(i))
-  ENDDO
-!-
-  nbo = nb
-  ma_atan_r11 = 0
-!-----------------------
-END FUNCTION ma_atan_r11
-!===
-INTEGER FUNCTION ma_exp_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = EXP(x(i))
-  ENDDO
-!-
-  nbo = nb
-  ma_exp_r11 = 0
-!----------------------
-END FUNCTION ma_exp_r11
-!===
-INTEGER FUNCTION ma_log_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = log(x(i))
-  ENDDO
-!-
-  nbo = nb
-  ma_log_r11 = 0
-!----------------------
-END FUNCTION ma_log_r11
-!===
-INTEGER FUNCTION ma_sqrt_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = SQRT(x(i))
-  ENDDO
-!-
-  nbo = nb
-  ma_sqrt_r11 = 0
-!-----------------------
-END FUNCTION ma_sqrt_r11
-!===
-INTEGER FUNCTION ma_abs_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = ABS(x(i))
-  ENDDO
-!-
-  nbo = nb
-  ma_abs_r11 = 0
-!----------------------
-END FUNCTION ma_abs_r11
-!===
-INTEGER FUNCTION ma_chs_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = x(i)*(-1.)
-  ENDDO
-!-
-  nbo = nb
-  ma_chs_r11 = 0
-!----------------------
-END FUNCTION ma_chs_r11
-!===
-INTEGER FUNCTION ma_cels_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = x(i)-273.15
-  ENDDO
-!-
-  nbo = nb
-  ma_cels_r11 = 0
-!-----------------------
-END FUNCTION ma_cels_r11
-!===
-INTEGER FUNCTION ma_kelv_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = x(i)+273.15
-  ENDDO
-!-
-  nbo = nb
-  ma_kelv_r11 = 0
-!-----------------------
-END FUNCTION ma_kelv_r11
-!===
-INTEGER FUNCTION ma_deg_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = x(i)*57.29577951
-  ENDDO
-!-
-  nbo = nb
-  ma_deg_r11 = 0
-!-----------------------
-END FUNCTION ma_deg_r11
-!===
-INTEGER FUNCTION ma_rad_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = x(i)*0.01745329252
-  ENDDO
-!-
-  nbo = nb
-  ma_rad_r11 = 0
-!----------------------
-END FUNCTION ma_rad_r11
-!===
-INTEGER FUNCTION ma_ident_r11(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,i
-  REAL :: x(nb),y(nbo)
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = x(i)
-  ENDDO
-!-
-  nbo = nb
-  ma_ident_r11 = 0
-!------------------------
-END FUNCTION ma_ident_r11
-!-
-!=== OPERATIONS (two argument)
-!-
-INTEGER FUNCTION ma_add_r11(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo
-  REAL :: x(nb),s,y(nbo)
-!-
-  INTEGER :: i
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = x(i)+s
-  ENDDO
-!-
-  nbo = nb
-  ma_add_r11 = 0
-!-----------------------
-  END FUNCTION ma_add_r11
-!===
-INTEGER FUNCTION ma_sub_r11(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo
-  REAL :: x(nb),s,y(nbo)
-!-
-  INTEGER :: i
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = x(i)-s
-  ENDDO
-!-
-  nbo = nb
-  ma_sub_r11 = 0
-!----------------------
-END FUNCTION ma_sub_r11
-!===
-INTEGER FUNCTION ma_subi_r11(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo
-  REAL :: x(nb),s,y(nbo)
-!-
-  INTEGER :: i
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) =  s-x(i)
-  ENDDO
-!-
-  nbo = nb
-  ma_subi_r11 = 0
-!-----------------------
-END FUNCTION ma_subi_r11
-!===
-INTEGER FUNCTION ma_mult_r11(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo
-  REAL :: x(nb),s,y(nbo)
-!-
-  INTEGER :: i
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = x(i)*s
-  ENDDO
-!-
-  nbo = nb
-  ma_mult_r11 = 0
-!-----------------------
-END FUNCTION ma_mult_r11
-!===
-INTEGER FUNCTION ma_div_r11(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo
-  REAL :: x(nb),s,y(nbo)
-!-
-  INTEGER :: i
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = x(i)/s
-  ENDDO
-!-
-  nbo = nb
-  ma_div_r11 = 0
-!-----------------------
-  END FUNCTION ma_div_r11
-!===
-INTEGER FUNCTION ma_divi_r11(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo
-  REAL :: x(nb),s,y(nbo)
-!-
-  INTEGER :: i
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = s/x(i)
-  ENDDO
-!-
-  nbo = nb
-  ma_divi_r11 = 0
-!-----------------------
-END FUNCTION ma_divi_r11
-!===
-INTEGER FUNCTION ma_power_r11(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo
-  REAL :: x(nb),s,y(nbo)
-!-
-  INTEGER :: i
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = x(i)**s
-  ENDDO
-!-
-  nbo = nb
-  ma_power_r11 = 0
-!-----------------------
-END FUNCTION ma_power_r11
-!===
-INTEGER FUNCTION ma_fumin_r11(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo
-  REAL :: x(nb),s,y(nbo)
-!-
-  INTEGER :: i
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = MIN(x(i),s)
-  ENDDO
-!-
-  nbo = nb
-  ma_fumin_r11 = 0
-!------------------------
-END FUNCTION ma_fumin_r11
-!===
-INTEGER FUNCTION ma_fumax_r11(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo
-  REAL :: x(nb),s,y(nbo)
-!-
-  INTEGER :: i
-!---------------------------------------------------------------------
-  DO i=1,nb
-    y(i) = MAX(x(i),s)
-  ENDDO
-!-
-  nbo = nb
-  ma_fumax_r11 = 0
-!------------------------
-END FUNCTION ma_fumax_r11
-!===
-INTEGER FUNCTION ma_fuscat_r11(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb),miss_val,y(nbo)
-!-
-  INTEGER :: i,ii,ipos
-!---------------------------------------------------------------------
-  ma_fuscat_r11 = 0
-!-
-  y(1:nbo) = miss_val
-!-
-  IF (nbi <= nb) THEN
-    ipos = 0
-    DO i=1,nbi
-      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
-        ipos = ipos+1
-        y(ind(i)) = x(ipos)
-      ELSE
-        IF (ind(i) > nbo) ma_fuscat_r11  = ma_fuscat_r11+1
-      ENDIF
-    ENDDO
-!-- Repeat the data if needed
-    IF (MINVAL(ind) < 0) THEN
-      DO i=1,nbi
-        IF (ind(i) <= 0) THEN
-          DO ii=1,ABS(ind(i))-1
-            IF (ind(i+1)+ii <= nbo) THEN
-              y(ind(i+1)+ii) = y(ind(i+1))
-            ELSE
-              ma_fuscat_r11  = ma_fuscat_r11+1
-            ENDIF
-          ENDDO
-        ENDIF
-      ENDDO
-    ENDIF
-  ELSE
-    ma_fuscat_r11  = 1
-  ENDIF
-!-------------------------
-END FUNCTION ma_fuscat_r11
-!===
-INTEGER FUNCTION ma_fugath_r11(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb),miss_val,y(nbo)
-!-
-  INTEGER :: i,ipos
-!---------------------------------------------------------------------
-  IF (nbi <= nbo) THEN
-    ma_fugath_r11 = 0
-    y(1:nbo) = miss_val
-    ipos = 0
-    DO i=1,nbi
-      IF (ipos+1 <= nbo) THEN
-        IF (ind(i) > 0) THEN
-          ipos = ipos+1
-          y(ipos) = x(ind(i))
-        ENDIF
-      ELSE
-        IF (ipos+1 > nbo) ma_fugath_r11  = ma_fugath_r11+1
-      ENDIF
-    ENDDO
-  ELSE
-    ma_fugath_r11 = 1
-  ENDIF
-!-
-  nbo = ipos
-!-------------------------
-END FUNCTION ma_fugath_r11
-!===
-INTEGER FUNCTION ma_fufill_r11(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb),miss_val,y(nbo)
-!-
-  INTEGER :: i,ii,ipos
-!---------------------------------------------------------------------
-  ma_fufill_r11 = 0
-!-
-  IF (nbi <= nb) THEN
-    ipos = 0
-    DO i=1,nbi
-      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
-        ipos = ipos+1
-        y(ind(i)) = x(ipos)
-      ELSE
-        IF (ind(i) > nbo) ma_fufill_r11  = ma_fufill_r11+1
-      ENDIF
-    ENDDO
-!-- Repeat the data if needed
-    IF (MINVAL(ind) < 0) THEN
-      DO i=1,nbi
-        IF (ind(i) <= 0) THEN
-          DO ii=1,ABS(ind(i))-1
-            IF (ind(i+1)+ii <= nbo) THEN
-              y(ind(i+1)+ii) = y(ind(i+1))
-            ELSE
-              ma_fufill_r11  = ma_fufill_r11+1
-            ENDIF
-          ENDDO
-        ENDIF
-      ENDDO
-    ENDIF
-  ELSE
-    ma_fufill_r11  = 1
-  ENDIF
-!-------------------------
-END FUNCTION ma_fufill_r11
-!===
-INTEGER FUNCTION ma_fucoll_r11(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb),miss_val,y(nbo)
-!-
-  INTEGER :: i,ipos
-!---------------------------------------------------------------------
-  IF (nbi <= nbo) THEN
-    ma_fucoll_r11 = 0
-    ipos = 0
-    DO i=1,nbi
-      IF (ipos+1 <= nbo) THEN
-        IF (ind(i) > 0) THEN
-          ipos = ipos+1
-          y(ipos) = x(ind(i))
-        ENDIF
-      ELSE
-        IF (ipos+1 > nbo) ma_fucoll_r11  = ma_fucoll_r11+1
-      ENDIF
-    ENDDO
-  ELSE
-    ma_fucoll_r11 = 1
-  ENDIF
-!-
-  nbo = ipos
-!-------------------------
-END FUNCTION ma_fucoll_r11
-!===
-INTEGER FUNCTION ma_fuundef_r11(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb),miss_val,y(nbo)
-!-
-  INTEGER :: i
-!---------------------------------------------------------------------
-  IF (nbi <= nbo .AND. nbo == nb) THEN
-    ma_fuundef_r11 = 0
-    DO i=1,nbo
-      y(i) = x(i)
-    ENDDO
-    DO i=1,nbi
-      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
-        y(ind(i)) =  miss_val
-      ELSE
-        IF (ind(i) > nbo) ma_fuundef_r11  = ma_fuundef_r11+1
-      ENDIF
-    ENDDO
-  ELSE
-    ma_fuundef_r11 = 1
-  ENDIF
-!--------------------------
-END FUNCTION ma_fuundef_r11
-!===
-INTEGER FUNCTION ma_fuonly_r11(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb,nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb),miss_val,y(nbo)
-!-
-  INTEGER :: i
-!---------------------------------------------------------------------
-  IF (     (nbi <= nbo).AND.(nbo == nb) &
- &    .AND.ALL(ind(1:nbi) <= nbo) ) THEN
-    ma_fuonly_r11 = 0
-    y(1:nbo) = miss_val
-    DO i=1,nbi
-      IF (ind(i) > 0) THEN
-        y(ind(i)) =  x(ind(i))
-      ENDIF
-    ENDDO
-  ELSE
-    ma_fuonly_r11 = 1
-  ENDIF
-!-------------------------
-END FUNCTION ma_fuonly_r11
-!===
-!===
-SUBROUTINE mathop_r21 &
- &  (fun,nb,work_in,miss_val,nb_index,nindex,scal,nb_max,work_out)
-!---------------------------------------------------------------------
-!- This subroutines gives an interface to the various operations
-!- which are allowed. The interface is general enough to allow its use
-!- for other cases.
-!-
-!- INPUT
-!-
-!- fun      : function to be applied to the vector of data
-!- nb       : Length of input vector
-!- work_in  : Input vector of data (REAL)
-!- miss_val : The value of the missing data flag (it has to be a
-!-            maximum value, in f90 : huge( a real ))
-!- nb_index : Length of index vector
-!- nindex   : Vector of indices
-!- scal     : A scalar value for vector/scalar operations
-!- nb_max   : maximum length of output vector
-!-
-!- OUTPUT
-!-
-!- nb_max   : Actual length of output variable
-!- work_out : Output vector after the operation was applied
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=7) :: fun
-  INTEGER :: nb(2),nb_max,nb_index
-  INTEGER :: nindex(nb_index)
-  REAL :: work_in(nb(1),nb(2)),scal,miss_val
-  REAL :: work_out(nb_max)
-!-
-  INTEGER :: ierr
-!-
-  INTRINSIC SIN,COS,TAN,ASIN,ACOS,ATAN,EXP,LOG,SQRT,ABS
-!---------------------------------------------------------------------
-  ierr = 0
-!-
-  IF (scal >= miss_val-1.) THEN
-    IF (INDEX(indexfu,fun(1:LEN_TRIM(fun))) == 0) THEN
-      SELECT CASE (fun)
-      CASE('sin')
-        ierr = ma_sin_r21(nb,work_in,nb_max,work_out)
-      CASE('cos')
-        ierr = ma_cos_r21(nb,work_in,nb_max,work_out)
-      CASE('tan')
-        ierr = ma_tan_r21(nb,work_in,nb_max,work_out)
-      CASE('asin')
-        ierr = ma_asin_r21(nb,work_in,nb_max,work_out)
-      CASE('acos')
-        ierr = ma_acos_r21(nb,work_in,nb_max,work_out)
-      CASE('atan')
-        ierr = ma_atan_r21(nb,work_in,nb_max,work_out)
-      CASE('exp')
-        ierr = ma_exp_r21(nb,work_in,nb_max,work_out)
-      CASE('log')
-        ierr = ma_log_r21(nb,work_in,nb_max,work_out)
-      CASE('sqrt')
-        ierr = ma_sqrt_r21(nb,work_in,nb_max,work_out)
-      CASE('chs')
-        ierr = ma_chs_r21(nb,work_in,nb_max,work_out)
-      CASE('abs')
-        ierr = ma_abs_r21(nb,work_in,nb_max,work_out)
-      CASE('cels')
-        ierr = ma_cels_r21(nb,work_in,nb_max,work_out)
-      CASE('kelv')
-        ierr = ma_kelv_r21(nb,work_in,nb_max,work_out)
-      CASE('deg')
-        ierr = ma_deg_r21(nb,work_in,nb_max,work_out)
-      CASE('rad')
-        ierr = ma_rad_r21(nb,work_in,nb_max,work_out)
-      CASE('ident')
-        ierr = ma_ident_r21(nb,work_in,nb_max,work_out)
-      CASE DEFAULT
-        CALL ipslerr(3,"mathop", &
- &        'scalar variable undefined and no indexing', &
- &        'but still unknown function',fun)
-      END SELECT
-      IF (ierr > 0) THEN
-        CALL ipslerr(3,"mathop", &
- &        'Error while executing a simple function',fun,' ')
-      ENDIF
-    ELSE
-      SELECT CASE (fun)
-      CASE('gather')
-        ierr = ma_fugath_r21(nb,work_in,nb_index,nindex, &
- &                            miss_val,nb_max,work_out)
-      CASE('scatter')
-        IF (nb_index > (nb(1)*nb(2)) ) THEN
-          work_out(1:nb_max) = miss_val
-          ierr=1
-        ELSE
-          ierr = ma_fuscat_r21(nb,work_in,nb_index,nindex, &
- &                             miss_val,nb_max,work_out)
-        ENDIF
-      CASE('coll')
-        ierr = ma_fucoll_r21(nb,work_in,nb_index,nindex, &
- &                           miss_val,nb_max,work_out)
-      CASE('fill')
-        ierr = ma_fufill_r21(nb,work_in,nb_index,nindex, &
- &                           miss_val,nb_max,work_out)
-      CASE('undef')
-        ierr = ma_fuundef_r21(nb,work_in,nb_index,nindex, &
- &                           miss_val,nb_max,work_out)
-      CASE('only')
-        ierr = ma_fuonly_r21(nb,work_in,nb_index,nindex, &
- &                           miss_val,nb_max,work_out)
-      CASE DEFAULT
-        CALL ipslerr(3,"mathop", &
- &        'scalar variable undefined and indexing', &
- &        'was requested but with unknown function',fun)
-      END SELECT
-      IF (ierr > 0) THEN
-        CALL ipslerr(3,"mathop_r21", &
- &        'Error while executing an indexing function',fun,' ')
-      ENDIF
-    ENDIF
-  ELSE
-    SELECT CASE (fun)
-    CASE('fumin')
-      ierr = ma_fumin_r21(nb,work_in,scal,nb_max,work_out)
-    CASE('fumax')
-      ierr = ma_fumax_r21(nb,work_in,scal,nb_max,work_out)
-    CASE('add')
-      ierr = ma_add_r21(nb,work_in,scal,nb_max,work_out)
-    CASE('subi')
-      ierr = ma_subi_r21(nb,work_in,scal,nb_max,work_out)
-    CASE('sub')
-      ierr = ma_sub_r21(nb,work_in,scal,nb_max,work_out)
-    CASE('mult')
-      ierr = ma_mult_r21(nb,work_in,scal,nb_max,work_out)
-    CASE('div')
-      ierr = ma_div_r21(nb,work_in,scal,nb_max,work_out)
-    CASE('divi')
-      ierr = ma_divi_r21(nb,work_in,scal,nb_max,work_out)
-    CASE('power')
-      ierr = ma_power_r21(nb,work_in,scal,nb_max,work_out)
-    CASE DEFAULT
-      CALL ipslerr(3,"mathop", &
- &      'Unknown operation with a scalar',fun,' ')
-    END SELECT
-    IF (ierr > 0) THEN
-      CALL ipslerr(3,"mathop", &
- &      'Error while executing a scalar function',fun,' ')
-    ENDIF
-  ENDIF
-!------------------------
-END SUBROUTINE mathop_r21
-!-
-!=== FUNCTIONS (only one argument)
-!-
-INTEGER FUNCTION ma_sin_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = SIN(x(i,j))
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_sin_r21 = 0
-!----------------------
-END FUNCTION ma_sin_r21
-!===
-INTEGER FUNCTION ma_cos_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = COS(x(i,j))
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_cos_r21 = 0
-!----------------------
-END FUNCTION ma_cos_r21
-!===
-INTEGER FUNCTION ma_tan_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = TAN(x(i,j))
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_tan_r21 = 0
-!----------------------
-END FUNCTION ma_tan_r21
-!===
-  INTEGER FUNCTION ma_asin_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = ASIN(x(i,j))
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_asin_r21 = 0
-!-----------------------
-END FUNCTION ma_asin_r21
-!===
-INTEGER FUNCTION ma_acos_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = ACOS(x(i,j))
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_acos_r21 = 0
-!-----------------------
-END FUNCTION ma_acos_r21
-!===
-INTEGER FUNCTION ma_atan_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = ATAN(x(i,j))
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_atan_r21 = 0
-!-----------------------
-END FUNCTION ma_atan_r21
-!===
-INTEGER FUNCTION ma_exp_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = EXP(x(i,j))
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_exp_r21 = 0
-!----------------------
-END FUNCTION ma_exp_r21
-!===
-INTEGER FUNCTION ma_log_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = LOG(x(i,j))
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_log_r21 = 0
-!----------------------
-END FUNCTION ma_log_r21
-!===
-INTEGER FUNCTION ma_sqrt_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = SQRT(x(i,j))
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_sqrt_r21 = 0
-!-----------------------
-END FUNCTION ma_sqrt_r21
-!===
-INTEGER FUNCTION ma_abs_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = ABS(x(i,j))
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_abs_r21 = 0
-!----------------------
-END FUNCTION ma_abs_r21
-!===
-INTEGER FUNCTION ma_chs_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = x(i,j)*(-1.)
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_chs_r21 = 0
-!----------------------
-END FUNCTION ma_chs_r21
-!===
-INTEGER FUNCTION ma_cels_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = x(i,j)-273.15
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_cels_r21 = 0
-!-----------------------
-END FUNCTION ma_cels_r21
-!===
-INTEGER FUNCTION ma_kelv_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = x(i,j)+273.15
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_kelv_r21 = 0
-!-----------------------
-END FUNCTION ma_kelv_r21
-!===
-INTEGER FUNCTION ma_deg_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = x(i,j)*57.29577951
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_deg_r21 = 0
-!----------------------
-END FUNCTION ma_deg_r21
-!===
-INTEGER FUNCTION ma_rad_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = x(i,j)*0.01745329252
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_rad_r21 = 0
-!----------------------
-END FUNCTION ma_rad_r21
-!===
-INTEGER FUNCTION ma_ident_r21(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,i,j,ij
-  REAL :: x(nb(1),nb(2)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = x(i,j)
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_ident_r21 = 0
-!------------------------
-END FUNCTION ma_ident_r21
-!-
-!=== OPERATIONS (two argument)
-!-
-INTEGER FUNCTION ma_add_r21(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo
-  REAL :: x(nb(1),nb(2)),s,y(nbo)
-!-
-  INTEGER :: i,j,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = x(i,j)+s
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_add_r21 = 0
-!----------------------
-END FUNCTION ma_add_r21
-!===
-INTEGER FUNCTION ma_sub_r21(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo
-  REAL :: x(nb(1),nb(2)),s,y(nbo)
-!-
-  INTEGER :: i,j,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = x(i,j)-s
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_sub_r21 = 0
-!----------------------
-END FUNCTION ma_sub_r21
-!===
-INTEGER FUNCTION ma_subi_r21(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo
-  REAL :: x(nb(1),nb(2)),s,y(nbo)
-!-
-  INTEGER :: i,j,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) =  s-x(i,j)
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_subi_r21 = 0
-!-----------------------
-END FUNCTION ma_subi_r21
-!===
-INTEGER FUNCTION ma_mult_r21(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo
-  REAL :: x(nb(1),nb(2)),s,y(nbo)
-!-
-  INTEGER :: i,j,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = x(i,j)*s
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_mult_r21 = 0
-!-----------------------
-END FUNCTION ma_mult_r21
-!===
-INTEGER FUNCTION ma_div_r21(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo
-  REAL :: x(nb(1),nb(2)),s,y(nbo)
-!-
-  INTEGER :: i,j,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = x(i,j)/s
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_div_r21 = 0
-!----------------------
-END FUNCTION ma_div_r21
-!===
-INTEGER FUNCTION ma_divi_r21(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo
-  REAL :: x(nb(1),nb(2)),s,y(nbo)
-!-
-  INTEGER :: i,j,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = s/x(i,j)
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_divi_r21 = 0
-!-----------------------
-END FUNCTION ma_divi_r21
-!===
-INTEGER FUNCTION ma_power_r21(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo
-  REAL :: x(nb(1),nb(2)),s,y(nbo)
-!-
-  INTEGER :: i,j,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = x(i,j) ** s
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_power_r21 = 0
-!------------------------
-END FUNCTION ma_power_r21
-!===
-INTEGER FUNCTION ma_fumin_r21(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo
-  REAL :: x(nb(1),nb(2)),s,y(nbo)
-!-
-  INTEGER :: i,j,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = MIN(x(i,j),s)
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_fumin_r21 = 0
-!------------------------
-END FUNCTION ma_fumin_r21
-!===
-INTEGER FUNCTION ma_fumax_r21(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo
-  REAL :: x(nb(1),nb(2)),s,y(nbo)
-!-
-  INTEGER :: i,j,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO j=1,nb(2)
-    DO i=1,nb(1)
-      ij = ij+1
-      y(ij) = MAX(x(i,j),s)
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)
-  ma_fumax_r21 = 0
-!------------------------
-END FUNCTION ma_fumax_r21
-!===
-INTEGER FUNCTION ma_fuscat_r21(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
-!-
-  INTEGER :: i,j,ij,ii,ipos
-!---------------------------------------------------------------------
-  ma_fuscat_r21 = 0
-!-
-  y(1:nbo) = miss_val
-!-
-  IF (nbi <= nb(1)*nb(2)) THEN
-    ipos = 0
-    DO ij=1,nbi
-       IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
-         ipos = ipos+1
-         j = ((ipos-1)/nb(1))+1
-         i = (ipos-(j-1)*nb(1))
-         y(ind(ij)) = x(i,j)
-       ELSE
-         IF (ind(ij) > nbo) ma_fuscat_r21  = ma_fuscat_r21+1
-       ENDIF
-    ENDDO
-!-- Repeat the data if needed
-    IF (MINVAL(ind) < 0) THEN
-      DO i=1,nbi
-        IF (ind(i) <= 0) THEN
-          DO ii=1,ABS(ind(i))-1
-            IF (ind(i+1)+ii <= nbo) THEN
-              y(ind(i+1)+ii) = y(ind(i+1))
-            ELSE
-              ma_fuscat_r21  = ma_fuscat_r21+1
-            ENDIF
-          ENDDO
-        ENDIF
-      ENDDO
-    ENDIF
-  ELSE
-    ma_fuscat_r21  = 1
-  ENDIF
-!-------------------------
-END FUNCTION ma_fuscat_r21
-!===
-INTEGER FUNCTION ma_fugath_r21(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
-!-
-  INTEGER :: i,j,ij,ipos
-!---------------------------------------------------------------------
-  IF (nbi <= nbo) THEN
-    ma_fugath_r21 = 0
-    y(1:nbo) = miss_val
-    ipos = 0
-    DO ij=1,nbi
-      IF (ipos+1 <= nbo) THEN
-        IF (ind(ij) > 0) THEN
-          j = ((ind(ij)-1)/nb(1))+1
-          i = (ind(ij)-(j-1)*nb(1))
-          ipos = ipos+1
-          y(ipos) = x(i,j)
-        ENDIF
-      ELSE
-        IF (ipos+1 > nbo) ma_fugath_r21  = ma_fugath_r21+1
-      ENDIF
-    ENDDO
-  ELSE
-    ma_fugath_r21 = 1
-  ENDIF
-  nbo = ipos
-!-------------------------
-END FUNCTION ma_fugath_r21
-!===
-INTEGER FUNCTION ma_fufill_r21(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
-!-
-  INTEGER :: i,j,ij,ii,ipos
-!---------------------------------------------------------------------
-  ma_fufill_r21 = 0
-!-
-  IF (nbi <= nb(1)*nb(2)) THEN
-    ipos = 0
-    DO ij=1,nbi
-      IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
-        ipos = ipos+1
-        j = ((ipos-1)/nb(1))+1
-        i = (ipos-(j-1)*nb(1))
-        y(ind(ij)) = x(i,j)
-      ELSE
-        IF (ind(ij) > nbo) ma_fufill_r21  = ma_fufill_r21+1
-      ENDIF
-    ENDDO
-!-- Repeat the data if needed
-    IF (MINVAL(ind) < 0) THEN
-      DO i=1,nbi
-        IF (ind(i) <= 0) THEN
-          DO ii=1,ABS(ind(i))-1
-            IF (ind(i+1)+ii <= nbo) THEN
-              y(ind(i+1)+ii) = y(ind(i+1))
-            ELSE
-              ma_fufill_r21  = ma_fufill_r21+1
-            ENDIF
-          ENDDO
-        ENDIF
-      ENDDO
-    ENDIF
-  ELSE
-    ma_fufill_r21  = 1
-  ENDIF
-!-------------------------
-END FUNCTION ma_fufill_r21
-!===
-INTEGER FUNCTION ma_fucoll_r21(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
-!-
-  INTEGER :: i,j,ij,ipos
-!---------------------------------------------------------------------
-  IF (nbi <= nbo) THEN
-    ma_fucoll_r21 = 0
-    ipos = 0
-    DO ij=1,nbi
-      IF (ipos+1 <= nbo) THEN
-        IF (ind(ij) > 0) THEN
-          j = ((ind(ij)-1)/nb(1))+1
-          i = (ind(ij)-(j-1)*nb(1))
-          ipos = ipos+1
-          y(ipos) = x(i,j)
-        ENDIF
-      ELSE
-        IF (ipos+1 > nbo) ma_fucoll_r21  = ma_fucoll_r21+1
-      ENDIF
-    ENDDO
-  ELSE
-    ma_fucoll_r21 = 1
-  ENDIF
-  nbo = ipos
-!-------------------------
-END FUNCTION ma_fucoll_r21
-!===
-INTEGER FUNCTION ma_fuundef_r21(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
-!-
-  INTEGER :: i,j,ij
-!---------------------------------------------------------------------
-  IF (nbi <= nbo .AND. nbo == nb(1)*nb(2)) THEN
-    ma_fuundef_r21 = 0
-    DO ij=1,nbo
-      j = ((ij-1)/nb(1))+1
-      i = (ij-(j-1)*nb(1))
-      y(ij) = x(i,j)
-    ENDDO
-    DO i=1,nbi
-      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
-        y(ind(i)) =  miss_val
-      ELSE
-        IF (ind(i) > nbo) ma_fuundef_r21 = ma_fuundef_r21+1
-      ENDIF
-    ENDDO
-  ELSE
-    ma_fuundef_r21 = 1
-  ENDIF
-!--------------------------
-END FUNCTION ma_fuundef_r21
-!===
-INTEGER FUNCTION ma_fuonly_r21(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(2),nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
-!-
-  INTEGER :: i,j,ij
-!---------------------------------------------------------------------
-  IF (     (nbi <= nbo).AND.(nbo == nb(1)*nb(2)) &
- &    .AND.ALL(ind(1:nbi) <= nbo) ) THEN
-    ma_fuonly_r21 = 0
-    y(1:nbo) = miss_val
-    DO ij=1,nbi
-      IF (ind(ij) > 0) THEN
-        j = ((ind(ij)-1)/nb(1))+1
-        i = (ind(ij)-(j-1)*nb(1))
-        y(ind(ij)) =  x(i,j)
-      ENDIF
-    ENDDO
-  ELSE
-    ma_fuonly_r21 = 1
-  ENDIF
-!-------------------------
-END FUNCTION ma_fuonly_r21
-!===
-!===
-SUBROUTINE mathop_r31 &
- &  (fun,nb,work_in,miss_val,nb_index,nindex,scal,nb_max,work_out)
-!---------------------------------------------------------------------
-!- This subroutines gives an interface to the various operations
-!- which are allowed. The interface is general enough to allow its use
-!- for other cases.
-!-
-!- INPUT
-!-
-!- fun      : function to be applied to the vector of data
-!- nb       : Length of input vector
-!- work_in  : Input vector of data (REAL)
-!- miss_val : The value of the missing data flag (it has to be a
-!-            maximum value, in f90 : huge( a real ))
-!- nb_index : Length of index vector
-!- nindex   : Vector of indices
-!- scal     : A scalar value for vector/scalar operations
-!- nb_max   : maximum length of output vector
-!-
-!- OUTPUT
-!-
-!- nb_max   : Actual length of output variable
-!- work_out : Output vector after the operation was applied
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=7) :: fun
-  INTEGER :: nb(3),nb_max,nb_index
-  INTEGER :: nindex(nb_index)
-  REAL :: work_in(nb(1),nb(2),nb(3)),scal,miss_val
-  REAL :: work_out(nb_max)
-!-
-  INTEGER :: ierr
-!-
-  INTRINSIC SIN,COS,TAN,ASIN,ACOS,ATAN,EXP,LOG,SQRT,ABS
-!---------------------------------------------------------------------
-  ierr = 0
-!-
-  IF (scal >= miss_val-1.) THEN
-    IF (INDEX(indexfu,fun(1:LEN_TRIM(fun))) == 0) THEN
-      SELECT CASE (fun)
-      CASE('sin')
-        ierr = ma_sin_r31(nb,work_in,nb_max,work_out)
-      CASE('cos')
-        ierr = ma_cos_r31(nb,work_in,nb_max,work_out)
-      CASE('tan')
-        ierr = ma_tan_r31(nb,work_in,nb_max,work_out)
-      CASE('asin')
-        ierr = ma_asin_r31(nb,work_in,nb_max,work_out)
-      CASE('acos')
-        ierr = ma_acos_r31(nb,work_in,nb_max,work_out)
-      CASE('atan')
-        ierr = ma_atan_r31(nb,work_in,nb_max,work_out)
-      CASE('exp')
-        ierr = ma_exp_r31(nb,work_in,nb_max,work_out)
-      CASE('log')
-        ierr = ma_log_r31(nb,work_in,nb_max,work_out)
-      CASE('sqrt')
-        ierr = ma_sqrt_r31(nb,work_in,nb_max,work_out)
-      CASE('chs')
-        ierr = ma_chs_r31(nb,work_in,nb_max,work_out)
-      CASE('abs')
-        ierr = ma_abs_r31(nb,work_in,nb_max,work_out)
-      CASE('cels')
-        ierr = ma_cels_r31(nb,work_in,nb_max,work_out)
-      CASE('kelv')
-        ierr = ma_kelv_r31(nb,work_in,nb_max,work_out)
-      CASE('deg')
-        ierr = ma_deg_r31(nb,work_in,nb_max,work_out)
-      CASE('rad')
-        ierr = ma_rad_r31(nb,work_in,nb_max,work_out)
-      CASE('ident')
-        ierr = ma_ident_r31(nb,work_in,nb_max,work_out)
-      CASE DEFAULT
-        CALL ipslerr(3,"mathop", &
- &        'scalar variable undefined and no indexing', &
- &        'but still unknown function',fun)
-      END SELECT
-      IF (ierr > 0) THEN
-         CALL ipslerr(3,"mathop", &
- &        'Error while executing a simple function',fun,' ')
-      ENDIF
-    ELSE
-      SELECT CASE (fun)
-      CASE('gather')
-        ierr = ma_fugath_r31(nb,work_in,nb_index,nindex, &
- &                           miss_val,nb_max,work_out)
-      CASE('scatter')
-        IF (nb_index > (nb(1)*nb(2)*nb(3))) THEN
-          work_out(1:nb_max) = miss_val
-          ierr=1
-        ELSE
-          ierr = ma_fuscat_r31(nb,work_in,nb_index,nindex, &
- &                             miss_val,nb_max,work_out)
-        ENDIF
-      CASE('coll')
-        ierr = ma_fucoll_r31(nb,work_in,nb_index,nindex, &
- &                           miss_val,nb_max,work_out)
-      CASE('fill')
-        ierr = ma_fufill_r31(nb,work_in,nb_index,nindex, &
- &                           miss_val,nb_max,work_out)
-      CASE('undef')
-        ierr = ma_fuundef_r31(nb,work_in,nb_index,nindex, &
- &                           miss_val,nb_max,work_out)
-      CASE('only')
-        ierr = ma_fuonly_r31(nb,work_in,nb_index,nindex, &
- &                           miss_val,nb_max,work_out)
-      CASE DEFAULT
-        CALL ipslerr(3,"mathop", &
- &        'scalar variable undefined and indexing', &
- &        'was requested but with unknown function',fun)
-      END SELECT
-      IF (ierr > 0) THEN
-        CALL ipslerr(3,"mathop_r31", &
- &        'Error while executing an indexing function',fun,' ')
-      ENDIF
-    ENDIF
-  ELSE
-    SELECT CASE (fun)
-    CASE('fumin')
-      ierr = ma_fumin_r31(nb,work_in,scal,nb_max,work_out)
-    CASE('fumax')
-      ierr = ma_fumax_r31(nb,work_in,scal,nb_max,work_out)
-    CASE('add')
-      ierr = ma_add_r31(nb,work_in,scal,nb_max,work_out)
-    CASE('subi')
-      ierr = ma_subi_r31(nb,work_in,scal,nb_max,work_out)
-    CASE('sub')
-      ierr = ma_sub_r31(nb,work_in,scal,nb_max,work_out)
-    CASE('mult')
-      ierr = ma_mult_r31(nb,work_in,scal,nb_max,work_out)
-    CASE('div')
-      ierr = ma_div_r31(nb,work_in,scal,nb_max,work_out)
-    CASE('divi')
-      ierr = ma_divi_r31(nb,work_in,scal,nb_max,work_out)
-    CASE('power')
-      ierr = ma_power_r31(nb,work_in,scal,nb_max,work_out)
-    CASE DEFAULT
-      CALL ipslerr(3,"mathop", &
- &      'Unknown operation with a scalar',fun,' ')
-    END SELECT
-    IF (ierr > 0) THEN
-      CALL ipslerr(3,"mathop", &
- &      'Error while executing a scalar function',fun,' ')
-    ENDIF
-  ENDIF
-!------------------------
-END SUBROUTINE mathop_r31
-!-
-!=== FUNCTIONS (only one argument)
-!-
-INTEGER FUNCTION ma_sin_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = SIN(x(i,j,k))
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_sin_r31 = 0
-!----------------------
-END FUNCTION ma_sin_r31
-!===
-INTEGER FUNCTION ma_cos_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = COS(x(i,j,k))
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_cos_r31 = 0
-!----------------------
-END FUNCTION ma_cos_r31
-!===
-INTEGER FUNCTION ma_tan_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = TAN(x(i,j,k))
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_tan_r31 = 0
-!----------------------
-END FUNCTION ma_tan_r31
-!===
-INTEGER FUNCTION ma_asin_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = ASIN(x(i,j,k))
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_asin_r31 = 0
-!-----------------------
-END FUNCTION ma_asin_r31
-!===
-INTEGER FUNCTION ma_acos_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = ACOS(x(i,j,k))
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_acos_r31 = 0
-!-----------------------
-END FUNCTION ma_acos_r31
-!===
-INTEGER FUNCTION ma_atan_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = ATAN(x(i,j,k))
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_atan_r31 = 0
-!-----------------------
-  END FUNCTION ma_atan_r31
-!===
-INTEGER FUNCTION ma_exp_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = EXP(x(i,j,k))
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_exp_r31 = 0
-!----------------------
-END FUNCTION ma_exp_r31
-!===
-INTEGER FUNCTION ma_log_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = LOG(x(i,j,k))
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_log_r31 = 0
-!----------------------
-END FUNCTION ma_log_r31
-!===
-INTEGER FUNCTION ma_sqrt_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = SQRT(x(i,j,k))
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_sqrt_r31 = 0
-!-----------------------
-END FUNCTION ma_sqrt_r31
-!===
-INTEGER FUNCTION ma_abs_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = ABS(x(i,j,k))
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_abs_r31 = 0
-!----------------------
-END FUNCTION ma_abs_r31
-!===
-INTEGER FUNCTION ma_chs_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = x(i,j,k)*(-1.)
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_chs_r31 = 0
-!----------------------
-END FUNCTION ma_chs_r31
-!===
-INTEGER FUNCTION ma_cels_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = x(i,j,k)-273.15
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_cels_r31 = 0
-!-----------------------
-END FUNCTION ma_cels_r31
-!===
-INTEGER FUNCTION ma_kelv_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = x(i,j,k)+273.15
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_kelv_r31 = 0
-!-----------------------
-  END FUNCTION ma_kelv_r31
-!===
-INTEGER FUNCTION ma_deg_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = x(i,j,k)*57.29577951
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_deg_r31 = 0
-!----------------------
-END FUNCTION ma_deg_r31
-!===
-INTEGER FUNCTION ma_rad_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = x(i,j,k)*0.01745329252
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_rad_r31 = 0
-!----------------------
-END FUNCTION ma_rad_r31
-!===
-INTEGER FUNCTION ma_ident_r31(nb,x,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,i,j,k,ij
-  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = x(i,j,k)
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_ident_r31 = 0
-!------------------------
-END FUNCTION ma_ident_r31
-!-
-!=== OPERATIONS (two argument)
-!-
-INTEGER FUNCTION ma_add_r31(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo
-  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
-!-
-  INTEGER :: i,j,k,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = x(i,j,k)+s
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_add_r31 = 0
-!----------------------
-END FUNCTION ma_add_r31
-!===
-INTEGER FUNCTION ma_sub_r31(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo
-  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
-!-
-  INTEGER :: i,j,k,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = x(i,j,k)-s
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_sub_r31 = 0
-!----------------------
-END FUNCTION ma_sub_r31
-!===
-INTEGER FUNCTION ma_subi_r31(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo
-  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
-!-
-  INTEGER :: i,j,k,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) =  s-x(i,j,k)
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_subi_r31 = 0
-!-----------------------
-END FUNCTION ma_subi_r31
-!===
-INTEGER FUNCTION ma_mult_r31(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo
-  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
-!-
-  INTEGER :: i,j,k,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = x(i,j,k)*s
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_mult_r31 = 0
-!-----------------------
-END FUNCTION ma_mult_r31
-!===
-INTEGER FUNCTION ma_div_r31(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo
-  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
-!-
-  INTEGER :: i,j,k,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = x(i,j,k)/s
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_div_r31 = 0
-!----------------------
-END FUNCTION ma_div_r31
-!===
-INTEGER FUNCTION ma_divi_r31(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo
-  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
-!-
-  INTEGER :: i,j,k,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = s/x(i,j,k)
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_divi_r31 = 0
-!-----------------------
-END FUNCTION ma_divi_r31
-!===
-INTEGER FUNCTION ma_power_r31(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo
-  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
-!-
-  INTEGER :: i,j,k,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = x(i,j,k)**s
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_power_r31 = 0
-!------------------------
-END FUNCTION ma_power_r31
-!===
-INTEGER FUNCTION ma_fumin_r31(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo
-  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
-!-
-  INTEGER :: i,j,k,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = MIN(x(i,j,k),s)
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_fumin_r31 = 0
-!------------------------
-END FUNCTION ma_fumin_r31
-!===
-INTEGER FUNCTION ma_fumax_r31(nb,x,s,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo
-  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
-!-
-  INTEGER :: i,j,k,ij
-!---------------------------------------------------------------------
-  ij = 0
-  DO k=1,nb(3)
-    DO j=1,nb(2)
-      DO i=1,nb(1)
-        ij = ij+1
-        y(ij) = MAX(x(i,j,k),s)
-      ENDDO
-    ENDDO
-  ENDDO
-!-
-  nbo = nb(1)*nb(2)*nb(3)
-  ma_fumax_r31 = 0
-!------------------------
-END FUNCTION ma_fumax_r31
-!===
-INTEGER FUNCTION ma_fuscat_r31(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
-!-
-  INTEGER :: i,j,k,ij,ii,ipos,ipp,isb
-!---------------------------------------------------------------------
-  ma_fuscat_r31 = 0
-!-
-  y(1:nbo) = miss_val
-!-
-  IF (nbi <= nb(1)*nb(2)*nb(3)) THEN
-    ipos = 0
-    isb = nb(1)*nb(2)
-    DO ij=1,nbi
-      IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
-        ipos = ipos+1
-        k = ((ipos-1)/isb)+1
-        ipp = ipos-(k-1)*isb
-        j = ((ipp-1)/nb(1))+1
-        i = (ipp-(j-1)*nb(1))
-        y(ind(ij)) = x(i,j,k)
-      ELSE
-        IF (ind(ij) > nbo) ma_fuscat_r31  = ma_fuscat_r31+1
-      ENDIF
-    ENDDO
-!-- Repeat the data if needed
-    IF (MINVAL(ind) < 0) THEN
-      DO i=1,nbi
-        IF (ind(i) <= 0) THEN
-          DO ii=1,ABS(ind(i))-1
-            IF (ind(i+1)+ii <= nbo) THEN
-              y(ind(i+1)+ii) = y(ind(i+1))
-            ELSE
-              ma_fuscat_r31  = ma_fuscat_r31+1
-            ENDIF
-          ENDDO
-        ENDIF
-      ENDDO
-    ENDIF
-  ELSE
-    ma_fuscat_r31  = 1
-  ENDIF
-!-------------------------
-END FUNCTION ma_fuscat_r31
-!===
-INTEGER FUNCTION ma_fugath_r31(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
-!-
-  INTEGER :: i,j,k,ij,ipos,ipp,isb
-!---------------------------------------------------------------------
-  IF (nbi <= nbo) THEN
-    ma_fugath_r31 = 0
-    y(1:nbo) = miss_val
-    ipos = 0
-    isb = nb(1)*nb(2)
-    DO ij=1,nbi
-      IF (ipos+1 <= nbo) THEN
-        IF (ind(ij) > 0) THEN
-          k = ((ind(ij)-1)/isb)+1
-          ipp = ind(ij)-(k-1)*isb
-          j = ((ipp-1)/nb(1))+1
-          i = (ipp-(j-1)*nb(1))
-          ipos = ipos+1
-          y(ipos) = x(i,j,k)
-        ENDIF
-      ELSE
-        IF (ipos+1 > nbo) ma_fugath_r31  = ma_fugath_r31+1
-      ENDIF
-    ENDDO
-  ELSE
-    ma_fugath_r31 = 1
-  ENDIF
-  nbo = ipos
-!-------------------------
-END FUNCTION ma_fugath_r31
-!===
-INTEGER FUNCTION ma_fufill_r31(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
-!-
-  INTEGER :: i,j,k,ij,ii,ipos,ipp,isb
-!---------------------------------------------------------------------
-  ma_fufill_r31 = 0
-  IF (nbi <= nb(1)*nb(2)*nb(3)) THEN
-    ipos = 0
-    isb = nb(1)*nb(2)
-    DO ij=1,nbi
-      IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
-        ipos = ipos+1
-        k = ((ipos-1)/isb)+1
-        ipp = ipos-(k-1)*isb
-        j = ((ipp-1)/nb(1))+1
-        i = (ipp-(j-1)*nb(1))
-        y(ind(ij)) = x(i,j,k)
-      ELSE
-        IF (ind(ij) > nbo) ma_fufill_r31  = ma_fufill_r31+1
-      ENDIF
-    ENDDO
-!-- Repeat the data if needed
-    IF (MINVAL(ind) < 0) THEN
-      DO i=1,nbi
-        IF (ind(i) <= 0) THEN
-          DO ii=1,ABS(ind(i))-1
-            IF (ind(i+1)+ii <= nbo) THEN
-              y(ind(i+1)+ii) = y(ind(i+1))
-            ELSE
-              ma_fufill_r31  = ma_fufill_r31+1
-            ENDIF
-          ENDDO
-        ENDIF
-      ENDDO
-    ENDIF
-  ELSE
-    ma_fufill_r31  = 1
-  ENDIF
-!-------------------------
-END FUNCTION ma_fufill_r31
-!===
-INTEGER FUNCTION ma_fucoll_r31(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
-!-
-  INTEGER :: i,j,k,ij,ipos,ipp,isb
-!---------------------------------------------------------------------
-  IF (nbi <= nbo) THEN
-    ma_fucoll_r31 = 0
-    ipos = 0
-    isb = nb(1)*nb(2)
-    DO ij=1,nbi
-      IF (ipos+1 <= nbo) THEN
-        IF (ind(ij) > 0) THEN
-          k = ((ind(ij)-1)/isb)+1
-          ipp = ind(ij)-(k-1)*isb
-          j = ((ipp-1)/nb(1))+1
-          i = (ipp-(j-1)*nb(1))
-          ipos = ipos+1
-          y(ipos) = x(i,j,k)
-        ENDIF
-      ELSE
-        IF (ipos+1 > nbo) ma_fucoll_r31  = ma_fucoll_r31+1
-      ENDIF
-    ENDDO
-  ELSE
-    ma_fucoll_r31 = 1
-  ENDIF
-  nbo = ipos
-!-------------------------
-END FUNCTION ma_fucoll_r31
-!===
-INTEGER FUNCTION ma_fuundef_r31(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
-!-
-  INTEGER :: i,j,k,ij,ipp,isb
-!---------------------------------------------------------------------
-  IF (nbi <= nbo .AND. nbo == nb(1)*nb(2)*nb(3)) THEN
-    ma_fuundef_r31 = 0
-    isb = nb(1)*nb(2)
-    DO ij=1,nbo
-      k = ((ij-1)/isb)+1
-      ipp = ij-(k-1)*isb
-      j = ((ipp-1)/nb(1))+1
-      i = (ipp-(j-1)*nb(1))
-      y(ij) = x(i,j,k)
-    ENDDO
-    DO i=1,nbi
-      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
-        y(ind(i)) =  miss_val
-      ELSE
-        IF (ind(i) > nbo) ma_fuundef_r31  = ma_fuundef_r31+1
-      ENDIF
-    ENDDO
-  ELSE
-    ma_fuundef_r31 = 1
-  ENDIF
-!--------------------------
-END FUNCTION ma_fuundef_r31
-!===
-INTEGER FUNCTION ma_fuonly_r31(nb,x,nbi,ind,miss_val,nbo,y)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb(3),nbo,nbi
-  INTEGER :: ind(nbi)
-  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
-!-
-  INTEGER :: i,j,k,ij,ipp,isb
-!---------------------------------------------------------------------
-  IF (     (nbi <= nbo).AND.(nbo == nb(1)*nb(2)*nb(3)) &
- &    .AND.ALL(ind(1:nbi) <= nbo) ) THEN
-    ma_fuonly_r31 = 0
-    y(1:nbo) = miss_val
-    isb = nb(1)*nb(2)
-    DO ij=1,nbi
-      IF (ind(ij) > 0) THEN
-        k = ((ind(ij)-1)/isb)+1
-        ipp = ind(ij)-(k-1)*isb
-        j = ((ipp-1)/nb(1))+1
-        i = (ipp-(j-1)*nb(1))
-        y(ind(ij)) = x(i,j,k)
-      ENDIF
-    ENDDO
-  ELSE
-    ma_fuonly_r31 = 1
-  ENDIF
-!-------------------------
-END FUNCTION ma_fuonly_r31
-!===
-SUBROUTINE moycum (opp,np,px,py,pwx)
-!---------------------------------------------------------------------
-!- Does time operations
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=7) :: opp
-  INTEGER :: np
-  REAL,DIMENSION(:) :: px,py
-  INTEGER :: pwx
-!---------------------------------------------------------------------
-  IF (pwx /= 0) THEN
-    IF      (opp == 'ave') THEN
-      px(1:np)=(px(1:np)*pwx+py(1:np))/REAL(pwx+1)
-    ELSE IF (opp == 't_sum') THEN
-      px(1:np)=px(1:np)+py(1:np)
-    ELSE IF ( (opp == 'l_min').OR.(opp == 't_min') ) THEN
-      px(1:np)=MIN(px(1:np),py(1:np))
-    ELSE IF ( (opp == 'l_max').OR.(opp == 't_max') ) THEN
-      px(1:np)=MAX(px(1:np),py(1:np))
-    ELSE
-      CALL ipslerr(3,"moycum",'Unknown time operation',opp,' ')
-    ENDIF
-  ELSE
-    IF      (opp == 'l_min') THEN
-      px(1:np)=MIN(px(1:np),py(1:np))
-    ELSE IF (opp == 'l_max') THEN
-      px(1:np)=MAX(px(1:np),py(1:np))
-    ELSE
-      px(1:np)=py(1:np)
-    ENDIF
-  ENDIF
-!--------------------
-END SUBROUTINE moycum
-!===
-!-----------------
-END MODULE mathelp
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_allreduce_generic.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_allreduce_generic.h90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_allreduce_generic.h90	(revision 12101)
@@ -0,0 +1,82 @@
+!                          !==  IN: ptab is an array  ==!
+#   if defined REAL_TYPE
+#      define ARRAY_TYPE(i)    REAL(wp)         , INTENT(inout) ::   ARRAY_IN(i)
+#      define TMP_TYPE(i)      REAL(wp)         , ALLOCATABLE   ::   work(i)
+#      define MPI_TYPE mpi_double_precision
+#   endif
+#   if defined INTEGER_TYPE
+#      define ARRAY_TYPE(i)    INTEGER          , INTENT(inout) ::   ARRAY_IN(i)
+#      define TMP_TYPE(i)      INTEGER          , ALLOCATABLE   ::   work(i)
+#      define MPI_TYPE mpi_integer
+#   endif
+#   if defined COMPLEX_TYPE
+#      define ARRAY_TYPE(i)    COMPLEX          , INTENT(inout) ::   ARRAY_IN(i)
+#      define TMP_TYPE(i)      COMPLEX          , ALLOCATABLE   ::   work(i)
+#      define MPI_TYPE mpi_double_complex
+#   endif
+#   if defined DIM_0d
+#      define ARRAY_IN(i)   ptab
+#      define I_SIZE(ptab)          1
+#   endif
+#   if defined DIM_1d
+#      define ARRAY_IN(i)   ptab(i)
+#      define I_SIZE(ptab)          SIZE(ptab,1)
+#   endif
+#   if defined OPERATION_MAX
+#      define MPI_OPERATION mpi_max
+#   endif
+#   if defined OPERATION_MIN
+#      define MPI_OPERATION mpi_min
+#   endif
+#   if defined OPERATION_SUM
+#      define MPI_OPERATION mpi_sum
+#   endif
+#   if defined OPERATION_SUM_DD
+#      define MPI_OPERATION mpi_sumdd
+#   endif
+
+   SUBROUTINE ROUTINE_ALLREDUCE( cdname, ptab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),                   INTENT(in   ) ::   cdname  ! name of the calling subroutine
+      ARRAY_TYPE(:)   ! array or pointer of arrays on which the boundary condition is applied
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kdim        ! optional pointer dimension
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kcom        ! optional communicator
+#if defined key_mpp_mpi
+      !
+      INTEGER :: ipi, ii, ierr
+      INTEGER :: ierror, ilocalcomm
+      TMP_TYPE(:)
+      !!-----------------------------------------------------------------------
+      !
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. )
+      !
+      ilocalcomm = mpi_comm_oce
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      !
+      IF( PRESENT(kdim) ) then
+         ipi = kdim
+      ELSE
+         ipi = I_SIZE(ptab)   ! 1st dimension
+      ENDIF
+      !
+      ALLOCATE(work(ipi))
+      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.)
+      CALL mpi_allreduce( ARRAY_IN(:), work, ipi, MPI_TYPE, MPI_OPERATION, ilocalcomm, ierror )
+      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
+      DO ii = 1, ipi
+         ARRAY_IN(ii) = work(ii)
+      ENDDO
+      DEALLOCATE(work)
+#else
+      ! nothing to do if non-mpp case
+      RETURN
+#endif
+
+   END SUBROUTINE ROUTINE_ALLREDUCE
+
+#undef ARRAY_TYPE
+#undef ARRAY_IN
+#undef I_SIZE
+#undef MPI_OPERATION
+#undef TMP_TYPE
+#undef MPI_TYPE
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_bdy_generic.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_bdy_generic.h90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_bdy_generic.h90	(revision 12101)
@@ -0,0 +1,293 @@
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define IBD_IN(k)                kb_bdy
+#   define F_SIZE(ptab)             1
+#   define OPT_K(k)                 
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+
+   SUBROUTINE ROUTINE_BDY( cdname, ptab, cd_nat, psgn      , kb_bdy )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_bdy_3d  ***
+      !!
+      !! ** Purpose :   Message passing management
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi_bdy : mark for "east-west local boundary"
+      !!                    nbondj_bdy : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !! ** Action  :   ptab with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)            , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      INTEGER                     , INTENT(in   ) ::   IBD_IN(:)   ! BDY boundary set
+      !
+      INTEGER  ::   ji, jj, jk, jl, jh, jf     ! dummy loop indices
+      INTEGER  ::   ipk, ipl, ipf              ! 3dimension of the input array
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland                      ! local scalar
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. )
+      !      
+      ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2),   &
+         &      zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2)  )
+
+      zland = 0._wp
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !
+      DO jf = 1, ipf                   ! number of arrays to be treated
+         !
+         !                                ! East-West boundaries
+         !                    
+         IF( nbondi == 2) THEN                  ! neither subdomain to the east nor to the west
+            !                                      !* Cyclic
+            IF( l_Iperio ) THEN
+               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
+               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
+            ELSE                                   !* Closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(     1       :nn_hls,:,:,:,jf) = zland  ! east except F-point
+                                               ARRAY_IN(nlci-nn_hls+1:jpi   ,:,:,:,jf) = zland  ! west
+            ENDIF
+         ELSEIF(nbondi == -1) THEN              ! subdomain to the east only
+            IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(1:nn_hls,:,:,:,jf) = zland     ! south except F-point
+            !
+         ELSEIF(nbondi ==  1) THEN              ! subdomain to the west only
+            ARRAY_IN(nlci-nn_hls+1:jpi,:,:,:,jf) = zland    ! north
+         ENDIF
+         !                                ! North-South boundaries
+         !
+         IF( nbondj == 2) THEN                  ! neither subdomain to the north nor to the south
+            !                                      !* Cyclic
+            IF( l_Jperio ) THEN
+               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:,jpjm1,:,:,jf)
+               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,  2  ,:,:,jf)
+            ELSE                                   !* Closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,     1       :nn_hls,:,:,jf) = zland  ! east except F-point
+                                               ARRAY_IN(:,nlcj-nn_hls+1:jpj   ,:,:,jf) = zland  ! west
+            ENDIF
+         ELSEIF(nbondj == -1) THEN              ! subdomain to the east only
+            IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,1:nn_hls,:,:,jf) = zland     ! south except F-point
+            !
+         ELSEIF(nbondj ==  1) THEN              ! subdomain to the west only
+            ARRAY_IN(:,nlcj-nn_hls+1:jpj,:,:,jf) = zland    ! north
+         ENDIF
+         !
+      END DO
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      !
+      DO jf = 1, ipf
+         SELECT CASE ( nbondi_bdy(IBD_IN(jf)) )      ! Read Dirichlet lateral conditions
+         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+            iihom = nlci-nreci
+               DO jl = 1, ipl
+                  DO jk = 1, ipk
+                     DO jh = 1, nn_hls
+                        zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf)
+                        zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO
+         END SELECT
+         !
+         !                           ! Migrations
+!!gm      imigr = nn_hls * jpj * ipk * ipl * ipf
+         imigr = nn_hls * jpj * ipk * ipl
+         !
+         IF( ln_timing ) CALL tic_tac(.TRUE.)
+         !
+         SELECT CASE ( nbondi_bdy(IBD_IN(jf)) )
+         CASE ( -1 )
+            CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         CASE ( 0 )
+            CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+            CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+            IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+         CASE ( 1 )
+            CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         END SELECT
+         !
+         IF( ln_timing ) CALL tic_tac(.FALSE.)
+         !
+         !                           ! Write Dirichlet lateral conditions
+         iihom = nlci-nn_hls
+         !
+         !
+         SELECT CASE ( nbondi_bdy_b(IBD_IN(jf)) )
+         CASE ( -1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 0 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END SELECT
+         !
+      END DO
+
+      ! 3. north fold treatment
+      ! -----------------------
+      !
+      ! do it before south directions so concerned processes can do it without waiting for the comm with the sourthern neighbor
+      IF( npolj /= 0) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+
+      ! 4. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      DO jf = 1, ipf
+         IF( nbondj_bdy(IBD_IN(jf)) /= 2 ) THEN      ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
+                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+         !                           ! Migrations
+!!gm      imigr = nn_hls * jpi * ipk * ipl * ipf
+         imigr = nn_hls * jpi * ipk * ipl
+         !
+         IF( ln_timing ) CALL tic_tac(.TRUE.)
+         ! 
+         SELECT CASE ( nbondj_bdy(IBD_IN(jf)) )
+         CASE ( -1 )
+            CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
+            CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         CASE ( 0 )
+            CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+            CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
+            CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+            CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+            IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+         CASE ( 1 )
+            CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+            CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         END SELECT
+         !
+         IF( ln_timing ) CALL tic_tac(.FALSE.)
+         !
+         !                           ! Write Dirichlet lateral conditions
+         ijhom = nlcj-nn_hls
+         !
+         SELECT CASE ( nbondj_bdy_b(IBD_IN(jf)) )
+         CASE ( -1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 0 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(:,      jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END SELECT
+      END DO
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we  )
+      !
+   END SUBROUTINE ROUTINE_BDY
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef IBD_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef OPT_K
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_lnk_generic.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_lnk_generic.h90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_lnk_generic.h90	(revision 12101)
@@ -0,0 +1,347 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   define OPT_K(k)                 ,ipf
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   define OPT_K(k)                 
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#endif
+
+#if defined MULTI
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, cd_mpp, pval )
+      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+#else
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , cd_mpp, pval )
+#endif
+      ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=*)            , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp      ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval        ! background value (used at closed boundaries)
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh, jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl, ipf      ! dimension of the input array
+      INTEGER  ::   imigr, iihom, ijhom          ! local integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
+      INTEGER  ::   ierr
+      REAL(wp) ::   zland
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! north-south & south-north  halos
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! east -west  & west - east  halos
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. )
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! zero by default
+      ENDIF
+
+      ! ------------------------------- !
+      !   standard boundary treatment   !    ! CAUTION: semi-column notation is often impossible
+      ! ------------------------------- !
+      !
+      IF( .NOT. PRESENT( cd_mpp ) ) THEN     !==  standard close or cyclic treatment  ==!
+         !
+         DO jf = 1, ipf                      ! number of arrays to be treated
+            !
+            !                                ! East-West boundaries
+            IF( l_Iperio ) THEN                    !* cyclic
+               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
+               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(     1       :nn_hls,:,:,:,jf) = zland    ! east except F-point
+                                               ARRAY_IN(nlci-nn_hls+1:jpi   ,:,:,:,jf) = zland    ! west
+            ENDIF
+            !                                ! North-South boundaries
+            IF( l_Jperio ) THEN                    !* cyclic (only with no mpp j-split)
+               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf)
+               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,   2  ,:,:,jf)
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,     1       :nn_hls,:,:,jf) = zland    ! south except F-point
+                                               ARRAY_IN(:,nlcj-nn_hls+1:jpj   ,:,:,jf) = zland    ! north
+            ENDIF
+         END DO
+         !
+      ENDIF
+
+      ! ------------------------------- !
+      !      East and west exchange     !
+      ! ------------------------------- !
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      IF( ABS(nbondi) == 1 ) ALLOCATE( zt3ew(jpj,nn_hls,ipk,ipl,ipf,1), zt3we(jpj,nn_hls,ipk,ipl,ipf,1) )
+      IF(     nbondi  == 0 ) ALLOCATE( zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2) )
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1 )
+         iihom = nlci-nreci
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 0 )
+         iihom = nlci-nreci
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf)
+                     zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 1 )
+         iihom = nlci-nreci
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+      !                           ! Migrations
+      imigr = nn_hls * jpj * ipk * ipl * ipf      
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,1,1,1), imigr, noea )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt3we(1,1,1,1,1,1), imigr, nowe )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      END SELECT
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-nn_hls
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,1)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 0 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,1)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+      !
+      IF( nbondi /= 2 ) DEALLOCATE( zt3ew, zt3we )
+      !
+      ! ------------------------------- !
+      !     3. north fold treatment     !
+      ! ------------------------------- !
+      ! do it before south directions so concerned processes can do it without waiting for the comm with the sourthern neighbor
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      ! ------------------------------- !
+      !  4. North and south directions  !
+      ! ------------------------------- !
+      ! always closed : we play only with the neigbours
+      !
+      IF( ABS(nbondj) == 1 ) ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,1), zt3sn(jpi,nn_hls,ipk,ipl,ipf,1) )
+      IF(     nbondj  == 0 ) ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2) )
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         ijhom = nlcj-nrecj
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 0 )
+         ijhom = nlcj-nrecj
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
+                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 1 )
+         ijhom = nlcj-nrecj
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = nn_hls * jpi * ipk * ipl * ipf
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      ! 
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,1,1,1), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err )
+      CASE ( 1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,1,1,1), imigr, noso )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      END SELECT
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-nn_hls
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,1)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 0 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(:,      jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,1)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+      !
+      IF( nbondj /= 2 ) DEALLOCATE( zt3ns, zt3sn )
+      !
+   END SUBROUTINE ROUTINE_LNK
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef OPT_K
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_loc_generic.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_loc_generic.h90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_loc_generic.h90	(revision 12101)
@@ -0,0 +1,109 @@
+                          !==  IN: ptab is an array  ==!
+#      define ARRAY_TYPE(i,j,k)    REAL(wp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define MASK_TYPE(i,j,k)     REAL(wp)        , INTENT(in   ) ::   MASK_IN(i,j,k)
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k)   ptab(i,j)
+#      define MASK_IN(i,j,k)    pmask(i,j)
+#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(2)
+#      define K_SIZE(ptab)      1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
+#      define MASK_IN(i,j,k)    pmask(i,j,k)
+#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(3)
+#      define K_SIZE(ptab)      SIZE(ptab,3)
+#   endif
+#   if defined OPERATION_MAXLOC
+#      define MPI_OPERATION mpi_maxloc
+#      define LOC_OPERATION MAXLOC
+#      define ERRVAL -HUGE
+#   endif
+#   if defined OPERATION_MINLOC
+#      define MPI_OPERATION mpi_minloc
+#      define LOC_OPERATION MINLOC
+#      define ERRVAL HUGE
+#   endif
+
+   SUBROUTINE ROUTINE_LOC( cdname, ptab, pmask, pmin, kindex )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   ) ::   cdname  ! name of the calling subroutine
+      ARRAY_TYPE(:,:,:)                            ! array on which loctrans operation is applied
+      MASK_TYPE(:,:,:)                             ! local mask
+      REAL(wp)        , INTENT(  out) ::   pmin    ! Global minimum of ptab
+      INDEX_TYPE(:)                                ! index of minimum in global frame
+# if defined key_mpp_mpi
+      !
+      INTEGER  ::   ierror, ii, idim
+      INTEGER  ::   index0
+      REAL(wp) ::   zmin     ! local minimum
+      INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. )
+      !
+      idim = SIZE(kindex)
+      !
+      IF ( ALL(MASK_IN(:,:,:) /= 1._wp) ) THEN
+         ! special case for land processors
+         zmin = ERRVAL(zmin)
+         index0 = 0
+      ELSE
+         ALLOCATE ( ilocs(idim) )
+         !
+         ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) == 1._wp )
+         zmin  = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3))
+         !
+         kindex(1) = mig( ilocs(1) )
+#  if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */
+         kindex(2) = mjg( ilocs(2) )
+#  endif
+#  if defined DIM_3d                      /* avoid warning when kindex has 2 elements */
+         kindex(3) = ilocs(3)
+#  endif
+         ! 
+         DEALLOCATE (ilocs)
+         !
+         index0 = kindex(1)-1   ! 1d index starting at 0
+#  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
+         index0 = index0 + jpiglo * (kindex(2)-1)
+#  endif
+#  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */
+         index0 = index0 + jpiglo * jpjglo * (kindex(3)-1)
+#  endif
+      END IF
+      zain(1,:) = zmin
+      zain(2,:) = REAL(index0, wp)
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.)
+      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror)
+      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
+      !
+      pmin      = zaout(1,1)
+      index0    = NINT( zaout(2,1) )
+#  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */
+      kindex(3) = index0 / (jpiglo*jpjglo)
+      index0    = index0 - kindex(3) * (jpiglo*jpjglo)
+#  endif
+#  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
+      kindex(2) = index0 / jpiglo
+      index0 = index0 - kindex(2) * jpiglo
+#  endif
+      kindex(1) = index0
+      kindex(:) = kindex(:) + 1   ! start indices at 1
+#else
+      kindex = 0 ; pmin = 0.
+      WRITE(*,*) 'ROUTINE_LOC: You should not have seen this print! error?'
+#endif
+
+   END SUBROUTINE ROUTINE_LOC
+
+#undef ARRAY_TYPE
+#undef MAX_TYPE
+#undef ARRAY_IN
+#undef MASK_IN
+#undef K_SIZE
+#undef MPI_OPERATION
+#undef LOC_OPERATION
+#undef INDEX_TYPE
+#undef ERRVAL
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_nfd_generic.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_nfd_generic.h90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mpp_nfd_generic.h90	(revision 12101)
@@ -0,0 +1,311 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   define LBC_ARG                  (jf)
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)     , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)     , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)     , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+!                          !==  IN: ptab is an array  ==!
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)         , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   define LBC_ARG
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#endif
+
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
+      !!----------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
+      !
+      INTEGER  ::   ji,  jj,  jk,  jl, jh, jf, jr   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl, ipf         ! dimension of the input array
+      INTEGER  ::   imigr, iihom, ijhom             ! local integers
+      INTEGER  ::   ierr, ibuffsize, ilci, ildi, ilei, iilb
+      INTEGER  ::   ij, iproc
+      INTEGER, DIMENSION (jpmaxngh)       ::   ml_req_nf   ! for mpi_isend when avoiding mpi_allgather
+      INTEGER                             ::   ml_err      ! for mpi_isend when avoiding mpi_allgather
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat     ! for mpi_isend when avoiding mpi_allgather
+      !                                                    ! Workspace for message transfers avoiding mpi_allgather
+      INTEGER                             ::   ipf_j       ! sum of lines for all multi fields
+      INTEGER                             ::   js          ! counter
+      INTEGER, DIMENSION(:,:),          ALLOCATABLE ::   jj_s  ! position of sent lines
+      INTEGER, DIMENSION(:),            ALLOCATABLE ::   ipj_s ! number of sent lines
+      REAL(wp), DIMENSION(:,:,:)      , ALLOCATABLE ::   ztabl
+      REAL(wp), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztab, ztabr
+      REAL(wp), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   znorthloc, zfoldwk      
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthgloio
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      IF( l_north_nogather ) THEN      !==  ????  ==!
+
+         ALLOCATE(ipj_s(ipf))
+
+         ipj      = 2            ! Max 2nd dimension of message transfers (last two j-line only)
+         ipj_s(:) = 1            ! Real 2nd dimension of message transfers (depending on perf requirement)
+                                 ! by default, only one line is exchanged
+
+         ALLOCATE( jj_s(ipf,2) )
+
+         ! re-define number of exchanged lines :
+         !  must be two during the first two time steps
+         !  to correct possible incoherent values on North fold lines from restart 
+
+         !!!!!!!!!           temporary switch off this optimisation ==> force TRUE           !!!!!!!!
+         !!!!!!!!!  needed to get the same results without agrif and with agrif and no zoom  !!!!!!!!
+         !!!!!!!!!                    I don't know why we must do that...                    !!!!!!!!
+         l_full_nf_update = .TRUE.
+
+         ! Two lines update (slower but necessary to avoid different values ion identical grid points
+         IF ( l_full_nf_update .OR.                          &    ! if coupling fields
+              ( ncom_stp == nit000 .AND. .NOT. ln_rstart ) ) &    ! at first time step, if not restart
+            ipj_s(:) = 2
+
+         ! Index of modifying lines in input
+         DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
+            !
+            SELECT CASE ( npolj )
+            !
+            CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+               !
+               SELECT CASE ( NAT_IN(jf) )
+               !
+               CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point
+                  jj_s(jf,1) = nlcj - 2 ;  jj_s(jf,2) = nlcj - 1
+               CASE ( 'V' , 'F' )                                 ! V-, F-point
+                  jj_s(jf,1) = nlcj - 3 ;  jj_s(jf,2) = nlcj - 2
+               END SELECT
+            !
+            CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+               SELECT CASE ( NAT_IN(jf) )
+               !
+               CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point
+                  jj_s(jf,1) = nlcj - 1      
+                  ipj_s(jf) = 1                  ! need only one line anyway
+               CASE ( 'V' , 'F' )                                 ! V-, F-point
+                  jj_s(jf,1) = nlcj - 2 ;  jj_s(jf,2) = nlcj - 1
+               END SELECT
+            !
+            END SELECT
+            !
+         ENDDO
+         ! 
+         ipf_j = sum (ipj_s(:))      ! Total number of lines to be exchanged
+         !
+         ALLOCATE( znorthloc(jpimax,ipf_j,ipk,ipl,1) )
+         !
+         js = 0
+         DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
+            DO jj = 1, ipj_s(jf)
+               js = js + 1
+               DO jl = 1, ipl
+                  DO jk = 1, ipk
+                     znorthloc(1:jpi,js,jk,jl,1) = ARRAY_IN(1:jpi,jj_s(jf,jj),jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         ibuffsize = jpimax * ipf_j * ipk * ipl
+         !
+         ALLOCATE( zfoldwk(jpimax,ipf_j,ipk,ipl,1) )
+         ALLOCATE( ztabr(jpimax*jpmaxngh,ipj,ipk,ipl,ipf) ) 
+         ! when some processors of the north fold are suppressed, 
+         ! values of ztab* arrays corresponding to these suppressed domain won't be defined 
+         ! and we need a default definition to 0.
+         ! a better test should be: a testing if "suppressed land-processors" belongs to the north-pole folding
+         IF ( jpni*jpnj /= jpnij ) ztabr(:,:,:,:,:) = 0._wp
+         !
+         ! start waiting time measurement
+         IF( ln_timing ) CALL tic_tac(.TRUE.)
+         !
+         DO jr = 1, nsndto
+            IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
+               CALL mppsend( 5, znorthloc, ibuffsize, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
+            ENDIF
+         END DO
+         !
+         DO jr = 1,nsndto
+            iproc = nfipproc(isendto(jr),jpnj)
+            IF(iproc /= -1) THEN
+               iilb = nimppt(iproc+1)
+               ilci = nlcit (iproc+1)
+               ildi = nldit (iproc+1)
+               ilei = nleit (iproc+1)
+               IF( iilb            ==      1 )   ildi = 1      ! e-w boundary already done -> force to take 1st column
+               IF( iilb + ilci - 1 == jpiglo )   ilei = ilci   ! e-w boundary already done -> force to take last column
+               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
+            ENDIF
+            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
+               CALL mpprecv(5, zfoldwk, ibuffsize, iproc)
+               js = 0
+               DO jf = 1, ipf ; DO jj = 1, ipj_s(jf)
+                  js = js + 1
+                  DO jl = 1, ipl
+                     DO jk = 1, ipk
+                        DO ji = ildi, ilei
+                           ztabr(iilb+ji,jj,jk,jl,jf) = zfoldwk(ji,js,jk,jl,1)
+                        END DO
+                     END DO
+                  END DO
+               END DO; END DO
+            ELSE IF( iproc == narea-1 ) THEN
+               DO jf = 1, ipf ; DO jj = 1, ipj_s(jf)
+                  DO jl = 1, ipl
+                     DO jk = 1, ipk
+                        DO ji = ildi, ilei
+                           ztabr(iilb+ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj_s(jf,jj),jk,jl,jf)
+                        END DO
+                     END DO
+                  END DO
+               END DO; END DO
+            ENDIF
+         END DO
+         IF( l_isend ) THEN
+            DO jr = 1,nsndto
+               IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
+                  CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err )
+               ENDIF
+            END DO
+         ENDIF
+         !
+         IF( ln_timing ) CALL tic_tac(.FALSE.)
+         !
+         ! North fold boundary condition
+         !
+         DO jf = 1, ipf
+            CALL lbc_nfd_nogather(ARRAY_IN(:,:,:,:,jf), ztabr(:,1:ipj_s(jf),:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )
+         END DO
+         !
+         DEALLOCATE( zfoldwk )
+         DEALLOCATE( ztabr ) 
+         DEALLOCATE( jj_s ) 
+         DEALLOCATE( ipj_s ) 
+      ELSE                             !==  ????  ==!
+         !
+         ipj   = 4            ! 2nd dimension of message transfers (last j-lines)
+         !
+         ALLOCATE( znorthloc(jpimax,ipj,ipk,ipl,ipf) )
+         !
+         DO jf = 1, ipf                ! put in znorthloc the last ipj j-lines of ptab
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jj = nlcj - ipj +1, nlcj
+                     ij = jj - nlcj + ipj
+                     znorthloc(1:jpi,ij,jk,jl,jf) = ARRAY_IN(1:jpi,jj,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         ibuffsize = jpimax * ipj * ipk * ipl * ipf
+         !
+         ALLOCATE( ztab       (jpiglo,ipj,ipk,ipl,ipf     ) )
+         ALLOCATE( znorthgloio(jpimax,ipj,ipk,ipl,ipf,jpni) )
+         !
+         ! when some processors of the north fold are suppressed,
+         ! values of ztab* arrays corresponding to these suppressed domain won't be defined
+         ! and we need a default definition to 0.
+         ! a better test should be: a testing if "suppressed land-processors" belongs to the north-pole folding
+         IF ( jpni*jpnj /= jpnij ) ztab(:,:,:,:,:) = 0._wp
+         !
+         ! start waiting time measurement
+         IF( ln_timing ) CALL tic_tac(.TRUE.)
+         CALL MPI_ALLGATHER( znorthloc  , ibuffsize, MPI_DOUBLE_PRECISION,                &
+            &                znorthgloio, ibuffsize, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
+         ! stop waiting time measurement
+         IF( ln_timing ) CALL tic_tac(.FALSE.)
+         !
+         DO jr = 1, ndim_rank_north         ! recover the global north array
+            iproc = nrank_north(jr) + 1
+            iilb  = nimppt(iproc)
+            ilci  = nlcit (iproc)
+            ildi  = nldit (iproc)
+            ilei  = nleit (iproc)
+            IF( iilb            ==      1 )   ildi = 1      ! e-w boundary already done -> force to take 1st column
+            IF( iilb + ilci - 1 == jpiglo )   ilei = ilci   ! e-w boundary already done -> force to take last column
+            DO jf = 1, ipf
+               DO jl = 1, ipl
+                  DO jk = 1, ipk
+                     DO jj = 1, ipj
+                        DO ji = ildi, ilei
+                           ztab(ji+iilb-1,jj,jk,jl,jf) = znorthgloio(ji,jj,jk,jl,jf,jr)
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         DO jf = 1, ipf
+            CALL lbc_nfd( ztab(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition
+         END DO
+         !
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jj = nlcj-ipj+1, nlcj             ! Scatter back to ARRAY_IN
+                     ij = jj - nlcj + ipj
+                     DO ji= 1, nlci
+                        ARRAY_IN(ji,jj,jk,jl,jf) = ztab(ji+nimpp-1,ij,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+      !
+         DEALLOCATE( ztab )
+         DEALLOCATE( znorthgloio )
+      ENDIF
+      !
+      DEALLOCATE( znorthloc )
+      !
+   END SUBROUTINE ROUTINE_NFD
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef LBC_ARG
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mppini.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mppini.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mppini.F90	(revision 12101)
@@ -0,0 +1,1217 @@
+MODULE mppini
+   !!======================================================================
+   !!                       ***  MODULE mppini   ***
+   !! Ocean initialization : distributed memory computing initialization
+   !!======================================================================
+   !! History :  6.0  !  1994-11  (M. Guyon)  Original code
+   !!  OPA       7.0  !  1995-04  (J. Escobar, M. Imbard)
+   !!            8.0  !  1998-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+   !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
+   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add mpp_init_nfdcom
+   !!            3.   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) mpp_init_nfdcom: setup avoiding MPI communication 
+   !!            4.0  !  2016-06  (G. Madec)  use domain configuration file instead of bathymetry file
+   !!            4.0  !  2017-06  (J.M. Molines, T. Lovato) merge of mppini and mppini_2
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  mpp_init          : Lay out the global domain over processors with/without land processor elimination
+   !!  mpp_init_mask     : Read global bathymetric information to facilitate land suppression
+   !!  mpp_init_ioipsl   : IOIPSL initialization in mpp 
+   !!  mpp_init_partition: Calculate MPP domain decomposition
+   !!  factorise         : Calculate the factors of the no. of MPI processes
+   !!  mpp_init_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE bdy_oce        ! open BounDarY  
+   !
+   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
+   USE lib_mpp        ! distribued memory computing library
+   USE iom            ! nemo I/O library 
+   USE ioipsl         ! I/O IPSL library
+   USE in_out_manager ! I/O Manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC mpp_init       ! called by opa.F90
+
+   INTEGER :: numbot = -1  ! 'bottom_level' local logical unit
+   INTEGER :: numbdy = -1  ! 'bdy_msk'      local logical unit
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: mppini.F90 10570 2019-01-24 15:14:49Z acc $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if ! defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   Default option :                            shared memory computing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Shared memory computing, set the local processor
+      !!              variables to the value of the global domain
+      !!----------------------------------------------------------------------
+      !
+      jpimax = jpiglo
+      jpjmax = jpjglo
+      jpi    = jpiglo
+      jpj    = jpjglo
+      jpk    = jpkglo
+      jpim1  = jpi-1                                            ! inner domain indices
+      jpjm1  = jpj-1                                            !   "           "
+      jpkm1  = MAX( 1, jpk-1 )                                  !   "           "
+      jpij   = jpi*jpj
+      jpni   = 1
+      jpnj   = 1
+      jpnij  = jpni*jpnj
+      nimpp  = 1           ! 
+      njmpp  = 1
+      nlci   = jpi
+      nlcj   = jpj
+      nldi   = 1
+      nldj   = 1
+      nlei   = jpi
+      nlej   = jpj
+      nbondi = 2
+      nbondj = 2
+      nidom  = FLIO_DOM_NONE
+      npolj = jperio
+      l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7)
+      l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7)
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'mpp_init : NO massively parallel processing'
+         WRITE(numout,*) '~~~~~~~~ '
+         WRITE(numout,*) '   l_Iperio = ', l_Iperio, '    l_Jperio = ', l_Jperio 
+         WRITE(numout,*) '     npolj  = ',   npolj , '      njmpp  = ', njmpp
+      ENDIF
+      !
+      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 )                                     &
+         CALL ctl_stop( 'mpp_init: equality  jpni = jpnj = jpnij = 1 is not satisfied',   &
+            &           'the domain is lay out for distributed memory computing!' )
+         !
+   END SUBROUTINE mpp_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'                     MPI massively parallel processing
+   !!----------------------------------------------------------------------
+
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!                    
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!      If land processors are to be eliminated, this program requires the
+      !!      presence of the domain configuration file. Land processors elimination
+      !!      is performed if jpni x jpnj /= jpnij. In this case, using the MPP_PREP
+      !!      preprocessing tool, help for defining the best cutting out.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!
+      !! ** Action : - set domain parameters
+      !!                    nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nbondi    : mark for "east-west local boundary"
+      !!                    nbondj    : mark for "north-south local boundary"
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jn, jproc, jarea   ! dummy loop indices
+      INTEGER ::   inijmin
+      INTEGER ::   i2add
+      INTEGER ::   inum                       ! local logical unit
+      INTEGER ::   idir, ifreq, icont         ! local integers
+      INTEGER ::   ii, il1, ili, imil         !   -       -
+      INTEGER ::   ij, il2, ilj, ijm1         !   -       -
+      INTEGER ::   iino, ijno, iiso, ijso     !   -       -
+      INTEGER ::   iiea, ijea, iiwe, ijwe     !   -       -
+      INTEGER ::   iarea0                     !   -       -
+      INTEGER ::   ierr, ios                  ! 
+      INTEGER ::   inbi, inbj, iimax,  ijmax, icnt1, icnt2
+      LOGICAL ::   llbest
+      LOGICAL ::   llwrtlay
+      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   iin, ii_nono, ii_noea          ! 1D workspace
+      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ijn, ii_noso, ii_nowe          !  -     -
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ilci, ibondi, ipproc   ! 2D workspace
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ilcj, ibondj, ipolj    !  -     -
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ilei, ildi, iono, ioea         !  -     -
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ilej, ildj, ioso, iowe         !  -     -
+      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   llisoce                        !  -     -
+      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,           &
+           &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
+           &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &  
+           &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
+           &             cn_ice, nn_ice_dta,                                     &
+           &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     &
+           &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
+      !!----------------------------------------------------------------------
+
+      llwrtlay = lwp .OR. ln_ctl .OR. sn_cfctl%l_layout
+      ! do we need to take into account bdy_msk?
+      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist : BDY
+      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)', lwp )
+      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist : BDY
+      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
+904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)', lwp )
+      !
+      IF(               ln_read_cfg ) CALL iom_open( cn_domcfg,    numbot )
+      IF( ln_bdy .AND. ln_mask_file ) CALL iom_open( cn_mask_file, numbdy )
+      !
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+      !
+      ! If dimensions of processor grid weren't specified in the namelist file
+      ! then we calculate them here now that we have our communicator size
+      IF( jpni < 1 .OR. jpnj < 1 ) THEN
+         CALL mpp_init_bestpartition( mppsize, jpni, jpnj )
+         llbest = .TRUE.
+      ELSE
+         CALL mpp_init_bestpartition( mppsize, inbi, inbj, icnt2 )
+         CALL mpp_basic_decomposition( jpni, jpnj, jpimax, jpjmax )
+         CALL mpp_basic_decomposition( inbi, inbj,  iimax,  ijmax )
+         IF( iimax*ijmax < jpimax*jpjmax ) THEN
+            llbest = .FALSE.
+            icnt1 = jpni*jpnj - mppsize
+            WRITE(ctmp1,9000) '   The chosen domain decomposition ', jpni, ' x ', jpnj, ' with ', icnt1, ' land sub-domains'
+            WRITE(ctmp2,9000) '   has larger MPI subdomains (jpi = ', jpimax, ', jpj = ', jpjmax, ', jpi*jpj = ', jpimax*jpjmax, ')'
+            WRITE(ctmp3,9000) '   than the following domain decompostion ', inbi, ' x ', inbj, ' with ', icnt2, ' land sub-domains'
+            WRITE(ctmp4,9000) '   which MPI subdomains size is jpi = ', iimax, ', jpj = ', ijmax, ', jpi*jpj = ', iimax*ijmax, ' '
+            CALL ctl_warn( 'mpp_init:', '~~~~~~~~ ', ctmp1, ctmp2, ctmp3, ctmp4, ' ', '    --- YOU ARE WASTING CPU... ---', ' ' )
+         ELSE
+            llbest = .TRUE.
+         ENDIF
+      ENDIF
+      
+      ! look for land mpi subdomains...
+      ALLOCATE( llisoce(jpni,jpnj) )
+      CALL mpp_init_isoce( jpni, jpnj, llisoce )
+      inijmin = COUNT( llisoce )   ! number of oce subdomains
+
+      IF( mppsize < inijmin ) THEN
+         WRITE(ctmp1,9001) '   With this specified domain decomposition: jpni = ', jpni, ' jpnj = ', jpnj
+         WRITE(ctmp2,9002) '   we can eliminate only ', jpni*jpnj - inijmin, ' land mpi subdomains therefore '
+         WRITE(ctmp3,9001) '   the number of ocean mpi subdomains (', inijmin,') exceed the number of MPI processes:', mppsize
+         WRITE(ctmp4,*) '   ==>>> There is the list of best domain decompositions you should use: '
+         CALL ctl_stop( 'mpp_init:', '~~~~~~~~ ', ctmp1, ctmp2, ctmp3, ctmp4 )
+         CALL mpp_init_bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core
+         CALL ctl_stop( 'STOP' )
+      ENDIF
+
+      IF( mppsize > jpni*jpnj ) THEN
+         WRITE(ctmp1,9003) '   The number of mpi processes: ', mppsize
+         WRITE(ctmp2,9003) '   exceeds the maximum number of subdomains (ocean+land) = ', jpni*jpnj
+         WRITE(ctmp3,9001) '   defined by the following domain decomposition: jpni = ', jpni, ' jpnj = ', jpnj
+         WRITE(ctmp4,*) '   ==>>> There is the list of best domain decompositions you should use: '
+         CALL ctl_stop( 'mpp_init:', '~~~~~~~~ ', ctmp1, ctmp2, ctmp3, ctmp4 )
+         CALL mpp_init_bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core
+         CALL ctl_stop( 'STOP' )
+      ENDIF
+
+      jpnij = mppsize   ! force jpnij definition <-- remove as much land subdomains as needed to reach this condition
+      IF( mppsize > inijmin ) THEN
+         WRITE(ctmp1,9003) '   The number of mpi processes: ', mppsize
+         WRITE(ctmp2,9003) '   exceeds the maximum number of ocean subdomains = ', inijmin
+         WRITE(ctmp3,9002) '   we suppressed ', jpni*jpnj - mppsize, ' land subdomains '
+         WRITE(ctmp4,9002) '   BUT we had to keep ', mppsize - inijmin, ' land subdomains that are useless...'
+         CALL ctl_warn( 'mpp_init:', '~~~~~~~~ ', ctmp1, ctmp2, ctmp3, ctmp4, ' ', '    --- YOU ARE WASTING CPU... ---', ' ' )
+      ELSE   ! mppsize = inijmin
+         IF(lwp) THEN
+            IF(llbest) WRITE(numout,*) 'mpp_init: You use an optimal domain decomposition'
+            WRITE(numout,*) '~~~~~~~~ '
+            WRITE(numout,9003) '   Number of mpi processes: ', mppsize
+            WRITE(numout,9003) '   Number of ocean subdomains = ', inijmin
+            WRITE(numout,9003) '   Number of suppressed land subdomains = ', jpni*jpnj - inijmin
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+9000  FORMAT (a, i4, a, i4, a, i7, a)
+9001  FORMAT (a, i4, a, i4)
+9002  FORMAT (a, i4, a)
+9003  FORMAT (a, i5)
+
+      IF( numbot /= -1 )   CALL iom_close( numbot )
+      IF( numbdy /= -1 )   CALL iom_close( numbdy )
+    
+      ALLOCATE(  nfiimpp(jpni,jpnj), nfipproc(jpni,jpnj), nfilcit(jpni,jpnj) ,    &
+         &       nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,    &
+         &       njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,    &
+         &                                       nleit(jpnij) , nlejt(jpnij) ,    &
+         &       iin(jpnij), ii_nono(jpnij), ii_noea(jpnij),   &
+         &       ijn(jpnij), ii_noso(jpnij), ii_nowe(jpnij),   &
+         &       iimppt(jpni,jpnj), ilci(jpni,jpnj), ibondi(jpni,jpnj), ipproc(jpni,jpnj),   &
+         &       ijmppt(jpni,jpnj), ilcj(jpni,jpnj), ibondj(jpni,jpnj), ipolj(jpni,jpnj),   &
+         &       ilei(jpni,jpnj), ildi(jpni,jpnj), iono(jpni,jpnj), ioea(jpni,jpnj),   &
+         &       ilej(jpni,jpnj), ildj(jpni,jpnj), ioso(jpni,jpnj), iowe(jpni,jpnj),   &
+         &       STAT=ierr )
+      CALL mpp_sum( 'mppini', ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' )
+      
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
+         IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'jpiglo shoud be: ', nbcellsx + 2 + 2*nbghostcells
+            ENDIF        
+            CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells' )
+         ENDIF   
+         IF( jpjglo /= nbcellsy + 2 + 2*nbghostcells ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'jpjglo shoud be: ', nbcellsy + 2 + 2*nbghostcells
+            ENDIF        
+            CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nbghostcells' )
+         ENDIF   
+         IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'mpp_init:Agrif children requires ln_use_jattr = .false. ' )
+      ENDIF
+#endif
+      !
+      !  2. Index arrays for subdomains
+      ! -----------------------------------
+      !
+      nreci = 2 * nn_hls
+      nrecj = 2 * nn_hls
+      CALL mpp_basic_decomposition( jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ilci, ilcj )
+      nfiimpp(:,:) = iimppt(:,:)
+      nfilcit(:,:) = ilci(:,:)
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'MPI Message Passing MPI - domain lay out over processors'
+         WRITE(numout,*)
+         WRITE(numout,*) '   defines mpp subdomains'
+         WRITE(numout,*) '      jpni = ', jpni  
+         WRITE(numout,*) '      jpnj = ', jpnj
+         WRITE(numout,*)
+         WRITE(numout,*) '      sum ilci(i,1) = ', sum(ilci(:,1)), ' jpiglo = ', jpiglo
+         WRITE(numout,*) '      sum ilcj(1,j) = ', sum(ilcj(1,:)), ' jpjglo = ', jpjglo
+      ENDIF
+     
+      ! 3. Subdomain description in the Regular Case
+      ! --------------------------------------------
+      ! specific cases where there is no communication -> must do the periodicity by itself
+      ! Warning: because of potential land-area suppression, do not use nbond[ij] == 2  
+      l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7)
+      l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7)
+      
+      DO jarea = 1, jpni*jpnj
+         !
+         iarea0 = jarea - 1
+         ii = 1 + MOD(iarea0,jpni)
+         ij = 1 +     iarea0/jpni
+         ili = ilci(ii,ij)
+         ilj = ilcj(ii,ij)
+         ibondi(ii,ij) = 0                         ! default: has e-w neighbours
+         IF( ii   ==    1 )   ibondi(ii,ij) = -1   ! first column, has only e neighbour
+         IF( ii   == jpni )   ibondi(ii,ij) =  1   ! last column,  has only w neighbour
+         IF( jpni ==    1 )   ibondi(ii,ij) =  2   ! has no e-w neighbour
+         ibondj(ii,ij) = 0                         ! default: has n-s neighbours
+         IF( ij   ==    1 )   ibondj(ii,ij) = -1   ! first row, has only n neighbour
+         IF( ij   == jpnj )   ibondj(ii,ij) =  1   ! last row,  has only s neighbour
+         IF( jpnj ==    1 )   ibondj(ii,ij) =  2   ! has no n-s neighbour
+
+         ! Subdomain neighbors (get their zone number): default definition
+         ioso(ii,ij) = iarea0 - jpni
+         iowe(ii,ij) = iarea0 - 1
+         ioea(ii,ij) = iarea0 + 1
+         iono(ii,ij) = iarea0 + jpni
+         ildi(ii,ij) =  1  + nn_hls
+         ilei(ii,ij) = ili - nn_hls
+         ildj(ii,ij) =  1  + nn_hls
+         ilej(ii,ij) = ilj - nn_hls
+
+         ! East-West periodicity: change ibondi, ioea, iowe
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN
+            IF( jpni  /= 1 )   ibondi(ii,ij) = 0                        ! redefine: all have e-w neighbours
+            IF( ii ==    1 )   iowe(ii,ij) = iarea0 +        (jpni-1)   ! redefine: first column, address of w neighbour
+            IF( ii == jpni )   ioea(ii,ij) = iarea0 -        (jpni-1)   ! redefine: last column,  address of e neighbour
+         ENDIF
+
+         ! Simple North-South periodicity: change ibondj, ioso, iono
+         IF( jperio == 2 .OR. jperio == 7 ) THEN
+            IF( jpnj  /= 1 )   ibondj(ii,ij) = 0                        ! redefine: all have n-s neighbours
+            IF( ij ==    1 )   ioso(ii,ij) = iarea0 + jpni * (jpnj-1)   ! redefine: first row, address of s neighbour
+            IF( ij == jpnj )   iono(ii,ij) = iarea0 - jpni * (jpnj-1)   ! redefine: last row,  address of n neighbour
+         ENDIF
+
+         ! North fold: define ipolj, change iono. Warning: we do not change ibondj...
+         ipolj(ii,ij) = 0
+         IF( jperio == 3 .OR. jperio == 4 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
+            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1   ! MPI rank of northern neighbour
+         ENDIF
+         IF( jperio == 5 .OR. jperio == 6 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1) ipolj(ii,ij) = 5
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
+            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour
+         ENDIF
+         !
+      END DO
+
+      ! 4. deal with land subdomains
+      ! ----------------------------
+      !
+      ! specify which subdomains are oce subdomains; other are land subdomains
+      ipproc(:,:) = -1
+      icont = -1
+      DO jarea = 1, jpni*jpnj
+         iarea0 = jarea - 1
+         ii = 1 + MOD(iarea0,jpni)
+         ij = 1 +     iarea0/jpni
+         IF( llisoce(ii,ij) ) THEN
+            icont = icont + 1
+            ipproc(ii,ij) = icont
+            iin(icont+1) = ii
+            ijn(icont+1) = ij
+         ENDIF
+      END DO
+      ! if needed add some land subdomains to reach jpnij active subdomains
+      i2add = jpnij - inijmin
+      DO jarea = 1, jpni*jpnj
+         iarea0 = jarea - 1
+         ii = 1 + MOD(iarea0,jpni)
+         ij = 1 +     iarea0/jpni
+         IF( .NOT. llisoce(ii,ij) .AND. i2add > 0 ) THEN
+            icont = icont + 1
+            ipproc(ii,ij) = icont
+            iin(icont+1) = ii
+            ijn(icont+1) = ij
+            i2add = i2add - 1
+         ENDIF
+      END DO
+      nfipproc(:,:) = ipproc(:,:)
+
+      ! neighbour treatment: change ibondi, ibondj if next to a land zone
+      DO jarea = 1, jpni*jpnj
+         ii = 1 + MOD( jarea-1  , jpni )
+         ij = 1 +     (jarea-1) / jpni
+         ! land-only area with an active n neigbour
+         IF ( ipproc(ii,ij) == -1 .AND. 0 <= iono(ii,ij) .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
+            iino = 1 + MOD( iono(ii,ij) , jpni )                    ! ii index of this n neigbour
+            ijno = 1 +      iono(ii,ij) / jpni                      ! ij index of this n neigbour
+            ! In case of north fold exchange: I am the n neigbour of my n neigbour!! (#1057)
+            ! --> for northern neighbours of northern row processors (in case of north-fold)
+            !     need to reverse the LOGICAL direction of communication 
+            idir = 1                                           ! we are indeed the s neigbour of this n neigbour
+            IF( ij == jpnj .AND. ijno == jpnj )   idir = -1    ! both are on the last row, we are in fact the n neigbour
+            IF( ibondj(iino,ijno) == idir     )   ibondj(iino,ijno) =   2     ! this n neigbour had only a s/n neigbour -> no more
+            IF( ibondj(iino,ijno) == 0        )   ibondj(iino,ijno) = -idir   ! this n neigbour had both, n-s neighbours -> keep 1
+         ENDIF
+         ! land-only area with an active s neigbour
+         IF( ipproc(ii,ij) == -1 .AND. 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
+            iiso = 1 + MOD( ioso(ii,ij) , jpni )                    ! ii index of this s neigbour
+            ijso = 1 +      ioso(ii,ij) / jpni                      ! ij index of this s neigbour
+            IF( ibondj(iiso,ijso) == -1 )   ibondj(iiso,ijso) = 2   ! this s neigbour had only a n neigbour    -> no more neigbour
+            IF( ibondj(iiso,ijso) ==  0 )   ibondj(iiso,ijso) = 1   ! this s neigbour had both, n-s neighbours -> keep s neigbour
+         ENDIF
+         ! land-only area with an active e neigbour
+         IF( ipproc(ii,ij) == -1 .AND. 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= jpni*jpnj-1 ) THEN
+            iiea = 1 + MOD( ioea(ii,ij) , jpni )                    ! ii index of this e neigbour
+            ijea = 1 +      ioea(ii,ij) / jpni                      ! ij index of this e neigbour
+            IF( ibondi(iiea,ijea) == 1 )   ibondi(iiea,ijea) =  2   ! this e neigbour had only a w neigbour    -> no more neigbour
+            IF( ibondi(iiea,ijea) == 0 )   ibondi(iiea,ijea) = -1   ! this e neigbour had both, e-w neighbours -> keep e neigbour
+         ENDIF
+         ! land-only area with an active w neigbour
+         IF( ipproc(ii,ij) == -1 .AND. 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
+            iiwe = 1 + MOD( iowe(ii,ij) , jpni )                    ! ii index of this w neigbour
+            ijwe = 1 +      iowe(ii,ij) / jpni                      ! ij index of this w neigbour
+            IF( ibondi(iiwe,ijwe) == -1 )   ibondi(iiwe,ijwe) = 2   ! this w neigbour had only a e neigbour    -> no more neigbour
+            IF( ibondi(iiwe,ijwe) ==  0 )   ibondi(iiwe,ijwe) = 1   ! this w neigbour had both, e-w neighbours -> keep w neigbour
+         ENDIF
+      END DO
+
+      ! Update il[de][ij] according to modified ibond[ij]
+      ! ----------------------
+      DO jproc = 1, jpnij
+         ii = iin(jproc)
+         ij = ijn(jproc)
+         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) =  1
+         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ilci(ii,ij)
+         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) =  1
+         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilcj(ii,ij)
+      END DO
+      
+      ! 5. Subdomain print
+      ! ------------------
+      IF(lwp) THEN
+         ifreq = 4
+         il1 = 1
+         DO jn = 1, (jpni-1)/ifreq+1
+            il2 = MIN(jpni,il1+ifreq-1)
+            WRITE(numout,*)
+            WRITE(numout,9400) ('***',ji=il1,il2-1)
+            DO jj = jpnj, 1, -1
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
+               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9400) ('***',ji=il1,il2-1)
+            END DO
+            WRITE(numout,9401) (ji,ji=il1,il2)
+            il1 = il1+ifreq
+         END DO
+ 9400    FORMAT('           ***'   ,20('*************',a3)    )
+ 9403    FORMAT('           *     ',20('         *   ',a3)    )
+ 9401    FORMAT('              '   ,20('   ',i3,'          ') )
+ 9402    FORMAT('       ',i3,' *  ',20(i3,'  x',i3,'   *   ') )
+ 9404    FORMAT('           *  '   ,20('      ',i3,'   *   ') )
+      ENDIF
+         
+      ! just to save nono etc for all proc
+      ! warning ii*ij (zone) /= nproc (processors)!
+      ! ioso = zone number, ii_noso = proc number
+      ii_noso(:) = -1
+      ii_nono(:) = -1
+      ii_noea(:) = -1
+      ii_nowe(:) = -1 
+      DO jproc = 1, jpnij
+         ii = iin(jproc)
+         ij = ijn(jproc)
+         IF( 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
+            iiso = 1 + MOD( ioso(ii,ij) , jpni )
+            ijso = 1 +      ioso(ii,ij) / jpni
+            ii_noso(jproc) = ipproc(iiso,ijso)
+         ENDIF
+         IF( 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
+          iiwe = 1 + MOD( iowe(ii,ij) , jpni )
+          ijwe = 1 +      iowe(ii,ij) / jpni
+          ii_nowe(jproc) = ipproc(iiwe,ijwe)
+         ENDIF
+         IF( 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
+            iiea = 1 + MOD( ioea(ii,ij) , jpni )
+            ijea = 1 +      ioea(ii,ij) / jpni
+            ii_noea(jproc)= ipproc(iiea,ijea)
+         ENDIF
+         IF( 0 <= iono(ii,ij) .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
+            iino = 1 + MOD( iono(ii,ij) , jpni )
+            ijno = 1 +      iono(ii,ij) / jpni
+            ii_nono(jproc)= ipproc(iino,ijno)
+         ENDIF
+      END DO
+    
+      ! 6. Change processor name
+      ! ------------------------
+      ii = iin(narea)
+      ij = ijn(narea)
+      !
+      ! set default neighbours
+      noso = ii_noso(narea)
+      nowe = ii_nowe(narea)
+      noea = ii_noea(narea)
+      nono = ii_nono(narea)
+      nlci = ilci(ii,ij)  
+      nldi = ildi(ii,ij)
+      nlei = ilei(ii,ij)
+      nlcj = ilcj(ii,ij)  
+      nldj = ildj(ii,ij)
+      nlej = ilej(ii,ij)
+      nbondi = ibondi(ii,ij)
+      nbondj = ibondj(ii,ij)
+      nimpp = iimppt(ii,ij)  
+      njmpp = ijmppt(ii,ij)
+      jpi = nlci
+      jpj = nlcj
+      jpk = jpkglo                                             ! third dim
+#if defined key_agrif
+      ! simple trick to use same vertical grid as parent but different number of levels: 
+      ! Save maximum number of levels in jpkglo, then define all vertical grids with this number.
+      ! Suppress once vertical online interpolation is ok
+!!$      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo )
+#endif
+      jpim1 = jpi-1                                            ! inner domain indices
+      jpjm1 = jpj-1                                            !   "           "
+      jpkm1 = MAX( 1, jpk-1 )                                  !   "           "
+      jpij  = jpi*jpj                                          !  jpi x j
+      DO jproc = 1, jpnij
+         ii = iin(jproc)
+         ij = ijn(jproc)
+         nlcit(jproc) = ilci(ii,ij)
+         nldit(jproc) = ildi(ii,ij)
+         nleit(jproc) = ilei(ii,ij)
+         nlcjt(jproc) = ilcj(ii,ij)
+         nldjt(jproc) = ildj(ii,ij)
+         nlejt(jproc) = ilej(ii,ij)
+         ibonit(jproc) = ibondi(ii,ij)
+         ibonjt(jproc) = ibondj(ii,ij)
+         nimppt(jproc) = iimppt(ii,ij)  
+         njmppt(jproc) = ijmppt(ii,ij) 
+      END DO
+
+      ! Save processor layout in ascii file
+      IF (llwrtlay) THEN
+         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+         WRITE(inum,'(a)') '   jpnij   jpimax  jpjmax    jpk  jpiglo  jpjglo'//&
+   &           ' ( local:    narea     jpi     jpj )'
+         WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,&
+   &           ' ( local: ',narea,jpi,jpj,' )'
+         WRITE(inum,'(a)') 'nproc nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj '
+
+         DO jproc = 1, jpnij
+            WRITE(inum,'(13i5,2i7)')   jproc-1, nlcit  (jproc), nlcjt  (jproc),   &
+               &                                nldit  (jproc), nldjt  (jproc),   &
+               &                                nleit  (jproc), nlejt  (jproc),   &
+               &                                nimppt (jproc), njmppt (jproc),   & 
+               &                                ii_nono(jproc), ii_noso(jproc),   &
+               &                                ii_nowe(jproc), ii_noea(jproc),   &
+               &                                ibonit (jproc), ibonjt (jproc) 
+         END DO
+      END IF
+
+      !                          ! north fold parameter
+      ! Defined npolj, either 0, 3 , 4 , 5 , 6
+      ! In this case the important thing is that npolj /= 0
+      ! Because if we go through these line it is because jpni >1 and thus
+      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
+      npolj = 0
+      ij = ijn(narea)
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         IF( ij == jpnj )   npolj = 3
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+         IF( ij == jpnj )   npolj = 5
+      ENDIF
+      !
+      nproc = narea-1
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   resulting internal parameters : '
+         WRITE(numout,*) '      nproc  = ', nproc
+         WRITE(numout,*) '      nowe   = ', nowe  , '   noea  =  ', noea
+         WRITE(numout,*) '      nono   = ', nono  , '   noso  =  ', noso
+         WRITE(numout,*) '      nbondi = ', nbondi
+         WRITE(numout,*) '      nbondj = ', nbondj
+         WRITE(numout,*) '      npolj  = ', npolj
+         WRITE(numout,*) '    l_Iperio = ', l_Iperio
+         WRITE(numout,*) '    l_Jperio = ', l_Jperio
+         WRITE(numout,*) '      nlci   = ', nlci
+         WRITE(numout,*) '      nlcj   = ', nlcj
+         WRITE(numout,*) '      nimpp  = ', nimpp
+         WRITE(numout,*) '      njmpp  = ', njmpp
+         WRITE(numout,*) '      nreci  = ', nreci  
+         WRITE(numout,*) '      nrecj  = ', nrecj  
+         WRITE(numout,*) '      nn_hls = ', nn_hls 
+      ENDIF
+
+      !                          ! Prepare mpp north fold
+      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+         IF (lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '   ==>>>   North fold boundary prepared for jpni >1'
+            ! additional prints in layout.dat
+         ENDIF
+         IF (llwrtlay) THEN
+            WRITE(inum,*)
+            WRITE(inum,*)
+            WRITE(inum,*) 'number of subdomains located along the north fold : ', ndim_rank_north
+            WRITE(inum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north
+            DO jproc = 1, ndim_rank_north, 5
+               WRITE(inum,*) nrank_north( jproc:MINVAL( (/jproc+4,ndim_rank_north/) ) )
+            END DO
+         ENDIF
+      ENDIF
+      !
+      CALL mpp_init_ioipsl       ! Prepare NetCDF output file (if necessary)
+      !
+      IF( ln_nnogather ) THEN
+         CALL mpp_init_nfdcom     ! northfold neighbour lists
+         IF (llwrtlay) THEN
+            WRITE(inum,*)
+            WRITE(inum,*)
+            WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :'
+            WRITE(inum,*) 'nfsloop : ', nfsloop
+            WRITE(inum,*) 'nfeloop : ', nfeloop
+            WRITE(inum,*) 'nsndto : ', nsndto
+            WRITE(inum,*) 'isendto : ', isendto
+         ENDIF
+      ENDIF
+      !
+      IF (llwrtlay) CLOSE(inum)   
+      !
+      DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe,    &
+         &       iimppt, ijmppt, ibondi, ibondj, ipproc, ipolj,   &
+         &       ilci, ilcj, ilei, ilej, ildi, ildj,              &
+         &       iono, ioea, ioso, iowe, llisoce)
+      !
+    END SUBROUTINE mpp_init
+
+
+    SUBROUTINE mpp_basic_decomposition( knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_basic_decomposition  ***
+      !!                    
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!
+      !! ** Action : - set for all knbi*knbj domains:
+      !!                    kimppt     : longitudinal index
+      !!                    kjmppt     : latitudinal  index
+      !!                    klci       : first dimension
+      !!                    klcj       : second dimension
+      !!----------------------------------------------------------------------
+      INTEGER,                                 INTENT(in   ) ::   knbi, knbj
+      INTEGER,                                 INTENT(  out) ::   kimax, kjmax
+      INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT(  out) ::   kimppt, kjmppt
+      INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT(  out) ::   klci, klcj
+      !
+      INTEGER ::   ji, jj
+      INTEGER ::   iresti, irestj, irm, ijpjmin
+      INTEGER ::   ireci, irecj
+      !!----------------------------------------------------------------------
+      !
+#if defined key_nemocice_decomp
+      kimax = ( nx_global+2-2*nn_hls + (knbi-1) ) / knbi + 2*nn_hls    ! first  dim.
+      kjmax = ( ny_global+2-2*nn_hls + (knbj-1) ) / knbj + 2*nn_hls    ! second dim. 
+#else
+      kimax = ( jpiglo - 2*nn_hls + (knbi-1) ) / knbi + 2*nn_hls    ! first  dim.
+      kjmax = ( jpjglo - 2*nn_hls + (knbj-1) ) / knbj + 2*nn_hls    ! second dim.
+#endif
+      IF( .NOT. PRESENT(kimppt) ) RETURN
+      !
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+      !  Computation of local domain sizes klci() klcj()
+      !  These dimensions depend on global sizes knbi,knbj and jpiglo,jpjglo
+      !  The subdomains are squares lesser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap array.
+      !
+      ireci = 2 * nn_hls
+      irecj = 2 * nn_hls
+      iresti = 1 + MOD( jpiglo - ireci -1 , knbi )
+      irestj = 1 + MOD( jpjglo - irecj -1 , knbj )
+      !
+      !  Need to use kimax and kjmax here since jpi and jpj not yet defined
+#if defined key_nemocice_decomp
+      ! Change padding to be consistent with CICE
+      klci(1:knbi-1      ,:) = kimax
+      klci(knbi          ,:) = jpiglo - (knbi - 1) * (kimax - nreci)
+      klcj(:,      1:knbj-1) = kjmax
+      klcj(:,          knbj) = jpjglo - (knbj - 1) * (kjmax - nrecj)
+#else
+      klci(1:iresti      ,:) = kimax
+      klci(iresti+1:knbi ,:) = kimax-1
+      IF( MINVAL(klci) < 3 ) THEN
+         WRITE(ctmp1,*) '   mpp_basic_decomposition: minimum value of jpi must be >= 3'
+         WRITE(ctmp2,*) '   We have ', MINVAL(klci)
+        CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
+      ENDIF
+      IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6 ) THEN
+         ! minimize the size of the last row to compensate for the north pole folding coast
+         IF( jperio == 3 .OR. jperio == 4 )   ijpjmin = 5   ! V and F folding involves line jpj-3 that must not be south boundary
+         IF( jperio == 5 .OR. jperio == 6 )   ijpjmin = 4   ! V and F folding involves line jpj-2 that must not be south boundary
+         irm = knbj - irestj                                    ! total number of lines to be removed
+         klcj(:,            knbj) = MAX( ijpjmin, kjmax-irm )   ! we must have jpj >= ijpjmin in the last row
+         irm = irm - ( kjmax - klcj(1,knbj) )                   ! remaining number of lines to remove 
+         irestj = knbj - 1 - irm                        
+         klcj(:,        1:irestj) = kjmax
+         klcj(:, irestj+1:knbj-1) = kjmax-1
+      ELSE
+         ijpjmin = 3
+         klcj(:,      1:irestj) = kjmax
+         klcj(:, irestj+1:knbj) = kjmax-1
+      ENDIF
+      IF( MINVAL(klcj) < ijpjmin ) THEN
+         WRITE(ctmp1,*) '   mpp_basic_decomposition: minimum value of jpj must be >= ', ijpjmin
+         WRITE(ctmp2,*) '   We have ', MINVAL(klcj)
+         CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
+      ENDIF
+#endif
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+      kimppt(:,:) = 1
+      kjmppt(:,:) = 1
+      !
+      IF( knbi > 1 ) THEN
+         DO jj = 1, knbj
+            DO ji = 2, knbi
+               kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - ireci
+            END DO
+         END DO
+      ENDIF
+      !
+      IF( knbj > 1 )THEN
+         DO jj = 2, knbj
+            DO ji = 1, knbi
+               kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - irecj
+            END DO
+         END DO
+      ENDIF
+      
+   END SUBROUTINE mpp_basic_decomposition
+
+
+   SUBROUTINE mpp_init_bestpartition( knbij, knbi, knbj, knbcnt, ldlist )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE mpp_init_bestpartition  ***
+      !!
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER,           INTENT(in   ) ::   knbij         ! total number if subdomains               (knbi*knbj)
+      INTEGER, OPTIONAL, INTENT(  out) ::   knbi, knbj    ! number if subdomains along i and j (knbi and knbj)
+      INTEGER, OPTIONAL, INTENT(  out) ::   knbcnt        ! number of land subdomains
+      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldlist        ! .true.: print the list the best domain decompositions (with land)
+      !
+      INTEGER :: ji, jj, ii, iitarget
+      INTEGER :: iszitst, iszjtst
+      INTEGER :: isziref, iszjref
+      INTEGER :: inbij, iszij
+      INTEGER :: inbimax, inbjmax, inbijmax
+      INTEGER :: isz0, isz1
+      INTEGER, DIMENSION(  :), ALLOCATABLE :: indexok
+      INTEGER, DIMENSION(  :), ALLOCATABLE :: inbi0, inbj0, inbij0   ! number of subdomains along i,j
+      INTEGER, DIMENSION(  :), ALLOCATABLE :: iszi0, iszj0, iszij0   ! max size of the subdomains along i,j
+      INTEGER, DIMENSION(  :), ALLOCATABLE :: inbi1, inbj1, inbij1   ! number of subdomains along i,j
+      INTEGER, DIMENSION(  :), ALLOCATABLE :: iszi1, iszj1, iszij1   ! max size of the subdomains along i,j
+      LOGICAL :: llist
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llmsk2d                 ! max size of the subdomains along i,j
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llisoce              !  -     -
+      REAL(wp)::   zpropland
+      !!----------------------------------------------------------------------
+      !
+      llist = .FALSE.
+      IF( PRESENT(ldlist) ) llist = ldlist
+
+      CALL mpp_init_landprop( zpropland )                      ! get the proportion of land point over the gloal domain
+      inbij = NINT( REAL(knbij, wp) / ( 1.0 - zpropland ) )    ! define the largest possible value for jpni*jpnj
+      !
+      IF( llist ) THEN   ;   inbijmax = inbij*2
+      ELSE               ;   inbijmax = inbij
+      ENDIF
+      !
+      ALLOCATE(inbi0(inbijmax),inbj0(inbijmax),iszi0(inbijmax),iszj0(inbijmax))
+      !
+      inbimax = 0
+      inbjmax = 0
+      isziref = jpiglo*jpjglo+1
+      iszjref = jpiglo*jpjglo+1
+      !
+      ! get the list of knbi that gives a smaller jpimax than knbi-1
+      ! get the list of knbj that gives a smaller jpjmax than knbj-1
+      DO ji = 1, inbijmax      
+#if defined key_nemocice_decomp
+         iszitst = ( nx_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls    ! first  dim.
+#else
+         iszitst = ( jpiglo - 2*nn_hls + (ji-1) ) / ji + 2*nn_hls
+#endif
+         IF( iszitst < isziref ) THEN
+            isziref = iszitst
+            inbimax = inbimax + 1
+            inbi0(inbimax) = ji
+            iszi0(inbimax) = isziref
+         ENDIF
+#if defined key_nemocice_decomp
+         iszjtst = ( ny_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls    ! first  dim.
+#else
+         iszjtst = ( jpjglo - 2*nn_hls + (ji-1) ) / ji + 2*nn_hls
+#endif
+         IF( iszjtst < iszjref ) THEN
+            iszjref = iszjtst
+            inbjmax = inbjmax + 1
+            inbj0(inbjmax) = ji
+            iszj0(inbjmax) = iszjref
+         ENDIF
+      END DO
+
+      ! combine these 2 lists to get all possible knbi*knbj <  inbijmax
+      ALLOCATE( llmsk2d(inbimax,inbjmax) )
+      DO jj = 1, inbjmax
+         DO ji = 1, inbimax
+            IF ( inbi0(ji) * inbj0(jj) <= inbijmax ) THEN   ;   llmsk2d(ji,jj) = .TRUE.
+            ELSE                                            ;   llmsk2d(ji,jj) = .FALSE.
+            ENDIF
+         END DO
+      END DO
+      isz1 = COUNT(llmsk2d)
+      ALLOCATE( inbi1(isz1), inbj1(isz1), iszi1(isz1), iszj1(isz1) )
+      ii = 0
+      DO jj = 1, inbjmax
+         DO ji = 1, inbimax
+            IF( llmsk2d(ji,jj) .EQV. .TRUE. ) THEN
+               ii = ii + 1
+               inbi1(ii) = inbi0(ji)
+               inbj1(ii) = inbj0(jj)
+               iszi1(ii) = iszi0(ji)
+               iszj1(ii) = iszj0(jj)
+            END IF
+         END DO
+      END DO
+      DEALLOCATE( inbi0, inbj0, iszi0, iszj0 )
+      DEALLOCATE( llmsk2d )
+
+      ALLOCATE( inbij1(isz1), iszij1(isz1) )
+      inbij1(:) = inbi1(:) * inbj1(:)
+      iszij1(:) = iszi1(:) * iszj1(:)
+
+      ! if therr is no land and no print
+      IF( .NOT. llist .AND. numbot == -1 .AND. numbdy == -1 ) THEN
+         ! get the smaller partition which gives the smallest subdomain size
+         ii = MINLOC(inbij1, mask = iszij1 == MINVAL(iszij1), dim = 1)
+         knbi = inbi1(ii)
+         knbj = inbj1(ii)
+         IF(PRESENT(knbcnt))   knbcnt = 0
+         DEALLOCATE( inbi1, inbj1, inbij1, iszi1, iszj1, iszij1 )
+         RETURN
+      ENDIF
+
+      ! extract only the partitions which reduce the subdomain size in comparison with smaller partitions
+      ALLOCATE( indexok(isz1) )                                 ! to store indices of the best partitions
+      isz0 = 0                                                  ! number of best partitions     
+      inbij = 1                                                 ! start with the min value of inbij1 => 1
+      iszij = jpiglo*jpjglo+1                                   ! default: larger than global domain
+      DO WHILE( inbij <= inbijmax )                             ! if we did not reach the max of inbij1
+         ii = MINLOC(iszij1, mask = inbij1 == inbij, dim = 1)   ! warning: send back the first occurence if multiple results
+         IF ( iszij1(ii) < iszij ) THEN
+            isz0 = isz0 + 1
+            indexok(isz0) = ii
+            iszij = iszij1(ii)
+         ENDIF
+         inbij = MINVAL(inbij1, mask = inbij1 > inbij)   ! warning: return largest integer value if mask = .false. everywhere
+      END DO
+      DEALLOCATE( inbij1, iszij1 )
+
+      ! keep only the best partitions (sorted by increasing order of subdomains number and decreassing subdomain size)
+      ALLOCATE( inbi0(isz0), inbj0(isz0), iszi0(isz0), iszj0(isz0) )
+      DO ji = 1, isz0
+         ii = indexok(ji)
+         inbi0(ji) = inbi1(ii)
+         inbj0(ji) = inbj1(ii)
+         iszi0(ji) = iszi1(ii)
+         iszj0(ji) = iszj1(ii)
+      END DO
+      DEALLOCATE( indexok, inbi1, inbj1, iszi1, iszj1 )
+
+      IF( llist ) THEN  ! we print about 21 best partitions
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,         *) '                  For your information:'
+            WRITE(numout,'(a,i5,a)') '  list of the best partitions around ',   knbij, ' mpi processes'
+            WRITE(numout,         *) '  --------------------------------------', '-----', '--------------'
+            WRITE(numout,*)
+         END IF
+         iitarget = MINLOC( inbi0(:)*inbj0(:), mask = inbi0(:)*inbj0(:) >= knbij, dim = 1 )
+         DO ji = MAX(1,iitarget-10), MIN(isz0,iitarget+10)
+            ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) )
+            CALL mpp_init_isoce( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum)
+            inbij = COUNT(llisoce)
+            DEALLOCATE( llisoce )
+            IF(lwp) WRITE(numout,'(a, i5, a, i5, a, i4, a, i4, a, i9, a, i5, a, i5, a)')    &
+               &     'nb_cores ' , inbij,' oce + ', inbi0(ji)*inbj0(ji) - inbij             &
+               &                                , ' land ( ', inbi0(ji),' x ', inbj0(ji),   &
+               & ' ), nb_points ', iszi0(ji)*iszj0(ji),' ( ', iszi0(ji),' x ', iszj0(ji),' )'
+         END DO
+         DEALLOCATE( inbi0, inbj0, iszi0, iszj0 )
+         RETURN
+      ENDIF
+      
+      DEALLOCATE( iszi0, iszj0 )
+      inbij = inbijmax + 1        ! default: larger than possible
+      ii = isz0+1                 ! start from the end of the list (smaller subdomains)
+      DO WHILE( inbij > knbij )   ! while the number of ocean subdomains exceed the number of procs
+         ii = ii -1 
+         ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) )
+         CALL mpp_init_isoce( inbi0(ii), inbj0(ii), llisoce )            ! must be done by all core
+         inbij = COUNT(llisoce)
+         DEALLOCATE( llisoce )
+      END DO
+      knbi = inbi0(ii)
+      knbj = inbj0(ii)
+      IF(PRESENT(knbcnt))   knbcnt = knbi * knbj - inbij
+      DEALLOCATE( inbi0, inbj0 )
+      !
+   END SUBROUTINE mpp_init_bestpartition
+   
+   
+   SUBROUTINE mpp_init_landprop( propland )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_landprop  ***
+      !!
+      !! ** Purpose : the the proportion of land points in the surface land-sea mask
+      !!
+      !! ** Method  : read iproc strips (of length jpiglo) of the land-sea mask
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(  out) :: propland    ! proportion of land points in the global domain (between 0 and 1)
+      !
+      INTEGER, DIMENSION(jpni*jpnj) ::   kusedom_1d
+      INTEGER :: inboce, iarea
+      INTEGER :: iproc, idiv, ijsz
+      INTEGER :: ijstr
+      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce
+      !!----------------------------------------------------------------------
+      ! do nothing if there is no land-sea mask
+      IF( numbot == -1 .and. numbdy == -1 ) THEN
+         propland = 0.
+         RETURN
+      ENDIF
+
+      ! number of processes reading the bathymetry file 
+      iproc = MINVAL( (/mppsize, jpjglo/2, 100/) )  ! read a least 2 lines, no more that 100 processes reading at the same time
+      
+      ! we want to read iproc strips of the land-sea mask. -> pick up iproc processes every idiv processes starting at 1
+      IF( iproc == 1 ) THEN   ;   idiv = mppsize
+      ELSE                    ;   idiv = ( mppsize - 1 ) / ( iproc - 1 )
+      ENDIF
+
+      iarea = (narea-1)/idiv   ! involed process number (starting counting at 0)
+      IF( MOD( narea-1, idiv ) == 0 .AND. iarea < iproc ) THEN   ! beware idiv can be = to 1
+         !
+         ijsz = jpjglo / iproc                                               ! width of the stripe to read
+         IF( iarea < MOD(jpjglo,iproc) ) ijsz = ijsz + 1
+         ijstr = iarea*(jpjglo/iproc) + MIN(iarea, MOD(jpjglo,iproc)) + 1    ! starting j position of the reading
+         !
+         ALLOCATE( lloce(jpiglo, ijsz) )                                     ! allocate the strip
+         CALL mpp_init_readbot_strip( ijstr, ijsz, lloce )
+         inboce = COUNT(lloce)                                               ! number of ocean point in the stripe
+         DEALLOCATE(lloce)
+         !
+      ELSE
+         inboce = 0
+      ENDIF
+      CALL mpp_sum( 'mppini', inboce )   ! total number of ocean points over the global domain
+      !
+      propland = REAL( jpiglo*jpjglo - inboce, wp ) / REAL( jpiglo*jpjglo, wp ) 
+      !
+   END SUBROUTINE mpp_init_landprop
+   
+   
+   SUBROUTINE mpp_init_isoce( knbi, knbj, ldisoce )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_nboce  ***
+      !!
+      !! ** Purpose : check for a mpi domain decomposition knbi x knbj which
+      !!              subdomains contain at least 1 ocean point
+      !!
+      !! ** Method  : read knbj strips (of length jpiglo) of the land-sea mask
+      !!----------------------------------------------------------------------
+      INTEGER,                       INTENT(in   ) ::   knbi, knbj     ! domain decomposition
+      LOGICAL, DIMENSION(knbi,knbj), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point 
+      !
+      INTEGER, DIMENSION(knbi,knbj) ::   inboce                        ! number oce oce pint in each mpi subdomain
+      INTEGER, DIMENSION(knbi*knbj) ::   inboce_1d
+      INTEGER :: idiv, iimax, ijmax, iarea
+      INTEGER :: ji, jn
+      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce                  ! lloce(i,j) = .true. if the point (i,j) is ocean 
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ilci
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ilcj
+      !!----------------------------------------------------------------------
+      ! do nothing if there is no land-sea mask
+      IF( numbot == -1 .AND. numbdy == -1 ) THEN
+         ldisoce(:,:) = .TRUE.
+         RETURN
+      ENDIF
+
+      ! we want to read knbj strips of the land-sea mask. -> pick up knbj processes every idiv processes starting at 1
+      IF           ( knbj == 1 ) THEN   ;   idiv = mppsize
+      ELSE IF ( mppsize < knbj ) THEN   ;   idiv = 1
+      ELSE                              ;   idiv = ( mppsize - 1 ) / ( knbj - 1 )
+      ENDIF
+      inboce(:,:) = 0          ! default no ocean point found
+
+      DO jn = 0, (knbj-1)/mppsize   ! if mppsize < knbj : more strips than mpi processes (because of potential land domains)
+         !
+         iarea = (narea-1)/idiv + jn * mppsize   ! involed process number (starting counting at 0)
+         IF( MOD( narea-1, idiv ) == 0 .AND. iarea < knbj ) THEN   ! beware idiv can be = to 1
+            !
+            ALLOCATE( iimppt(knbi,knbj), ijmppt(knbi,knbj), ilci(knbi,knbj), ilcj(knbi,knbj) )
+            CALL mpp_basic_decomposition( knbi, knbj, iimax, ijmax, iimppt, ijmppt, ilci, ilcj )
+            !
+            ALLOCATE( lloce(jpiglo, ilcj(1,iarea+1)) )                                         ! allocate the strip
+            CALL mpp_init_readbot_strip( ijmppt(1,iarea+1), ilcj(1,iarea+1), lloce )           ! read the strip
+            DO  ji = 1, knbi
+               inboce(ji,iarea+1) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ilci(ji,1)-1,:) )   ! number of ocean point in subdomain
+            END DO
+            !
+            DEALLOCATE(lloce)
+            DEALLOCATE(iimppt, ijmppt, ilci, ilcj)
+            !
+         ENDIF
+      END DO
+   
+      inboce_1d = RESHAPE(inboce, (/ knbi*knbj /))
+      CALL mpp_sum( 'mppini', inboce_1d )
+      inboce = RESHAPE(inboce_1d, (/knbi, knbj/))
+      ldisoce(:,:) = inboce(:,:) /= 0
+      !
+   END SUBROUTINE mpp_init_isoce
+   
+   
+   SUBROUTINE mpp_init_readbot_strip( kjstr, kjcnt, ldoce )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_readbot_strip  ***
+      !!
+      !! ** Purpose : Read relevant bathymetric information in order to
+      !!              provide a land/sea mask used for the elimination
+      !!              of land domains, in an mpp computation.
+      !!
+      !! ** Method  : read stipe of size (jpiglo,...)
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) :: kjstr       ! starting j position of the reading
+      INTEGER                         , INTENT(in   ) :: kjcnt       ! number of lines to read
+      LOGICAL, DIMENSION(jpiglo,kjcnt), INTENT(  out) :: ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean 
+      !
+      INTEGER                           ::   inumsave                ! local logical unit
+      REAL(wp), DIMENSION(jpiglo,kjcnt) ::   zbot, zbdy 
+      !!----------------------------------------------------------------------
+      !
+      inumsave = numout   ;   numout = numnul   !   redirect all print to /dev/null
+      !
+      IF( numbot /= -1 ) THEN
+         CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/jpiglo, kjcnt/) )
+      ELSE
+         zbot(:,:) = 1.                         ! put a non-null value
+      ENDIF
+
+       IF( numbdy /= -1 ) THEN                  ! Adjust with bdy_msk if it exists    
+         CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/jpiglo, kjcnt/) )
+         zbot(:,:) = zbot(:,:) * zbdy(:,:)
+      ENDIF
+      !
+      ldoce(:,:) = zbot(:,:) > 0.
+      numout = inumsave
+      !
+   END SUBROUTINE mpp_init_readbot_strip
+
+
+   SUBROUTINE mpp_init_ioipsl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_ioipsl  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !! ** Method  :   
+      !!
+      !! History :
+      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL 
+      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid
+      !!----------------------------------------------------------------------
+
+      ! The domain is split only horizontally along i- or/and j- direction
+      ! So we need at the most only 1D arrays with 2 elements.
+      ! Set idompar values equivalent to the jpdom_local_noextra definition
+      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
+      iglo(1) = jpiglo
+      iglo(2) = jpjglo
+      iloc(1) = nlci
+      iloc(2) = nlcj
+      iabsf(1) = nimppt(narea)
+      iabsf(2) = njmppt(narea)
+      iabsl(:) = iabsf(:) + iloc(:) - 1
+      ihals(1) = nldi - 1
+      ihals(2) = nldj - 1
+      ihale(1) = nlci - nlei
+      ihale(2) = nlcj - nlej
+      idid(1) = 1
+      idid(2) = 2
+
+      IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
+          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
+          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
+          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
+      ENDIF
+      !
+      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
+      !
+   END SUBROUTINE mpp_init_ioipsl  
+
+
+   SUBROUTINE mpp_init_nfdcom
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE  mpp_init_nfdcom  ***
+      !! ** Purpose :   Setup for north fold exchanges with explicit 
+      !!                point-to-point messaging
+      !!
+      !! ** Method :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   sxM, dxM, sxT, dxT, jn
+      INTEGER  ::   njmppmax
+      !!----------------------------------------------------------------------
+      !
+      njmppmax = MAXVAL( njmppt )
+      !
+      !initializes the north-fold communication variables
+      isendto(:) = 0
+      nsndto     = 0
+      !
+      IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north
+         !
+         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process
+         sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+         !dxM is the last point (in the global domain) needed to compute the north-fold for the current process
+         dxM = jpiglo - nimppt(narea) + 2
+         !
+         ! loop over the other north-fold processes to find the processes
+         ! managing the points belonging to the sxT-dxT range
+         !
+         DO jn = 1, jpni
+            !
+            sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process
+            dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process
+            !
+            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ENDIF
+            !
+         END DO
+         nfsloop = 1
+         nfeloop = nlci
+         DO jn = 2,jpni-1
+            IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN
+               IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi
+               IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei
+            ENDIF
+         END DO
+         !
+      ENDIF
+      l_north_nogather = .TRUE.
+      !
+   END SUBROUTINE mpp_init_nfdcom
+
+
+#endif
+
+   !!======================================================================
+END MODULE mppini
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mppini.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mppini.f90	(revision 12100)
+++ 	(revision )
@@ -1,1011 +1,0 @@
-MODULE mppini
-   !!==============================================================================
-   !!                       ***  MODULE mppini   ***
-   !! Ocean initialization : distributed memory computing initialization
-   !!==============================================================================
-
-   !!----------------------------------------------------------------------
-   !!   mpp_init       : Lay out the global domain over processors
-   !!   mpp_init2      : Lay out the global domain over processors 
-   !!                    with land processor elimination
-   !!   mpp_init_ioispl: IOIPSL initialization in mpp
-   !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain 
-   USE in_out_manager  ! I/O Manager
-   USE lib_mpp         ! distribued memory computing library
-   USE ioipsl
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC mpp_init       ! called by opa.F90
-   PUBLIC mpp_init2      ! called by opa.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: mppini.F90 6412 2016-03-31 16:22:32Z lovato $ 
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'          OR         MPI massively parallel processing
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE mpp_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init  ***
-      !!                    
-      !! ** Purpose :   Lay out the global domain over processors.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!      Periodic condition is a function of the local domain position
-      !!      (global boundary or neighbouring domain) and of the global
-      !!      periodic
-      !!      Type :         jperio global periodic condition
-      !!                     nperio local  periodic condition
-      !!
-      !! ** Action  : - set domain parameters
-      !!                    nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlci      : first dimension
-      !!                    nlcj      : second dimension
-      !!                    nbondi    : mark for "east-west local boundary"
-      !!                    nbondj    : mark for "north-south local boundary"
-      !!                    nproc     : number for local processor
-      !!                    noea      : number for local neighboring processor
-      !!                    nowe      : number for local neighboring processor
-      !!                    noso      : number for local neighboring processor
-      !!                    nono      : number for local neighboring processor
-      !!
-      !! History :
-      !!        !  94-11  (M. Guyon)  Original code
-      !!        !  95-04  (J. Escobar, M. Imbard)
-      !!        !  98-02  (M. Guyon)  FETI method
-      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
-      !!   8.5  !  02-08  (G. Madec)  F90 : free form
-      !!   3.4  !  11-11  (C. Harris) decomposition changes for running with CICE
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jn   ! dummy loop indices
-      INTEGER  ::   ii, ij, ifreq, il1, il2            ! local integers
-      INTEGER  ::   iresti, irestj, ijm1, imil, inum   !   -      -
-      REAL(wp) ::   zidom, zjdom                       ! local scalars
-      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ijmppt, ilcit, ilcjt   ! local workspace
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~'
-
-
-      !  1. Dimension arrays for subdomains
-      ! -----------------------------------
-      !  Computation of local domain sizes ilcit() ilcjt()
-      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array (cf. par_oce.F90).
-      
-      nreci  = 2 * jpreci
-      nrecj  = 2 * jprecj
-      iresti = MOD( jpiglo - nreci , jpni )
-      irestj = MOD( jpjglo - nrecj , jpnj )
-
-      IF(  iresti == 0 )   iresti = jpni
-
-
-      DO jj = 1, jpnj
-         DO ji = 1, iresti
-            ilcit(ji,jj) = jpi
-         END DO
-         DO ji = iresti+1, jpni
-            ilcit(ji,jj) = jpi -1
-         END DO
-      END DO
-      
-      nfilcit(:,:) = ilcit(:,:)
-      IF( irestj == 0 )   irestj = jpnj
-
-
-      DO ji = 1, jpni
-         DO jj = 1, irestj
-            ilcjt(ji,jj) = jpj
-         END DO
-         DO jj = irestj+1, jpnj
-            ilcjt(ji,jj) = jpj -1
-         END DO
-      END DO
-      
-
-      !  2. Index arrays for subdomains
-      ! -------------------------------
-      
-      iimppt(:,:) = 1
-      ijmppt(:,:) = 1
-      
-      IF( jpni > 1 ) THEN
-         DO jj = 1, jpnj
-            DO ji = 2, jpni
-               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
-            END DO
-         END DO
-      ENDIF
-      nfiimpp(:,:)=iimppt(:,:)
-
-      IF( jpnj > 1 ) THEN
-         DO jj = 2, jpnj
-            DO ji = 1, jpni
-               ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
-            END DO
-         END DO
-      ENDIF
-      
-      ! 3. Subdomain description
-      ! ------------------------
-
-      DO jn = 1, jpnij
-         ii = 1 + MOD( jn-1, jpni )
-         ij = 1 + (jn-1) / jpni
-         nfipproc(ii,ij) = jn - 1
-         nimppt(jn) = iimppt(ii,ij)
-         njmppt(jn) = ijmppt(ii,ij)
-         nlcit (jn) = ilcit (ii,ij)     
-         nlci       = nlcit (jn)     
-         nlcjt (jn) = ilcjt (ii,ij)     
-         nlcj       = nlcjt (jn)
-         nbondj = -1                                   ! general case
-         IF( jn   >  jpni          )   nbondj = 0      ! first row of processor
-         IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor
-         IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction
-         ibonjt(jn) = nbondj
-         
-         nbondi = 0                                    ! 
-         IF( MOD( jn, jpni ) == 1 )   nbondi = -1      !
-         IF( MOD( jn, jpni ) == 0 )   nbondi =  1      !
-         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction
-         ibonit(jn) = nbondi
-         
-         nldi =  1   + jpreci
-         nlei = nlci - jpreci
-         IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1
-         IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci
-         nldj =  1   + jprecj
-         nlej = nlcj - jprecj
-         IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1
-         IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj
-         nldit(jn) = nldi
-         nleit(jn) = nlei
-         nldjt(jn) = nldj
-         nlejt(jn) = nlej
-      END DO
-
-      ! 4. Subdomain print
-      ! ------------------
-      
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' mpp_init: defines mpp subdomains'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
-      zidom = nreci
-      DO ji = 1, jpni
-         zidom = zidom + ilcit(ji,1) - nreci
-      END DO
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)' sum ilcit(i,1)=', zidom, ' jpiglo=', jpiglo
-
-      zjdom = nrecj
-      DO jj = 1, jpnj
-         zjdom = zjdom + ilcjt(1,jj) - nrecj
-      END DO
-      IF(lwp) WRITE(numout,*)' sum ilcit(1,j)=', zjdom, ' jpjglo=', jpjglo
-      IF(lwp) WRITE(numout,*)
-
-      IF(lwp) THEN
-         ifreq = 4
-         il1   = 1
-         DO jn = 1, (jpni-1)/ifreq+1
-            il2 = MIN( jpni, il1+ifreq-1 )
-            WRITE(numout,*)
-            WRITE(numout,9200) ('***',ji = il1,il2-1)
-            DO jj = jpnj, 1, -1
-               WRITE(numout,9203) ('   ',ji = il1,il2-1)
-               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
-               WRITE(numout,9204) (nfipproc(ji,jj),ji=il1,il2)
-               WRITE(numout,9203) ('   ',ji = il1,il2-1)
-               WRITE(numout,9200) ('***',ji = il1,il2-1)
-            END DO
-            WRITE(numout,9201) (ji,ji = il1,il2)
-            il1 = il1+ifreq
-         END DO
- 9200     FORMAT('     ***',20('*************',a3))
- 9203     FORMAT('     *     ',20('         *   ',a3))
- 9201     FORMAT('        ',20('   ',i3,'          '))
- 9202     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
- 9204     FORMAT('     *  ',20('      ',i3,'   *   '))
-      ENDIF
-
-      ! 5. From global to local
-      ! -----------------------
-
-      nperio = 0
-      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
-
-
-      ! 6. Subdomain neighbours
-      ! ----------------------
-
-      nproc = narea - 1
-      noso  = nproc - jpni
-      nowe  = nproc - 1
-      noea  = nproc + 1
-      nono  = nproc + jpni
-      ! great neighbours
-      npnw = nono - 1
-      npne = nono + 1
-      npsw = noso - 1
-      npse = noso + 1
-      nbsw = 1
-      nbnw = 1
-      IF( MOD( nproc, jpni ) == 0 ) THEN
-         nbsw = 0
-         nbnw = 0
-      ENDIF
-      nbse = 1
-      nbne = 1
-      IF( MOD( nproc, jpni ) == jpni-1 ) THEN
-         nbse = 0
-         nbne = 0
-      ENDIF
-      IF(nproc < jpni) THEN
-         nbsw = 0
-         nbse = 0
-      ENDIF
-      IF( nproc >= (jpnj-1)*jpni ) THEN
-         nbnw = 0
-         nbne = 0
-      ENDIF
-      nlcj = nlcjt(narea)  
-      nlci = nlcit(narea)  
-      nldi = nldit(narea)
-      nlei = nleit(narea)
-      nldj = nldjt(narea)
-      nlej = nlejt(narea)
-      nbondi = ibonit(narea)
-      nbondj = ibonjt(narea)
-      nimpp  = nimppt(narea)  
-      njmpp  = njmppt(narea)  
-
-     ! Save processor layout in layout.dat file 
-       IF (lwp) THEN
-        CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
-        WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
-        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
-        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
-
-        DO  jn = 1, jpnij
-         WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
-                                      nldit(jn), nldjt(jn), &
-                                      nleit(jn), nlejt(jn), &
-                                      nimppt(jn), njmppt(jn)
-        END DO
-        CLOSE(inum)   
-      END IF
-
-
-      ! w a r n i n g  narea (zone) /= nproc (processors)!
-
-      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
-         IF( jpni == 1 )THEN
-            nbondi = 2
-            nperio = 1
-         ELSE
-            nbondi = 0
-         ENDIF
-         IF( MOD( narea, jpni ) == 0 ) THEN
-            noea = nproc-(jpni-1)
-            npne = npne-jpni
-            npse = npse-jpni
-         ENDIF
-         IF( MOD( narea, jpni ) == 1 ) THEN
-            nowe = nproc+(jpni-1)
-            npnw = npnw+jpni
-            npsw = npsw+jpni
-         ENDIF
-         nbsw = 1
-         nbnw = 1
-         nbse = 1
-         nbne = 1
-         IF( nproc < jpni ) THEN
-            nbsw = 0
-            nbse = 0
-         ENDIF
-         IF( nproc >= (jpnj-1)*jpni ) THEN
-            nbnw = 0
-            nbne = 0
-         ENDIF
-      ENDIF
-      npolj = 0
-      IF( jperio == 3 .OR. jperio == 4 ) THEN
-         ijm1 = jpni*(jpnj-1)
-         imil = ijm1+(jpni+1)/2
-         IF( narea > ijm1 ) npolj = 3
-         IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
-         IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
-      ENDIF
-      IF( jperio == 5 .OR. jperio == 6 ) THEN
-          ijm1 = jpni*(jpnj-1)
-          imil = ijm1+(jpni+1)/2
-          IF( narea > ijm1) npolj = 5
-          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
-          IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
-      ENDIF
-
-      ! Periodicity : no corner if nbondi = 2 and nperio != 1
-
-      IF(lwp) THEN
-         WRITE(numout,*) ' nproc  = ', nproc
-         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
-         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
-         WRITE(numout,*) ' nbondi = ', nbondi
-         WRITE(numout,*) ' nbondj = ', nbondj
-         WRITE(numout,*) ' npolj  = ', npolj
-         WRITE(numout,*) ' nperio = ', nperio
-         WRITE(numout,*) ' nlci   = ', nlci
-         WRITE(numout,*) ' nlcj   = ', nlcj
-         WRITE(numout,*) ' nimpp  = ', nimpp
-         WRITE(numout,*) ' njmpp  = ', njmpp
-         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse
-         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw
-         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne
-         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw
-         WRITE(numout,*)
-      ENDIF
-
-      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' )
-
-      ! Prepare mpp north fold
-
-      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
-         CALL mpp_ini_north
-         IF(lwp) WRITE(numout,*) ' mpp_init : North fold boundary prepared for jpni >1'
-      ENDIF
-
-      ! Prepare NetCDF output file (if necessary)
-      CALL mpp_init_ioipsl
-
-   END SUBROUTINE mpp_init
-
-   SUBROUTINE mpp_init2
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init2  ***
-      !!
-      !! * Purpose :   Lay out the global domain over processors.
-      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
-      !!     FOR DEFINING BETTER CUTTING OUT.
-      !!       This routine is used with a the bathymetry file.
-      !!       In this version, the land processors are avoided and the adress
-      !!     processor (nproc, narea,noea, ...) are calculated again.
-      !!     The jpnij parameter can be lesser than jpni x jpnj
-      !!     and this jpnij parameter must be calculated before with an
-      !!     algoritmic preprocessing program.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!      Periodic condition is a function of the local domain position
-      !!      (global boundary or neighbouring domain) and of the global
-      !!      periodic
-      !!      Type :         jperio global periodic condition
-      !!                     nperio local  periodic condition
-      !!
-      !! ** Action :        nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlci      : first dimension
-      !!                    nlcj      : second dimension
-      !!                    nproc     : number for local processor
-      !!                    noea      : number for local neighboring processor
-      !!                    nowe      : number for local neighboring processor
-      !!                    noso      : number for local neighboring processor
-      !!                    nono      : number for local neighboring processor
-      !!
-      !! History :
-      !!        !  94-11  (M. Guyon)  Original code
-      !!        !  95-04  (J. Escobar, M. Imbard)
-      !!        !  98-02  (M. Guyon)  FETI method
-      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
-      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
-      !!----------------------------------------------------------------------
-      USE in_out_manager  ! I/O Manager
-      USE iom
-      !! 
-      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
-      INTEGER ::  inum                        ! temporary logical unit
-      INTEGER ::  idir                        ! temporary integers
-      INTEGER ::  jstartrow                   ! temporary integers
-      INTEGER ::   ios                        ! Local integer output status for namelist read
-      INTEGER ::   &
-         ii, ij, ifreq, il1, il2,          &  ! temporary integers
-         icont, ili, ilj,                  &  !    "          "
-         isurf, ijm1, imil,                &  !    "          "
-         iino, ijno, iiso, ijso,           &  !    "          " 
-         iiea, ijea, iiwe, ijwe,           &  !    "          "
-         iinw, ijnw, iine, ijne,           &  !    "          "
-         iisw, ijsw, iise, ijse,           &  !    "          "
-         iresti, irestj, iproc                !    "          "
-      INTEGER, DIMENSION(jpnij) ::   &
-         iin, ijn          
-      INTEGER, DIMENSION(jpni,jpnj) ::   &
-         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
-         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
-         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
-         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
-         ione  , ionw  , iose  , iosw  ,   &  !    "           "
-         ibne  , ibnw  , ibse  , ibsw         !    "           "
-      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   &
-         imask                                ! temporary global workspace
-      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
-         zdta, zdtaisf                     ! temporary data workspace
-      REAL(wp) ::   zidom , zjdom          ! temporary scalars
-
-      ! read namelist for ln_zco
-      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh
-
-      !!----------------------------------------------------------------------
-      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-      !! $Id: mppini_2.h90 6412 2016-03-31 16:22:32Z lovato $
-      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
-      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
-      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namzgr )
-
-      IF(lwp)WRITE(numout,*)
-      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
-      IF(lwp)WRITE(numout,*) '~~~~~~~~'
-      IF(lwp)WRITE(numout,*) ' '
-
-      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
-
-      ! 0. initialisation
-      ! -----------------
-
-      ! open the file
-      ! Remember that at this level in the code, mpp is not yet initialized, so
-      ! the file must be open with jpdom_unknown, and kstart and kcount forced 
-      jstartrow = 1
-      IF ( ln_zco ) THEN 
-         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
-          ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
-          ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
-         CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
-         jstartrow = MAX(1,jstartrow)
-         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) )
-      ELSE
-         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
-         IF ( ln_isfcav ) THEN
-             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
-         ELSE
-             ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
-             ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
-             CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
-             jstartrow = MAX(1,jstartrow)
-             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/)   &
-                &                                                   , kcount=(/jpiglo,jpjglo/) )
-         ENDIF
-      ENDIF
-      CALL iom_close (inum)
-      
-      ! used to compute the land processor in case of not masked bathy file.
-      zdtaisf(:,:) = 0.0_wp
-      IF ( ln_isfcav ) THEN
-         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
-         CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
-      END IF
-      CALL iom_close (inum)
-
-      ! land/sea mask over the global/zoom domain
-
-      imask(:,:)=1
-      WHERE ( zdta(:,:) - zdtaisf(:,:) <= rn_isfhmin ) imask = 0
-
-      !  1. Dimension arrays for subdomains
-      ! -----------------------------------
-
-      !  Computation of local domain sizes ilci() ilcj()
-      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array.
-
-      nreci=2*jpreci
-      nrecj=2*jprecj
-      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
-      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
-
-      ilci(1:iresti      ,:) = jpi
-      ilci(iresti+1:jpni ,:) = jpi-1
-
-      ilcj(:,      1:irestj) = jpj
-      ilcj(:, irestj+1:jpnj) = jpj-1
-
-      nfilcit(:,:) = ilci(:,:)
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
-
-      zidom = nreci + sum(ilci(:,1) - nreci ) 
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
-
-      zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 
-      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
-      IF(lwp) WRITE(numout,*)
-
-
-      !  2. Index arrays for subdomains
-      ! -------------------------------
-
-      iimppt(:,:) = 1
-      ijmppt(:,:) = 1
-      ipproc(:,:) = -1
-
-      IF( jpni > 1 )THEN
-         DO jj = 1, jpnj
-            DO ji = 2, jpni
-               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
-            END DO
-         END DO
-      ENDIF
-      nfiimpp(:,:) = iimppt(:,:)
-
-      IF( jpnj > 1 )THEN
-         DO jj = 2, jpnj
-            DO ji = 1, jpni
-               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
-            END DO
-         END DO
-      ENDIF
-
-
-      ! 3. Subdomain description in the Regular Case
-      ! --------------------------------------------
-
-      nperio = 0
-      icont = -1
-      DO jarea = 1, jpni*jpnj
-         ii = 1 + MOD(jarea-1,jpni)
-         ij = 1 +    (jarea-1)/jpni
-         ili = ilci(ii,ij)
-         ilj = ilcj(ii,ij)
-         ibondj(ii,ij) = -1
-         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
-         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
-         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
-         ibondi(ii,ij) = 0
-         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
-         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
-         IF( jpni            == 1 )   ibondi(ii,ij) =  2
-
-         ! 2.4 Subdomain neighbors
-
-         iproc = jarea - 1
-         ioso(ii,ij) = iproc - jpni
-         iowe(ii,ij) = iproc - 1
-         ioea(ii,ij) = iproc + 1
-         iono(ii,ij) = iproc + jpni
-         ildi(ii,ij) = 1 + jpreci
-         ilei(ii,ij) = ili -jpreci
-         ionw(ii,ij) = iono(ii,ij) - 1
-         ione(ii,ij) = iono(ii,ij) + 1
-         iosw(ii,ij) = ioso(ii,ij) - 1
-         iose(ii,ij) = ioso(ii,ij) + 1
-         ibsw(ii,ij) = 1
-         ibnw(ii,ij) = 1
-         IF( MOD(iproc,jpni) == 0 ) THEN
-            ibsw(ii,ij) = 0
-            ibnw(ii,ij) = 0
-         ENDIF
-         ibse(ii,ij) = 1
-         ibne(ii,ij) = 1
-         IF( MOD(iproc,jpni) == jpni-1 ) THEN
-            ibse(ii,ij) = 0
-            ibne(ii,ij) = 0
-         ENDIF
-         IF( iproc < jpni ) THEN
-            ibsw(ii,ij) = 0
-            ibse(ii,ij) = 0
-         ENDIF
-         IF( iproc >= (jpnj-1)*jpni ) THEN
-            ibnw(ii,ij) = 0
-            ibne(ii,ij) = 0
-         ENDIF
-         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) = ili
-         ildj(ii,ij) =  1  + jprecj
-         ilej(ii,ij) = ilj - jprecj
-         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) = ilj
-
-         ! warning ii*ij (zone) /= nproc (processors)!
-
-         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
-            IF( jpni == 1 )THEN
-               ibondi(ii,ij) = 2
-               nperio = 1
-            ELSE
-               ibondi(ii,ij) = 0
-            ENDIF
-            IF( MOD(jarea,jpni) == 0 ) THEN
-               ioea(ii,ij) = iproc - (jpni-1)
-               ione(ii,ij) = ione(ii,ij) - jpni
-               iose(ii,ij) = iose(ii,ij) - jpni
-            ENDIF
-            IF( MOD(jarea,jpni) == 1 ) THEN
-               iowe(ii,ij) = iproc + jpni - 1
-               ionw(ii,ij) = ionw(ii,ij) + jpni
-               iosw(ii,ij) = iosw(ii,ij) + jpni 
-            ENDIF
-            ibsw(ii,ij) = 1
-            ibnw(ii,ij) = 1
-            ibse(ii,ij) = 1
-            ibne(ii,ij) = 1
-            IF( iproc < jpni ) THEN
-               ibsw(ii,ij) = 0
-               ibse(ii,ij) = 0
-            ENDIF
-            IF( iproc >= (jpnj-1)*jpni ) THEN
-               ibnw(ii,ij) = 0
-               ibne(ii,ij) = 0
-            ENDIF
-         ENDIF
-         ipolj(ii,ij) = 0
-         IF( jperio == 3 .OR. jperio == 4 ) THEN
-            ijm1 = jpni*(jpnj-1)
-            imil = ijm1+(jpni+1)/2
-            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
-            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
-            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1   ! MPI rank of northern neighbour
-         ENDIF
-         IF( jperio == 5 .OR. jperio == 6 ) THEN
-            ijm1 = jpni*(jpnj-1)
-            imil = ijm1+(jpni+1)/2
-            IF( jarea > ijm1) ipolj(ii,ij) = 5
-            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
-            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour
-         ENDIF
-
-         ! Check wet points over the entire domain to preserve the MPI communication stencil
-         isurf = 0
-         DO jj = 1, ilj
-            DO  ji = 1, ili
-               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
-            END DO
-         END DO
-
-         IF(isurf /= 0) THEN
-            icont = icont + 1
-            ipproc(ii,ij) = icont
-            iin(icont+1) = ii
-            ijn(icont+1) = ij
-         ENDIF
-      END DO
-
-      nfipproc(:,:) = ipproc(:,:)
-
-      ! Control
-      IF(icont+1 /= jpnij) THEN
-         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
-         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
-         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
-         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
-      ENDIF
-
-      ! 4. Subdomain print
-      ! ------------------
-
-      IF(lwp) THEN
-         ifreq = 4
-         il1 = 1
-         DO jn = 1,(jpni-1)/ifreq+1
-            il2 = MIN(jpni,il1+ifreq-1)
-            WRITE(numout,*)
-            WRITE(numout,9400) ('***',ji=il1,il2-1)
-            DO jj = jpnj, 1, -1
-               WRITE(numout,9403) ('   ',ji=il1,il2-1)
-               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
-               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
-               WRITE(numout,9403) ('   ',ji=il1,il2-1)
-               WRITE(numout,9400) ('***',ji=il1,il2-1)
-            END DO
-            WRITE(numout,9401) (ji,ji=il1,il2)
-            il1 = il1+ifreq
-         END DO
- 9400     FORMAT('     ***',20('*************',a3))
- 9403     FORMAT('     *     ',20('         *   ',a3))
- 9401     FORMAT('        ',20('   ',i3,'          '))
- 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
- 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
-      ENDIF
-
-
-      ! 5. neighbour treatment
-      ! ----------------------
-
-      DO jarea = 1, jpni*jpnj
-         iproc = jarea-1
-         ii = 1 + MOD(jarea-1,jpni)
-         ij = 1 +    (jarea-1)/jpni
-         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
-            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
-            iino = 1 + MOD(iono(ii,ij),jpni)
-            ijno = 1 +    (iono(ii,ij))/jpni
-              ! Need to reverse the logical direction of communication 
-              ! for northern neighbours of northern row processors (north-fold)
-              ! i.e. need to check that the northern neighbour only communicates
-              ! to the SOUTH (or not at all) if this area is land-only (#1057)
-            idir = 1
-            IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1    
-            IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
-            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
-            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
-            iiso = 1 + MOD(ioso(ii,ij),jpni)
-            ijso = 1 +    (ioso(ii,ij))/jpni
-            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
-            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
-            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
-            iiea = 1 + MOD(ioea(ii,ij),jpni)
-            ijea = 1 +    (ioea(ii,ij))/jpni
-            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
-            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
-            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
-            iiwe = 1 + MOD(iowe(ii,ij),jpni)
-            ijwe = 1 +    (iowe(ii,ij))/jpni
-            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
-            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
-            iine = 1 + MOD(ione(ii,ij),jpni)
-            ijne = 1 +    (ione(ii,ij))/jpni
-            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
-            iisw = 1 + MOD(iosw(ii,ij),jpni)
-            ijsw = 1 +    (iosw(ii,ij))/jpni
-            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
-            iinw = 1 + MOD(ionw(ii,ij),jpni)
-            ijnw = 1 +    (ionw(ii,ij))/jpni
-            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
-            iise = 1 + MOD(iose(ii,ij),jpni)
-            ijse = 1 +    (iose(ii,ij))/jpni
-            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
-         ENDIF
-      END DO
-
-
-      ! 6. Change processor name
-      ! ------------------------
-
-      nproc = narea-1
-      ii = iin(narea)
-      ij = ijn(narea)
-
-      ! set default neighbours
-      noso = ioso(ii,ij)
-      nowe = iowe(ii,ij)
-      noea = ioea(ii,ij)
-      nono = iono(ii,ij) 
-      npse = iose(ii,ij)
-      npsw = iosw(ii,ij)
-      npne = ione(ii,ij)
-      npnw = ionw(ii,ij)
-
-      ! check neighbours location
-      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiso = 1 + MOD(ioso(ii,ij),jpni)
-         ijso = 1 +    (ioso(ii,ij))/jpni
-         noso = ipproc(iiso,ijso)
-      ENDIF
-      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiwe = 1 + MOD(iowe(ii,ij),jpni)
-         ijwe = 1 +    (iowe(ii,ij))/jpni
-         nowe = ipproc(iiwe,ijwe)
-      ENDIF
-      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiea = 1 + MOD(ioea(ii,ij),jpni)
-         ijea = 1 +    (ioea(ii,ij))/jpni
-         noea = ipproc(iiea,ijea)
-      ENDIF
-      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iino = 1 + MOD(iono(ii,ij),jpni)
-         ijno = 1 +    (iono(ii,ij))/jpni
-         nono = ipproc(iino,ijno)
-      ENDIF
-      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iise = 1 + MOD(iose(ii,ij),jpni)
-         ijse = 1 +    (iose(ii,ij))/jpni
-         npse = ipproc(iise,ijse)
-      ENDIF
-      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iisw = 1 + MOD(iosw(ii,ij),jpni)
-         ijsw = 1 +    (iosw(ii,ij))/jpni
-         npsw = ipproc(iisw,ijsw)
-      ENDIF
-      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iine = 1 + MOD(ione(ii,ij),jpni)
-         ijne = 1 +    (ione(ii,ij))/jpni
-         npne = ipproc(iine,ijne)
-      ENDIF
-      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iinw = 1 + MOD(ionw(ii,ij),jpni)
-         ijnw = 1 +    (ionw(ii,ij))/jpni
-         npnw = ipproc(iinw,ijnw)
-      ENDIF
-      nbnw = ibnw(ii,ij)
-      nbne = ibne(ii,ij)
-      nbsw = ibsw(ii,ij)
-      nbse = ibse(ii,ij)
-      nlcj = ilcj(ii,ij)  
-      nlci = ilci(ii,ij)  
-      nldi = ildi(ii,ij)
-      nlei = ilei(ii,ij)
-      nldj = ildj(ii,ij)
-      nlej = ilej(ii,ij)
-      nbondi = ibondi(ii,ij)
-      nbondj = ibondj(ii,ij)
-      nimpp = iimppt(ii,ij)  
-      njmpp = ijmppt(ii,ij)  
-      DO jproc = 1, jpnij
-         ii = iin(jproc)
-         ij = ijn(jproc)
-         nimppt(jproc) = iimppt(ii,ij)  
-         njmppt(jproc) = ijmppt(ii,ij)  
-         nlcjt(jproc) = ilcj(ii,ij)
-         nlcit(jproc) = ilci(ii,ij)
-         nldit(jproc) = ildi(ii,ij)
-         nleit(jproc) = ilei(ii,ij)
-         nldjt(jproc) = ildj(ii,ij)
-         nlejt(jproc) = ilej(ii,ij)
-      END DO
-
-      ! Save processor layout in ascii file
-      IF (lwp) THEN
-         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
-         WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
-         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
-         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
-
-        DO  jproc = 1, jpnij
-         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
-                                      nldit(jproc), nldjt(jproc), &
-                                      nleit(jproc), nlejt(jproc), &
-                                      nimppt(jproc), njmppt(jproc)
-        END DO
-        CLOSE(inum)   
-      END IF
-
-      ! Defined npolj, either 0, 3 , 4 , 5 , 6
-      ! In this case the important thing is that npolj /= 0
-      ! Because if we go through these line it is because jpni >1 and thus
-      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
-
-      npolj = 0
-      ij = ijn(narea)
-
-      IF( jperio == 3 .OR. jperio == 4 ) THEN
-         IF( ij == jpnj ) npolj = 3
-      ENDIF
-
-      IF( jperio == 5 .OR. jperio == 6 ) THEN
-         IF( ij == jpnj ) npolj = 5
-      ENDIF
-
-      ! Periodicity : no corner if nbondi = 2 and nperio != 1
-
-      IF(lwp) THEN
-         WRITE(numout,*) ' nproc  = ', nproc
-         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
-         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
-         WRITE(numout,*) ' nbondi = ', nbondi
-         WRITE(numout,*) ' nbondj = ', nbondj
-         WRITE(numout,*) ' npolj  = ', npolj
-         WRITE(numout,*) ' nperio = ', nperio
-         WRITE(numout,*) ' nlci   = ', nlci
-         WRITE(numout,*) ' nlcj   = ', nlcj
-         WRITE(numout,*) ' nimpp  = ', nimpp
-         WRITE(numout,*) ' njmpp  = ', njmpp
-         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse
-         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw
-         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne
-         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw
-         WRITE(numout,*)
-      ENDIF
-
-      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )
-
-      ! Prepare mpp north fold
-
-      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
-         CALL mpp_ini_north
-         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
-      ENDIF
-
-      ! Prepare NetCDF output file (if necessary)
-      CALL mpp_init_ioipsl
-
-
-   END SUBROUTINE mpp_init2
-
-   SUBROUTINE mpp_init_ioipsl
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init_ioipsl  ***
-      !!
-      !! ** Purpose :   
-      !!
-      !! ** Method  :   
-      !!
-      !! History :
-      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL 
-      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
-      !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid
-      !!----------------------------------------------------------------------
-
-      ! The domain is split only horizontally along i- or/and j- direction
-      ! So we need at the most only 1D arrays with 2 elements.
-      ! Set idompar values equivalent to the jpdom_local_noextra definition
-      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
-      iglo(1) = jpiglo
-      iglo(2) = jpjglo
-      iloc(1) = nlci
-      iloc(2) = nlcj
-      iabsf(1) = nimppt(narea)
-      iabsf(2) = njmppt(narea)
-      iabsl(:) = iabsf(:) + iloc(:) - 1
-      ihals(1) = nldi - 1
-      ihals(2) = nldj - 1
-      ihale(1) = nlci - nlei
-      ihale(2) = nlcj - nlej
-      idid(1) = 1
-      idid(2) = 2
-
-      IF(lwp) THEN
-          WRITE(numout,*)
-          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
-          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
-          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
-          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
-      ENDIF
-      !
-      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
-      !
-   END SUBROUTINE mpp_init_ioipsl  
-
-
-   !!======================================================================
-END MODULE mppini
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mppini_2.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/mppini_2.h90	(revision 12100)
+++ 	(revision )
@@ -1,580 +1,0 @@
-   SUBROUTINE mpp_init2
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init2  ***
-      !!
-      !! * Purpose :   Lay out the global domain over processors.
-      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
-      !!     FOR DEFINING BETTER CUTTING OUT.
-      !!       This routine is used with a the bathymetry file.
-      !!       In this version, the land processors are avoided and the adress
-      !!     processor (nproc, narea,noea, ...) are calculated again.
-      !!     The jpnij parameter can be lesser than jpni x jpnj
-      !!     and this jpnij parameter must be calculated before with an
-      !!     algoritmic preprocessing program.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!      Periodic condition is a function of the local domain position
-      !!      (global boundary or neighbouring domain) and of the global
-      !!      periodic
-      !!      Type :         jperio global periodic condition
-      !!                     nperio local  periodic condition
-      !!
-      !! ** Action :        nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlci      : first dimension
-      !!                    nlcj      : second dimension
-      !!                    nproc     : number for local processor
-      !!                    noea      : number for local neighboring processor
-      !!                    nowe      : number for local neighboring processor
-      !!                    noso      : number for local neighboring processor
-      !!                    nono      : number for local neighboring processor
-      !!
-      !! History :
-      !!        !  94-11  (M. Guyon)  Original code
-      !!        !  95-04  (J. Escobar, M. Imbard)
-      !!        !  98-02  (M. Guyon)  FETI method
-      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
-      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
-      !!----------------------------------------------------------------------
-      USE in_out_manager  ! I/O Manager
-      USE iom
-      !! 
-      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
-      INTEGER ::  inum                        ! temporary logical unit
-      INTEGER ::  idir                        ! temporary integers
-      INTEGER ::  jstartrow                   ! temporary integers
-      INTEGER ::   ios                        ! Local integer output status for namelist read
-      INTEGER ::   &
-         ii, ij, ifreq, il1, il2,          &  ! temporary integers
-         icont, ili, ilj,                  &  !    "          "
-         isurf, ijm1, imil,                &  !    "          "
-         iino, ijno, iiso, ijso,           &  !    "          " 
-         iiea, ijea, iiwe, ijwe,           &  !    "          "
-         iinw, ijnw, iine, ijne,           &  !    "          "
-         iisw, ijsw, iise, ijse,           &  !    "          "
-         iresti, irestj, iproc                !    "          "
-      INTEGER, DIMENSION(jpnij) ::   &
-         iin, ijn          
-      INTEGER, DIMENSION(jpni,jpnj) ::   &
-         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
-         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
-         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
-         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
-         ione  , ionw  , iose  , iosw  ,   &  !    "           "
-         ibne  , ibnw  , ibse  , ibsw         !    "           "
-      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   &
-         imask                                ! temporary global workspace
-      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
-         zdta, zdtaisf                     ! temporary data workspace
-      REAL(wp) ::   zidom , zjdom          ! temporary scalars
-
-      ! read namelist for ln_zco
-      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh
-
-      !!----------------------------------------------------------------------
-      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-      !! $Id: mppini_2.h90 6412 2016-03-31 16:22:32Z lovato $
-      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
-      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
-      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namzgr )
-
-      IF(lwp)WRITE(numout,*)
-      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
-      IF(lwp)WRITE(numout,*) '~~~~~~~~'
-      IF(lwp)WRITE(numout,*) ' '
-
-      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
-
-      ! 0. initialisation
-      ! -----------------
-
-      ! open the file
-      ! Remember that at this level in the code, mpp is not yet initialized, so
-      ! the file must be open with jpdom_unknown, and kstart and kcount forced 
-      jstartrow = 1
-      IF ( ln_zco ) THEN 
-         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
-          ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
-          ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
-         CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
-         jstartrow = MAX(1,jstartrow)
-         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) )
-      ELSE
-         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
-         IF ( ln_isfcav ) THEN
-             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
-         ELSE
-             ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
-             ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
-             CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
-             jstartrow = MAX(1,jstartrow)
-             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/)   &
-                &                                                   , kcount=(/jpiglo,jpjglo/) )
-         ENDIF
-      ENDIF
-      CALL iom_close (inum)
-      
-      ! used to compute the land processor in case of not masked bathy file.
-      zdtaisf(:,:) = 0.0_wp
-      IF ( ln_isfcav ) THEN
-         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
-         CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
-      END IF
-      CALL iom_close (inum)
-
-      ! land/sea mask over the global/zoom domain
-
-      imask(:,:)=1
-      WHERE ( zdta(:,:) - zdtaisf(:,:) <= rn_isfhmin ) imask = 0
-
-      !  1. Dimension arrays for subdomains
-      ! -----------------------------------
-
-      !  Computation of local domain sizes ilci() ilcj()
-      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array.
-
-      nreci=2*jpreci
-      nrecj=2*jprecj
-      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
-      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
-
-      ilci(1:iresti      ,:) = jpi
-      ilci(iresti+1:jpni ,:) = jpi-1
-
-      ilcj(:,      1:irestj) = jpj
-      ilcj(:, irestj+1:jpnj) = jpj-1
-
-      nfilcit(:,:) = ilci(:,:)
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
-
-      zidom = nreci + sum(ilci(:,1) - nreci ) 
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
-
-      zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 
-      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
-      IF(lwp) WRITE(numout,*)
-
-
-      !  2. Index arrays for subdomains
-      ! -------------------------------
-
-      iimppt(:,:) = 1
-      ijmppt(:,:) = 1
-      ipproc(:,:) = -1
-
-      IF( jpni > 1 )THEN
-         DO jj = 1, jpnj
-            DO ji = 2, jpni
-               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
-            END DO
-         END DO
-      ENDIF
-      nfiimpp(:,:) = iimppt(:,:)
-
-      IF( jpnj > 1 )THEN
-         DO jj = 2, jpnj
-            DO ji = 1, jpni
-               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
-            END DO
-         END DO
-      ENDIF
-
-
-      ! 3. Subdomain description in the Regular Case
-      ! --------------------------------------------
-
-      nperio = 0
-      icont = -1
-      DO jarea = 1, jpni*jpnj
-         ii = 1 + MOD(jarea-1,jpni)
-         ij = 1 +    (jarea-1)/jpni
-         ili = ilci(ii,ij)
-         ilj = ilcj(ii,ij)
-         ibondj(ii,ij) = -1
-         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
-         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
-         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
-         ibondi(ii,ij) = 0
-         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
-         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
-         IF( jpni            == 1 )   ibondi(ii,ij) =  2
-
-         ! 2.4 Subdomain neighbors
-
-         iproc = jarea - 1
-         ioso(ii,ij) = iproc - jpni
-         iowe(ii,ij) = iproc - 1
-         ioea(ii,ij) = iproc + 1
-         iono(ii,ij) = iproc + jpni
-         ildi(ii,ij) = 1 + jpreci
-         ilei(ii,ij) = ili -jpreci
-         ionw(ii,ij) = iono(ii,ij) - 1
-         ione(ii,ij) = iono(ii,ij) + 1
-         iosw(ii,ij) = ioso(ii,ij) - 1
-         iose(ii,ij) = ioso(ii,ij) + 1
-         ibsw(ii,ij) = 1
-         ibnw(ii,ij) = 1
-         IF( MOD(iproc,jpni) == 0 ) THEN
-            ibsw(ii,ij) = 0
-            ibnw(ii,ij) = 0
-         ENDIF
-         ibse(ii,ij) = 1
-         ibne(ii,ij) = 1
-         IF( MOD(iproc,jpni) == jpni-1 ) THEN
-            ibse(ii,ij) = 0
-            ibne(ii,ij) = 0
-         ENDIF
-         IF( iproc < jpni ) THEN
-            ibsw(ii,ij) = 0
-            ibse(ii,ij) = 0
-         ENDIF
-         IF( iproc >= (jpnj-1)*jpni ) THEN
-            ibnw(ii,ij) = 0
-            ibne(ii,ij) = 0
-         ENDIF
-         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) = ili
-         ildj(ii,ij) =  1  + jprecj
-         ilej(ii,ij) = ilj - jprecj
-         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) = ilj
-
-         ! warning ii*ij (zone) /= nproc (processors)!
-
-         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
-            IF( jpni == 1 )THEN
-               ibondi(ii,ij) = 2
-               nperio = 1
-            ELSE
-               ibondi(ii,ij) = 0
-            ENDIF
-            IF( MOD(jarea,jpni) == 0 ) THEN
-               ioea(ii,ij) = iproc - (jpni-1)
-               ione(ii,ij) = ione(ii,ij) - jpni
-               iose(ii,ij) = iose(ii,ij) - jpni
-            ENDIF
-            IF( MOD(jarea,jpni) == 1 ) THEN
-               iowe(ii,ij) = iproc + jpni - 1
-               ionw(ii,ij) = ionw(ii,ij) + jpni
-               iosw(ii,ij) = iosw(ii,ij) + jpni 
-            ENDIF
-            ibsw(ii,ij) = 1
-            ibnw(ii,ij) = 1
-            ibse(ii,ij) = 1
-            ibne(ii,ij) = 1
-            IF( iproc < jpni ) THEN
-               ibsw(ii,ij) = 0
-               ibse(ii,ij) = 0
-            ENDIF
-            IF( iproc >= (jpnj-1)*jpni ) THEN
-               ibnw(ii,ij) = 0
-               ibne(ii,ij) = 0
-            ENDIF
-         ENDIF
-         ipolj(ii,ij) = 0
-         IF( jperio == 3 .OR. jperio == 4 ) THEN
-            ijm1 = jpni*(jpnj-1)
-            imil = ijm1+(jpni+1)/2
-            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
-            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
-            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1   ! MPI rank of northern neighbour
-         ENDIF
-         IF( jperio == 5 .OR. jperio == 6 ) THEN
-            ijm1 = jpni*(jpnj-1)
-            imil = ijm1+(jpni+1)/2
-            IF( jarea > ijm1) ipolj(ii,ij) = 5
-            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
-            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour
-         ENDIF
-
-         ! Check wet points over the entire domain to preserve the MPI communication stencil
-         isurf = 0
-         DO jj = 1, ilj
-            DO  ji = 1, ili
-               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
-            END DO
-         END DO
-
-         IF(isurf /= 0) THEN
-            icont = icont + 1
-            ipproc(ii,ij) = icont
-            iin(icont+1) = ii
-            ijn(icont+1) = ij
-         ENDIF
-      END DO
-
-      nfipproc(:,:) = ipproc(:,:)
-
-      ! Control
-      IF(icont+1 /= jpnij) THEN
-         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
-         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
-         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
-         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
-      ENDIF
-
-      ! 4. Subdomain print
-      ! ------------------
-
-      IF(lwp) THEN
-         ifreq = 4
-         il1 = 1
-         DO jn = 1,(jpni-1)/ifreq+1
-            il2 = MIN(jpni,il1+ifreq-1)
-            WRITE(numout,*)
-            WRITE(numout,9400) ('***',ji=il1,il2-1)
-            DO jj = jpnj, 1, -1
-               WRITE(numout,9403) ('   ',ji=il1,il2-1)
-               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
-               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
-               WRITE(numout,9403) ('   ',ji=il1,il2-1)
-               WRITE(numout,9400) ('***',ji=il1,il2-1)
-            END DO
-            WRITE(numout,9401) (ji,ji=il1,il2)
-            il1 = il1+ifreq
-         END DO
- 9400     FORMAT('     ***',20('*************',a3))
- 9403     FORMAT('     *     ',20('         *   ',a3))
- 9401     FORMAT('        ',20('   ',i3,'          '))
- 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
- 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
-      ENDIF
-
-
-      ! 5. neighbour treatment
-      ! ----------------------
-
-      DO jarea = 1, jpni*jpnj
-         iproc = jarea-1
-         ii = 1 + MOD(jarea-1,jpni)
-         ij = 1 +    (jarea-1)/jpni
-         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
-            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
-            iino = 1 + MOD(iono(ii,ij),jpni)
-            ijno = 1 +    (iono(ii,ij))/jpni
-              ! Need to reverse the logical direction of communication 
-              ! for northern neighbours of northern row processors (north-fold)
-              ! i.e. need to check that the northern neighbour only communicates
-              ! to the SOUTH (or not at all) if this area is land-only (#1057)
-            idir = 1
-            IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1    
-            IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
-            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
-            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
-            iiso = 1 + MOD(ioso(ii,ij),jpni)
-            ijso = 1 +    (ioso(ii,ij))/jpni
-            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
-            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
-            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
-            iiea = 1 + MOD(ioea(ii,ij),jpni)
-            ijea = 1 +    (ioea(ii,ij))/jpni
-            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
-            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
-            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
-            iiwe = 1 + MOD(iowe(ii,ij),jpni)
-            ijwe = 1 +    (iowe(ii,ij))/jpni
-            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
-            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
-            iine = 1 + MOD(ione(ii,ij),jpni)
-            ijne = 1 +    (ione(ii,ij))/jpni
-            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
-            iisw = 1 + MOD(iosw(ii,ij),jpni)
-            ijsw = 1 +    (iosw(ii,ij))/jpni
-            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
-            iinw = 1 + MOD(ionw(ii,ij),jpni)
-            ijnw = 1 +    (ionw(ii,ij))/jpni
-            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
-            iise = 1 + MOD(iose(ii,ij),jpni)
-            ijse = 1 +    (iose(ii,ij))/jpni
-            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
-         ENDIF
-      END DO
-
-
-      ! 6. Change processor name
-      ! ------------------------
-
-      nproc = narea-1
-      ii = iin(narea)
-      ij = ijn(narea)
-
-      ! set default neighbours
-      noso = ioso(ii,ij)
-      nowe = iowe(ii,ij)
-      noea = ioea(ii,ij)
-      nono = iono(ii,ij) 
-      npse = iose(ii,ij)
-      npsw = iosw(ii,ij)
-      npne = ione(ii,ij)
-      npnw = ionw(ii,ij)
-
-      ! check neighbours location
-      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiso = 1 + MOD(ioso(ii,ij),jpni)
-         ijso = 1 +    (ioso(ii,ij))/jpni
-         noso = ipproc(iiso,ijso)
-      ENDIF
-      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiwe = 1 + MOD(iowe(ii,ij),jpni)
-         ijwe = 1 +    (iowe(ii,ij))/jpni
-         nowe = ipproc(iiwe,ijwe)
-      ENDIF
-      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiea = 1 + MOD(ioea(ii,ij),jpni)
-         ijea = 1 +    (ioea(ii,ij))/jpni
-         noea = ipproc(iiea,ijea)
-      ENDIF
-      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iino = 1 + MOD(iono(ii,ij),jpni)
-         ijno = 1 +    (iono(ii,ij))/jpni
-         nono = ipproc(iino,ijno)
-      ENDIF
-      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iise = 1 + MOD(iose(ii,ij),jpni)
-         ijse = 1 +    (iose(ii,ij))/jpni
-         npse = ipproc(iise,ijse)
-      ENDIF
-      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iisw = 1 + MOD(iosw(ii,ij),jpni)
-         ijsw = 1 +    (iosw(ii,ij))/jpni
-         npsw = ipproc(iisw,ijsw)
-      ENDIF
-      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iine = 1 + MOD(ione(ii,ij),jpni)
-         ijne = 1 +    (ione(ii,ij))/jpni
-         npne = ipproc(iine,ijne)
-      ENDIF
-      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iinw = 1 + MOD(ionw(ii,ij),jpni)
-         ijnw = 1 +    (ionw(ii,ij))/jpni
-         npnw = ipproc(iinw,ijnw)
-      ENDIF
-      nbnw = ibnw(ii,ij)
-      nbne = ibne(ii,ij)
-      nbsw = ibsw(ii,ij)
-      nbse = ibse(ii,ij)
-      nlcj = ilcj(ii,ij)  
-      nlci = ilci(ii,ij)  
-      nldi = ildi(ii,ij)
-      nlei = ilei(ii,ij)
-      nldj = ildj(ii,ij)
-      nlej = ilej(ii,ij)
-      nbondi = ibondi(ii,ij)
-      nbondj = ibondj(ii,ij)
-      nimpp = iimppt(ii,ij)  
-      njmpp = ijmppt(ii,ij)  
-      DO jproc = 1, jpnij
-         ii = iin(jproc)
-         ij = ijn(jproc)
-         nimppt(jproc) = iimppt(ii,ij)  
-         njmppt(jproc) = ijmppt(ii,ij)  
-         nlcjt(jproc) = ilcj(ii,ij)
-         nlcit(jproc) = ilci(ii,ij)
-         nldit(jproc) = ildi(ii,ij)
-         nleit(jproc) = ilei(ii,ij)
-         nldjt(jproc) = ildj(ii,ij)
-         nlejt(jproc) = ilej(ii,ij)
-      END DO
-
-      ! Save processor layout in ascii file
-      IF (lwp) THEN
-         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
-         WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
-         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
-         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
-
-        DO  jproc = 1, jpnij
-         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
-                                      nldit(jproc), nldjt(jproc), &
-                                      nleit(jproc), nlejt(jproc), &
-                                      nimppt(jproc), njmppt(jproc)
-        END DO
-        CLOSE(inum)   
-      END IF
-
-      ! Defined npolj, either 0, 3 , 4 , 5 , 6
-      ! In this case the important thing is that npolj /= 0
-      ! Because if we go through these line it is because jpni >1 and thus
-      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
-
-      npolj = 0
-      ij = ijn(narea)
-
-      IF( jperio == 3 .OR. jperio == 4 ) THEN
-         IF( ij == jpnj ) npolj = 3
-      ENDIF
-
-      IF( jperio == 5 .OR. jperio == 6 ) THEN
-         IF( ij == jpnj ) npolj = 5
-      ENDIF
-
-      ! Periodicity : no corner if nbondi = 2 and nperio != 1
-
-      IF(lwp) THEN
-         WRITE(numout,*) ' nproc  = ', nproc
-         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
-         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
-         WRITE(numout,*) ' nbondi = ', nbondi
-         WRITE(numout,*) ' nbondj = ', nbondj
-         WRITE(numout,*) ' npolj  = ', npolj
-         WRITE(numout,*) ' nperio = ', nperio
-         WRITE(numout,*) ' nlci   = ', nlci
-         WRITE(numout,*) ' nlcj   = ', nlcj
-         WRITE(numout,*) ' nimpp  = ', nimpp
-         WRITE(numout,*) ' njmpp  = ', njmpp
-         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse
-         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw
-         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne
-         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw
-         WRITE(numout,*)
-      ENDIF
-
-      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )
-
-      ! Prepare mpp north fold
-
-      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
-         CALL mpp_ini_north
-         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
-      ENDIF
-
-      ! Prepare NetCDF output file (if necessary)
-      CALL mpp_init_ioipsl
-
-
-   END SUBROUTINE mpp_init2
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/nemogcm.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/nemogcm.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/nemogcm.F90	(revision 12101)
@@ -0,0 +1,421 @@
+MODULE nemogcm
+   !!======================================================================
+   !!                       ***  MODULE nemogcm   ***
+   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
+   !!======================================================================
+   !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code
+   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec)
+   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
+   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1
+   !!             -   ! 1992-06  (L.Terray)  coupling implementation
+   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice
+   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
+   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0
+   !!            8.1  ! 1997-06  (M. Imbard, G. Madec)
+   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model
+   !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP
+   !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules
+   !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
+   !!             -   ! 2004-08  (C. Talandier) New trends organization
+   !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation
+   !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization
+   !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
+   !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp
+   !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
+   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms
+   !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE
+   !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
+   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 
+   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
+   !!   nemo_init     : initialization of the NEMO system
+   !!   nemo_ctl      : initialisation of the contol print
+   !!   nemo_closefile: close remaining open files
+   !!   nemo_alloc    : dynamical allocation
+   !!   nemo_partition: calculate MPP domain decomposition
+   !!   factorise     : calculate the factors of the no. of MPI processes
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain variables
+   USE in_out_manager ! I/O manager
+   USE iom            !
+   USE domcfg         ! domain configuration               (dom_cfg routine)
+   USE mppini         ! shared/distributed memory setting (mpp_init routine)
+   USE domain         ! domain initialization             (dom_init routine)
+   USE phycst         ! physical constant                  (par_cst routine)
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lib_mpp        ! distributed memory computing
+
+   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   nemo_gcm    ! called by model.F90
+   PUBLIC   nemo_init   ! needed by AGRIF
+   PUBLIC   nemo_alloc  ! needed by TAM
+
+   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
+   
+#if defined key_agrif 
+   external agrif_boundary_connections, agrif_update_all, agrif_recompute_scalefactors
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id: nemogcm.F90 6152 2015-12-21 22:33:57Z acc $
+   !! Software governed by the CeCILL licence     (./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE nemo_gcm
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_gcm  ***
+      !!
+      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal
+      !!              curvilinear mesh on the sphere.
+      !!
+      !! ** Method  : - model general initialization
+      !!              - launch the time-stepping (stp routine)
+      !!              - finalize the run by closing files and communications
+      !!
+      !! References : Madec, Delecluse, Imbard, and Levy, 1997:  internal report, IPSL.
+      !!              Madec, 2008, internal report, IPSL.
+      !!----------------------------------------------------------------------
+      INTEGER ::   istp       ! time step index
+      !!----------------------------------------------------------------------
+      !
+#if defined key_agrif
+      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes
+#endif
+      !                            !-----------------------!
+      CALL nemo_init               !==  Initialisations  ==!
+      !                            !-----------------------!
+
+#if defined key_agrif    
+      CALL Agrif_Regrid()
+      
+      CALL Agrif_Step_Child(agrif_boundary_connections)
+      
+      CALL Agrif_Step_Child_adj(agrif_update_all)
+      
+      CALL Agrif_Step_Child(agrif_recompute_scalefactors)
+      
+      CALL Agrif_Step_Child(cfg_write)
+#endif
+
+      ! check that all process are still there... If some process have an error,
+      ! they will never enter in step and other processes will wait until the end of the cpu time!
+      IF( lk_mpp )   CALL mpp_max( 'nemogcm',nstop )
+
+      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
+
+      !                            !-----------------------!
+      !                            !==  finalize the run  ==!
+      !                            !------------------------!
+      !
+      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
+         WRITE(numout,cform_err)
+         WRITE(numout,*) nstop, ' error have been found'
+      ENDIF
+      !
+      !
+      CALL nemo_closefile
+      !
+      !
+   END SUBROUTINE nemo_gcm
+
+
+   SUBROUTINE nemo_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_init  ***
+      !!
+      !! ** Purpose :   initialization of the NEMO GCM
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji                 ! dummy loop indices
+      INTEGER  ::   ios, ilocal_comm   ! local integers
+      CHARACTER(len=120), DIMENSION(60) ::   cltxt, cltxt2, clnam
+      !!
+      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
+         &             ln_timing, ln_diacfl
+      NAMELIST/namcfg/ ln_e3_dep,                                &
+         &             cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
+         &             jperio, ln_use_jattr, ln_domclo
+      !!----------------------------------------------------------------------
+      !
+      cltxt = ''
+      !
+      !                             ! Open reference namelist and configuration namelist files
+      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist
+      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
+      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
+      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
+      !
+      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist
+      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
+903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
+      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist
+      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
+904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
+
+! Force values for AGRIF zoom (cf. agrif_user.F90)
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !  NB: mynode also opens output.namelist.dyn !
+      !                             !      on unit number numond on first proc   !
+      !                             !--------------------------------------------!
+      ! Nodes selection (control print return in cltxt)
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )
+      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwm = (narea == 1)                                    ! control of output namelists
+      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
+
+      IF(lwm) THEN
+         ! write merged namelists from earlier to output namelist now that the
+         ! file has been opened in call to mynode. nammpp has already been
+         ! written in mynode (if lk_mpp_mpi)
+         WRITE( numond, namctl )
+         WRITE( numond, namcfg )
+      ENDIF
+
+        IF(lwp) THEN                            ! open listing units
+         !
+         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+         WRITE(numout,*)
+         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
+         WRITE(numout,*) '                       NEMO team'
+         WRITE(numout,*) '            Ocean General Circulation Model'
+         WRITE(numout,*) '                NEMO version 4.0  (2019) '
+         WRITE(numout,*)
+         WRITE(numout,*) "           ._      ._      ._      ._      ._    "
+         WRITE(numout,*) "       _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
+         WRITE(numout,*)
+         WRITE(numout,*) "           o         _,           _,             "
+         WRITE(numout,*) "            o      .' (        .-' /             "
+         WRITE(numout,*) "           o     _/..._'.    .'   /              "
+         WRITE(numout,*) "      (    o .-'`      ` '-./  _.'               "
+         WRITE(numout,*) "       )    ( o)           ;= <_         (       "
+         WRITE(numout,*) "      (      '-.,\\__ __.-;`\   '.        )      "
+         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   "
+         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  "
+         WRITE(numout,*) "       )  )                        `     (   (   "
+         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
+         WRITE(numout,*)
+         
+         DO ji = 1, SIZE(cltxt)
+            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) TRIM(cltxt(ji))    ! control print of mynode
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*)
+   !      DO ji = 1, SIZE(cltxt2)
+   !         IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) TRIM(cltxt2(ji))   ! control print of domain size
+   !      END DO
+         !
+         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
+         !
+      ENDIF
+      ! open /dev/null file to be able to supress output write easily
+   !   CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      !                                      ! Domain decomposition
+      CALL mpp_init                          ! MPP
+
+ !    IF( Agrif_Root() ) THEN
+ !        jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+ !        jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.
+ !     ENDIF
+         jpk = jpkdta                                             ! third dim
+         jpim1 = jpi-1                                            ! inner domain indices
+         jpjm1 = jpj-1                                            !   "           "
+         jpkm1 = jpk-1                                            !   "           "
+         jpij  = jpi*jpj                                          !  jpi x j
+
+#if defined key_agrif
+      CALL Agrif_Declare_Var
+#endif
+
+      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
+      CALL nemo_alloc()
+
+      !                             !-------------------------------!
+      !                             !  NEMO general initialization  !
+      !                             !-------------------------------!
+
+      CALL nemo_ctl                          ! Control prints & Benchmark
+
+      !                                      ! Domain decomposition
+        !
+      !                                      ! General initialization
+                            CALL     phy_cst    ! Physical constants
+                            CALL     dom_cfg    ! Domain configuration
+                            CALL     dom_init   ! Domain
+      !
+   END SUBROUTINE nemo_init
+
+
+   SUBROUTINE nemo_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_ctl  ***
+      !!
+      !! ** Purpose :   control print setting
+      !!
+      !! ** Method  : - print namctl information and check some consistencies
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'nemo_ctl: Control prints'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '   Namelist namctl'
+         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
+         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
+         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
+         WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
+         WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
+         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
+         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
+         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin  
+         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax  
+         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
+         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
+         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
+         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
+         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
+         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
+         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
+         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
+         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
+         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing
+         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl
+      ENDIF
+      !
+      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
+      nictls    = nn_ictls
+      nictle    = nn_ictle
+      njctls    = nn_jctls
+      njctle    = nn_jctle
+      isplt     = nn_isplt
+      jsplt     = nn_jsplt
+
+      !
+      !                             ! Parameter control
+      !
+      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+         IF( lk_mpp .AND. jpnij > 1 ) THEN
+            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
+         ELSE
+            IF( isplt == 1 .AND. jsplt == 1  ) THEN
+               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
+                  &           ' - the print control will be done over the whole domain' )
+            ENDIF
+            ijsplt = isplt * jsplt            ! total number of processors ijsplt
+         ENDIF
+         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
+         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
+         !
+         !                              ! indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
+            lsp_area = .FALSE.
+         ELSE                                             ! print control done over a specific  area
+            lsp_area = .TRUE.
+            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
+               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
+               nictls = 1
+            ENDIF
+            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
+               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
+               nictle = jpiglo
+            ENDIF
+            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
+               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
+               njctls = 1
+            ENDIF
+            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
+               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
+               njctle = jpjglo
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+!      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
+!         &                                                'Compile with key_nosignedzero enabled:',   &
+!         &                                                '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' )
+      !
+#if defined key_agrif
+      IF( ln_timing )   CALL ctl_stop( 'AGRIF not implemented with ln_timing = true')
+#endif
+      !
+   END SUBROUTINE nemo_ctl
+
+
+   SUBROUTINE nemo_closefile
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_closefile  ***
+      !!
+      !! ** Purpose :   Close the files
+      !!----------------------------------------------------------------------
+      !
+      IF( lk_mpp )   CALL mppsync
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
+      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
+      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
+      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
+      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
+      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
+      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
+      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
+      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
+      IF( numdct_vol      /= -1 )   CLOSE( numdct_vol      )   ! volume transports
+      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
+      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
+      !
+      numout = 6                                     ! redefine numout in case it is used after this point...
+      !
+   END SUBROUTINE nemo_closefile
+
+
+   SUBROUTINE nemo_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      USE dom_oce   , ONLY: dom_oce_alloc
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr = dom_oce_alloc   ()          ! ocean domain
+      !
+      CALL mpp_sum( 'nemogcm', ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
+      !
+   END SUBROUTINE nemo_alloc
+
+
+
+   !!======================================================================
+END MODULE nemogcm
+
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/nemogcm.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/nemogcm.f90	(revision 12100)
+++ 	(revision )
@@ -1,588 +1,0 @@
-MODULE nemogcm
-   !!======================================================================
-   !!                       ***  MODULE nemogcm   ***
-   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
-   !!======================================================================
-   !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code
-   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec)
-   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
-   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1
-   !!             -   ! 1992-06  (L.Terray)  coupling implementation
-   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice
-   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
-   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0
-   !!            8.1  ! 1997-06  (M. Imbard, G. Madec)
-   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model
-   !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP
-   !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
-   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules
-   !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
-   !!             -   ! 2004-08  (C. Talandier) New trends organization
-   !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility
-   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
-   !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation
-   !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization
-   !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
-   !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp
-   !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
-   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
-   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
-   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms
-   !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE
-   !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
-   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 
-   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla)
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
-   !!   nemo_init     : initialization of the NEMO system
-   !!   nemo_ctl      : initialisation of the contol print
-   !!   nemo_closefile: close remaining open files
-   !!   nemo_alloc    : dynamical allocation
-   !!   nemo_partition: calculate MPP domain decomposition
-   !!   factorise     : calculate the factors of the no. of MPI processes
-   !!----------------------------------------------------------------------
-   USE step_oce       ! module used in the ocean time stepping module (step.F90)
-   USE domcfg         ! domain configuration               (dom_cfg routine)
-   USE mppini         ! shared/distributed memory setting (mpp_init routine)
-   USE domain         ! domain initialization             (dom_init routine)
-   USE phycst         ! physical constant                  (par_cst routine)
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
-   USE lib_mpp        ! distributed memory computing
-
-   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   nemo_gcm    ! called by model.F90
-   PUBLIC   nemo_init   ! needed by AGRIF
-   PUBLIC   nemo_alloc  ! needed by TAM
-
-   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
-   !! $Id: nemogcm.F90 6152 2015-12-21 22:33:57Z acc $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE nemo_gcm
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE nemo_gcm  ***
-      !!
-      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal
-      !!              curvilinear mesh on the sphere.
-      !!
-      !! ** Method  : - model general initialization
-      !!              - launch the time-stepping (stp routine)
-      !!              - finalize the run by closing files and communications
-      !!
-      !! References : Madec, Delecluse, Imbard, and Levy, 1997:  internal report, IPSL.
-      !!              Madec, 2008, internal report, IPSL.
-      !!----------------------------------------------------------------------
-      INTEGER ::   istp       ! time step index
-      !!----------------------------------------------------------------------
-      !
-      !                            !-----------------------!
-      CALL nemo_init               !==  Initialisations  ==!
-      !                            !-----------------------!
-
-      ! check that all process are still there... If some process have an error,
-      ! they will never enter in step and other processes will wait until the end of the cpu time!
-      IF( lk_mpp )   CALL mpp_max( nstop )
-
-      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
-
-      !                            !-----------------------!
-      !                            !==  finalize the run  ==!
-      !                            !------------------------!
-      !
-      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
-         WRITE(numout,cform_err)
-         WRITE(numout,*) nstop, ' error have been found'
-      ENDIF
-      !
-      IF( nn_timing == 1 )   CALL timing_finalize
-      !
-      CALL nemo_closefile
-      !
-      !
-   END SUBROUTINE nemo_gcm
-
-
-   SUBROUTINE nemo_init
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE nemo_init  ***
-      !!
-      !! ** Purpose :   initialization of the NEMO GCM
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji            ! dummy loop indices
-      INTEGER ::   ilocal_comm   ! local integer
-      INTEGER ::   ios
-      CHARACTER(len=80), DIMENSION(16) ::   cltxt
-      !
-      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
-         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
-         &             nn_bench, nn_timing, nn_diacfl
-      NAMELIST/namcfg/ ln_e3_dep,                                &
-         &             cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
-         &             jpizoom, jpjzoom, jperio, ln_use_jattr
-      !!----------------------------------------------------------------------
-      !
-      cltxt = ''
-      !
-      !                             ! Open reference namelist and configuration namelist files
-      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
-      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
-      !
-      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark
-      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
-
-      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark
-      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
-
-      !
-      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark
-      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 : Control prints & Benchmark
-      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)
-      ilocal_comm = 0
-      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )
-      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
-
-      lwm = (narea == 1)                                    ! control of output namelists
-      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
-
-      IF(lwm) THEN
-         ! write merged namelists from earlier to output namelist now that the
-         ! file has been opened in call to mynode. nammpp has already been
-         ! written in mynode (if lk_mpp_mpi)
-         WRITE( numond, namctl )
-         WRITE( numond, namcfg )
-      ENDIF
-
-      ! If dimensions of processor grid weren't specified in the namelist file
-      ! then we calculate them here now that we have our communicator size
-      IF( jpni < 1 .OR. jpnj < 1 ) THEN
-         IF( Agrif_Root() )   CALL nemo_partition( mppsize )
-      ENDIF
-
-      ! Calculate domain dimensions given calculated jpni and jpnj
-      ! This used to be done in par_oce.F90 when they were parameters rather than variables
-      IF( Agrif_Root() ) THEN
-         jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
-         jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.
-      ENDIF         
-         jpk = jpkdta                                             ! third dim
-         jpim1 = jpi-1                                            ! inner domain indices
-         jpjm1 = jpj-1                                            !   "           "
-         jpkm1 = jpk-1                                            !   "           "
-         jpij  = jpi*jpj                                          !  jpi x j
-
-      IF(lwp) THEN                            ! open listing units
-         !
-         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
-         !
-         WRITE(numout,*)
-         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
-         WRITE(numout,*) '                       NEMO team'
-         WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.7  (2015) '
-         WRITE(numout,*)
-         WRITE(numout,*)
-         DO ji = 1, SIZE(cltxt)
-            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode
-         END DO
-         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA
-         !
-      ENDIF
-
-      ! Now we know the dimensions of the grid and numout has been set we can
-      ! allocate arrays
-      CALL nemo_alloc()
-
-      !                             !-------------------------------!
-      !                             !  NEMO general initialization  !
-      !                             !-------------------------------!
-
-      CALL nemo_ctl                          ! Control prints & Benchmark
-
-      !                                      ! Domain decomposition
-      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
-      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_init
-      !
-      !                                      ! General initialization
-                            CALL     phy_cst    ! Physical constants
-                            CALL     eos_init   ! Equation of state
-                            CALL     dom_cfg    ! Domain configuration
-                            CALL     dom_init   ! Domain
-      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
-      !
-   END SUBROUTINE nemo_init
-
-
-   SUBROUTINE nemo_ctl
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE nemo_ctl  ***
-      !!
-      !! ** Purpose :   control print setting
-      !!
-      !! ** Method  : - print namctl information and check some consistencies
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) THEN                  ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark'
-         WRITE(numout,*) '~~~~~~~ '
-         WRITE(numout,*) '   Namelist namctl'
-         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
-         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
-         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
-         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
-         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
-         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
-         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
-         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
-         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench
-         WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing
-      ENDIF
-      !
-      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
-      nictls    = nn_ictls
-      nictle    = nn_ictle
-      njctls    = nn_jctls
-      njctle    = nn_jctle
-      isplt     = nn_isplt
-      jsplt     = nn_jsplt
-      nbench    = nn_bench
-
-      IF(lwp) THEN                  ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'namcfg  : configuration initialization through namelist read'
-         WRITE(numout,*) '~~~~~~~ '
-         WRITE(numout,*) '   Namelist namcfg'
-         WRITE(numout,*) '      vertical scale factors =T: e3.=dk[depth]       ln_e3_dep = ', ln_e3_dep
-         WRITE(numout,*) '                             =F: old definition                 '
-         WRITE(numout,*) '      configuration name                               cp_cfg  = ', TRIM(cp_cfg)
-         WRITE(numout,*) '      configuration zoom name                          cp_cfz  = ', TRIM(cp_cfz)
-         WRITE(numout,*) '      configuration resolution                         jp_cfg  = ', jp_cfg
-         WRITE(numout,*) '      1st lateral dimension ( >= jpiglo )              jpidta  = ', jpidta
-         WRITE(numout,*) '      2nd    "         "    ( >= jpjglo )              jpjdta  = ', jpjdta
-         WRITE(numout,*) '      3nd    "         "                               jpkdta  = ', jpkdta
-         WRITE(numout,*) '      1st dimension of global domain in i              jpiglo  = ', jpiglo
-         WRITE(numout,*) '      2nd    -                  -    in j              jpjglo  = ', jpjglo
-         WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom
-         WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
-         WRITE(numout,*) '      lateral cond. type (between 0 and 6)             jperio  = ', jperio   
-         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
-         !
-         IF(.NOT.ln_e3_dep ) THEN
-            WRITE(numout,cform_war)
-            WRITE(numout,*)
-            WRITE(numout,*) '      ===>>>>    Obsolescent definition of e3 scale factors is used'
-            WRITE(numout,*)
-         ENDIF
-      ENDIF
-      !                             ! Parameter control
-      !
-      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
-         IF( lk_mpp .AND. jpnij > 1 ) THEN
-            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
-         ELSE
-            IF( isplt == 1 .AND. jsplt == 1  ) THEN
-               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
-                  &           ' - the print control will be done over the whole domain' )
-            ENDIF
-            ijsplt = isplt * jsplt            ! total number of processors ijsplt
-         ENDIF
-         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
-         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
-         !
-         !                              ! indices used for the SUM control
-         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
-            lsp_area = .FALSE.
-         ELSE                                             ! print control done over a specific  area
-            lsp_area = .TRUE.
-            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
-               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
-               nictls = 1
-            ENDIF
-            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
-               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
-               nictle = jpiglo
-            ENDIF
-            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
-               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
-               njctls = 1
-            ENDIF
-            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
-               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
-               njctle = jpjglo
-            ENDIF
-         ENDIF
-      ENDIF
-      !
-      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
-         &                                               'f2003 standard. '                              ,  &
-         &                                               'Compile with key_nosignedzero enabled' )
-      !
-   END SUBROUTINE nemo_ctl
-
-
-   SUBROUTINE nemo_closefile
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE nemo_closefile  ***
-      !!
-      !! ** Purpose :   Close the files
-      !!----------------------------------------------------------------------
-      !
-      IF( lk_mpp )   CALL mppsync
-      !
-      CALL iom_close                                 ! close all input/output files managed by iom_*
-      !
-      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
-      IF( numsol          /= -1 )   CLOSE( numsol          )   ! solver file
-      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
-      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
-      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
-      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
-      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
-      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
-      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
-      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
-      IF( numdct_vol      /= -1 )   CLOSE( numdct_vol      )   ! volume transports
-      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
-      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
-      !
-      numout = 6                                     ! redefine numout in case it is used after this point...
-      !
-   END SUBROUTINE nemo_closefile
-
-
-   SUBROUTINE nemo_alloc
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE nemo_alloc  ***
-      !!
-      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
-      !!
-      !! ** Method  :
-      !!----------------------------------------------------------------------
-      USE dom_oce   , ONLY: dom_oce_alloc
-      !
-      INTEGER :: ierr
-      !!----------------------------------------------------------------------
-      !
-      ierr =        oce_alloc       ()          ! ocean
-      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
-      !
-      IF( lk_mpp    )   CALL mpp_sum( ierr )
-      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
-      !
-   END SUBROUTINE nemo_alloc
-
-
-   SUBROUTINE nemo_partition( num_pes )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE nemo_partition  ***
-      !!
-      !! ** Purpose :
-      !!
-      !! ** Method  :
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have
-      !
-      INTEGER, PARAMETER :: nfactmax = 20
-      INTEGER :: nfact ! The no. of factors returned
-      INTEGER :: ierr  ! Error flag
-      INTEGER :: ji
-      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
-      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
-      !!----------------------------------------------------------------------
-      !
-      ierr = 0
-      !
-      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
-      !
-      IF( nfact <= 1 ) THEN
-         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
-         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
-         jpnj = 1
-         jpni = num_pes
-      ELSE
-         ! Search through factors for the pair that are closest in value
-         mindiff = 1000000
-         imin    = 1
-         DO ji = 1, nfact-1, 2
-            idiff = ABS( ifact(ji) - ifact(ji+1) )
-            IF( idiff < mindiff ) THEN
-               mindiff = idiff
-               imin = ji
-            ENDIF
-         END DO
-         jpnj = ifact(imin)
-         jpni = ifact(imin + 1)
-      ENDIF
-      !
-      jpnij = jpni*jpnj
-      !
-   END SUBROUTINE nemo_partition
-
-
-   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE factorise  ***
-      !!
-      !! ** Purpose :   return the prime factors of n.
-      !!                knfax factors are returned in array kfax which is of
-      !!                maximum dimension kmaxfax.
-      !! ** Method  :
-      !!----------------------------------------------------------------------
-      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
-      INTEGER                    , INTENT(  out) ::   kerr, knfax
-      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
-      !
-      INTEGER :: ifac, jl, inu
-      INTEGER, PARAMETER :: ntest = 14
-      INTEGER, DIMENSION(ntest) ::   ilfax
-      !!----------------------------------------------------------------------
-      !
-      ! lfax contains the set of allowed factors.
-      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
-      !
-      ! Clear the error flag and initialise output vars
-      kerr  = 0
-      kfax  = 1
-      knfax = 0
-      !
-      ! Find the factors of n.
-      IF( kn == 1 )   GOTO 20
-
-      ! nu holds the unfactorised part of the number.
-      ! knfax holds the number of factors found.
-      ! l points to the allowed factor list.
-      ! ifac holds the current factor.
-      !
-      inu   = kn
-      knfax = 0
-      !
-      DO jl = ntest, 1, -1
-         !
-         ifac = ilfax(jl)
-         IF( ifac > inu )   CYCLE
-
-         ! Test whether the factor will divide.
-
-         IF( MOD(inu,ifac) == 0 ) THEN
-            !
-            knfax = knfax + 1            ! Add the factor to the list
-            IF( knfax > kmaxfax ) THEN
-               kerr = 6
-               write (*,*) 'FACTOR: insufficient space in factor array ', knfax
-               return
-            ENDIF
-            kfax(knfax) = ifac
-            ! Store the other factor that goes with this one
-            knfax = knfax + 1
-            kfax(knfax) = inu / ifac
-            !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
-         ENDIF
-         !
-      END DO
-      !
-   20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
-      !
-   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
-      l_north_nogather = .TRUE.
-   END SUBROUTINE nemo_northcomms
-
-
-   !!======================================================================
-END MODULE nemogcm
-
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/oce.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/oce.f90	(revision 12100)
+++ 	(revision )
@@ -1,132 +1,0 @@
-MODULE oce
-   !!======================================================================
-   !!                      ***  MODULE  oce  ***
-   !! Ocean        :  dynamics and active tracers defined in memory 
-   !!======================================================================
-   !! History :  1.0  !  2002-11  (G. Madec)  F90: Free form and module
-   !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate
-   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays
-   !!            3.7  !  2014-01  (G. Madec) suppression of curl and before hdiv from in-core memory
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE lib_mpp        ! MPP library
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90
-
-   !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields
-   !! --------------------------                            ! fields ! fields ! trends ! only after tra_zdf and dyn_spg
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity        [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity        [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity            [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           hdivn          !: horizontal divergence        [s-1]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                  [Celcius,psu] 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celcius-1,psu-1]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2     [s-2]
-   !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhop   !: potential volumic mass                           [kg/m3]
-
-   !! free surface                                      !  before  ! now    ! after  !
-   !! ------------                                      !  fields  ! fields ! fields !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b   ,  un_b  ,  ua_b  !: Barotropic velocities at u-point [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vb_b   ,  vn_b  ,  va_b  !: Barotropic velocities at v-point [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshb   ,  sshn  ,  ssha  !: sea surface height at t-point [m]
-
-   !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubb_e  ,  ub_e  ,  un_e  , ua_e   !: u-external velocity
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vbb_e  ,  vb_e  ,  vn_e  , va_e   !: v-external velocity
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshbb_e,  sshb_e,  sshn_e, ssha_e !: external ssh
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hu_e   !: external u-depth
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hv_e   !: external v-depth
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hur_e  !: inverse of u-depth
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hvr_e  !: inverse of v-depth
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b  , vb2_b           !: Half step fluxes (ln_bt_fw=T)
-
-
-
-   !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv               !: horizontal surface pressure gradient
-
-   !! interpolated gradient (only used in zps case)
-   !! ---------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point
-
-   !! (ISF) interpolated gradient (only used for ice shelf case) 
-   !! --------------------- 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtui, gtvi   !: horizontal gradient of T, S and rd at top u-point 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   grui, grvi   !: horizontal gradient of T, S and rd at top v-point  
-   !! (ISF) ice load
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riceload
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rke          !: kinetic energy
-
-   !! arrays relating to embedding ice in the ocean. These arrays need to be declared 
-   !! even if no ice model is required. In the no ice model or traditional levitating 
-   !! ice cases they contain only zeros
-   !! ---------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s]
-
-   !! Energy budget of the leads (open water embedded in sea ice)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-]
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: oce.F90 6140 2015-12-21 11:35:23Z timgraham $ 
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION oce_alloc()
-      !!----------------------------------------------------------------------
-      !!                   ***  FUNCTION oce_alloc  ***
-      !!----------------------------------------------------------------------
-      INTEGER :: ierr(7)
-      !!----------------------------------------------------------------------
-      !
-      ierr(:) = 0 
-      ALLOCATE( ub   (jpi,jpj,jpk)      , un   (jpi,jpj,jpk)      , ua(jpi,jpj,jpk)       ,     &
-         &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &          
-         &      wn   (jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             &
-         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     &
-         &      rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) ,                             &
-         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)      ,                             &
-         &      rhd  (jpi,jpj,jpk)      , rhop (jpi,jpj,jpk)                              , STAT=ierr(1) )
-         !
-      ALLOCATE(rke(jpi,jpj,jpk)  ,                                         &
-         &     sshb(jpi,jpj)     , sshn(jpi,jpj)   , ssha(jpi,jpj)   ,     &
-         &     ub_b(jpi,jpj)     , un_b(jpi,jpj)   , ua_b(jpi,jpj)   ,     &
-         &     vb_b(jpi,jpj)     , vn_b(jpi,jpj)   , va_b(jpi,jpj)   ,     &
-         &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       &
-         &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     &
-         &     gru(jpi,jpj)      , grv(jpi,jpj)      ,                     &
-         &     gtui(jpi,jpj,jpts), gtvi(jpi,jpj,jpts),                     &
-         &     grui(jpi,jpj)     , grvi(jpi,jpj)     ,                     &
-         &     riceload(jpi,jpj),                             STAT=ierr(2) )
-         !
-      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) )
-         !
-      ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) )
-         !
-      ALLOCATE( ssha_e(jpi,jpj),  sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), &
-         &        ua_e(jpi,jpj),    un_e(jpi,jpj),   ub_e(jpi,jpj),   ubb_e(jpi,jpj), &
-         &        va_e(jpi,jpj),    vn_e(jpi,jpj),   vb_e(jpi,jpj),   vbb_e(jpi,jpj), &
-         &        hu_e(jpi,jpj),   hur_e(jpi,jpj),   hv_e(jpi,jpj),   hvr_e(jpi,jpj), STAT=ierr(5) )
-         !
-      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj)                                      , STAT=ierr(6) )
-
-
-
-         !
-      oce_alloc = MAXVAL( ierr )
-      IF( oce_alloc /= 0 )   CALL ctl_warn('oce_alloc: failed to allocate arrays')
-      !
-   END FUNCTION oce_alloc
-
-   !!======================================================================
-END MODULE oce
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/par_oce.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/par_oce.f90	(revision 12100)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/par_oce.f90	(revision 12101)
@@ -13,4 +13,67 @@
    PUBLIC
 
+   CHARACTER(lc) ::   cp_cfg           !: name of the configuration
+   CHARACTER(lc) ::   cp_cfz           !: name of the zoom of configuration
+   INTEGER       ::   jp_cfg           !: resolution of the configuration
+
+   ! data size                                       !!! * size of all input files *
+   INTEGER       ::   jpidta           !: 1st lateral dimension ( >= jpi )
+   INTEGER       ::   jpjdta           !: 2nd    "         "    ( >= jpj )
+   INTEGER       ::   jpkdta           !: number of levels      ( >= jpk )
+   LOGICAL       ::   ln_e3_dep        ! e3. definition flag
+   REAL(wp)      ::   pp_not_used       = 999999._wp   !: vertical grid parameter
+   REAL(wp)      ::   pp_to_be_computed = 999999._wp   !:    -      -       -
+   !!----------------------------------------------------------------------
+   !!                   namcfg namelist parameters
+   !!----------------------------------------------------------------------
+   LOGICAL       ::   ln_read_cfg      !: (=T) read the domain configuration file or (=F) not
+   CHARACTER(lc) ::      cn_domcfg        !: filename the configuration file to be read
+   LOGICAL       ::   ln_write_cfg     !: (=T) create the domain configuration file
+   CHARACTER(lc) ::      cn_domcfg_out    !: filename the configuration file to be read
+   !
+   LOGICAL       ::   ln_use_jattr     !: input file read offset
+   !                                   !  Use file global attribute: open_ocean_jstart to determine start j-row 
+   !                                   !  when reading input from those netcdf files that have the 
+   !                                   !  attribute defined. This is designed to enable input files associated 
+   !                                   !  with the extended grids used in the under ice shelf configurations to 
+   !                                   !  be used without redundant rows when the ice shelves are not in use.
+   ! 
+
+   !!---------------------------------------------------------------------
+   !! Domain Matrix size 
+   !!---------------------------------------------------------------------
+   ! configuration name & resolution   (required only in ORCA family case)
+   CHARACTER(lc) ::   cn_cfg           !: name of the configuration
+   INTEGER       ::   nn_cfg           !: resolution of the configuration 
+
+   ! global domain size               !!! * total computational domain *
+   INTEGER       ::   jpiglo           !: 1st dimension of global domain --> i-direction
+   INTEGER       ::   jpjglo           !: 2nd    -                  -    --> j-direction
+   INTEGER       ::   jpkglo           !: 3nd    -                  -    --> k levels
+
+   ! global domain size for AGRIF     !!! * total AGRIF computational domain *
+   INTEGER, PUBLIC            ::   nbug_in_agrif_conv_do_not_remove_or_modify = 1 - 1
+   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 3                             !: number of ghost cells
+   INTEGER, PUBLIC            ::   nbcellsx   ! = jpiglo - 2 - 2*nbghostcells   !: number of cells in i-direction
+   INTEGER, PUBLIC            ::   nbcellsy   ! = jpjglo - 2 - 2*nbghostcells   !: number of cells in j-direction
+
+   ! local domain size                !!! * local computational domain *
+   INTEGER, PUBLIC ::   jpi   !                                                    !: first  dimension
+   INTEGER, PUBLIC ::   jpj   !                                                    !: second dimension
+   INTEGER, PUBLIC ::   jpk   ! = jpkglo                                           !: third  dimension
+   INTEGER, PUBLIC ::   jpim1 ! = jpi-1                                            !: inner domain indices
+   INTEGER, PUBLIC ::   jpjm1 ! = jpj-1                                            !:   -     -      -
+   INTEGER, PUBLIC ::   jpkm1 ! = jpk-1                                            !:   -     -      -
+   INTEGER, PUBLIC ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj
+   INTEGER, PUBLIC ::   jpimax! = ( jpiglo-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls !: maximum jpi
+   INTEGER, PUBLIC ::   jpjmax! = ( jpjglo-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls !: maximum jpj
+
+   !!---------------------------------------------------------------------
+   !! Active tracer parameters
+   !!---------------------------------------------------------------------
+   INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S )
+   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature
+   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity
+
    !!----------------------------------------------------------------------
    !!   Domain decomposition
@@ -22,81 +85,10 @@
    INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo 
    INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo 
-   INTEGER, PUBLIC, PARAMETER ::   jpreci = 1   !: number of columns for overlap 
-   INTEGER, PUBLIC, PARAMETER ::   jprecj = 1   !: number of rows    for overlap 
-
-   !!----------------------------------------------------------------------
-   !!                   namcfg namelist parameters
-   !!----------------------------------------------------------------------
-   !
-   LOGICAL       ::   ln_e3_dep        ! e3. definition flag
-   !
-   CHARACTER(lc) ::   cp_cfg           !: name of the configuration
-   CHARACTER(lc) ::   cp_cfz           !: name of the zoom of configuration
-   INTEGER       ::   jp_cfg           !: resolution of the configuration
-
-   ! data size                                       !!! * size of all input files *
-   INTEGER       ::   jpidta           !: 1st lateral dimension ( >= jpi )
-   INTEGER       ::   jpjdta           !: 2nd    "         "    ( >= jpj )
-   INTEGER       ::   jpkdta           !: number of levels      ( >= jpk )
-
-   ! global or zoom domain size                      !!! * computational domain *
-   INTEGER       ::   jpiglo           !: 1st dimension of global domain --> i
-   INTEGER       ::   jpjglo           !: 2nd    -                  -    --> j
-
-   ! zoom starting position 
-   INTEGER       ::   jpizoom          !: left bottom (i,j) indices of the zoom
-   INTEGER       ::   jpjzoom          !: in data domain indices
-
-   ! Domain characteristics
-   INTEGER       ::   jperio           !: lateral cond. type (between 0 and 6)
-   !                                       !  = 0 closed                 ;   = 1 cyclic East-West
-   !                                       !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
-   !                                       !  = 4 cyclic East-West AND North fold T-point pivot
-   !                                       !  = 5 North fold F-point pivot
-   !                                       !  = 6 cyclic East-West AND North fold F-point pivot
-
-   ! Input file read offset
-   LOGICAL       ::   ln_use_jattr     !: Use file global attribute: open_ocean_jstart to determine start j-row 
-                                           ! when reading input from those netcdf files that have the 
-                                           ! attribute defined. This is designed to enable input files associated 
-                                           ! with the extended grids used in the under ice shelf configurations to 
-                                           ! be used without redundant rows when the ice shelves are not in use.
-
-   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
-   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
-   REAL(wp)      ::   pp_not_used       = 999999._wp   !: vertical grid parameter
-   REAL(wp)      ::   pp_to_be_computed = 999999._wp   !:    -      -       -
-
-
-
-
-   !!---------------------------------------------------------------------
-   !! Active tracer parameters
-   !!---------------------------------------------------------------------
-   INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S )
-   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature
-   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity
-
-   !!---------------------------------------------------------------------
-   !! Domain Matrix size  (if AGRIF, they are not all parameters)
-   !!---------------------------------------------------------------------
-
-
-
-
-
-
-   INTEGER, PUBLIC  ::   jpi   ! = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension
-   INTEGER, PUBLIC  ::   jpj   ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension
-   INTEGER, PUBLIC  ::   jpk   ! = jpkdta
-   INTEGER, PUBLIC  ::   jpim1 ! = jpi-1                                            !: inner domain indices
-   INTEGER, PUBLIC  ::   jpjm1 ! = jpj-1                                            !:   -     -      -
-   INTEGER, PUBLIC  ::   jpkm1 ! = jpk-1                                            !:   -     -      -
-   INTEGER, PUBLIC  ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj
+   INTEGER, PUBLIC, PARAMETER ::   nn_hls = 1   !: halo width (applies to both rows and columns)
 
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: par_oce.F90 5836 2015-10-26 14:49:40Z cetlod $ 
-   !! Software governed by the CeCILL licence (./LICENSE)
+   !! $Id: par_oce.F90 10068 2018-08-28 14:09:04Z nicolasmartin $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
    !!======================================================================
 END MODULE par_oce
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/phycst.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/phycst.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/phycst.F90	(revision 12101)
@@ -0,0 +1,139 @@
+MODULE phycst
+   !!======================================================================
+   !!                    ***  MODULE  phycst  ***
+   !!     Definition of of both ocean and ice parameters used in the code
+   !!=====================================================================
+   !! History :   OPA  !  1990-10  (C. Levy - G. Madec)  Original code
+   !!             8.1  !  1991-11  (G. Madec, M. Imbard)  cosmetic changes
+   !!   NEMO      1.0  !  2002-08  (G. Madec, C. Ethe)  F90, add ice constants
+   !!              -   !  2006-08  (G. Madec)  style 
+   !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style 
+   !!             3.4  !  2011-11  (C. Harris)  minor changes for CICE constants 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   phy_cst  : define and print physical constant and domain parameters
+   !!----------------------------------------------------------------------
+   USE par_oce          ! ocean parameters
+   USE in_out_manager   ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   phy_cst     ! routine called by inipar.F90
+
+   REAL(wp), PUBLIC ::   rpi      = 3.141592653589793_wp             !: pi
+   REAL(wp), PUBLIC ::   rad      = 3.141592653589793_wp / 180._wp   !: conversion from degre into radian
+   REAL(wp), PUBLIC ::   rsmall   = 0.5 * EPSILON( 1.e0 )            !: smallest real computer value
+   
+   REAL(wp), PUBLIC ::   rday     = 24.*60.*60.      !: day                                [s]
+   REAL(wp), PUBLIC ::   rsiyea                      !: sideral year                       [s]
+   REAL(wp), PUBLIC ::   rsiday                      !: sideral day                        [s]
+   REAL(wp), PUBLIC ::   raamo    =  12._wp          !: number of months in one year
+   REAL(wp), PUBLIC ::   rjjhh    =  24._wp          !: number of hours in one day
+   REAL(wp), PUBLIC ::   rhhmm    =  60._wp          !: number of minutes in one hour
+   REAL(wp), PUBLIC ::   rmmss    =  60._wp          !: number of seconds in one minute
+   REAL(wp), PUBLIC ::   omega                       !: earth rotation parameter           [s-1]
+   REAL(wp), PUBLIC ::   ra       = 6371229._wp      !: earth radius                       [m]
+   REAL(wp), PUBLIC ::   grav     = 9.80665_wp       !: gravity                            [m/s2]   
+   REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin]
+
+   REAL(wp), PUBLIC ::   rau0                        !: volumic mass of reference     [kg/m3]
+   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg]
+   REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin]
+   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J]
+   REAL(wp), PUBLIC ::   rau0_rcp                    !: = rau0 * rcp 
+   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp )
+
+   REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice (not used?)
+
+   REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice (for pisces)          [psu]
+   REAL(wp), PUBLIC ::   soce     =   34.7_wp        !: salinity of sea (for pisces and isf)  [psu]
+   REAL(wp), PUBLIC ::   rLevap   =    2.5e+6_wp     !: latent heat of evaporation (water)
+   REAL(wp), PUBLIC ::   vkarmn   =    0.4_wp        !: von Karman constant
+   REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant 
+
+   REAL(wp), PUBLIC ::   rhos     =  330._wp         !: volumic mass of snow                                  [kg/m3]
+   REAL(wp), PUBLIC ::   rhoi     =  917._wp         !: volumic mass of sea ice                               [kg/m3]
+   REAL(wp), PUBLIC ::   rhow     = 1000._wp         !: volumic mass of freshwater in melt ponds              [kg/m3]
+   REAL(wp), PUBLIC ::   rcnd_i   =    2.034396_wp   !: thermal conductivity of fresh ice                     [W/m/K]
+   REAL(wp), PUBLIC ::   rcpi     = 2067.0_wp        !: specific heat of fresh ice                            [J/kg/K]
+   REAL(wp), PUBLIC ::   rLsub    =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg]
+   REAL(wp), PUBLIC ::   rLfus    =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg]
+   REAL(wp), PUBLIC ::   rTmlt    =    0.054_wp      !: decrease of seawater meltpoint with salinity
+
+   REAL(wp), PUBLIC ::   r1_rhoi                     !: 1 / rhoi
+   REAL(wp), PUBLIC ::   r1_rhos                     !: 1 / rhos
+   REAL(wp), PUBLIC ::   r1_rcpi                     !: 1 / rcpi
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: phycst.F90 10068 2018-08-28 14:09:04Z nicolasmartin $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+   
+   SUBROUTINE phy_cst
+      !!----------------------------------------------------------------------
+      !!                       ***  ROUTINE phy_cst  ***
+      !!
+      !! ** Purpose :   set and print the constants
+      !!----------------------------------------------------------------------
+
+      rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp
+      rsiday = rday / ( 1._wp + rday / rsiyea )
+#if defined key_cice
+      omega  = 7.292116e-05
+#else
+      omega  = 2._wp * rpi / rsiday 
+#endif
+
+      r1_rhoi = 1._wp / rhoi
+      r1_rhos = 1._wp / rhos
+      r1_rcpi = 1._wp / rcpi
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'phy_cst : initialization of ocean parameters and constants'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '      mathematical constant                 rpi = ', rpi
+         WRITE(numout,*) '      day                                rday   = ', rday,   ' s'
+         WRITE(numout,*) '      sideral year                       rsiyea = ', rsiyea, ' s'
+         WRITE(numout,*) '      sideral day                        rsiday = ', rsiday, ' s'
+         WRITE(numout,*) '      omega                              omega  = ', omega,  ' s^-1'
+         WRITE(numout,*)
+         WRITE(numout,*) '      nb of months per year               raamo = ', raamo, ' months'
+         WRITE(numout,*) '      nb of hours per day                 rjjhh = ', rjjhh, ' hours'
+         WRITE(numout,*) '      nb of minutes per hour              rhhmm = ', rhhmm, ' mn'
+         WRITE(numout,*) '      nb of seconds per minute            rmmss = ', rmmss, ' s'
+         WRITE(numout,*)
+         WRITE(numout,*) '      earth radius                         ra   = ', ra   , ' m'
+         WRITE(numout,*) '      gravity                              grav = ', grav , ' m/s^2'
+         WRITE(numout,*)
+         WRITE(numout,*) '      freezing point of water              rt0  = ', rt0  , ' K'
+         WRITE(numout,*)
+         WRITE(numout,*) '   reference density and heat capacity now defined in eosbn2.f90'
+         WRITE(numout,*)
+         WRITE(numout,*) '      thermal conductivity of pure ice          = ', rcnd_i  , ' J/s/m/K'
+         WRITE(numout,*) '      thermal conductivity of snow is defined in a namelist '
+         WRITE(numout,*) '      fresh ice specific heat                   = ', rcpi    , ' J/kg/K'
+         WRITE(numout,*) '      latent heat of fusion of fresh ice / snow = ', rLfus   , ' J/kg'
+         WRITE(numout,*) '      latent heat of subl.  of fresh ice / snow = ', rLsub   , ' J/kg'
+         WRITE(numout,*) '      density of sea ice                        = ', rhoi    , ' kg/m^3'
+         WRITE(numout,*) '      density of snow                           = ', rhos    , ' kg/m^3'
+         WRITE(numout,*) '      density of freshwater (in melt ponds)     = ', rhow    , ' kg/m^3'
+         WRITE(numout,*) '      salinity of ice (for pisces)              = ', sice    , ' psu'
+         WRITE(numout,*) '      salinity of sea (for pisces and isf)      = ', soce    , ' psu'
+         WRITE(numout,*) '      latent heat of evaporation (water)        = ', rLevap  , ' J/m^3' 
+         WRITE(numout,*) '      von Karman constant                       = ', vkarmn 
+         WRITE(numout,*) '      Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4'
+         WRITE(numout,*)
+         WRITE(numout,*) '      conversion: degre ==> radian          rad = ', rad
+         WRITE(numout,*)
+         WRITE(numout,*) '      smallest real computer value       rsmall = ', rsmall
+      ENDIF
+
+   END SUBROUTINE phy_cst
+
+   !!======================================================================
+END MODULE phycst
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/phycst.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/phycst.f90	(revision 12100)
+++ 	(revision )
@@ -1,179 +1,0 @@
-MODULE phycst
-   !!======================================================================
-   !!                    ***  MODULE  phycst  ***
-   !!     Definition of of both ocean and ice parameters used in the code
-   !!=====================================================================
-   !! History :   OPA  !  1990-10  (C. Levy - G. Madec)  Original code
-   !!             8.1  !  1991-11  (G. Madec, M. Imbard)  cosmetic changes
-   !!   NEMO      1.0  !  2002-08  (G. Madec, C. Ethe)  F90, add ice constants
-   !!              -   !  2006-08  (G. Madec)  style 
-   !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style 
-   !!             3.4  !  2011-11  (C. Harris)  minor changes for CICE constants 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   phy_cst  : define and print physical constant and domain parameters
-   !!----------------------------------------------------------------------
-   USE par_oce          ! ocean parameters
-   USE in_out_manager   ! I/O manager
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   phy_cst     ! routine called by inipar.F90
-
-   REAL(wp), PUBLIC ::   rpi = 3.141592653589793_wp             !: pi
-   REAL(wp), PUBLIC ::   rad = 3.141592653589793_wp / 180._wp   !: conversion from degre into radian
-   REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1.e0 )         !: smallest real computer value
-   
-   REAL(wp), PUBLIC ::   rday = 24.*60.*60.     !: day                                [s]
-   REAL(wp), PUBLIC ::   rsiyea                 !: sideral year                       [s]
-   REAL(wp), PUBLIC ::   rsiday                 !: sideral day                        [s]
-   REAL(wp), PUBLIC ::   raamo =  12._wp        !: number of months in one year
-   REAL(wp), PUBLIC ::   rjjhh =  24._wp        !: number of hours in one day
-   REAL(wp), PUBLIC ::   rhhmm =  60._wp        !: number of minutes in one hour
-   REAL(wp), PUBLIC ::   rmmss =  60._wp        !: number of seconds in one minute
-   REAL(wp), PUBLIC ::   omega                  !: earth rotation parameter           [s-1]
-   REAL(wp), PUBLIC ::   ra    = 6371229._wp    !: earth radius                       [m]
-   REAL(wp), PUBLIC ::   grav  = 9.80665_wp     !: gravity                            [m/s2]
-   
-   REAL(wp), PUBLIC ::   rtt      = 273.16_wp        !: triple point of temperature   [Kelvin]
-   REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin]
-
-
-
-
-   REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp        !: melting point of snow         [Kelvin]
-   REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp        !: melting point of ice          [Kelvin]
-
-   REAL(wp), PUBLIC ::   rau0                        !: volumic mass of reference     [kg/m3]
-   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg]
-   REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin]
-   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J]
-   REAL(wp), PUBLIC ::   rau0_rcp                    !: = rau0 * rcp 
-   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp )
-
-   REAL(wp), PUBLIC ::   rhosn    =  330._wp         !: volumic mass of snow          [kg/m3]
-   REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice
-   REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice               [psu]
-   REAL(wp), PUBLIC ::   soce     =   34.7_wp        !: salinity of sea               [psu]
-   REAL(wp), PUBLIC ::   cevap    =    2.5e+6_wp     !: latent heat of evaporation (water)
-   REAL(wp), PUBLIC ::   srgamma  =    0.9_wp        !: correction factor for solar radiation (Oberhuber, 1974)
-   REAL(wp), PUBLIC ::   vkarmn   =    0.4_wp        !: von Karman constant
-   REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant 
-
-   REAL(wp), PUBLIC ::   rhoic    =  900._wp         !: volumic mass of sea ice                               [kg/m3]
-   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: conductivity of the ice                               [W/m/K]
-   REAL(wp), PUBLIC ::   rcpic    =    1.8837e+6_wp  !: volumetric specific heat for ice                      [J/m3/K]
-   REAL(wp), PUBLIC ::   cpic                        !: = rcpic / rhoic  (specific heat for ice)              [J/Kg/K]
-   REAL(wp), PUBLIC ::   rcdsn    =    0.22_wp       !: conductivity of the snow                              [W/m/K]
-   REAL(wp), PUBLIC ::   rcpsn    =    6.9069e+5_wp  !: volumetric specific heat for snow                     [J/m3/K]
-   REAL(wp), PUBLIC ::   xlsn     =  110.121e+6_wp   !: volumetric latent heat fusion of snow                 [J/m3]
-   REAL(wp), PUBLIC ::   lfus                        !: = xlsn / rhosn   (latent heat of fusion of fresh ice) [J/Kg]
-   REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3]
-   REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3]
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: phycst.F90 5147 2015-03-13 10:01:32Z cetlod $ 
-   !! Software governed by the CeCILL licence (./LICENSE)
-   !!----------------------------------------------------------------------
-   
-CONTAINS
-   
-   SUBROUTINE phy_cst
-      !!----------------------------------------------------------------------
-      !!                       ***  ROUTINE phy_cst  ***
-      !!
-      !! ** Purpose :   Print model parameters and set and print the constants
-      !!----------------------------------------------------------------------
-      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7) )" 
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~~'
-
-      ! Ocean Parameters
-      ! ----------------
-      IF(lwp) THEN
-         WRITE(numout,*) '       Domain info'
-         WRITE(numout,*) '          dimension of model'
-         WRITE(numout,*) '                 Local domain      Global domain       Data domain '
-         WRITE(numout,cform) '            ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta
-         WRITE(numout,cform) '            ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta
-         WRITE(numout,cform) '            ','   jpk     : ', jpk, '   jpk     : ', jpk   , '   jpkdta  : ', jpkdta
-         WRITE(numout,*)      '           ','   jpij    : ', jpij
-         WRITE(numout,*) '          mpp local domain info (mpp)'
-         WRITE(numout,*) '             jpni    : ', jpni, '   jpreci  : ', jpreci
-         WRITE(numout,*) '             jpnj    : ', jpnj, '   jprecj  : ', jprecj
-         WRITE(numout,*) '             jpnij   : ', jpnij
-         WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio
-      ENDIF
-
-      ! Define constants
-      ! ----------------
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '       Constants'
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '          mathematical constant                 rpi = ', rpi
-
-      rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp
-      rsiday = rday / ( 1._wp + rday / rsiyea )
-      omega  = 2._wp * rpi / rsiday 
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '          day                                rday   = ', rday,   ' s'
-      IF(lwp) WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s'
-      IF(lwp) WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s'
-      IF(lwp) WRITE(numout,*) '          omega                              omega  = ', omega,  ' s^-1'
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months'
-      IF(lwp) WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours'
-      IF(lwp) WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn'
-      IF(lwp) WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s'
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m'
-      IF(lwp) WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2'
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K'
-      IF(lwp) WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K'
-      IF(lwp) WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K'
-      IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K'
-
-      IF(lwp) WRITE(numout,*) '          reference density and heat capacity now defined in eosbn2.f90'
-              
-      cpic = rcpic / rhoic       ! specific heat for ice   [J/Kg/K]
-      lfus = xlsn / rhosn        ! latent heat of fusion of fresh ice
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K'
-         WRITE(numout,*) '          thermal conductivity of the ice           = ', rcdic   , ' J/s/m/K'
-         WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K'
-         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg'
-         WRITE(numout,*) '          density times specific heat for snow      = ', rcpsn   , ' J/m^3/K' 
-         WRITE(numout,*) '          density times specific heat for ice       = ', rcpic   , ' J/m^3/K'
-         WRITE(numout,*) '          volumetric latent heat fusion of sea ice  = ', xlic    , ' J/m' 
-         WRITE(numout,*) '          latent heat of sublimation of snow        = ', xsn     , ' J/kg' 
-         WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m^3' 
-         WRITE(numout,*) '          density of sea ice                        = ', rhoic   , ' kg/m^3'
-         WRITE(numout,*) '          density of snow                           = ', rhosn   , ' kg/m^3'
-         WRITE(numout,*) '          emissivity of snow or ice                 = ', emic  
-         WRITE(numout,*) '          salinity of ice                           = ', sice    , ' psu'
-         WRITE(numout,*) '          salinity of sea                           = ', soce    , ' psu'
-         WRITE(numout,*) '          latent heat of evaporation (water)        = ', cevap   , ' J/m^3' 
-         WRITE(numout,*) '          correction factor for solar radiation     = ', srgamma 
-         WRITE(numout,*) '          von Karman constant                       = ', vkarmn 
-         WRITE(numout,*) '          Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4'
-         WRITE(numout,*)
-         WRITE(numout,*) '          conversion: degre ==> radian          rad = ', rad
-         WRITE(numout,*)
-         WRITE(numout,*) '          smallest real computer value       rsmall = ', rsmall
-      ENDIF
-
-   END SUBROUTINE phy_cst
-
-   !!======================================================================
-END MODULE phycst
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/prtctl.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/prtctl.f90	(revision 12100)
+++ 	(revision )
@@ -1,561 +1,0 @@
-MODULE prtctl
-   !!======================================================================
-   !!                       ***  MODULE prtctl   ***
-   !! Ocean system : print all SUM trends for each processor domain
-   !!======================================================================
-   !! History :  9.0  !  05-07  (C. Talandier) original code
-   !!            3.4  !  11-11  (C. Harris) decomposition changes for running with CICE
-   !!----------------------------------------------------------------------
-   USE dom_oce          ! ocean space and time domain variables
-
-
-
-   USE in_out_manager   ! I/O manager
-   USE lib_mpp          ! distributed memory computing
-   USE wrk_nemo         ! work arrays
-
-   IMPLICIT NONE
-   PRIVATE
-
-   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   numid
-   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlditl , nldjtl    ! first, last indoor index for each i-domain
-   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nleitl , nlejtl    ! first, last indoor index for each j-domain
-   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nimpptl, njmpptl   ! i-, j-indexes for each processor
-   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlcitl , nlcjtl    ! dimensions of every subdomain
-   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   ibonitl, ibonjtl   !
-
-   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   t_ctll , s_ctll    ! previous tracer trend values
-   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   u_ctll , v_ctll    ! previous velocity trend values
-
-   INTEGER ::   ktime   ! time step
-
-   PUBLIC prt_ctl         ! called by all subroutines
-   PUBLIC prt_ctl_info    ! called by all subroutines
-   PUBLIC prt_ctl_init    ! called by opa.F90
-   PUBLIC sub_dom         ! called by opa.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: prtctl.F90 5025 2015-01-12 15:53:50Z timgraham $ 
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2,   &
-      &                                  mask2, clinfo2, ovlap, kdim, clinfo3 )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE prt_ctl  ***
-      !!
-      !! ** Purpose : - print sum control of 2D or 3D arrays over the same area 
-      !!                in mono and mpp case. This way can be usefull when
-      !!                debugging a new parametrization in mono or mpp. 
-      !!
-      !! ** Method  : 2 possibilities exist when setting the ln_ctl parameter to
-      !!                .true. in the ocean namelist:
-      !!              - to debug a MPI run .vs. a mono-processor one; 
-      !!                the control print will be done over each sub-domain.
-      !!                The nictl[se] and njctl[se] parameters in the namelist must 
-      !!                be set to zero and [ij]splt to the corresponding splitted
-      !!                domain in MPI along respectively i-, j- directions.
-      !!              - to debug a mono-processor run over the whole domain/a specific area; 
-      !!                in the first case the nictl[se] and njctl[se] parameters must be set
-      !!                to zero else to the indices of the area to be controled. In both cases
-      !!                isplt and jsplt must be set to 1.
-      !!              - All arguments of the above calling sequence are optional so their
-      !!                name must be explicitly typed if used. For instance if the 3D
-      !!                array tn(:,:,:) must be passed through the prt_ctl subroutine, 
-      !!                it must looks like: CALL prt_ctl(tab3d_1=tn).
-      !!
-      !!                    tab2d_1 : first 2D array
-      !!                    tab3d_1 : first 3D array
-      !!                    mask1   : mask (3D) to apply to the tab[23]d_1 array
-      !!                    clinfo1 : information about the tab[23]d_1 array
-      !!                    tab2d_2 : second 2D array
-      !!                    tab3d_2 : second 3D array
-      !!                    mask2   : mask (3D) to apply to the tab[23]d_2 array
-      !!                    clinfo2 : information about the tab[23]d_2 array
-      !!                    ovlap   : overlap value
-      !!                    kdim    : k- direction for 3D arrays 
-      !!                    clinfo3 : additional information 
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_1
-      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_1
-      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask1
-      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo1
-      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_2
-      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_2
-      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask2
-      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo2
-      INTEGER                   , INTENT(in), OPTIONAL ::   ovlap
-      INTEGER                   , INTENT(in), OPTIONAL ::   kdim
-      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo3
-      !
-      CHARACTER (len=15) :: cl2
-      INTEGER ::   overlap, jn, sind, eind, kdir,j_id
-      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2
-      REAL(wp), POINTER, DIMENSION(:,:)   :: ztab2d_1, ztab2d_2
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask1, zmask2, ztab3d_1, ztab3d_2
-      !!----------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi,jpj, ztab2d_1, ztab2d_2 )
-      CALL wrk_alloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 )
-
-      ! Arrays, scalars initialization 
-      overlap   = 0
-      kdir      = jpkm1
-      cl2       = ''
-      zsum1     = 0.e0
-      zsum2     = 0.e0
-      zvctl1    = 0.e0
-      zvctl2    = 0.e0
-      ztab2d_1(:,:)   = 0.e0
-      ztab2d_2(:,:)   = 0.e0
-      ztab3d_1(:,:,:) = 0.e0
-      ztab3d_2(:,:,:) = 0.e0
-      zmask1  (:,:,:) = 1.e0
-      zmask2  (:,:,:) = 1.e0
-
-      ! Control of optional arguments
-      IF( PRESENT(clinfo2) )   cl2                  = clinfo2
-      IF( PRESENT(ovlap)   )   overlap              = ovlap
-      IF( PRESENT(kdim)    )   kdir                 = kdim
-      IF( PRESENT(tab2d_1) )   ztab2d_1(:,:)        = tab2d_1(:,:)
-      IF( PRESENT(tab2d_2) )   ztab2d_2(:,:)        = tab2d_2(:,:)
-      IF( PRESENT(tab3d_1) )   ztab3d_1(:,:,1:kdir) = tab3d_1(:,:,1:kdir)
-      IF( PRESENT(tab3d_2) )   ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,1:kdir)
-      IF( PRESENT(mask1)   )   zmask1  (:,:,:)      = mask1  (:,:,:)
-      IF( PRESENT(mask2)   )   zmask2  (:,:,:)      = mask2  (:,:,:)
-
-      IF( lk_mpp .AND. jpnij > 1 ) THEN       ! processor number
-         sind = narea
-         eind = narea
-      ELSE                                    ! processors total number
-         sind = 1
-         eind = ijsplt
-      ENDIF
-
-      ! Loop over each sub-domain, i.e. the total number of processors ijsplt
-      DO jn = sind, eind
-         ! Set logical unit
-         j_id = numid(jn - narea + 1)
-         ! Set indices for the SUM control
-         IF( .NOT. lsp_area ) THEN
-            IF (lk_mpp .AND. jpnij > 1)   THEN
-               nictls = MAX( 1, nlditl(jn) - overlap )
-               nictle = nleitl(jn) + overlap * MIN( 1, nlcitl(jn) - nleitl(jn)) 
-               njctls = MAX( 1, nldjtl(jn) - overlap )
-               njctle = nlejtl(jn) + overlap * MIN( 1, nlcjtl(jn) - nlejtl(jn))
-               ! Do not take into account the bound of the domain
-               IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls)
-               IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls)
-               IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nleitl(jn) - 1)
-               IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nlejtl(jn) - 1)
-            ELSE
-               nictls = MAX( 1, nimpptl(jn) + nlditl(jn) - 1 - overlap )
-               nictle = nimpptl(jn) + nleitl(jn) - 1 + overlap * MIN( 1, nlcitl(jn) - nleitl(jn) ) 
-               njctls = MAX( 1, njmpptl(jn) + nldjtl(jn) - 1 - overlap )
-               njctle = njmpptl(jn) + nlejtl(jn) - 1 + overlap * MIN( 1, nlcjtl(jn) - nlejtl(jn) ) 
-               ! Do not take into account the bound of the domain
-               IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls)
-               IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls)
-               IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + nleitl(jn) - 2)
-               IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + nlejtl(jn) - 2)
-            ENDIF
-         ENDIF
-
-         IF( PRESENT(clinfo3)) THEN
-            IF ( clinfo3 == 'tra' )  THEN
-               zvctl1 = t_ctll(jn)
-               zvctl2 = s_ctll(jn)
-            ELSEIF ( clinfo3 == 'dyn' )   THEN
-               zvctl1 = u_ctll(jn)
-               zvctl2 = v_ctll(jn)
-            ENDIF
-         ENDIF
-
-         ! Compute the sum control
-         ! 2D arrays
-         IF( PRESENT(tab2d_1) )   THEN
-            zsum1 = SUM( ztab2d_1(nictls:nictle,njctls:njctle)*zmask1(nictls:nictle,njctls:njctle,1) )
-            zsum2 = SUM( ztab2d_2(nictls:nictle,njctls:njctle)*zmask2(nictls:nictle,njctls:njctle,1) )
-         ENDIF
-
-         ! 3D arrays
-         IF( PRESENT(tab3d_1) )   THEN
-            zsum1 = SUM( ztab3d_1(nictls:nictle,njctls:njctle,1:kdir)*zmask1(nictls:nictle,njctls:njctle,1:kdir) )
-            zsum2 = SUM( ztab3d_2(nictls:nictle,njctls:njctle,1:kdir)*zmask2(nictls:nictle,njctls:njctle,1:kdir) )
-         ENDIF
-
-         ! Print the result
-         IF( PRESENT(clinfo3) )   THEN
-            WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1-zvctl1, cl2, zsum2-zvctl2
-            SELECT CASE( clinfo3 )
-            CASE ( 'tra-ta' ) 
-               t_ctll(jn) = zsum1
-            CASE ( 'tra' ) 
-                t_ctll(jn) = zsum1
-                s_ctll(jn) = zsum2
-            CASE ( 'dyn' ) 
-                u_ctll(jn) = zsum1
-                v_ctll(jn) = zsum2 
-            END SELECT
-         ELSEIF ( PRESENT(clinfo2) .OR. PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN
-            WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1, cl2, zsum2
-         ELSE
-            WRITE(j_id,FMT='(a,D23.16)')clinfo1, zsum1
-         ENDIF
-
-      ENDDO
-
-      CALL wrk_dealloc( jpi,jpj, ztab2d_1, ztab2d_2 )
-      CALL wrk_dealloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 )
-      !
-   END SUBROUTINE prt_ctl
-
-
-   SUBROUTINE prt_ctl_info (clinfo1, ivar1, clinfo2, ivar2, itime)
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE prt_ctl_info  ***
-      !!
-      !! ** Purpose : - print information without any computation
-      !!
-      !! ** Action  : - input arguments
-      !!                    clinfo1 : information about the ivar1
-      !!                    ivar1   : value to print
-      !!                    clinfo2 : information about the ivar2
-      !!                    ivar2   : value to print
-      !!----------------------------------------------------------------------
-      CHARACTER (len=*), INTENT(in)           ::   clinfo1
-      INTEGER          , INTENT(in), OPTIONAL ::   ivar1
-      CHARACTER (len=*), INTENT(in), OPTIONAL ::   clinfo2
-      INTEGER          , INTENT(in), OPTIONAL ::   ivar2
-      INTEGER          , INTENT(in), OPTIONAL ::   itime
-      !
-      INTEGER :: jn, sind, eind, iltime, j_id
-      !!----------------------------------------------------------------------
-
-      IF( lk_mpp .AND. jpnij > 1 ) THEN       ! processor number
-         sind = narea
-         eind = narea
-      ELSE                                    ! total number of processors
-         sind = 1
-         eind = ijsplt
-      ENDIF
-
-      ! Set to zero arrays at each new time step
-      IF( PRESENT(itime) )   THEN
-         iltime = itime
-         IF( iltime > ktime )   THEN
-            t_ctll(:) = 0.e0   ;   s_ctll(:) = 0.e0
-            u_ctll(:) = 0.e0   ;   v_ctll(:) = 0.e0
-            ktime = iltime
-         ENDIF
-      ENDIF
-
-      ! Loop over each sub-domain, i.e. number of processors ijsplt
-      DO jn = sind, eind
-         !
-         j_id = numid(jn - narea + 1)         ! Set logical unit
-         !
-         IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN
-            WRITE(j_id,*)clinfo1, ivar1, clinfo2, ivar2
-         ELSEIF ( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN
-            WRITE(j_id,*)clinfo1, ivar1, clinfo2
-         ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN
-            WRITE(j_id,*)clinfo1, ivar1, ivar2
-         ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN
-            WRITE(j_id,*)clinfo1, ivar1
-         ELSE
-            WRITE(j_id,*)clinfo1
-         ENDIF
-         !
-      END DO
-      !
-   END SUBROUTINE prt_ctl_info
-
-
-   SUBROUTINE prt_ctl_init
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE prt_ctl_init  ***
-      !!
-      !! ** Purpose :   open ASCII files & compute indices
-      !!----------------------------------------------------------------------
-      INTEGER ::   jn, sind, eind, j_id
-      CHARACTER (len=28) :: clfile_out
-      CHARACTER (len=23) :: clb_name
-      CHARACTER (len=19) :: cl_run
-      !!----------------------------------------------------------------------
-
-      ! Allocate arrays
-      ALLOCATE( nlditl(ijsplt) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   &
-         &      nldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   &
-         &      nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll (ijsplt) ,                     &
-         &      nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll (ijsplt)                       )
-
-      ! Initialization 
-      t_ctll(:) = 0.e0
-      s_ctll(:) = 0.e0
-      u_ctll(:) = 0.e0
-      v_ctll(:) = 0.e0
-      ktime = 1
-
-      IF( lk_mpp .AND. jpnij > 1 ) THEN
-         sind = narea
-         eind = narea
-         clb_name = "('mpp.output_',I4.4)"
-         cl_run = 'MULTI processor run'
-         ! use indices for each area computed by mpp_init subroutine
-         nlditl(1:jpnij) = nldit(:) 
-         nleitl(1:jpnij) = nleit(:) 
-         nldjtl(1:jpnij) = nldjt(:) 
-         nlejtl(1:jpnij) = nlejt(:) 
-         !
-         nimpptl(1:jpnij) = nimppt(:)
-         njmpptl(1:jpnij) = njmppt(:)
-         !
-         nlcitl(1:jpnij) = nlcit(:)
-         nlcjtl(1:jpnij) = nlcjt(:)
-         !
-         ibonitl(1:jpnij) = ibonit(:)
-         ibonjtl(1:jpnij) = ibonjt(:)
-      ELSE
-         sind = 1
-         eind = ijsplt
-         clb_name = "('mono.output_',I4.4)"
-         cl_run = 'MONO processor run '
-         ! compute indices for each area as done in mpp_init subroutine
-         CALL sub_dom
-      ENDIF
-
-      ALLOCATE( numid(eind-sind+1) )
-
-      DO jn = sind, eind
-         WRITE(clfile_out,FMT=clb_name) jn-1
-         CALL ctl_opn( numid(jn -narea + 1), clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. )
-         j_id = numid(jn -narea + 1)
-         WRITE(j_id,*)
-         WRITE(j_id,*) '                 L O D Y C - I P S L'
-         WRITE(j_id,*) '                     O P A model'
-         WRITE(j_id,*) '            Ocean General Circulation Model'
-         WRITE(j_id,*) '               version OPA 9.0  (2005) '
-         WRITE(j_id,*)
-         WRITE(j_id,*) '                   PROC number: ', jn
-         WRITE(j_id,*)
-         WRITE(j_id,FMT="(19x,a20)")cl_run
-
-         ! Print the SUM control indices
-         IF( .NOT. lsp_area )   THEN
-            nictls = nimpptl(jn) + nlditl(jn) - 1
-            nictle = nimpptl(jn) + nleitl(jn) - 1
-            njctls = njmpptl(jn) + nldjtl(jn) - 1
-            njctle = njmpptl(jn) + nlejtl(jn) - 1
-         ENDIF
-         WRITE(j_id,*) 
-         WRITE(j_id,*) 'prt_ctl :  Sum control indices'
-         WRITE(j_id,*) '~~~~~~~'
-         WRITE(j_id,*)
-         WRITE(j_id,9000)'                                nlej   = ', nlejtl(jn), '              '
-         WRITE(j_id,9000)'                  ------------- njctle = ', njctle, ' -------------'
-         WRITE(j_id,9001)'                  |                                       |'
-         WRITE(j_id,9001)'                  |                                       |'
-         WRITE(j_id,9001)'                  |                                       |'
-         WRITE(j_id,9002)'           nictls = ', nictls,  '                           nictle = ', nictle
-         WRITE(j_id,9002)'           nldi   = ', nlditl(jn),  '                           nlei   = ', nleitl(jn)
-         WRITE(j_id,9001)'                  |                                       |'
-         WRITE(j_id,9001)'                  |                                       |'
-         WRITE(j_id,9001)'                  |                                       |'
-         WRITE(j_id,9004)'  njmpp  = ',njmpptl(jn),'   ------------- njctls = ', njctls, ' -------------'
-         WRITE(j_id,9003)'           nimpp  = ', nimpptl(jn), '        nldj   = ', nldjtl(jn), '              '
-         WRITE(j_id,*)
-         WRITE(j_id,*)
-
-9000     FORMAT(a41,i4.4,a14)
-9001     FORMAT(a59)
-9002     FORMAT(a20,i4.4,a36,i3.3)
-9003     FORMAT(a20,i4.4,a17,i4.4)
-9004     FORMAT(a11,i4.4,a26,i4.4,a14)
-      END DO
-      !
-   END SUBROUTINE prt_ctl_init
-
-
-   SUBROUTINE sub_dom
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE sub_dom  ***
-      !!                    
-      !! ** Purpose :   Lay out the global domain over processors. 
-      !!                CAUTION: 
-      !!                This part has been extracted from the mpp_init
-      !!                subroutine and names of variables/arrays have been 
-      !!                slightly changed to avoid confusion but the computation
-      !!                is exactly the same. Any modification about indices of
-      !!                each sub-domain in the mppini.F90 module should be reported 
-      !!                here.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!                Periodic condition is a function of the local domain position
-      !!                (global boundary or neighbouring domain) and of the global
-      !!                periodic
-      !!                Type :         jperio global periodic condition
-      !!                               nperio local  periodic condition
-      !!
-      !! ** Action  : - set domain parameters
-      !!                    nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlcil      : first dimension
-      !!                    nlcjl      : second dimension
-      !!                    nbondil    : mark for "east-west local boundary"
-      !!                    nbondjl    : mark for "north-south local boundary"
-      !!
-      !! History :
-      !!        !  94-11  (M. Guyon)  Original code
-      !!        !  95-04  (J. Escobar, M. Imbard)
-      !!        !  98-02  (M. Guyon)  FETI method
-      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
-      !!   8.5  !  02-08  (G. Madec)  F90 : free form
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj, jn               ! dummy loop indices
-      INTEGER ::   &
-         ii, ij,                         &  ! temporary integers
-         irestil, irestjl,               &  !    "          "
-         ijpi  , ijpj, nlcil,            &  ! temporary logical unit
-         nlcjl , nbondil, nbondjl,       &
-         nrecil, nrecjl, nldil, nleil, nldjl, nlejl
-
-      INTEGER, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace
-      REAL(wp) ::   zidom, zjdom            ! temporary scalars
-      !!----------------------------------------------------------------------
-
-      !
-      CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
-      !
-      !  1. Dimension arrays for subdomains
-      ! -----------------------------------
-      !  Computation of local domain sizes ilcitl() ilcjtl()
-      !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array (cf. par_oce.F90).
-
-
-
-
-
-      ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci
-      ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj
-
-
-
-      nrecil  = 2 * jpreci
-      nrecjl  = 2 * jprecj
-      irestil = MOD( jpiglo - nrecil , isplt )
-      irestjl = MOD( jpjglo - nrecjl , jsplt )
-
-      IF(  irestil == 0 )   irestil = isplt
-
-      DO jj = 1, jsplt
-         DO ji = 1, irestil
-            ilcitl(ji,jj) = ijpi
-         END DO
-         DO ji = irestil+1, isplt
-            ilcitl(ji,jj) = ijpi -1
-         END DO
-      END DO
-
-      
-      IF( irestjl == 0 )   irestjl = jsplt
-
-      DO ji = 1, isplt
-         DO jj = 1, irestjl
-            ilcjtl(ji,jj) = ijpj
-         END DO
-         DO jj = irestjl+1, jsplt
-            ilcjtl(ji,jj) = ijpj -1
-         END DO
-      END DO
-
-      zidom = nrecil
-      DO ji = 1, isplt
-         zidom = zidom + ilcitl(ji,1) - nrecil
-      END DO
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)' sum ilcitl(i,1) = ', zidom, ' jpiglo = ', jpiglo
-      
-      zjdom = nrecjl
-      DO jj = 1, jsplt
-         zjdom = zjdom + ilcjtl(1,jj) - nrecjl
-      END DO
-      IF(lwp) WRITE(numout,*)' sum ilcitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo
-      IF(lwp) WRITE(numout,*)
-      
-
-      !  2. Index arrays for subdomains
-      ! -------------------------------
-
-      iimpptl(:,:) = 1
-      ijmpptl(:,:) = 1
-      
-      IF( isplt > 1 ) THEN
-         DO jj = 1, jsplt
-            DO ji = 2, isplt
-               iimpptl(ji,jj) = iimpptl(ji-1,jj) + ilcitl(ji-1,jj) - nrecil
-            END DO
-         END DO
-      ENDIF
-
-      IF( jsplt > 1 ) THEN
-         DO jj = 2, jsplt
-            DO ji = 1, isplt
-               ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ilcjtl(ji,jj-1)-nrecjl
-            END DO
-         END DO
-      ENDIF
-      
-      ! 3. Subdomain description
-      ! ------------------------
-
-      DO jn = 1, ijsplt
-         ii = 1 + MOD( jn-1, isplt )
-         ij = 1 + (jn-1) / isplt
-         nimpptl(jn) = iimpptl(ii,ij)
-         njmpptl(jn) = ijmpptl(ii,ij)
-         nlcitl (jn) = ilcitl (ii,ij)     
-         nlcil       = nlcitl (jn)     
-         nlcjtl (jn) = ilcjtl (ii,ij)     
-         nlcjl       = nlcjtl (jn)
-         nbondjl = -1                                    ! general case
-         IF( jn   >  isplt          )   nbondjl = 0      ! first row of processor
-         IF( jn   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor
-         IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction
-         ibonjtl(jn) = nbondjl
-         
-         nbondil = 0                                     ! 
-         IF( MOD( jn, isplt ) == 1 )   nbondil = -1      !
-         IF( MOD( jn, isplt ) == 0 )   nbondil =  1      !
-         IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction
-         ibonitl(jn) = nbondil
-         
-         nldil =  1   + jpreci
-         nleil = nlcil - jpreci
-         IF( nbondil == -1 .OR. nbondil == 2 )   nldil = 1
-         IF( nbondil ==  1 .OR. nbondil == 2 )   nleil = nlcil
-         nldjl =  1   + jprecj
-         nlejl = nlcjl - jprecj
-         IF( nbondjl == -1 .OR. nbondjl == 2 )   nldjl = 1
-         IF( nbondjl ==  1 .OR. nbondjl == 2 )   nlejl = nlcjl
-         nlditl(jn) = nldil
-         nleitl(jn) = nleil
-         nldjtl(jn) = nldjl
-         nlejtl(jn) = nlejl
-      END DO
-      !
-      !
-      CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
-      !
-      !
-   END SUBROUTINE sub_dom
-
-   !!======================================================================
-END MODULE prtctl
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/restart.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/restart.f90	(revision 12100)
+++ 	(revision )
@@ -1,281 +1,0 @@
-MODULE restart
-   !!======================================================================
-   !!                     ***  MODULE  restart  ***
-   !! Ocean restart :  write the ocean restart file
-   !!======================================================================
-   !! History :  OPA  !  1999-11  (M. Imbard)  Original code
-   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form
-   !!            2.0  !  2006-07  (S. Masson)  use IOM for restart
-   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  modified LF-RA
-   !!            - -  !  2010-10  (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D)
-   !!            3.7  !  2014-01  (G. Madec) suppression of curl and hdiv from the restart
-   !!             -   !  2014-12  (G. Madec) remove KPP scheme
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   rst_opn    : open the ocean restart file
-   !!   rst_write  : write the ocean restart file
-   !!   rst_read   : read the ocean restart file
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers 
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_ice         ! only lk_lim3 
-   USE phycst          ! physical constants
-   USE eosbn2          ! equation of state            (eos bn2 routine)
-   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
-   !
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O module
-   USE diurnal_bulk
-   
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   rst_opn         ! routine called by step module
-   PUBLIC   rst_write       ! routine called by step module
-   PUBLIC   rst_read        ! routine called by istate module
-   PUBLIC   rst_read_open   ! routine called in rst_read and (possibly) in dom_vvl_init
-
-   !! * Substitutions
-   !!----------------------------------------------------------------------
-   !!                   ***  vectopt_loop_substitute  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
-   !!                allow unrolling of do-loop (useful with vector processors)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
-   !! Software governed by the CeCILL licence (./LICENSE)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: restart.F90 6140 2015-12-21 11:35:23Z timgraham $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE rst_opn( kt )
-      !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE rst_opn  ***
-      !!                     
-      !! ** Purpose : + initialization (should be read in the namelist) of nitrst 
-      !!              + open the restart when we are one time step before nitrst
-      !!                   - restart header is defined when kt = nitrst-1
-      !!                   - restart data  are written when kt = nitrst
-      !!              + define lrst_oce to .TRUE. when we need to define or write the restart
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt     ! ocean time-step
-      !!
-      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
-      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
-      CHARACTER(lc)       ::   clpath   ! full path to ocean output restart file
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 ) THEN   ! default definitions
-         lrst_oce = .FALSE.   
-         IF( ln_rst_list ) THEN
-            nrst_lst = 1
-            nitrst = nstocklist( nrst_lst )
-         ELSE
-            nitrst = nitend
-         ENDIF
-      ENDIF
-
-      ! frequency-based restart dumping (nn_stock)
-      IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN   
-         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
-         nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
-         IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
-      ENDIF
-      ! to get better performances with NetCDF format:
-      ! we open and define the ocean restart file one time step before writing the data (-> at nitrst - 1)
-      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1
-      IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN
-         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
-            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
-            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
-            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
-            ENDIF
-            ! create the file
-            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out)
-            clpath = TRIM(cn_ocerst_outdir)
-            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
-            IF(lwp) THEN
-               WRITE(numout,*)
-               SELECT CASE ( jprstlib )
-               CASE DEFAULT         ;   WRITE(numout,*)                            &
-                   '             open ocean restart NetCDF file: ',TRIM(clpath)//clname
-               END SELECT
-               IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression'
-               IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt
-               ELSE                          ;   WRITE(numout,*) '             kt = '             , kt
-               ENDIF
-            ENDIF
-            !
-            CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib )
-            lrst_oce = .TRUE.
-         ENDIF
-      ENDIF
-      !
-   END SUBROUTINE rst_opn
-
-
-   SUBROUTINE rst_write( kt )
-      !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE rstwrite  ***
-      !!                     
-      !! ** Purpose :   Write restart fields in the format corresponding to jprstlib
-      !!
-      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF
-      !!              file, save fields which are necessary for restart
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step
-      !!----------------------------------------------------------------------
-
-                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       )   ! dynamics and tracer time step
-
-      IF ( .NOT. ln_diurnal_only ) THEN
-                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields
-                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        )
-                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) )
-                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) )
-                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      )
-                     !
-                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields
-                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn        )
-                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem) )
-                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) )
-                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      )
-                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      )
-
-                  ! extra variable needed for the ice sheet coupling
-                  IF ( ln_iscpl ) THEN 
-                     CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask     ) ! need to extrapolate T/S
-                     CALL iom_rstput( kt, nitrst, numrow, 'umask'  , umask     ) ! need to correct barotropic velocity
-                     CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask     ) ! need to correct barotropic velocity
-                     CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask    ) ! need to correct barotropic velocity
-                     CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) )   ! need to compute temperature correction
-                     CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:) )   ! need to compute bt conservation
-                     CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:) )   ! need to compute bt conservation
-                     CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:) ) ! need to compute extrapolation if vvl
-                  END IF
-      ENDIF
-      
-      IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst    )  
-
-      IF( kt == nitrst ) THEN
-         CALL iom_close( numrow )     ! close the restart file (only at last time step)
-!!gm         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE.
-!!gm  not sure what to do here   ===>>>  ask to Sebastian
-         lrst_oce = .FALSE.
-            IF( ln_rst_list ) THEN
-               nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1))
-               nitrst = nstocklist( nrst_lst )
-            ENDIF
-            lrst_oce = .FALSE.
-      ENDIF
-      !
-   END SUBROUTINE rst_write
-
-
-   SUBROUTINE rst_read_open
-      !!---------------------------------------------------------------------- 
-      !!                   ***  ROUTINE rst_read_open  ***
-      !! 
-      !! ** Purpose :   Open read files for restart (format fixed by jprstlib )
-      !! 
-      !! ** Method  :   Use a non-zero, positive value of numror to assess whether or not
-      !!                the file has already been opened
-      !!----------------------------------------------------------------------
-      INTEGER        ::   jlibalt = jprstlib
-      LOGICAL        ::   llok
-      CHARACTER(lc)  ::   clpath   ! full path to ocean output restart file
-      !!----------------------------------------------------------------------
-      !
-      IF( numror <= 0 ) THEN
-         IF(lwp) THEN                                             ! Contol prints
-            WRITE(numout,*)
-            SELECT CASE ( jprstlib )
-            CASE ( jpnf90    )   ;   WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
-            END SELECT
-            IF ( snc4set%luse )      WRITE(numout,*) 'rst_read : configured with NetCDF4 support'
-            WRITE(numout,*) '~~~~~~~~'
-         ENDIF
-
-         clpath = TRIM(cn_ocerst_indir)
-         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
-         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt )
-      ENDIF
-   END SUBROUTINE rst_read_open
-
-
-   SUBROUTINE rst_read
-      !!---------------------------------------------------------------------- 
-      !!                   ***  ROUTINE rst_read  ***
-      !! 
-      !! ** Purpose :   Read files for restart (format fixed by jprstlib )
-      !! 
-      !! ** Method  :   Read in restart.nc file fields which are necessary for restart
-      !!----------------------------------------------------------------------
-      REAL(wp) ::   zrdt
-      INTEGER  ::   jk
-      !!----------------------------------------------------------------------
-
-      CALL rst_read_open           ! open restart for reading (if not already opened)
-
-      ! Check dynamics and tracer time-step consistency and force Euler restart if changed
-      IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN
-         CALL iom_get( numror, 'rdt', zrdt )
-         IF( zrdt /= rdt )   neuler = 0
-      ENDIF
-
-      ! Diurnal DSST 
-      IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst  ) 
-      IF ( ln_diurnal_only ) THEN 
-         IF(lwp) WRITE( numout, * ) &
-         &   "rst_read:- ln_diurnal_only set, setting rhop=rau0" 
-         rhop = rau0
-         CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,1,jp_tem) ) 
-         RETURN 
-      ENDIF  
-      
-      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN
-         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields
-         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      )
-         CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) )
-         CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) )
-         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    )
-      ELSE
-         neuler = 0
-      ENDIF
-      !
-      CALL iom_get( numror, jpdom_autoglo, 'un'     , un      )   ! now    fields
-      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn      )
-      CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem) )
-      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) )
-      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
-      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN
-         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density
-      ELSE
-         CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) )   
-      ENDIF
-      !
-      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
-         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values
-         ub   (:,:,:)   = un   (:,:,:)
-         vb   (:,:,:)   = vn   (:,:,:)
-         sshb (:,:)     = sshn (:,:)
-         !
-         IF( .NOT.ln_linssh ) THEN
-            DO jk = 1, jpk
-               e3t_b(:,:,jk) = e3t_n(:,:,jk)
-            END DO
-         ENDIF
-         !
-      ENDIF
-      !
-   END SUBROUTINE rst_read
-
-   !!=====================================================================
-END MODULE restart
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/restcom.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/restcom.f90	(revision 12100)
+++ 	(revision )
@@ -1,2546 +1,0 @@
-MODULE restcom
-!-
-!$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
-!===
-!-----------------
-END MODULE restcom
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/step_oce.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/step_oce.f90	(revision 12100)
+++ 	(revision )
@@ -1,30 +1,0 @@
-MODULE step_oce
-   !!======================================================================
-   !!                       ***  MODULE step_oce  ***
-   !! Ocean time-stepping : module used in both initialisation phase and time stepping
-   !!======================================================================
-   !! History :   3.3  !  2010-08  (C. Ethe)  Original code - reorganisation of the initial phase
-   !!             3.7  !  2014-01  (G. Madec) LDF simplication 
-   !!----------------------------------------------------------------------
-   USE oce              ! ocean dynamics and tracers variables
-   USE dom_oce          ! ocean space and time domain variables
-
-   USE daymod           ! calendar                         (day     routine)
-
-   USE eosbn2           ! equation of state                (eos_bn2 routine)
-
-   USE prtctl           ! Print control                    (prt_ctl routine)
-
-   USE in_out_manager   ! I/O manager
-   USE iom              !
-   USE lbclnk
-   USE timing           ! Timing
-
-
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: step_oce.F90 6140 2015-12-21 11:35:23Z timgraham $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!======================================================================
-END MODULE step_oce
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/stpctl.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/stpctl.f90	(revision 12100)
+++ 	(revision )
@@ -1,159 +1,0 @@
-MODULE stpctl
-   !!======================================================================
-   !!                       ***  MODULE  stpctl  ***
-   !! Ocean run control :  gross check of the ocean time stepping
-   !!======================================================================
-   !! History :  OPA  ! 1991-03  (G. Madec) Original code
-   !!            6.0  ! 1992-06  (M. Imbard)
-   !!            8.0  ! 1997-06  (A.M. Treguier)
-   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
-   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   stp_ctl      : Control the run
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE c1d             ! 1D vertical configuration
-   !
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! distributed memory computing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC stp_ctl           ! routine called by step.F90
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: stpctl.F90 6140 2015-12-21 11:35:23Z timgraham $
-   !! Software governed by the CeCILL licence (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE stp_ctl( kt, kindic )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE stp_ctl  ***
-      !!                     
-      !! ** Purpose :   Control the run
-      !!
-      !! ** Method  : - Save the time step in numstp
-      !!              - Print it each 50 time steps
-      !!              - Stop the run IF problem ( indic < 0 )
-      !!
-      !! ** Actions :   'time.step' file containing the last ocean time-step
-      !!                
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
-      INTEGER, INTENT(inout) ::   kindic   ! error indicator
-      !!
-      INTEGER  ::   ji, jj, jk             ! dummy loop indices
-      INTEGER  ::   ii, ij, ik             ! local integers
-      REAL(wp) ::   zumax, zsmin, zssh2    ! local scalars
-      INTEGER, DIMENSION(3) ::   ilocu     ! 
-      INTEGER, DIMENSION(2) ::   ilocs     ! 
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'stp_ctl : time-stepping control'
-         WRITE(numout,*) '~~~~~~~'
-         ! open time.step file
-         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-      ENDIF
-      !
-      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
-      IF(lwp) REWIND( numstp )                       !  --------------------------
-      !
-      !                                              !* Test maximum of velocity (zonal only)
-      !                                              !  ------------------------
-      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
-      zumax = 0.e0
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
-          END DO 
-        END DO 
-      END DO        
-      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
-      !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
-      !
-      IF( zumax > 20.e0 ) THEN
-         IF( lk_mpp ) THEN
-            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
-         ELSE
-            ilocu = MAXLOC( ABS( un(:,:,:) ) )
-            ii = ilocu(1) + nimpp - 1
-            ij = ilocu(2) + njmpp - 1
-            ik = ilocu(3)
-         ENDIF
-         IF(lwp) THEN
-            WRITE(numout,cform_err)
-            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
-            WRITE(numout,*) ' ====== '
-            WRITE(numout,9400) kt, zumax, ii, ij, ik
-            WRITE(numout,*)
-            WRITE(numout,*) '          output of last fields in numwso'
-         ENDIF
-         kindic = -3
-      ENDIF
-9400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
-      !
-      !                                              !* Test minimum of salinity
-      !                                              !  ------------------------
-      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
-      zsmin = 100._wp
-      DO jj = 2, jpjm1
-         DO ji = 1, jpi
-            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal))
-         END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
-      !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
-      !
-      IF( zsmin < 0.) THEN 
-         IF (lk_mpp) THEN
-            CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij )
-         ELSE
-            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )
-            ii = ilocs(1) + nimpp - 1
-            ij = ilocs(2) + njmpp - 1
-         ENDIF
-         !
-         IF(lwp) THEN
-            WRITE(numout,cform_err)
-            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
-            WRITE(numout,*) '======= '
-            WRITE(numout,9500) kt, zsmin, ii, ij
-            WRITE(numout,*)
-            WRITE(numout,*) '          output of last fields in numwso'
-         ENDIF
-         kindic = -3
-      ENDIF
-9500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
-      !
-      !
-      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
-
-      ! log file (ssh statistics)
-      ! --------                                   !* ssh statistics (and others...)
-      IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
-         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-      ENDIF
-      !
-      zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) )
-      IF( lk_mpp )   CALL mpp_sum( zssh2 )      ! sum over the global domain
-      !
-      IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin      ! ssh statistics
-      !
-9200  FORMAT('it:', i8, ' iter:', i4, ' r: ',e16.10, ' b: ',e16.10 )
-9300  FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10)
-      !
-   END SUBROUTINE stp_ctl
-
-   !!======================================================================
-END MODULE stpctl
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/timing.F90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/timing.F90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/timing.F90	(revision 12101)
@@ -0,0 +1,866 @@
+MODULE timing
+   !!========================================================================
+   !!                     ***  MODULE  timing  ***
+   !!========================================================================
+   !! History : 4.0  ! 2001-05  (R. Benshila)   
+   !!------------------------------------------------------------------------
+
+   !!------------------------------------------------------------------------
+   !!   timming_init    : initialize timing process 
+   !!   timing_start    : start Timer
+   !!   timing_stop     : stop  Timer
+   !!   timing_reset    : end timing variable creation
+   !!   timing_finalize : compute stats and write output in calling w*_info 
+   !!   timing_ini_var  : create timing variables 
+   !!   timing_listing  : print instumented subroutines in ocean.output
+   !!   wcurrent_info   : compute and print detailed stats on the current CPU
+   !!   wave_info       : compute and print averaged statson all processors
+   !!   wmpi_info       : compute and write global stats  
+   !!   supress         : suppress an element of the timing linked list  
+   !!   insert          : insert an element of the timing linked list  
+   !!------------------------------------------------------------------------
+   USE in_out_manager  ! I/O manager 
+   USE dom_oce         ! ocean domain
+   USE lib_mpp          
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   timing_init, timing_finalize   ! called in nemogcm module 
+   PUBLIC   timing_reset                   ! called in step module 
+   PUBLIC   timing_start, timing_stop      ! called in each routine to time 
+   
+#if defined key_mpp_mpi
+   INCLUDE 'mpif.h'
+#endif
+
+   ! Variables for fine grain timing
+   TYPE timer
+      CHARACTER(LEN=20)  :: cname
+      CHARACTER(LEN=20)  :: surname
+      INTEGER :: rank
+      REAL(wp)  :: t_cpu, t_clock, tsum_cpu, tsum_clock, tmax_cpu, tmax_clock, tmin_cpu, tmin_clock, tsub_cpu, tsub_clock
+      INTEGER :: ncount, ncount_max, ncount_rate  
+      INTEGER :: niter
+      LOGICAL :: l_tdone
+      TYPE(timer), POINTER :: next => NULL()
+      TYPE(timer), POINTER :: prev => NULL()
+      TYPE(timer), POINTER :: parent_section => NULL()
+   END TYPE timer
+    
+   TYPE alltimer
+      CHARACTER(LEN=20), DIMENSION(:), POINTER :: cname => NULL()
+      REAL(wp), DIMENSION(:), POINTER :: tsum_cpu   => NULL()
+      REAL(wp), DIMENSION(:), POINTER :: tsum_clock => NULL()
+      INTEGER, DIMENSION(:), POINTER :: niter => NULL()
+      TYPE(alltimer), POINTER :: next => NULL()
+      TYPE(alltimer), POINTER :: prev => NULL()
+   END TYPE alltimer 
+ 
+   TYPE(timer), POINTER :: s_timer_root => NULL()
+   TYPE(timer), POINTER :: s_timer      => NULL()
+   TYPE(timer), POINTER :: s_timer_old      => NULL()
+
+   TYPE(timer), POINTER :: s_wrk        => NULL()
+   REAL(wp) :: t_overclock, t_overcpu
+   LOGICAL :: l_initdone = .FALSE.
+   INTEGER :: nsize
+   
+   ! Variables for coarse grain timing
+   REAL(wp) :: tot_etime, tot_ctime
+   REAL(kind=wp), DIMENSION(2)     :: t_elaps, t_cpu
+   REAL(wp), ALLOCATABLE, DIMENSION(:) :: all_etime, all_ctime
+   INTEGER :: nfinal_count, ncount, ncount_rate, ncount_max
+   INTEGER, DIMENSION(8)           :: nvalues
+   CHARACTER(LEN=8), DIMENSION(2)  :: cdate
+   CHARACTER(LEN=10), DIMENSION(2) :: ctime
+   CHARACTER(LEN=5)                :: czone
+    
+   ! From of ouput file (1/proc or one global)   !RB to put in nammpp or namctl
+   LOGICAL :: ln_onefile = .TRUE. 
+   LOGICAL :: lwriter
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: timing.F90 10510 2019-01-14 16:13:17Z clem $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE timing_start(cdinfo)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_start  ***
+      !! ** Purpose :   collect execution time
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      !
+       IF(ASSOCIATED(s_timer) ) s_timer_old => s_timer
+       !
+      ! Create timing structure at first call of the routine 
+       CALL timing_ini_var(cdinfo)
+   !   write(*,*) 'after inivar ', s_timer%cname
+
+      ! ici timing_ini_var a soit retrouve s_timer et fait return soit ajoute un maillon
+      ! maintenant on regarde si le call d'avant corrsspond a un parent ou si il est ferme
+      IF( .NOT. s_timer_old%l_tdone ) THEN      
+         s_timer%parent_section => s_timer_old
+      ELSE
+         s_timer%parent_section => NULL()
+      ENDIF    
+
+      s_timer%l_tdone = .FALSE.
+      s_timer%niter = s_timer%niter + 1
+      s_timer%t_cpu = 0.
+      s_timer%t_clock = 0.
+                  
+      ! CPU time collection
+      CALL CPU_TIME( s_timer%t_cpu  )
+      ! clock time collection
+#if defined key_mpp_mpi
+      s_timer%t_clock= MPI_Wtime()
+#else
+      CALL SYSTEM_CLOCK(COUNT_RATE=s_timer%ncount_rate, COUNT_MAX=s_timer%ncount_max)
+      CALL SYSTEM_CLOCK(COUNT = s_timer%ncount)
+#endif
+!      write(*,*) 'end of start ', s_timer%cname
+
+      !
+   END SUBROUTINE timing_start
+
+
+   SUBROUTINE timing_stop(cdinfo, csection)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_stop  ***
+      !! ** Purpose :   finalize timing and output
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      CHARACTER(len=*), INTENT(in), OPTIONAL :: csection
+      !
+      INTEGER  :: ifinal_count, iperiods    
+      REAL(wp) :: zcpu_end, zmpitime,zcpu_raw,zclock_raw
+      !
+      s_wrk => NULL()
+
+      ! clock time collection
+#if defined key_mpp_mpi
+      zmpitime = MPI_Wtime()
+#else
+      CALL SYSTEM_CLOCK(COUNT = ifinal_count)
+#endif
+      ! CPU time collection
+      CALL CPU_TIME( zcpu_end )
+
+!!$      IF(associated(s_timer%parent_section))then
+!!$        write(*,*) s_timer%cname,' <-- ', s_timer%parent_section%cname
+!!$      ENDIF  
+
+ !     No need to search ... : s_timer has the last value defined in start
+ !     s_timer => s_timer_root
+ !     DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) ) 
+ !        IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+ !     END DO
+ 
+      ! CPU time correction
+      zcpu_raw = zcpu_end - s_timer%t_cpu - t_overcpu ! total time including child
+      s_timer%t_cpu  = zcpu_raw - s_timer%tsub_cpu
+  !    IF(s_timer%cname==trim('lbc_lnk_2d'))  write(*,*) s_timer%tsub_cpu,zcpu_end
+
+      ! clock time correction
+#if defined key_mpp_mpi
+      zclock_raw = zmpitime - s_timer%t_clock - t_overclock ! total time including child
+      s_timer%t_clock = zclock_raw - t_overclock - s_timer%tsub_clock
+#else
+      iperiods = ifinal_count - s_timer%ncount
+      IF( ifinal_count < s_timer%ncount )  &
+         iperiods = iperiods + s_timer%ncount_max 
+         zclock_raw = REAL(iperiods) / s_timer%ncount_rate !- t_overclock   
+         s_timer%t_clock  = zclock_raw - s_timer%tsub_clock
+#endif
+ !     IF(s_timer%cname==trim('lbc_lnk_2d')) write(*,*) zclock_raw , s_timer%tsub_clock
+      
+      ! Correction of parent section
+      IF( .NOT. PRESENT(csection) ) THEN
+         IF ( ASSOCIATED(s_timer%parent_section ) ) THEN
+            s_timer%parent_section%tsub_cpu   = zcpu_raw   + s_timer%parent_section%tsub_cpu 
+            s_timer%parent_section%tsub_clock = zclock_raw + s_timer%parent_section%tsub_clock             
+         ENDIF
+      ENDIF
+            
+      ! time diagnostics 
+      s_timer%tsum_clock = s_timer%tsum_clock + s_timer%t_clock 
+      s_timer%tsum_cpu   = s_timer%tsum_cpu   + s_timer%t_cpu
+!RB to use to get min/max during a time integration
+!      IF( .NOT. l_initdone ) THEN
+!         s_timer%tmin_clock = s_timer%t_clock 
+!         s_timer%tmin_cpu   = s_timer%t_cpu 
+!      ELSE
+!         s_timer%tmin_clock = MIN( s_timer%tmin_clock, s_timer%t_clock ) 
+!         s_timer%tmin_cpu   = MIN( s_timer%tmin_cpu  , s_timer%t_cpu   ) 
+!      ENDIF   
+!      s_timer%tmax_clock = MAX( s_timer%tmax_clock, s_timer%t_clock ) 
+!      s_timer%tmax_cpu   = MAX( s_timer%tmax_cpu  , s_timer%t_cpu   )  
+      !
+      s_timer%tsub_clock = 0.
+      s_timer%tsub_cpu = 0.
+      s_timer%l_tdone = .TRUE.
+      !
+      !
+      ! we come back
+      IF ( ASSOCIATED(s_timer%parent_section ) ) s_timer => s_timer%parent_section
+     
+!      write(*,*) 'end of stop ', s_timer%cname
+
+   END SUBROUTINE timing_stop
+ 
+ 
+   SUBROUTINE timing_init
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_init  ***
+      !! ** Purpose :   open timing output file
+      !!----------------------------------------------------------------------
+      INTEGER :: iperiods, istart_count, ifinal_count
+      REAL(wp) :: zdum
+      LOGICAL :: ll_f
+             
+      IF( ln_onefile ) THEN
+         IF( lwp) CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.TRUE., narea )
+         lwriter = lwp
+      ELSE
+         CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.FALSE., narea )
+         lwriter = .TRUE.
+      ENDIF
+      
+      IF( lwriter) THEN      
+         WRITE(numtime,*)
+         WRITE(numtime,*) '      CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC - INGV'
+         WRITE(numtime,*) '                             NEMO team'
+         WRITE(numtime,*) '                  Ocean General Circulation Model'
+         WRITE(numtime,*) '                        version 4.0  (2019) '
+         WRITE(numtime,*)
+         WRITE(numtime,*) '                        Timing Informations '
+         WRITE(numtime,*)
+         WRITE(numtime,*)
+      ENDIF   
+      
+      ! Compute clock function overhead
+#if defined key_mpp_mpi        
+      t_overclock = MPI_WTIME()
+      t_overclock = MPI_WTIME() - t_overclock
+#else        
+      CALL SYSTEM_CLOCK(COUNT_RATE=ncount_rate, COUNT_MAX=ncount_max)
+      CALL SYSTEM_CLOCK(COUNT = istart_count)
+      CALL SYSTEM_CLOCK(COUNT = ifinal_count)
+      iperiods = ifinal_count - istart_count
+      IF( ifinal_count < istart_count )  &
+          iperiods = iperiods + ncount_max 
+      t_overclock = REAL(iperiods) / ncount_rate
+#endif
+
+      ! Compute cpu_time function overhead
+      CALL CPU_TIME(zdum)
+      CALL CPU_TIME(t_overcpu)
+      
+      ! End overhead omputation  
+      t_overcpu = t_overcpu - zdum        
+      t_overclock = t_overcpu + t_overclock        
+
+      ! Timing on date and time
+      CALL DATE_AND_TIME(cdate(1),ctime(1),czone,nvalues)
+    
+      CALL CPU_TIME(t_cpu(1))      
+#if defined key_mpp_mpi        
+      ! Start elapsed and CPU time counters
+      t_elaps(1) = MPI_WTIME()
+#else
+      CALL SYSTEM_CLOCK(COUNT_RATE=ncount_rate, COUNT_MAX=ncount_max)
+      CALL SYSTEM_CLOCK(COUNT = ncount)
+#endif                 
+      !
+   END SUBROUTINE timing_init
+
+
+   SUBROUTINE timing_finalize
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_finalize ***
+      !! ** Purpose :  compute average time 
+      !!               write timing output file
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER :: s_temp
+      INTEGER :: idum, iperiods, icode
+      INTEGER :: ji
+      LOGICAL :: ll_ord, ll_averep
+      CHARACTER(len=120) :: clfmt            
+      REAL(wp), DIMENSION(:), ALLOCATABLE ::   timing_glob
+      REAL(wp) ::   zsypd   ! simulated years per day (Balaji 2017)
+      REAL(wp) ::   zperc, ztot
+
+      ll_averep = .TRUE.
+    
+      ! total CPU and elapse
+      CALL CPU_TIME(t_cpu(2))
+      t_cpu(2)   = t_cpu(2)    - t_cpu(1)   - t_overcpu
+#if defined key_mpp_mpi
+      t_elaps(2) = MPI_WTIME() - t_elaps(1) - t_overclock
+#else
+      CALL SYSTEM_CLOCK(COUNT = nfinal_count)
+      iperiods = nfinal_count - ncount
+      IF( nfinal_count < ncount )  &
+          iperiods = iperiods + ncount_max 
+      t_elaps(2) = REAL(iperiods) / ncount_rate - t_overclock
+#endif      
+
+      ! End of timings on date & time
+      CALL DATE_AND_TIME(cdate(2),ctime(2),czone,nvalues)
+       
+      ! Compute the numer of routines
+      nsize = 0 
+      s_timer => s_timer_root
+      DO WHILE( ASSOCIATED(s_timer) )
+         nsize = nsize + 1
+         s_timer => s_timer%next
+      END DO
+      idum = nsize
+      CALL mpp_sum('timing', idum)
+      IF( idum/jpnij /= nsize ) THEN
+         IF( lwriter ) WRITE(numtime,*) '        ===> W A R N I N G: '
+         IF( lwriter ) WRITE(numtime,*) ' Some CPU have different number of routines instrumented for timing'
+         IF( lwriter ) WRITE(numtime,*) ' No detailed report on averaged timing can be provided'
+         IF( lwriter ) WRITE(numtime,*) ' The following detailed report only deals with the current processor'
+         IF( lwriter ) WRITE(numtime,*)
+         ll_averep = .FALSE.
+      ENDIF   
+
+#if defined key_mpp_mpi      
+      ! in MPI gather some info
+      ALLOCATE( all_etime(jpnij), all_ctime(jpnij) )
+      CALL MPI_ALLGATHER(t_elaps(2), 1, MPI_DOUBLE_PRECISION,   &
+                         all_etime , 1, MPI_DOUBLE_PRECISION,   &
+                         MPI_COMM_OCE, icode)
+      CALL MPI_ALLGATHER(t_cpu(2) , 1, MPI_DOUBLE_PRECISION,   &
+                         all_ctime, 1, MPI_DOUBLE_PRECISION,   &
+                         MPI_COMM_OCE, icode)
+      tot_etime = SUM(all_etime(:))
+      tot_ctime = SUM(all_ctime(:))
+#else
+      tot_etime = t_elaps(2)
+      tot_ctime = t_cpu  (2)           
+#endif
+
+      ! write output file
+      IF( lwriter ) WRITE(numtime,*) 'Total timing (sum) :'
+      IF( lwriter ) WRITE(numtime,*) '--------------------'
+      IF( lwriter ) WRITE(numtime,"('Elapsed Time (s)  CPU Time (s)')")
+      IF( lwriter ) WRITE(numtime,'(5x,f12.3,1x,f12.3)')  tot_etime, tot_ctime
+      IF( lwriter ) WRITE(numtime,*) 
+#if defined key_mpp_mpi
+      IF( ll_averep ) CALL waver_info
+      CALL wmpi_info
+#endif      
+      IF( lwriter ) CALL wcurrent_info
+      
+      clfmt='(1X,"Timing started on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
+      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &           
+      &       cdate(1)(7:8), cdate(1)(5:6), cdate(1)(1:4),   &
+      &       ctime(1)(1:2), ctime(1)(3:4), ctime(1)(5:6),   &
+      &       czone(1:3),    czone(4:5)                     
+      clfmt='(1X,  "Timing   ended on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
+      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &           
+      &       cdate(2)(7:8), cdate(2)(5:6), cdate(2)(1:4),   &
+      &       ctime(2)(1:2), ctime(2)(3:4), ctime(2)(5:6),   &
+      &       czone(1:3),    czone(4:5)
+
+#if defined key_mpp_mpi
+      ALLOCATE(timing_glob(4*jpnij), stat=icode)
+      CALL MPI_GATHER( (/compute_time, waiting_time(1), waiting_time(2), elapsed_time/),   &
+         &             4, MPI_DOUBLE_PRECISION, timing_glob, 4, MPI_DOUBLE_PRECISION, 0, MPI_COMM_OCE, icode)
+      IF( narea == 1 ) THEN
+         WRITE(numtime,*) ' '
+         WRITE(numtime,*) ' Report on time spent on waiting MPI messages '
+         WRITE(numtime,*) '    total timing measured between nit000+1 and nitend-1 '
+         WRITE(numtime,*) '    warning: includes restarts writing time if output before nitend... '
+         WRITE(numtime,*) ' '
+         DO ji = 1, jpnij
+            ztot = SUM( timing_glob(4*ji-3:4*ji-1) )
+            WRITE(numtime,'(A28,F11.6,            A34,I8)') 'Computing       time : ',timing_glob(4*ji-3), ' on MPI rank : ', ji
+            IF ( ztot /= 0. ) zperc = timing_glob(4*ji-2) / ztot * 100.
+            WRITE(numtime,'(A28,F11.6,A2, F4.1,A3,A25,I8)') 'Waiting lbc_lnk time : ',timing_glob(4*ji-2)   &
+               &                                                         , ' (',      zperc,' %)',   ' on MPI rank : ', ji
+            IF ( ztot /= 0. ) zperc = timing_glob(4*ji-1) / ztot * 100.
+            WRITE(numtime,'(A28,F11.6,A2, F4.1,A3,A25,I8)') 'Waiting  global time : ',timing_glob(4*ji-1)   &
+               &                                                         , ' (',      zperc,' %)',   ' on MPI rank : ', ji
+            zsypd = rn_rdt * REAL(nitend-nit000-1, wp) / (timing_glob(4*ji) * 365.)
+            WRITE(numtime,'(A28,F11.6,A7,F10.3,A2,A15,I8)') 'Total           time : ',timing_glob(4*ji  )   &
+               &                                                         , ' (SYPD: ', zsypd, ')',   ' on MPI rank : ', ji
+         END DO
+      ENDIF
+      DEALLOCATE(timing_glob)
+#endif      
+
+      IF( lwriter ) CLOSE(numtime) 
+      !
+   END SUBROUTINE timing_finalize
+   
+
+   SUBROUTINE wcurrent_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wcurrent_info ***
+      !! ** Purpose :  compute and write timing output file
+      !!----------------------------------------------------------------------
+      LOGICAL :: ll_ord
+      CHARACTER(len=2048) :: clfmt            
+   
+      ! reorder the current list by elapse time      
+      s_wrk => NULL()
+      s_timer => s_timer_root
+      DO
+         ll_ord = .TRUE.
+         s_timer => s_timer_root
+         DO WHILE ( ASSOCIATED( s_timer%next ) )
+         IF (.NOT. ASSOCIATED(s_timer%next)) EXIT
+            IF ( s_timer%tsum_clock < s_timer%next%tsum_clock ) THEN 
+               ALLOCATE(s_wrk)
+               s_wrk = s_timer%next
+               CALL insert  (s_timer, s_timer_root, s_wrk)
+               CALL suppress(s_timer%next)            
+               ll_ord = .FALSE.
+               CYCLE            
+            ENDIF           
+         IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+         END DO         
+         IF( ll_ord ) EXIT
+      END DO
+            
+      ! write current info
+      WRITE(numtime,*) 'Detailed timing for proc :', narea-1
+      WRITE(numtime,*) '--------------------------'
+      WRITE(numtime,*) 'Section             ',            &
+      &   'Elapsed Time (s)  ','Elapsed Time (%)  ',   &
+      &   'CPU Time(s)  ','CPU Time (%)  ','CPU/Elapsed  ','Frequency' 
+      s_timer => s_timer_root  
+      clfmt = '(1x,a,4x,f12.3,6x,f12.3,x,f12.3,2x,f12.3,6x,f7.3,2x,i9)'
+      DO WHILE ( ASSOCIATED(s_timer) )
+         WRITE(numtime,TRIM(clfmt))   s_timer%cname,   &
+         &   s_timer%tsum_clock,s_timer%tsum_clock*100./t_elaps(2),            &
+         &   s_timer%tsum_cpu  ,s_timer%tsum_cpu*100./t_cpu(2)    ,            &
+         &   s_timer%tsum_cpu/s_timer%tsum_clock, s_timer%niter
+         s_timer => s_timer%next
+      END DO
+      WRITE(numtime,*)
+      !                  
+   END SUBROUTINE wcurrent_info
+
+#if defined key_mpp_mpi     
+   SUBROUTINE waver_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wcurrent_info ***
+      !! ** Purpose :  compute and write averaged timing informations
+      !!----------------------------------------------------------------------
+      TYPE(alltimer), POINTER :: sl_timer_glob_root => NULL()
+      TYPE(alltimer), POINTER :: sl_timer_glob      => NULL()
+      TYPE(timer), POINTER :: sl_timer_ave_root => NULL()
+      TYPE(timer), POINTER :: sl_timer_ave      => NULL()
+      INTEGER :: icode
+      INTEGER :: ierr
+      LOGICAL :: ll_ord           
+      CHARACTER(len=200) :: clfmt              
+                 
+      ! Initialised the global strucutre   
+      ALLOCATE(sl_timer_glob_root, Stat=ierr)
+      IF(ierr /= 0)THEN
+         WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
+         RETURN
+      END IF
+
+      ALLOCATE(sl_timer_glob_root%cname     (jpnij), &
+               sl_timer_glob_root%tsum_cpu  (jpnij), &
+               sl_timer_glob_root%tsum_clock(jpnij), &
+               sl_timer_glob_root%niter     (jpnij), Stat=ierr)
+      IF(ierr /= 0)THEN
+         WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
+         RETURN
+      END IF
+      sl_timer_glob_root%cname(:)       = ''
+      sl_timer_glob_root%tsum_cpu(:)   = 0._wp
+      sl_timer_glob_root%tsum_clock(:) = 0._wp
+      sl_timer_glob_root%niter(:)      = 0
+      sl_timer_glob_root%next => NULL()
+      sl_timer_glob_root%prev => NULL()
+      !ARPDBG - don't need to allocate a pointer that's immediately then
+      !         set to point to some other object.
+      !ALLOCATE(sl_timer_glob)
+      !ALLOCATE(sl_timer_glob%cname     (jpnij))
+      !ALLOCATE(sl_timer_glob%tsum_cpu  (jpnij))
+      !ALLOCATE(sl_timer_glob%tsum_clock(jpnij))
+      !ALLOCATE(sl_timer_glob%niter     (jpnij))
+      sl_timer_glob => sl_timer_glob_root
+      !
+      IF( narea .EQ. 1 ) THEN
+         ALLOCATE(sl_timer_ave_root)
+         sl_timer_ave_root%cname       = ''
+         sl_timer_ave_root%t_cpu      = 0._wp
+         sl_timer_ave_root%t_clock    = 0._wp
+         sl_timer_ave_root%tsum_cpu   = 0._wp
+         sl_timer_ave_root%tsum_clock = 0._wp
+         sl_timer_ave_root%tmax_cpu   = 0._wp
+         sl_timer_ave_root%tmax_clock = 0._wp
+         sl_timer_ave_root%tmin_cpu   = 0._wp
+         sl_timer_ave_root%tmin_clock = 0._wp
+         sl_timer_ave_root%tsub_cpu   = 0._wp
+         sl_timer_ave_root%tsub_clock = 0._wp
+         sl_timer_ave_root%ncount      = 0
+         sl_timer_ave_root%ncount_rate = 0
+         sl_timer_ave_root%ncount_max  = 0
+         sl_timer_ave_root%niter       = 0
+         sl_timer_ave_root%l_tdone  = .FALSE.
+         sl_timer_ave_root%next => NULL()
+         sl_timer_ave_root%prev => NULL()
+         ALLOCATE(sl_timer_ave)
+         sl_timer_ave => sl_timer_ave_root            
+      ENDIF 
+
+      ! Gather info from all processors
+      s_timer => s_timer_root
+      DO WHILE ( ASSOCIATED(s_timer) )
+         CALL MPI_GATHER(s_timer%cname     , 20, MPI_CHARACTER,   &
+                         sl_timer_glob%cname, 20, MPI_CHARACTER,   &
+                         0, MPI_COMM_OCE, icode)
+         CALL MPI_GATHER(s_timer%tsum_clock     , 1, MPI_DOUBLE_PRECISION,   &
+                         sl_timer_glob%tsum_clock, 1, MPI_DOUBLE_PRECISION,   &
+                         0, MPI_COMM_OCE, icode)
+         CALL MPI_GATHER(s_timer%tsum_cpu     , 1, MPI_DOUBLE_PRECISION,   &
+                         sl_timer_glob%tsum_cpu, 1, MPI_DOUBLE_PRECISION,   &
+                         0, MPI_COMM_OCE, icode)
+         CALL MPI_GATHER(s_timer%niter     , 1, MPI_INTEGER,   &
+                         sl_timer_glob%niter, 1, MPI_INTEGER,   &
+                         0, MPI_COMM_OCE, icode)
+
+         IF( narea == 1 .AND. ASSOCIATED(s_timer%next) ) THEN
+            ALLOCATE(sl_timer_glob%next)
+            ALLOCATE(sl_timer_glob%next%cname     (jpnij))
+            ALLOCATE(sl_timer_glob%next%tsum_cpu  (jpnij))
+            ALLOCATE(sl_timer_glob%next%tsum_clock(jpnij))
+            ALLOCATE(sl_timer_glob%next%niter     (jpnij))
+            sl_timer_glob%next%prev => sl_timer_glob
+            sl_timer_glob%next%next => NULL()
+            sl_timer_glob           => sl_timer_glob%next
+         ENDIF              
+         s_timer => s_timer%next
+      END DO      
+      
+      IF( narea == 1 ) THEN    
+         ! Compute some stats
+         sl_timer_glob => sl_timer_glob_root
+         DO WHILE( ASSOCIATED(sl_timer_glob) )
+            sl_timer_ave%cname  = sl_timer_glob%cname(1)
+            sl_timer_ave%tsum_cpu   = SUM   (sl_timer_glob%tsum_cpu  (:)) / jpnij
+            sl_timer_ave%tsum_clock = SUM   (sl_timer_glob%tsum_clock(:)) / jpnij
+            sl_timer_ave%tmax_cpu   = MAXVAL(sl_timer_glob%tsum_cpu  (:))
+            sl_timer_ave%tmax_clock = MAXVAL(sl_timer_glob%tsum_clock(:))
+            sl_timer_ave%tmin_cpu   = MINVAL(sl_timer_glob%tsum_cpu  (:))
+            sl_timer_ave%tmin_clock = MINVAL(sl_timer_glob%tsum_clock(:))
+            sl_timer_ave%niter      = SUM   (sl_timer_glob%niter     (:))
+            !
+            IF( ASSOCIATED(sl_timer_glob%next) ) THEN
+               ALLOCATE(sl_timer_ave%next)          
+               sl_timer_ave%next%prev => sl_timer_ave
+               sl_timer_ave%next%next => NULL()           
+               sl_timer_ave           => sl_timer_ave%next
+            ENDIF
+            sl_timer_glob => sl_timer_glob%next                                
+         END DO
+      
+         ! reorder the averaged list by CPU time      
+         s_wrk => NULL()
+         sl_timer_ave => sl_timer_ave_root
+         DO
+            ll_ord = .TRUE.
+            sl_timer_ave => sl_timer_ave_root
+            DO WHILE( ASSOCIATED( sl_timer_ave%next ) )
+
+               IF( .NOT. ASSOCIATED(sl_timer_ave%next) ) EXIT
+
+               IF ( sl_timer_ave%tsum_clock < sl_timer_ave%next%tsum_clock ) THEN 
+                  ALLOCATE(s_wrk)
+                  ! Copy data into the new object pointed to by s_wrk
+                  s_wrk = sl_timer_ave%next
+                  ! Insert this new timer object before our current position
+                  CALL insert  (sl_timer_ave, sl_timer_ave_root, s_wrk)
+                  ! Remove the old object from the list
+                  CALL suppress(sl_timer_ave%next)            
+                  ll_ord = .FALSE.
+                  CYCLE            
+               ENDIF           
+               IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next
+            END DO         
+            IF( ll_ord ) EXIT
+         END DO
+
+         ! write averaged info
+         WRITE(numtime,"('Averaged timing on all processors :')")
+         WRITE(numtime,"('-----------------------------------')")
+         WRITE(numtime,"('Section',13x,'Elap. Time(s)',2x,'Elap. Time(%)',2x, &
+         &   'CPU Time(s)',2x,'CPU Time(%)',2x,'CPU/Elap',1x,   &
+         &   'Max elap(%)',2x,'Min elap(%)',2x,            &           
+         &   'Freq')")
+         sl_timer_ave => sl_timer_ave_root  
+         clfmt = '((A),E15.7,2x,f6.2,5x,f12.2,5x,f6.2,5x,f7.2,2x,f12.2,4x,f6.2,2x,f9.2)'
+         DO WHILE ( ASSOCIATED(sl_timer_ave) )
+            WRITE(numtime,TRIM(clfmt))   sl_timer_ave%cname(1:18),                            &
+            &   sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime,   &
+            &   sl_timer_ave%tsum_cpu  ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime  ,   &
+            &   sl_timer_ave%tsum_cpu/sl_timer_ave%tsum_clock,                          &
+            &   sl_timer_ave%tmax_clock*100.*jpnij/tot_etime,                           &
+            &   sl_timer_ave%tmin_clock*100.*jpnij/tot_etime,                           &                                               
+            &   sl_timer_ave%niter/REAL(jpnij)
+            sl_timer_ave => sl_timer_ave%next
+         END DO
+         WRITE(numtime,*)
+         !
+         DEALLOCATE(sl_timer_ave_root)
+      ENDIF
+      !
+      DEALLOCATE(sl_timer_glob_root)
+      !                  
+   END SUBROUTINE waver_info
+  
+  
+   SUBROUTINE wmpi_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wmpi_time  ***
+      !! ** Purpose :   compute and write a summary of MPI infos 
+      !!----------------------------------------------------------------------   
+      !   
+      INTEGER                            :: idum, icode
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iall_rank
+      REAL(wp) :: ztot_ratio
+      REAL(wp) :: zmax_etime, zmax_ctime, zmax_ratio, zmin_etime, zmin_ctime, zmin_ratio
+      REAL(wp) :: zavg_etime, zavg_ctime, zavg_ratio
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: zall_ratio
+      CHARACTER(LEN=128), dimension(8) :: cllignes
+      CHARACTER(LEN=128)               :: clhline, clstart_date, clfinal_date
+      CHARACTER(LEN=2048)              :: clfmt    
+   
+      ! Gather all times
+      ALLOCATE( zall_ratio(jpnij), iall_rank(jpnij) )
+      IF( narea == 1 ) THEN
+         iall_rank(:) = (/ (idum,idum=0,jpnij-1) /)
+   
+         ! Compute elapse user time
+         zavg_etime = tot_etime/REAL(jpnij,wp)
+         zmax_etime = MAXVAL(all_etime(:))
+         zmin_etime = MINVAL(all_etime(:))
+
+         ! Compute CPU user time
+         zavg_ctime = tot_ctime/REAL(jpnij,wp)
+         zmax_ctime = MAXVAL(all_ctime(:))
+         zmin_ctime = MINVAL(all_ctime(:))
+   
+         ! Compute cpu/elapsed ratio
+         zall_ratio(:) = all_ctime(:) / all_etime(:)
+         ztot_ratio    = SUM(zall_ratio(:))
+         zavg_ratio    = ztot_ratio/REAL(jpnij,wp)
+         zmax_ratio    = MAXVAL(zall_ratio(:))
+         zmin_ratio    = MINVAL(zall_ratio(:))   
+   
+         ! Output Format
+         clhline    ='1x,13("-"),"|",18("-"),"|",14("-"),"|",18("-"),/,'
+         cllignes(1)='(1x,"MPI summary report :",/,'
+         cllignes(2)='1x,"--------------------",//,'
+         cllignes(3)='1x,"Process Rank |"," Elapsed Time (s) |"," CPU Time (s) |"," Ratio CPU/Elapsed",/,'
+         cllignes(4)='    (1x,i4,9x,"|",f12.3,6x,"|",f12.3,2x,"|",4x,f7.3,/),'
+         WRITE(cllignes(4)(1:4),'(I4)') jpnij
+         cllignes(5)='1x,"Total        |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(6)='1x,"Minimum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(7)='1x,"Maximum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(8)='1x,"Average      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3)'
+         clfmt=TRIM(cllignes(1))// TRIM(cllignes(2))//TRIM(cllignes(3))//          &
+           & TRIM(clhline)//TRIM(cllignes(4))//TRIM(clhline)//TRIM(cllignes(5))//  &
+           & TRIM(clhline)//TRIM(cllignes(6))//TRIM(clhline)//TRIM(cllignes(7))//  &
+           & TRIM(clhline)//TRIM(cllignes(8))
+         WRITE(numtime, TRIM(clfmt)) &
+             (iall_rank(idum),all_etime(idum),all_ctime(idum),zall_ratio(idum),idum=1, jpnij), &
+             tot_etime,     tot_ctime,     ztot_ratio,   &
+             zmin_etime,    zmin_ctime,    zmin_ratio,   &
+             zmax_etime,    zmax_ctime,    zmax_ratio,   &
+             zavg_etime,    zavg_ctime,    zavg_ratio
+         WRITE(numtime,*)    
+      END IF
+      !
+      DEALLOCATE(zall_ratio, iall_rank)
+      !
+   END SUBROUTINE wmpi_info
+#endif   
+
+
+   SUBROUTINE timing_ini_var(cdinfo)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_ini_var  ***
+      !! ** Purpose :   create timing structure 
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      LOGICAL :: ll_section
+       
+      !
+      IF( .NOT. ASSOCIATED(s_timer_root) ) THEN
+         ALLOCATE(s_timer_root)
+         s_timer_root%cname       = cdinfo
+         s_timer_root%t_cpu      = 0._wp
+         s_timer_root%t_clock    = 0._wp
+         s_timer_root%tsum_cpu   = 0._wp
+         s_timer_root%tsum_clock = 0._wp
+         s_timer_root%tmax_cpu   = 0._wp
+         s_timer_root%tmax_clock = 0._wp
+         s_timer_root%tmin_cpu   = 0._wp
+         s_timer_root%tmin_clock = 0._wp
+         s_timer_root%tsub_cpu   = 0._wp
+         s_timer_root%tsub_clock = 0._wp
+         s_timer_root%ncount      = 0
+         s_timer_root%ncount_rate = 0
+         s_timer_root%ncount_max  = 0
+         s_timer_root%niter       = 0
+         s_timer_root%l_tdone  = .FALSE.
+         s_timer_root%next => NULL()
+         s_timer_root%prev => NULL()
+         s_timer => s_timer_root
+         !
+         ALLOCATE(s_wrk)
+         s_wrk => NULL()
+         !
+         ALLOCATE(s_timer_old)
+         s_timer_old%cname       = cdinfo
+         s_timer_old%t_cpu      = 0._wp
+         s_timer_old%t_clock    = 0._wp
+         s_timer_old%tsum_cpu   = 0._wp
+         s_timer_old%tsum_clock = 0._wp
+         s_timer_old%tmax_cpu   = 0._wp
+         s_timer_old%tmax_clock = 0._wp
+         s_timer_old%tmin_cpu   = 0._wp
+         s_timer_old%tmin_clock = 0._wp
+         s_timer_old%tsub_cpu   = 0._wp
+         s_timer_old%tsub_clock = 0._wp
+         s_timer_old%ncount      = 0
+         s_timer_old%ncount_rate = 0
+         s_timer_old%ncount_max  = 0
+         s_timer_old%niter       = 0
+         s_timer_old%l_tdone  = .TRUE.
+         s_timer_old%next => NULL()
+         s_timer_old%prev => NULL()
+
+      ELSE
+         s_timer => s_timer_root
+         ! case of already existing area (typically inside a loop)
+   !         write(*,*) 'in ini_var for routine : ', cdinfo
+         DO WHILE( ASSOCIATED(s_timer) ) 
+            IF( TRIM(s_timer%cname) .EQ. TRIM(cdinfo) ) THEN
+ !             write(*,*) 'in ini_var for routine : ', cdinfo,' we return'           
+               RETURN ! cdinfo is already in the chain
+            ENDIF
+            s_timer => s_timer%next
+         END DO
+
+         ! end of the chain
+         s_timer => s_timer_root
+         DO WHILE( ASSOCIATED(s_timer%next) )
+            s_timer => s_timer%next
+         END DO
+
+    !     write(*,*) 'after search', s_timer%cname
+         ! cdinfo is not part of the chain so we add it with initialisation          
+          ALLOCATE(s_timer%next)
+    !     write(*,*) 'after allocation of next'
+  
+         s_timer%next%cname       = cdinfo
+         s_timer%next%t_cpu      = 0._wp
+         s_timer%next%t_clock    = 0._wp
+         s_timer%next%tsum_cpu   = 0._wp
+         s_timer%next%tsum_clock = 0._wp  
+         s_timer%next%tmax_cpu   = 0._wp
+         s_timer%next%tmax_clock = 0._wp
+         s_timer%next%tmin_cpu   = 0._wp
+         s_timer%next%tmin_clock = 0._wp
+         s_timer%next%tsub_cpu   = 0._wp
+         s_timer%next%tsub_clock = 0._wp
+         s_timer%next%ncount      = 0
+         s_timer%next%ncount_rate = 0
+         s_timer%next%ncount_max  = 0
+         s_timer%next%niter       = 0
+         s_timer%next%l_tdone  = .FALSE.
+         s_timer%next%parent_section => NULL()
+         s_timer%next%prev => s_timer
+         s_timer%next%next => NULL()
+         s_timer => s_timer%next
+      ENDIF 
+      !    write(*,*) 'after allocation'
+     !
+   END SUBROUTINE timing_ini_var
+
+
+   SUBROUTINE timing_reset
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_reset  ***
+      !! ** Purpose :   go to root of timing tree 
+      !!----------------------------------------------------------------------
+      l_initdone = .TRUE. 
+!      IF(lwp) WRITE(numout,*)
+!      IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing'
+!      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      CALL timing_list(s_timer_root)
+!      WRITE(numout,*)
+      !
+   END SUBROUTINE timing_reset
+
+
+   RECURSIVE SUBROUTINE timing_list(ptr)
+   
+      TYPE(timer), POINTER, INTENT(inout) :: ptr
+      !
+      IF( ASSOCIATED(ptr%next) ) CALL timing_list(ptr%next)
+      IF(lwp) WRITE(numout,*)'   ', ptr%cname   
+      !
+   END SUBROUTINE timing_list
+
+
+   SUBROUTINE insert(sd_current, sd_root ,sd_ptr)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE insert  ***
+      !! ** Purpose :   insert an element in timer structure
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER, INTENT(inout) :: sd_current, sd_root, sd_ptr
+      !
+     
+      IF( ASSOCIATED( sd_current, sd_root ) ) THEN
+         ! If our current element is the root element then
+         ! replace it with the one being inserted
+         sd_root => sd_ptr
+      ELSE
+         sd_current%prev%next => sd_ptr
+      END IF
+      sd_ptr%next     => sd_current
+      sd_ptr%prev     => sd_current%prev
+      sd_current%prev => sd_ptr
+      ! Nullify the pointer to the new element now that it is held
+      ! within the list. If we don't do this then a subsequent call
+      ! to ALLOCATE memory to this pointer will fail.
+      sd_ptr => NULL()
+      !    
+   END SUBROUTINE insert
+  
+  
+   SUBROUTINE suppress(sd_ptr)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE suppress  ***
+      !! ** Purpose :   supress an element in timer structure
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER, INTENT(inout) :: sd_ptr
+      !
+      TYPE(timer), POINTER :: sl_temp
+    
+      sl_temp => sd_ptr
+      sd_ptr => sd_ptr%next    
+      IF ( ASSOCIATED(sl_temp%next) ) sl_temp%next%prev => sl_temp%prev
+      DEALLOCATE(sl_temp)
+      sl_temp => NULL()
+      !
+    END SUBROUTINE suppress
+
+   !!=====================================================================
+END MODULE timing
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/timing.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/timing.f90	(revision 12100)
+++ 	(revision )
@@ -1,766 +1,0 @@
-MODULE timing
-   !!========================================================================
-   !!                     ***  MODULE  timing  ***
-   !!========================================================================
-   !! History : 4.0  ! 2001-05  (R. Benshila)   
-   !!------------------------------------------------------------------------
-
-   !!------------------------------------------------------------------------
-   !!   timming_init    : initialize timing process 
-   !!   timing_start    : start Timer
-   !!   timing_stop     : stop  Timer
-   !!   timing_reset    : end timing variable creation
-   !!   timing_finalize : compute stats and write output in calling w*_info 
-   !!   timing_ini_var  : create timing variables 
-   !!   timing_listing  : print instumented subroutines in ocean.output
-   !!   wcurrent_info   : compute and print detailed stats on the current CPU
-   !!   wave_info       : compute and print averaged statson all processors
-   !!   wmpi_info       : compute and write global stats  
-   !!   supress         : suppress an element of the timing linked list  
-   !!   insert          : insert an element of the timing linked list  
-   !!------------------------------------------------------------------------
-   USE in_out_manager  ! I/O manager 
-   USE dom_oce         ! ocean domain
-   USE lib_mpp          
-   
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   timing_init, timing_finalize   ! called in nemogcm module 
-   PUBLIC   timing_reset                   ! called in step module 
-   PUBLIC   timing_start, timing_stop      ! called in each routine to time 
-   
-
-   INCLUDE 'mpif.h'
-
-
-   ! Variables for fine grain timing
-   TYPE timer
-      CHARACTER(LEN=20)  :: cname
-   	  REAL(wp)  :: t_cpu, t_clock, tsum_cpu, tsum_clock, tmax_cpu, tmax_clock, tmin_cpu, tmin_clock, tsub_cpu, tsub_clock
-      INTEGER :: ncount, ncount_max, ncount_rate  
-      INTEGER :: niter
-      LOGICAL :: l_tdone
-      TYPE(timer), POINTER :: next => NULL()
-      TYPE(timer), POINTER :: prev => NULL()
-      TYPE(timer), POINTER :: parent_section => NULL()
-   END TYPE timer
-    
-   TYPE alltimer
-      CHARACTER(LEN=20), DIMENSION(:), POINTER :: cname => NULL()
-   	  REAL(wp), DIMENSION(:), POINTER :: tsum_cpu   => NULL()
-   	  REAL(wp), DIMENSION(:), POINTER :: tsum_clock => NULL()
-   	  INTEGER, DIMENSION(:), POINTER :: niter => NULL()
-      TYPE(alltimer), POINTER :: next => NULL()
-      TYPE(alltimer), POINTER :: prev => NULL()
-   END TYPE alltimer 
- 
-   TYPE(timer), POINTER :: s_timer_root => NULL()
-   TYPE(timer), POINTER :: s_timer      => NULL()
-   TYPE(timer), POINTER :: s_wrk        => NULL()
-   REAL(wp) :: t_overclock, t_overcpu
-   LOGICAL :: l_initdone = .FALSE.
-   INTEGER :: nsize
-   
-   ! Variables for coarse grain timing
-   REAL(wp) :: tot_etime, tot_ctime
-   REAL(kind=wp), DIMENSION(2)     :: t_elaps, t_cpu
-   REAL(wp), ALLOCATABLE, DIMENSION(:) :: all_etime, all_ctime
-   INTEGER :: nfinal_count, ncount, ncount_rate, ncount_max
-   INTEGER, DIMENSION(8)           :: nvalues
-   CHARACTER(LEN=8), DIMENSION(2)  :: cdate
-   CHARACTER(LEN=10), DIMENSION(2) :: ctime
-   CHARACTER(LEN=5)                :: czone
-    
-   ! From of ouput file (1/proc or one global)   !RB to put in nammpp or namctl
-   LOGICAL :: ln_onefile = .TRUE. 
-   LOGICAL :: lwriter
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id: timing.F90 5120 2015-03-03 16:11:55Z acc $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE timing_start(cdinfo)
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE timing_start  ***
-      !! ** Purpose :   collect execution time
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*), INTENT(in) :: cdinfo
-      !
-       
-      ! Create timing structure at first call
-      IF( .NOT. l_initdone ) THEN
-         CALL timing_ini_var(cdinfo)
-      ELSE
-         s_timer => s_timer_root
-         DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) ) 
-            IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
-         END DO
-      ENDIF         
-      s_timer%l_tdone = .FALSE.
-      s_timer%niter = s_timer%niter + 1
-      s_timer%t_cpu = 0.
-      s_timer%t_clock = 0.
-                  
-      ! CPU time collection
-      CALL CPU_TIME( s_timer%t_cpu  )
-      ! clock time collection
-
-      s_timer%t_clock= MPI_Wtime()
-
-
-
-
-      !
-   END SUBROUTINE timing_start
-
-
-   SUBROUTINE timing_stop(cdinfo, csection)
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE timing_stop  ***
-      !! ** Purpose :   finalize timing and output
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*), INTENT(in) :: cdinfo
-      CHARACTER(len=*), INTENT(in), OPTIONAL :: csection
-      !
-      INTEGER  :: ifinal_count, iperiods    
-      REAL(wp) :: zcpu_end, zmpitime
-      !
-      s_wrk => NULL()
-
-      ! clock time collection
-
-      zmpitime = MPI_Wtime()
-
-
-
-      ! CPU time collection
-      CALL CPU_TIME( zcpu_end )
-
-      s_timer => s_timer_root
-      DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) ) 
-         IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
-      END DO
- 
-      ! CPU time correction
-      s_timer%t_cpu  = zcpu_end - s_timer%t_cpu - t_overcpu - s_timer%tsub_cpu
-  
-      ! clock time correction
-
-      s_timer%t_clock = zmpitime - s_timer%t_clock - t_overclock - s_timer%tsub_clock
-
-
-
-
-
-
-      
-      ! Correction of parent section
-      IF( .NOT. PRESENT(csection) ) THEN
-         s_wrk => s_timer
-         DO WHILE ( ASSOCIATED(s_wrk%parent_section ) )
-            s_wrk => s_wrk%parent_section
-            s_wrk%tsub_cpu   = s_wrk%tsub_cpu   + s_timer%t_cpu 
-            s_wrk%tsub_clock = s_wrk%tsub_clock + s_timer%t_clock              
-         END DO
-      ENDIF
-            
-      ! time diagnostics 
-      s_timer%tsum_clock = s_timer%tsum_clock + s_timer%t_clock 
-      s_timer%tsum_cpu   = s_timer%tsum_cpu   + s_timer%t_cpu
-!RB to use to get min/max during a time integration
-!      IF( .NOT. l_initdone ) THEN
-!         s_timer%tmin_clock = s_timer%t_clock 
-!         s_timer%tmin_cpu   = s_timer%t_cpu 
-!      ELSE
-!         s_timer%tmin_clock = MIN( s_timer%tmin_clock, s_timer%t_clock ) 
-!         s_timer%tmin_cpu   = MIN( s_timer%tmin_cpu  , s_timer%t_cpu   ) 
-!      ENDIF   
-!      s_timer%tmax_clock = MAX( s_timer%tmax_clock, s_timer%t_clock ) 
-!      s_timer%tmax_cpu   = MAX( s_timer%tmax_cpu  , s_timer%t_cpu   )  
-      !
-      s_timer%tsub_clock = 0.
-      s_timer%tsub_cpu = 0.
-      s_timer%l_tdone = .TRUE.
-      !
-   END SUBROUTINE timing_stop
- 
- 
-   SUBROUTINE timing_init
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE timing_init  ***
-      !! ** Purpose :   open timing output file
-      !!----------------------------------------------------------------------
-      INTEGER :: iperiods, istart_count, ifinal_count
-      REAL(wp) :: zdum
-      LOGICAL :: ll_f
-             
-      IF( ln_onefile ) THEN
-         IF( lwp) CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.TRUE., narea )
-         lwriter = lwp
-      ELSE
-         CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.FALSE., narea )
-         lwriter = .TRUE.
-      ENDIF
-      
-      IF( lwriter) THEN      
-         WRITE(numtime,*)
-         WRITE(numtime,*) '      CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC - INGV'
-         WRITE(numtime,*) '                             NEMO team'
-         WRITE(numtime,*) '                  Ocean General Circulation Model'
-         WRITE(numtime,*) '                        version 3.6  (2015) '
-         WRITE(numtime,*)
-         WRITE(numtime,*) '                        Timing Informations '
-         WRITE(numtime,*)
-         WRITE(numtime,*)
-      ENDIF   
-      
-      ! Compute clock function overhead
-
-      t_overclock = MPI_WTIME()
-      t_overclock = MPI_WTIME() - t_overclock
-
-      ! Compute cpu_time function overhead
-      CALL CPU_TIME(zdum)
-      CALL CPU_TIME(t_overcpu)
-      
-      ! End overhead omputation  
-      t_overcpu = t_overcpu - zdum        
-      t_overclock = t_overcpu + t_overclock        
-
-      ! Timing on date and time
-      CALL DATE_AND_TIME(cdate(1),ctime(1),czone,nvalues)
-    
-      CALL CPU_TIME(t_cpu(1))      
-      ! Start elapsed and CPU time counters
-      t_elaps(1) = MPI_WTIME()
-      !
-   END SUBROUTINE timing_init
-
-
-   SUBROUTINE timing_finalize
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE timing_finalize ***
-      !! ** Purpose :  compute average time 
-      !!               write timing output file
-      !!----------------------------------------------------------------------
-      TYPE(timer), POINTER :: s_temp
-      INTEGER :: idum, iperiods, icode
-      LOGICAL :: ll_ord, ll_averep
-      CHARACTER(len=120) :: clfmt            
-      
-      ll_averep = .TRUE.
-    
-      ! total CPU and elapse
-      CALL CPU_TIME(t_cpu(2))
-      t_cpu(2)   = t_cpu(2)    - t_cpu(1)   - t_overcpu
-      t_elaps(2) = MPI_WTIME() - t_elaps(1) - t_overclock
-
-      ! End of timings on date & time
-      CALL DATE_AND_TIME(cdate(2),ctime(2),czone,nvalues)
-       
-      ! Compute the numer of routines
-      nsize = 0 
-      s_timer => s_timer_root
-      DO WHILE( ASSOCIATED(s_timer) )
-         nsize = nsize + 1
-         s_timer => s_timer%next
-      END DO
-      idum = nsize
-      IF(lk_mpp) CALL mpp_sum(idum)
-      IF( idum/jpnij /= nsize ) THEN
-         IF( lwriter ) WRITE(numtime,*) '        ===> W A R N I N G: '
-         IF( lwriter ) WRITE(numtime,*) ' Some CPU have different number of routines instrumented for timing'
-         IF( lwriter ) WRITE(numtime,*) ' No detailed report on averaged timing can be provided'
-         IF( lwriter ) WRITE(numtime,*) ' The following detailed report only deals with the current processor'
-         IF( lwriter ) WRITE(numtime,*)
-         ll_averep = .FALSE.
-      ENDIF   
-
-      ! in MPI gather some info
-      ALLOCATE( all_etime(jpnij), all_ctime(jpnij) )
-      CALL MPI_ALLGATHER(t_elaps(2), 1, MPI_DOUBLE_PRECISION,   &
-                         all_etime , 1, MPI_DOUBLE_PRECISION,   &
-                         MPI_COMM_OPA, icode)
-      CALL MPI_ALLGATHER(t_cpu(2) , 1, MPI_DOUBLE_PRECISION,   &
-                         all_ctime, 1, MPI_DOUBLE_PRECISION,   &
-                         MPI_COMM_OPA, icode)
-      tot_etime = SUM(all_etime(:))
-      tot_ctime = SUM(all_ctime(:))
-
-      ! write output file
-      IF( lwriter ) WRITE(numtime,*) 'Total timing (sum) :'
-      IF( lwriter ) WRITE(numtime,*) '--------------------'
-      IF( lwriter ) WRITE(numtime,"('Elapsed Time (s)  CPU Time (s)')")
-      IF( lwriter ) WRITE(numtime,'(5x,f12.3,1x,f12.3)')  tot_etime, tot_ctime
-      IF( lwriter ) WRITE(numtime,*) 
-      IF( ll_averep ) CALL waver_info
-      CALL wmpi_info
-      IF( lwriter ) CALL wcurrent_info
-      
-      clfmt='(1X,"Timing started on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
-      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &           
-      &       cdate(1)(7:8), cdate(1)(5:6), cdate(1)(1:4),   &
-      &       ctime(1)(1:2), ctime(1)(3:4), ctime(1)(5:6),   &
-      &       czone(1:3),    czone(4:5)                     
-      clfmt='(1X,  "Timing   ended on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
-      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &           
-      &       cdate(2)(7:8), cdate(2)(5:6), cdate(2)(1:4),   &
-      &       ctime(2)(1:2), ctime(2)(3:4), ctime(2)(5:6),   &
-      &       czone(1:3),    czone(4:5)
-
-      IF( lwriter ) CLOSE(numtime) 
-      !
-   END SUBROUTINE timing_finalize
-   
-
-   SUBROUTINE wcurrent_info
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE wcurrent_info ***
-      !! ** Purpose :  compute and write timing output file
-      !!----------------------------------------------------------------------
-      LOGICAL :: ll_ord
-      CHARACTER(len=2048) :: clfmt            
-   
-      ! reorder the current list by elapse time      
-      s_wrk => NULL()
-      s_timer => s_timer_root
-      DO
-         ll_ord = .TRUE.
-         s_timer => s_timer_root
-         DO WHILE ( ASSOCIATED( s_timer%next ) )
-         IF (.NOT. ASSOCIATED(s_timer%next)) EXIT
-            IF ( s_timer%tsum_clock < s_timer%next%tsum_clock ) THEN 
-               ALLOCATE(s_wrk)
-               s_wrk = s_timer%next
-               CALL insert  (s_timer, s_timer_root, s_wrk)
-               CALL suppress(s_timer%next)            
-               ll_ord = .FALSE.
-               CYCLE            
-            ENDIF           
-         IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
-         END DO         
-         IF( ll_ord ) EXIT
-      END DO
-            
-      ! write current info
-      WRITE(numtime,*) 'Detailed timing for proc :', narea-1
-      WRITE(numtime,*) '--------------------------'
-      WRITE(numtime,*) 'Section             ',            &
-      &   'Elapsed Time (s)  ','Elapsed Time (%)  ',   &
-      &   'CPU Time(s)  ','CPU Time (%)  ','CPU/Elapsed  ','Frequency' 
-      s_timer => s_timer_root  
-      clfmt = '(1x,a,4x,f12.3,6x,f12.3,x,f12.3,2x,f12.3,6x,f7.3,2x,i9)'
-      DO WHILE ( ASSOCIATED(s_timer) )
-         WRITE(numtime,TRIM(clfmt))   s_timer%cname,   &
-         &   s_timer%tsum_clock,s_timer%tsum_clock*100./t_elaps(2),            &
-         &   s_timer%tsum_cpu  ,s_timer%tsum_cpu*100./t_cpu(2)    ,            &
-         &   s_timer%tsum_cpu/s_timer%tsum_clock, s_timer%niter
-         s_timer => s_timer%next
-      END DO
-      WRITE(numtime,*)
-      !                  
-   END SUBROUTINE wcurrent_info
-
-   SUBROUTINE waver_info
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE wcurrent_info ***
-      !! ** Purpose :  compute and write averaged timing informations
-      !!----------------------------------------------------------------------
-      TYPE(alltimer), POINTER :: sl_timer_glob_root => NULL()
-      TYPE(alltimer), POINTER :: sl_timer_glob      => NULL()
-      TYPE(timer), POINTER :: sl_timer_ave_root => NULL()
-      TYPE(timer), POINTER :: sl_timer_ave      => NULL()
-      INTEGER :: icode
-      INTEGER :: ierr
-      LOGICAL :: ll_ord           
-      CHARACTER(len=200) :: clfmt              
-                 
-      ! Initialised the global strucutre   
-      ALLOCATE(sl_timer_glob_root, Stat=ierr)
-      IF(ierr /= 0)THEN
-         WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
-         RETURN
-      END IF
-
-      ALLOCATE(sl_timer_glob_root%cname     (jpnij), &
-               sl_timer_glob_root%tsum_cpu  (jpnij), &
-               sl_timer_glob_root%tsum_clock(jpnij), &
-               sl_timer_glob_root%niter     (jpnij), Stat=ierr)
-      IF(ierr /= 0)THEN
-         WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
-         RETURN
-      END IF
-      sl_timer_glob_root%cname(:)       = ''
-      sl_timer_glob_root%tsum_cpu(:)   = 0._wp
-      sl_timer_glob_root%tsum_clock(:) = 0._wp
-      sl_timer_glob_root%niter(:)      = 0
-      sl_timer_glob_root%next => NULL()
-      sl_timer_glob_root%prev => NULL()
-      !ARPDBG - don't need to allocate a pointer that's immediately then
-      !         set to point to some other object.
-      !ALLOCATE(sl_timer_glob)
-      !ALLOCATE(sl_timer_glob%cname     (jpnij))
-      !ALLOCATE(sl_timer_glob%tsum_cpu  (jpnij))
-      !ALLOCATE(sl_timer_glob%tsum_clock(jpnij))
-      !ALLOCATE(sl_timer_glob%niter     (jpnij))
-      sl_timer_glob => sl_timer_glob_root
-      !
-      IF( narea .EQ. 1 ) THEN
-         ALLOCATE(sl_timer_ave_root)
-         sl_timer_ave_root%cname       = ''
-         sl_timer_ave_root%t_cpu      = 0._wp
-         sl_timer_ave_root%t_clock    = 0._wp
-         sl_timer_ave_root%tsum_cpu   = 0._wp
-         sl_timer_ave_root%tsum_clock = 0._wp
-         sl_timer_ave_root%tmax_cpu   = 0._wp
-         sl_timer_ave_root%tmax_clock = 0._wp
-         sl_timer_ave_root%tmin_cpu   = 0._wp
-         sl_timer_ave_root%tmin_clock = 0._wp
-         sl_timer_ave_root%tsub_cpu   = 0._wp
-         sl_timer_ave_root%tsub_clock = 0._wp
-         sl_timer_ave_root%ncount      = 0
-         sl_timer_ave_root%ncount_rate = 0
-         sl_timer_ave_root%ncount_max  = 0
-         sl_timer_ave_root%niter       = 0
-         sl_timer_ave_root%l_tdone  = .FALSE.
-         sl_timer_ave_root%next => NULL()
-         sl_timer_ave_root%prev => NULL()
-         ALLOCATE(sl_timer_ave)
-         sl_timer_ave => sl_timer_ave_root            
-      ENDIF 
-
-      ! Gather info from all processors
-      s_timer => s_timer_root
-      DO WHILE ( ASSOCIATED(s_timer) )
-         CALL MPI_GATHER(s_timer%cname     , 20, MPI_CHARACTER,   &
-                         sl_timer_glob%cname, 20, MPI_CHARACTER,   &
-                         0, MPI_COMM_OPA, icode)
-         CALL MPI_GATHER(s_timer%tsum_clock     , 1, MPI_DOUBLE_PRECISION,   &
-                         sl_timer_glob%tsum_clock, 1, MPI_DOUBLE_PRECISION,   &
-                         0, MPI_COMM_OPA, icode)
-         CALL MPI_GATHER(s_timer%tsum_cpu     , 1, MPI_DOUBLE_PRECISION,   &
-                         sl_timer_glob%tsum_cpu, 1, MPI_DOUBLE_PRECISION,   &
-                         0, MPI_COMM_OPA, icode)
-         CALL MPI_GATHER(s_timer%niter     , 1, MPI_INTEGER,   &
-                         sl_timer_glob%niter, 1, MPI_INTEGER,   &
-                         0, MPI_COMM_OPA, icode)
-
-         IF( narea == 1 .AND. ASSOCIATED(s_timer%next) ) THEN
-            ALLOCATE(sl_timer_glob%next)
-            ALLOCATE(sl_timer_glob%next%cname     (jpnij))
-            ALLOCATE(sl_timer_glob%next%tsum_cpu  (jpnij))
-            ALLOCATE(sl_timer_glob%next%tsum_clock(jpnij))
-            ALLOCATE(sl_timer_glob%next%niter     (jpnij))
-            sl_timer_glob%next%prev => sl_timer_glob
-            sl_timer_glob%next%next => NULL()
-            sl_timer_glob           => sl_timer_glob%next
-         ENDIF              
-         s_timer => s_timer%next
-      END DO      
-
-         WRITE(*,*) 'ARPDBG: timing: done gathers'
-      
-      IF( narea == 1 ) THEN    
-         ! Compute some stats
-         sl_timer_glob => sl_timer_glob_root
-         DO WHILE( ASSOCIATED(sl_timer_glob) )
-            sl_timer_ave%cname  = sl_timer_glob%cname(1)
-            sl_timer_ave%tsum_cpu   = SUM   (sl_timer_glob%tsum_cpu  (:)) / jpnij
-            sl_timer_ave%tsum_clock = SUM   (sl_timer_glob%tsum_clock(:)) / jpnij
-            sl_timer_ave%tmax_cpu   = MAXVAL(sl_timer_glob%tsum_cpu  (:))
-            sl_timer_ave%tmax_clock = MAXVAL(sl_timer_glob%tsum_clock(:))
-            sl_timer_ave%tmin_cpu   = MINVAL(sl_timer_glob%tsum_cpu  (:))
-            sl_timer_ave%tmin_clock = MINVAL(sl_timer_glob%tsum_clock(:))
-            sl_timer_ave%niter      = SUM   (sl_timer_glob%niter     (:))
-            !
-            IF( ASSOCIATED(sl_timer_glob%next) ) THEN
-               ALLOCATE(sl_timer_ave%next)          
-               sl_timer_ave%next%prev => sl_timer_ave
-               sl_timer_ave%next%next => NULL()           
-               sl_timer_ave           => sl_timer_ave%next
-            ENDIF
-            sl_timer_glob => sl_timer_glob%next                                
-         END DO
-
-         WRITE(*,*) 'ARPDBG: timing: done computing stats'
-      
-         ! reorder the averaged list by CPU time      
-         s_wrk => NULL()
-         sl_timer_ave => sl_timer_ave_root
-         DO
-            ll_ord = .TRUE.
-            sl_timer_ave => sl_timer_ave_root
-            DO WHILE( ASSOCIATED( sl_timer_ave%next ) )
-
-               IF( .NOT. ASSOCIATED(sl_timer_ave%next) ) EXIT
-
-               IF ( sl_timer_ave%tsum_clock < sl_timer_ave%next%tsum_clock ) THEN 
-                  ALLOCATE(s_wrk)
-                  ! Copy data into the new object pointed to by s_wrk
-                  s_wrk = sl_timer_ave%next
-                  ! Insert this new timer object before our current position
-                  CALL insert  (sl_timer_ave, sl_timer_ave_root, s_wrk)
-                  ! Remove the old object from the list
-                  CALL suppress(sl_timer_ave%next)            
-                  ll_ord = .FALSE.
-                  CYCLE            
-               ENDIF           
-               IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next
-            END DO         
-            IF( ll_ord ) EXIT
-         END DO
-
-         ! write averaged info
-         WRITE(numtime,"('Averaged timing on all processors :')")
-         WRITE(numtime,"('-----------------------------------')")
-         WRITE(numtime,"('Section',13x,'Elap. Time(s)',2x,'Elap. Time(%)',2x, &
-         &   'CPU Time(s)',2x,'CPU Time(%)',2x,'CPU/Elap',1x,   &
-         &   'Max elap(%)',2x,'Min elap(%)',2x,            &           
-         &   'Freq')")
-         sl_timer_ave => sl_timer_ave_root  
-         clfmt = '((A),E15.7,2x,f6.2,5x,f12.2,5x,f6.2,5x,f7.2,2x,f12.2,4x,f6.2,2x,f9.2)'
-         DO WHILE ( ASSOCIATED(sl_timer_ave) )
-            WRITE(numtime,TRIM(clfmt))   sl_timer_ave%cname(1:18),                            &
-            &   sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime,   &
-            &   sl_timer_ave%tsum_cpu  ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime  ,   &
-            &   sl_timer_ave%tsum_cpu/sl_timer_ave%tsum_clock,                          &
-            &   sl_timer_ave%tmax_clock*100.*jpnij/tot_etime,                           &
-            &   sl_timer_ave%tmin_clock*100.*jpnij/tot_etime,                           &                                               
-            &   sl_timer_ave%niter/REAL(jpnij)
-            sl_timer_ave => sl_timer_ave%next
-         END DO
-         WRITE(numtime,*)
-         !
-         DEALLOCATE(sl_timer_ave_root)
-      ENDIF
-      !
-      DEALLOCATE(sl_timer_glob_root)
-      !                  
-   END SUBROUTINE waver_info
-  
-  
-   SUBROUTINE wmpi_info
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE wmpi_time  ***
-      !! ** Purpose :   compute and write a summary of MPI infos 
-      !!----------------------------------------------------------------------   
-      !   
-      INTEGER                            :: idum, icode
-      INTEGER, ALLOCATABLE, DIMENSION(:) :: iall_rank
-      REAL(wp) :: ztot_ratio
-      REAL(wp) :: zmax_etime, zmax_ctime, zmax_ratio, zmin_etime, zmin_ctime, zmin_ratio
-      REAL(wp) :: zavg_etime, zavg_ctime, zavg_ratio
-      REAL(wp), ALLOCATABLE, DIMENSION(:) :: zall_ratio
-      CHARACTER(LEN=128), dimension(8) :: cllignes
-      CHARACTER(LEN=128)               :: clhline, clstart_date, clfinal_date
-      CHARACTER(LEN=2048)              :: clfmt    
-   
-      ! Gather all times
-      ALLOCATE( zall_ratio(jpnij), iall_rank(jpnij) )
-      IF( narea == 1 ) THEN
-         iall_rank(:) = (/ (idum,idum=0,jpnij-1) /)
-   
-         ! Compute elapse user time
-         zavg_etime = tot_etime/REAL(jpnij,wp)
-         zmax_etime = MAXVAL(all_etime(:))
-         zmin_etime = MINVAL(all_etime(:))
-
-         ! Compute CPU user time
-         zavg_ctime = tot_ctime/REAL(jpnij,wp)
-         zmax_ctime = MAXVAL(all_ctime(:))
-         zmin_ctime = MINVAL(all_ctime(:))
-   
-         ! Compute cpu/elapsed ratio
-         zall_ratio(:) = all_ctime(:) / all_etime(:)
-         ztot_ratio    = SUM(zall_ratio(:))
-         zavg_ratio    = ztot_ratio/REAL(jpnij,wp)
-         zmax_ratio    = MAXVAL(zall_ratio(:))
-         zmin_ratio    = MINVAL(zall_ratio(:))   
-   
-         ! Output Format
-         clhline    ='1x,13("-"),"|",18("-"),"|",14("-"),"|",18("-"),/,'
-         cllignes(1)='(1x,"MPI summary report :",/,'
-         cllignes(2)='1x,"--------------------",//,'
-         cllignes(3)='1x,"Process Rank |"," Elapsed Time (s) |"," CPU Time (s) |"," Ratio CPU/Elapsed",/,'
-         cllignes(4)='    (1x,i4,9x,"|",f12.3,6x,"|",f12.3,2x,"|",4x,f7.3,/),'
-         WRITE(cllignes(4)(1:4),'(I4)') jpnij
-         cllignes(5)='1x,"Total        |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
-         cllignes(6)='1x,"Minimum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
-         cllignes(7)='1x,"Maximum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
-         cllignes(8)='1x,"Average      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3)'
-         clfmt=TRIM(cllignes(1))// TRIM(cllignes(2))//TRIM(cllignes(3))//          &
-           & TRIM(clhline)//TRIM(cllignes(4))//TRIM(clhline)//TRIM(cllignes(5))//  &
-           & TRIM(clhline)//TRIM(cllignes(6))//TRIM(clhline)//TRIM(cllignes(7))//  &
-           & TRIM(clhline)//TRIM(cllignes(8))
-         WRITE(numtime, TRIM(clfmt)) &
-             (iall_rank(idum),all_etime(idum),all_ctime(idum),zall_ratio(idum),idum=1, jpnij), &
-             tot_etime,     tot_ctime,     ztot_ratio,   &
-             zmin_etime,    zmin_ctime,    zmin_ratio,   &
-             zmax_etime,    zmax_ctime,    zmax_ratio,   &
-             zavg_etime,    zavg_ctime,    zavg_ratio
-         WRITE(numtime,*)    
-      END IF
-      !
-      DEALLOCATE(zall_ratio, iall_rank)
-      !
-   END SUBROUTINE wmpi_info
-
-
-   SUBROUTINE timing_ini_var(cdinfo)
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE timing_ini_var  ***
-      !! ** Purpose :   create timing structure 
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*), INTENT(in) :: cdinfo
-      LOGICAL :: ll_section
-       
-      !
-      IF( .NOT. ASSOCIATED(s_timer_root) ) THEN
-         ALLOCATE(s_timer_root)
-         s_timer_root%cname       = cdinfo
-         s_timer_root%t_cpu      = 0._wp
-         s_timer_root%t_clock    = 0._wp
-         s_timer_root%tsum_cpu   = 0._wp
-         s_timer_root%tsum_clock = 0._wp
-         s_timer_root%tmax_cpu   = 0._wp
-         s_timer_root%tmax_clock = 0._wp
-         s_timer_root%tmin_cpu   = 0._wp
-         s_timer_root%tmin_clock = 0._wp
-         s_timer_root%tsub_cpu   = 0._wp
-         s_timer_root%tsub_clock = 0._wp
-         s_timer_root%ncount      = 0
-         s_timer_root%ncount_rate = 0
-         s_timer_root%ncount_max  = 0
-         s_timer_root%niter       = 0
-         s_timer_root%l_tdone  = .FALSE.
-         s_timer_root%next => NULL()
-         s_timer_root%prev => NULL()
-         s_timer => s_timer_root
-         !
-         ALLOCATE(s_wrk)
-         s_wrk => NULL()
-         
-      ELSE
-         s_timer => s_timer_root
-         ! case of already existing area (typically inside a loop)
-         DO WHILE( ASSOCIATED(s_timer) ) 
-            IF( TRIM(s_timer%cname) .EQ. TRIM(cdinfo) ) RETURN
-            s_timer => s_timer%next
-         END DO
-         
-         ! end of the chain
-         s_timer => s_timer_root
-         DO WHILE( ASSOCIATED(s_timer%next) )
-            s_timer => s_timer%next
-         END DO
-          
-         ALLOCATE(s_timer%next)      
-         s_timer%next%cname       = cdinfo
-         s_timer%next%t_cpu      = 0._wp
-         s_timer%next%t_clock    = 0._wp
-         s_timer%next%tsum_cpu   = 0._wp
-         s_timer%next%tsum_clock = 0._wp  
-         s_timer%next%tmax_cpu   = 0._wp
-         s_timer%next%tmax_clock = 0._wp
-         s_timer%next%tmin_cpu   = 0._wp
-         s_timer%next%tmin_clock = 0._wp
-         s_timer%next%tsub_cpu   = 0._wp
-         s_timer%next%tsub_clock = 0._wp
-         s_timer%next%ncount      = 0
-         s_timer%next%ncount_rate = 0
-         s_timer%next%ncount_max  = 0
-         s_timer%next%niter       = 0
-         s_timer%next%l_tdone  = .FALSE.
-         s_timer%next%parent_section => NULL()
-         s_timer%next%prev => s_timer
-         s_timer%next%next => NULL()
-         s_timer => s_timer%next
-
-         ! are we inside a section
-         s_wrk => s_timer%prev
-         ll_section = .FALSE.
-         DO WHILE( ASSOCIATED(s_wrk) .AND. .NOT. ll_section )
-            IF( .NOT. s_wrk%l_tdone ) THEN
-               ll_section = .TRUE.
-               s_timer%parent_section => s_wrk 
-            ENDIF
-            s_wrk => s_wrk%prev
-         END DO 
-      ENDIF         
-      !
-   END SUBROUTINE timing_ini_var
-
-
-   SUBROUTINE timing_reset
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE timing_reset  ***
-      !! ** Purpose :   go to root of timing tree 
-      !!----------------------------------------------------------------------
-      l_initdone = .TRUE. 
-!      IF(lwp) WRITE(numout,*)
-!      IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing'
-!      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-!      CALL timing_list(s_timer_root)
-!      WRITE(numout,*)
-      !
-   END SUBROUTINE timing_reset
-
-
-   RECURSIVE SUBROUTINE timing_list(ptr)
-   
-      TYPE(timer), POINTER, INTENT(inout) :: ptr
-      !
-      IF( ASSOCIATED(ptr%next) ) CALL timing_list(ptr%next)
-      IF(lwp) WRITE(numout,*)'   ', ptr%cname   
-      !
-   END SUBROUTINE timing_list
-
-
-   SUBROUTINE insert(sd_current, sd_root ,sd_ptr)
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE insert  ***
-      !! ** Purpose :   insert an element in timer structure
-      !!----------------------------------------------------------------------
-      TYPE(timer), POINTER, INTENT(inout) :: sd_current, sd_root, sd_ptr
-      !
-     
-      IF( ASSOCIATED( sd_current, sd_root ) ) THEN
-         ! If our current element is the root element then
-         ! replace it with the one being inserted
-         sd_root => sd_ptr
-      ELSE
-         sd_current%prev%next => sd_ptr
-      END IF
-      sd_ptr%next     => sd_current
-      sd_ptr%prev     => sd_current%prev
-      sd_current%prev => sd_ptr
-      ! Nullify the pointer to the new element now that it is held
-      ! within the list. If we don't do this then a subsequent call
-      ! to ALLOCATE memory to this pointer will fail.
-      sd_ptr => NULL()
-      !    
-   END SUBROUTINE insert
-  
-  
-   SUBROUTINE suppress(sd_ptr)
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE suppress  ***
-      !! ** Purpose :   supress an element in timer structure
-      !!----------------------------------------------------------------------
-      TYPE(timer), POINTER, INTENT(inout) :: sd_ptr
-      !
-      TYPE(timer), POINTER :: sl_temp
-    
-      sl_temp => sd_ptr
-      sd_ptr => sd_ptr%next    
-      IF ( ASSOCIATED(sl_temp%next) ) sl_temp%next%prev => sl_temp%prev
-      DEALLOCATE(sl_temp)
-      sl_temp => NULL()
-      !
-    END SUBROUTINE suppress
-
-   !!=====================================================================
-END MODULE timing
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/trc_oce.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/trc_oce.f90	(revision 12100)
+++ 	(revision )
@@ -1,263 +1,0 @@
-MODULE trc_oce
-   !!======================================================================
-   !!                      ***  MODULE  trc_oce  ***
-   !! Ocean passive tracer  :  share SMS/Ocean variables
-   !!======================================================================
-   !! History :  1.0  !  2004-03  (C. Ethe)  Original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   trc_oce_rgb   : tabulated attenuation coefficients for RGB light penetration         
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE dom_oce        ! ocean space and time domain
-   !
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   trc_oce_rgb        ! routine called by traqsr.F90
-   PUBLIC   trc_oce_rgb_read   ! routine called by traqsr.F90
-   PUBLIC   trc_oce_ext_lev    ! function called by traqsr.F90 at least
-   PUBLIC   trc_oce_alloc      ! function called by nemogcm.F90
-
-   INTEGER , PUBLIC                                      ::   nn_dttrc      !: frequency of step on passive tracers
-   REAL(wp), PUBLIC                                      ::   r_si2         !: largest depth of extinction (blue & 0.01 mg.m-3)  (RGB)
-   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3         !: light absortion coefficient
-   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   facvol        !: volume for degraded regions
-
-
-
-
-
-
-
-
-   !!----------------------------------------------------------------------
-   !! Default option                          No bio-model light absorption      
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_top     = .FALSE.   !: TOP model
-
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: trc_oce.F90 6140 2015-12-21 11:35:23Z timgraham $ 
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION trc_oce_alloc()
-      !!----------------------------------------------------------------------
-      !!                  ***  trc_oce_alloc  ***
-      !!----------------------------------------------------------------------
-      INTEGER ::   ierr(2)        ! Local variables
-      !!----------------------------------------------------------------------
-      ierr(:) = 0
-                     ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) )
-      IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) )
-      trc_oce_alloc  = MAXVAL( ierr )
-      !
-      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array')
-   END FUNCTION trc_oce_alloc
-
-
-   SUBROUTINE trc_oce_rgb( prgb )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE p4z_opt_init  ***
-      !!
-      !! ** Purpose :   Initialization of of the optical scheme
-      !!
-      !! ** Method  :   Set a look up table for the optical coefficients
-      !!                i.e. the attenuation coefficient for R-G-B light 
-      !!                tabulated in Chlorophyll class (from JM Andre)
-      !!
-      !! ** Action  :   prgb(3,61) tabulated R-G-B attenuation coef. 
-      !!
-      !! Reference  : Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient
-      !
-      INTEGER  ::   jc     ! dummy loop indice
-      INTEGER  ::   irgb   ! temporary integer
-      REAL(wp) ::   zchl   ! temporary scalar
-      REAL(wp), DIMENSION(4,61) ::   zrgb   ! tabulated attenuation coefficient (formerly read in 'kRGB61.txt')
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_oce_rgb : Initialisation of the optical look-up table'
-         WRITE(numout,*) '~~~~~~~~~~~ '
-      ENDIF
-      !
-      !  Chlorophyll        !     Blue attenuation     !     Green attenuation    !     Red attenuation      !
-      zrgb(1, 1) =  0.010   ;   zrgb(2, 1) = 0.01618   ;   zrgb(3, 1) = 0.07464   ;   zrgb(4, 1) = 0.37807
-      zrgb(1, 2) =  0.011   ;   zrgb(2, 2) = 0.01654   ;   zrgb(3, 2) = 0.07480   ;   zrgb(4, 2) = 0.37823
-      zrgb(1, 3) =  0.013   ;   zrgb(2, 3) = 0.01693   ;   zrgb(3, 3) = 0.07499   ;   zrgb(4, 3) = 0.37840
-      zrgb(1, 4) =  0.014   ;   zrgb(2, 4) = 0.01736   ;   zrgb(3, 4) = 0.07518   ;   zrgb(4, 4) = 0.37859
-      zrgb(1, 5) =  0.016   ;   zrgb(2, 5) = 0.01782   ;   zrgb(3, 5) = 0.07539   ;   zrgb(4, 5) = 0.37879
-      zrgb(1, 6) =  0.018   ;   zrgb(2, 6) = 0.01831   ;   zrgb(3, 6) = 0.07562   ;   zrgb(4, 6) = 0.37900
-      zrgb(1, 7) =  0.020   ;   zrgb(2, 7) = 0.01885   ;   zrgb(3, 7) = 0.07586   ;   zrgb(4, 7) = 0.37923
-      zrgb(1, 8) =  0.022   ;   zrgb(2, 8) = 0.01943   ;   zrgb(3, 8) = 0.07613   ;   zrgb(4, 8) = 0.37948
-      zrgb(1, 9) =  0.025   ;   zrgb(2, 9) = 0.02005   ;   zrgb(3, 9) = 0.07641   ;   zrgb(4, 9) = 0.37976
-      zrgb(1,10) =  0.028   ;   zrgb(2,10) = 0.02073   ;   zrgb(3,10) = 0.07672   ;   zrgb(4,10) = 0.38005
-      zrgb(1,11) =  0.032   ;   zrgb(2,11) = 0.02146   ;   zrgb(3,11) = 0.07705   ;   zrgb(4,11) = 0.38036
-      zrgb(1,12) =  0.035   ;   zrgb(2,12) = 0.02224   ;   zrgb(3,12) = 0.07741   ;   zrgb(4,12) = 0.38070
-      zrgb(1,13) =  0.040   ;   zrgb(2,13) = 0.02310   ;   zrgb(3,13) = 0.07780   ;   zrgb(4,13) = 0.38107
-      zrgb(1,14) =  0.045   ;   zrgb(2,14) = 0.02402   ;   zrgb(3,14) = 0.07821   ;   zrgb(4,14) = 0.38146
-      zrgb(1,15) =  0.050   ;   zrgb(2,15) = 0.02501   ;   zrgb(3,15) = 0.07866   ;   zrgb(4,15) = 0.38189
-      zrgb(1,16) =  0.056   ;   zrgb(2,16) = 0.02608   ;   zrgb(3,16) = 0.07914   ;   zrgb(4,16) = 0.38235
-      zrgb(1,17) =  0.063   ;   zrgb(2,17) = 0.02724   ;   zrgb(3,17) = 0.07967   ;   zrgb(4,17) = 0.38285
-      zrgb(1,18) =  0.071   ;   zrgb(2,18) = 0.02849   ;   zrgb(3,18) = 0.08023   ;   zrgb(4,18) = 0.38338
-      zrgb(1,19) =  0.079   ;   zrgb(2,19) = 0.02984   ;   zrgb(3,19) = 0.08083   ;   zrgb(4,19) = 0.38396
-      zrgb(1,20) =  0.089   ;   zrgb(2,20) = 0.03131   ;   zrgb(3,20) = 0.08149   ;   zrgb(4,20) = 0.38458
-      zrgb(1,21) =  0.100   ;   zrgb(2,21) = 0.03288   ;   zrgb(3,21) = 0.08219   ;   zrgb(4,21) = 0.38526
-      zrgb(1,22) =  0.112   ;   zrgb(2,22) = 0.03459   ;   zrgb(3,22) = 0.08295   ;   zrgb(4,22) = 0.38598
-      zrgb(1,23) =  0.126   ;   zrgb(2,23) = 0.03643   ;   zrgb(3,23) = 0.08377   ;   zrgb(4,23) = 0.38676
-      zrgb(1,24) =  0.141   ;   zrgb(2,24) = 0.03842   ;   zrgb(3,24) = 0.08466   ;   zrgb(4,24) = 0.38761
-      zrgb(1,25) =  0.158   ;   zrgb(2,25) = 0.04057   ;   zrgb(3,25) = 0.08561   ;   zrgb(4,25) = 0.38852
-      zrgb(1,26) =  0.178   ;   zrgb(2,26) = 0.04289   ;   zrgb(3,26) = 0.08664   ;   zrgb(4,26) = 0.38950
-      zrgb(1,27) =  0.200   ;   zrgb(2,27) = 0.04540   ;   zrgb(3,27) = 0.08775   ;   zrgb(4,27) = 0.39056
-      zrgb(1,28) =  0.224   ;   zrgb(2,28) = 0.04811   ;   zrgb(3,28) = 0.08894   ;   zrgb(4,28) = 0.39171
-      zrgb(1,29) =  0.251   ;   zrgb(2,29) = 0.05103   ;   zrgb(3,29) = 0.09023   ;   zrgb(4,29) = 0.39294
-      zrgb(1,30) =  0.282   ;   zrgb(2,30) = 0.05420   ;   zrgb(3,30) = 0.09162   ;   zrgb(4,30) = 0.39428
-      zrgb(1,31) =  0.316   ;   zrgb(2,31) = 0.05761   ;   zrgb(3,31) = 0.09312   ;   zrgb(4,31) = 0.39572
-      zrgb(1,32) =  0.355   ;   zrgb(2,32) = 0.06130   ;   zrgb(3,32) = 0.09474   ;   zrgb(4,32) = 0.39727
-      zrgb(1,33) =  0.398   ;   zrgb(2,33) = 0.06529   ;   zrgb(3,33) = 0.09649   ;   zrgb(4,33) = 0.39894
-      zrgb(1,34) =  0.447   ;   zrgb(2,34) = 0.06959   ;   zrgb(3,34) = 0.09837   ;   zrgb(4,34) = 0.40075
-      zrgb(1,35) =  0.501   ;   zrgb(2,35) = 0.07424   ;   zrgb(3,35) = 0.10040   ;   zrgb(4,35) = 0.40270
-      zrgb(1,36) =  0.562   ;   zrgb(2,36) = 0.07927   ;   zrgb(3,36) = 0.10259   ;   zrgb(4,36) = 0.40480
-      zrgb(1,37) =  0.631   ;   zrgb(2,37) = 0.08470   ;   zrgb(3,37) = 0.10495   ;   zrgb(4,37) = 0.40707
-      zrgb(1,38) =  0.708   ;   zrgb(2,38) = 0.09056   ;   zrgb(3,38) = 0.10749   ;   zrgb(4,38) = 0.40952
-      zrgb(1,39) =  0.794   ;   zrgb(2,39) = 0.09690   ;   zrgb(3,39) = 0.11024   ;   zrgb(4,39) = 0.41216
-      zrgb(1,40) =  0.891   ;   zrgb(2,40) = 0.10374   ;   zrgb(3,40) = 0.11320   ;   zrgb(4,40) = 0.41502
-      zrgb(1,41) =  1.000   ;   zrgb(2,41) = 0.11114   ;   zrgb(3,41) = 0.11639   ;   zrgb(4,41) = 0.41809
-      zrgb(1,42) =  1.122   ;   zrgb(2,42) = 0.11912   ;   zrgb(3,42) = 0.11984   ;   zrgb(4,42) = 0.42142
-      zrgb(1,43) =  1.259   ;   zrgb(2,43) = 0.12775   ;   zrgb(3,43) = 0.12356   ;   zrgb(4,43) = 0.42500
-      zrgb(1,44) =  1.413   ;   zrgb(2,44) = 0.13707   ;   zrgb(3,44) = 0.12757   ;   zrgb(4,44) = 0.42887
-      zrgb(1,45) =  1.585   ;   zrgb(2,45) = 0.14715   ;   zrgb(3,45) = 0.13189   ;   zrgb(4,45) = 0.43304
-      zrgb(1,46) =  1.778   ;   zrgb(2,46) = 0.15803   ;   zrgb(3,46) = 0.13655   ;   zrgb(4,46) = 0.43754
-      zrgb(1,47) =  1.995   ;   zrgb(2,47) = 0.16978   ;   zrgb(3,47) = 0.14158   ;   zrgb(4,47) = 0.44240
-      zrgb(1,48) =  2.239   ;   zrgb(2,48) = 0.18248   ;   zrgb(3,48) = 0.14701   ;   zrgb(4,48) = 0.44765
-      zrgb(1,49) =  2.512   ;   zrgb(2,49) = 0.19620   ;   zrgb(3,49) = 0.15286   ;   zrgb(4,49) = 0.45331
-      zrgb(1,50) =  2.818   ;   zrgb(2,50) = 0.21102   ;   zrgb(3,50) = 0.15918   ;   zrgb(4,50) = 0.45942
-      zrgb(1,51) =  3.162   ;   zrgb(2,51) = 0.22703   ;   zrgb(3,51) = 0.16599   ;   zrgb(4,51) = 0.46601
-      zrgb(1,52) =  3.548   ;   zrgb(2,52) = 0.24433   ;   zrgb(3,52) = 0.17334   ;   zrgb(4,52) = 0.47313
-      zrgb(1,53) =  3.981   ;   zrgb(2,53) = 0.26301   ;   zrgb(3,53) = 0.18126   ;   zrgb(4,53) = 0.48080
-      zrgb(1,54) =  4.467   ;   zrgb(2,54) = 0.28320   ;   zrgb(3,54) = 0.18981   ;   zrgb(4,54) = 0.48909
-      zrgb(1,55) =  5.012   ;   zrgb(2,55) = 0.30502   ;   zrgb(3,55) = 0.19903   ;   zrgb(4,55) = 0.49803
-      zrgb(1,56) =  5.623   ;   zrgb(2,56) = 0.32858   ;   zrgb(3,56) = 0.20898   ;   zrgb(4,56) = 0.50768
-      zrgb(1,57) =  6.310   ;   zrgb(2,57) = 0.35404   ;   zrgb(3,57) = 0.21971   ;   zrgb(4,57) = 0.51810
-      zrgb(1,58) =  7.079   ;   zrgb(2,58) = 0.38154   ;   zrgb(3,58) = 0.23129   ;   zrgb(4,58) = 0.52934
-      zrgb(1,59) =  7.943   ;   zrgb(2,59) = 0.41125   ;   zrgb(3,59) = 0.24378   ;   zrgb(4,59) = 0.54147
-      zrgb(1,60) =  8.912   ;   zrgb(2,60) = 0.44336   ;   zrgb(3,60) = 0.25725   ;   zrgb(4,60) = 0.55457
-      zrgb(1,61) = 10.000   ;   zrgb(2,61) = 0.47804   ;   zrgb(3,61) = 0.27178   ;   zrgb(4,61) = 0.56870
-      !
-      prgb(:,:) = zrgb(2:4,:)
-      !
-      r_si2 = 1.e0 / zrgb(2, 1)        ! blue with the smallest chlorophyll concentration)
-      IF(lwp) WRITE(numout,*) '      RGB longest depth of extinction    r_si2 = ', r_si2
-      !
-      DO jc = 1, 61                         ! check
-         zchl = zrgb(1,jc)
-         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )
-         IF(lwp .AND. nn_print >= 1 ) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb
-         IF( irgb /= jc ) THEN
-            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb
-            CALL ctl_stop( 'trc_oce_rgb : inconsistency in Chl tabulated attenuation coeff.' )
-         ENDIF
-      END DO
-      !
-   END SUBROUTINE trc_oce_rgb
-
-
-   SUBROUTINE trc_oce_rgb_read( prgb )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE p4z_opt_init  ***
-      !!
-      !! ** Purpose :   Initialization of of the optical scheme
-      !!
-      !! ** Method  :   read the look up table for the optical coefficients
-      !!
-      !! ** input   :   xkrgb(61) precomputed array corresponding to the  
-      !!                          attenuation coefficient (from JM Andre)
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient
-      !
-      INTEGER  ::   jc, jb ! dummy loop indice
-      INTEGER  ::   irgb   ! temporary integer
-      REAL(wp) ::   zchl   ! temporary scalar
-      INTEGER  ::   numlight
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) THEN                         ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' trc_oce_rgb_read : optical look-up table read in kRGB61.txt file'
-         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
-         WRITE(numout,*) 
-      ENDIF
-      !
-      CALL ctl_opn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-      DO jc = 1, 61
-         READ(numlight,*) zchl, ( prgb(jb,jc), jb = 1, 3 )
-         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )   
-         IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb  
-         IF( irgb /= jc ) THEN  
-            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb
-            CALL ctl_stop( 'trc_oce_rgb_read : inconsistency in Chl tabulated attenuation coeff.' )
-         ENDIF
-      END DO
-      CLOSE( numlight )
-      !
-      r_si2 = 1.e0 / prgb(1, 1)      ! blue with the smallest chlorophyll concentration)
-      IF(lwp) WRITE(numout,*) '      RGB longest depth of extinction    r_si2 = ', r_si2
-      !
-   END SUBROUTINE trc_oce_rgb_read
-
-
-   FUNCTION trc_oce_ext_lev( prldex, pqsr_frc ) RESULT( pjl )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE trc_oce_ext_lev  ***
-      !!       
-      !! ** Purpose :   compute max. level for light penetration
-      !!          
-      !! ** Method  :   the function provides the level at which irradiance 
-      !!                becomes negligible (i.e. = 1.e-15 W/m2) for 3 or 2 bands light
-      !!                penetration: I(z) = pqsr_frc * EXP(hext/prldex) = 1.e-15 W/m2
-      !!                # prldex is the longest depth of extinction:
-      !!                   - prldex = 23 m (2 bands case)
-      !!                   - prldex = 62 m (3 bands case: blue waveband & 0.01 mg/m2 for the chlorophyll)
-      !!                # pqsr_frc is the fraction of solar radiation which penetrates,
-      !!                considering Qsr=240 W/m2 and rn_abs = 0.58:
-      !!                   - pqsr_frc = Qsr * (1-rn_abs)   = 1.00e2 W/m2 (2 bands case)
-      !!                   - pqsr_frc = Qsr * (1-rn_abs)/3 = 0.33e2 W/m2 (3 bands case & equi-partition)
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in) ::   prldex    ! longest depth of extinction
-      REAL(wp), INTENT(in) ::   pqsr_frc  ! frac. solar radiation which penetrates 
-      !
-      INTEGER  ::   jk, pjl            ! levels
-      REAL(wp) ::   zhext              ! deepest level till which light penetrates
-      REAL(wp) ::   zprec = 15._wp     ! precision to reach -LOG10(1.e-15)
-      REAL(wp) ::   zem                ! temporary scalar 
-      !!----------------------------------------------------------------------
-      !
-      ! It is not necessary to compute anything below the following depth
-      zhext = prldex * ( LOG(10._wp) * zprec + LOG(pqsr_frc) )
-      !
-      ! Level of light extinction
-      pjl = jpkm1
-      DO jk = jpkm1, 1, -1
-         IF(SUM(tmask(:,:,jk)) > 0 ) THEN
-            zem = MAXVAL( gdepw_0(:,:,jk+1) * tmask(:,:,jk) )
-            IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr
-         ELSE
-            pjl = jk                                            ! or regional sea-bed depth 
-         ENDIF
-      END DO
-      !
-   END FUNCTION trc_oce_ext_lev
-
-   !!======================================================================
-END MODULE trc_oce
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/vectopt_loop_substitute.h90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/vectopt_loop_substitute.h90	(revision 12101)
+++ utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/vectopt_loop_substitute.h90	(revision 12101)
@@ -0,0 +1,18 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: vectopt_loop_substitute.h90 10068 2018-08-28 14:09:04Z nicolasmartin $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+#if defined key_vectopt_loop
+#  define   fs_2       1
+#  define   fs_jpim1   jpi
+#else
+#  define   fs_2       2
+#  define   fs_jpim1   jpim1
+#endif
Index: utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/wrk_nemo.f90
===================================================================
--- utils/tools_UKMO_MERGE_2019/DOMAINcfg/src/wrk_nemo.f90	(revision 12100)
+++ 	(revision )
@@ -1,599 +1,0 @@
-MODULE wrk_nemo
-   !!======================================================================
-   !!                       ***  MODULE  wrk_nemo  ***
-   !! NEMO work space:  define and allocate work-space arrays used in 
-   !! all components of NEMO
-   !!======================================================================
-   !! History :  4.0  !  2011-01  (A Porter)  Original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   wrk_alloc         : get work space arrays
-   !!   wrk_dealloc       : release work space arrays
-   !!
-   !! 1d arrays:
-   !!   REAL(wp), POINTER, DIMENSION(:) :: arr1, arr2, ... arr10
-   !!    or
-   !!   INTEGER, POINTER, DIMENSION(:) :: arr1, arr2, ... arr10
-   !!   ...
-   !!   CALL wrk_alloc( nx, arr1, arr2, ... arr10, kistart = kistart )
-   !!   ...
-   !!   CALL wrk_dealloc( nx, arr1, arr2, ... arr10, kistart = kistart)
-   !!   with:
-   !!     - arr*: 1d arrays. real or (not and) integer
-   !!     - nx: size of the 1d arr* arrays
-   !!     - arr2, ..., arr10: optional parameters
-   !!     - kistart: optional parameter to lower bound of the 1st dimension (default = 1)
-   !!
-   !! 2d arrays:
-   !!   REAL(wp), POINTER, DIMENSION(:,:) :: arr1, arr2, ... arr10
-   !!    or
-   !!   INTEGER, POINTER, DIMENSION(:,:) :: arr1, arr2, ... arr10
-   !!   ...
-   !!   CALL wrk_alloc( nx, ny, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart )
-   !!   ...
-   !!   CALL wrk_dealloc( nx, ny, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart )
-   !!   with:
-   !!     - arr* 2d arrays. real or (not and) integer
-   !!     - nx, ny: size of the 2d arr* arrays
-   !!     - arr2, ..., arr10: optional parameters
-   !!     - kistart, kjstart: optional parameters to lower bound of the 1st/2nd dimension (default = 1)
-   !!
-   !! 3d arrays:
-   !!   REAL(wp), POINTER, DIMENSION(:,:,:) :: arr1, arr2, ... arr10
-   !!    or
-   !!   INTEGER, POINTER, DIMENSION(:,:,:) :: arr1, arr2, ... arr10
-   !!   ...
-   !!   CALL wrk_alloc( nx, ny, nz, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart, kkstart = kkstart )
-   !!   ...
-   !!   CALL wrk_dealloc( nx, ny, nz, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart, kkstart = kkstart )
-   !!   with:
-   !!     - arr* 3d arrays. real or (not and) integer
-   !!     - nx, ny, nz: size of the 3d arr* arrays
-   !!     - arr2, ..., arr10: optional parameters
-   !!     - kistart, kjstart, kkstart: optional parameters to lower bound of the 1st/2nd/3rd dimension (default = 1)
-   !!
-   !! 4d arrays:
-   !!   REAL(wp), POINTER, DIMENSION(:,:,:,:) :: arr1, arr2, ... arr10
-   !!    or
-   !!   INTEGER, POINTER, DIMENSION(:,:,:,:) :: arr1, arr2, ... arr10
-   !!   ...
-   !!   CALL wrk_alloc( nx, ny, nz, nl, arr1, arr2, ... arr10, &
-   !!      &            kistart = kistart, kjstart = kjstart, kkstart = kkstart, klstart = klstart )
-   !!   ...
-   !!   CALL wrk_dealloc( nx, ny, nz, nl, arr1, arr2, ... arr10, &
-   !!      &            kistart = kistart, kjstart = kjstart, kkstart = kkstart, klstart = klstart )
-   !!   with:
-   !!     - arr* 3d arrays. real or (not and) integer
-   !!     - nx, ny, nz, nl: size of the 4d arr* arrays
-   !!     - arr2, ..., arr10: optional parameters
-   !!     - kistart, kjstart, kkstart, klstart: optional parameters to lower bound of the 1st/2nd/3rd/4th dimension (default = 1)
-   !!   
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC wrk_alloc, wrk_dealloc, wrk_list
-
-   INTERFACE wrk_alloc
-      MODULE PROCEDURE wrk_alloc_1dr, wrk_alloc_2dr, wrk_alloc_3dr, wrk_alloc_4dr,   &
-         &             wrk_alloc_1di, wrk_alloc_2di, wrk_alloc_3di, wrk_alloc_4di
-   END INTERFACE
-
-   INTERFACE wrk_dealloc
-      MODULE PROCEDURE wrk_dealloc_1dr, wrk_dealloc_2dr, wrk_dealloc_3dr, wrk_dealloc_4dr,   &
-         &             wrk_dealloc_1di, wrk_dealloc_2di, wrk_dealloc_3di, wrk_dealloc_4di
-   END INTERFACE
-
-
-   INTEGER, PARAMETER :: jparray = 1000
-   INTEGER, PARAMETER :: jpmaxdim = 4
-
-   INTEGER, PARAMETER :: jpnotdefined = 0
-   INTEGER, PARAMETER :: jpinteger = 1
-   INTEGER, PARAMETER :: jpreal = 2
-  
-   TYPE leaf
-      LOGICAL :: in_use
-      INTEGER :: indic
-      INTEGER , DIMENSION(:)      , POINTER :: iwrk1d => NULL()    
-      INTEGER , DIMENSION(:,:)    , POINTER :: iwrk2d => NULL()    
-      INTEGER , DIMENSION(:,:,:)  , POINTER :: iwrk3d => NULL()    
-      INTEGER , DIMENSION(:,:,:,:), POINTER :: iwrk4d => NULL()    
-      REAL(wp), DIMENSION(:)      , POINTER :: zwrk1d => NULL()    
-      REAL(wp), DIMENSION(:,:)    , POINTER :: zwrk2d => NULL()    
-      REAL(wp), DIMENSION(:,:,:)  , POINTER :: zwrk3d => NULL()    
-      REAL(wp), DIMENSION(:,:,:,:), POINTER :: zwrk4d => NULL()    
-      TYPE (leaf), POINTER :: next => NULL() 
-      TYPE (leaf), POINTER :: prev => NULL() 
-   END TYPE leaf
-   
-   TYPE branch
-      INTEGER :: itype
-      INTEGER, DIMENSION(jpmaxdim) :: ishape, istart
-      TYPE(leaf), POINTER :: start => NULL()     
-      TYPE(leaf), POINTER :: current => NULL()      
-   END TYPE branch
-
-   TYPE(branch), SAVE, DIMENSION(jparray) :: tree
-
-   LOGICAL ::   linit = .FALSE.
-   LOGICAL ::   ldebug = .FALSE.
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id: wrk_nemo.F90 5514 2015-06-30 10:06:05Z smasson $
-   !! Software governed by the CeCILL licence     (./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE wrk_list
-      ! to list 3d arrays in use, to be duplicated for all cases 
-      WRITE(*,*) 'Arrays in use :'
-      !      CALL listage(tree_3d(1)%s_wrk_3d_start)
-      WRITE(*,*) ''
-      
-   END SUBROUTINE wrk_list
-   
-   
-   RECURSIVE SUBROUTINE listage(ptr)
-      
-      TYPE(leaf), POINTER, INTENT(in) :: ptr
-      !
-      IF( ASSOCIATED(ptr%next) ) CALL listage(ptr%next)
-      WRITE(*,*) ptr%in_use, ptr%indic   
-      
-   END SUBROUTINE listage
-
-
-   SUBROUTINE wrk_alloc_1dr( kidim, p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10, kistart )
-      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size
-      REAL(wp), POINTER, DIMENSION(:), INTENT(inout)           ::   p1d01
-      REAL(wp), POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   p1d02,p1d03,p1d04,p1d05,p1d06,p1d07,p1d08,p1d09,p1d10
-      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart
-      !
-      CALL wrk_alloc_xd( kidim, 0, 0, 0, kistart, 1, 1, 1,                                            &
-         &               p1d01 = p1d01, p1d02 = p1d02, p1d03 = p1d03, p1d04 = p1d04, p1d05 = p1d05,   &
-         &               p1d06 = p1d06, p1d07 = p1d07, p1d08 = p1d08, p1d09 = p1d09, p1d10 = p1d10    )
-      !
-   END SUBROUTINE wrk_alloc_1dr
-
-
-   SUBROUTINE wrk_alloc_1di( kidim, k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10, kistart )
-      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size
-      INTEGER , POINTER, DIMENSION(:), INTENT(inout)           ::   k1d01
-      INTEGER , POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   k1d02,k1d03,k1d04,k1d05,k1d06,k1d07,k1d08,k1d09,k1d10
-      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart
-      !
-      CALL wrk_alloc_xd( kidim, 0, 0, 0, kistart, 1, 1, 1,                                            &
-         &               k1d01 = k1d01, k1d02 = k1d02, k1d03 = k1d03, k1d04 = k1d04, k1d05 = k1d05,   &
-         &               k1d06 = k1d06, k1d07 = k1d07, k1d08 = k1d08, k1d09 = k1d09, k1d10 = k1d10    )
-      !
-   END SUBROUTINE wrk_alloc_1di
-
-
-   SUBROUTINE wrk_alloc_2dr( kidim, kjdim, p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10, kistart, kjstart )
-      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size
-      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout)           ::   p2d01
-      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   p2d02,p2d03,p2d04,p2d05,p2d06,p2d07,p2d08,p2d09,p2d10
-      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart
-      !
-      CALL wrk_alloc_xd( kidim, kjdim, 0, 0, kistart, kjstart, 1, 1,                                  &
-         &               p2d01 = p2d01, p2d02 = p2d02, p2d03 = p2d03, p2d04 = p2d04, p2d05 = p2d05,   &
-         &               p2d06 = p2d06, p2d07 = p2d07, p2d08 = p2d08, p2d09 = p2d09, p2d10 = p2d10    )
-      !
-   END SUBROUTINE wrk_alloc_2dr
-
-
-   SUBROUTINE wrk_alloc_2di( kidim, kjdim, k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10, kistart, kjstart )
-      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size
-      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout)           ::   k2d01
-      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   k2d02,k2d03,k2d04,k2d05,k2d06,k2d07,k2d08,k2d09,k2d10
-      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart
-      !
-      CALL wrk_alloc_xd( kidim, kjdim, 0, 0, kistart, kjstart, 1, 1,                                  &
-         &               k2d01 = k2d01, k2d02 = k2d02, k2d03 = k2d03, k2d04 = k2d04, k2d05 = k2d05,   &
-         &               k2d06 = k2d06, k2d07 = k2d07, k2d08 = k2d08, k2d09 = k2d09, k2d10 = k2d10    )
-      !
-   END SUBROUTINE wrk_alloc_2di
-
-
-   SUBROUTINE wrk_alloc_3dr( kidim, kjdim, kkdim, p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10,   &
-      &                      kistart, kjstart, kkstart )
-      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size
-      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   p3d01
-      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   p3d02,p3d03,p3d04,p3d05,p3d06,p3d07,p3d08,p3d09,p3d10
-      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart
-      !
-      CALL wrk_alloc_xd( kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1,                        &
-         &               p3d01 = p3d01, p3d02 = p3d02, p3d03 = p3d03, p3d04 = p3d04, p3d05 = p3d05,   &
-         &               p3d06 = p3d06, p3d07 = p3d07, p3d08 = p3d08, p3d09 = p3d09, p3d10 = p3d10    )
-      !
-   END SUBROUTINE wrk_alloc_3dr
-
-
-   SUBROUTINE wrk_alloc_3di( kidim, kjdim, kkdim, k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10,   &
-      &                      kistart, kjstart, kkstart )
-      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size
-      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   k3d01
-      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   k3d02,k3d03,k3d04,k3d05,k3d06,k3d07,k3d08,k3d09,k3d10
-      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart
-      !
-      CALL wrk_alloc_xd( kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1,                        &
-         &               k3d01 = k3d01, k3d02 = k3d02, k3d03 = k3d03, k3d04 = k3d04, k3d05 = k3d05,   &
-         &               k3d06 = k3d06, k3d07 = k3d07, k3d08 = k3d08, k3d09 = k3d09, k3d10 = k3d10    )
-      !
-   END SUBROUTINE wrk_alloc_3di
-
-
-   SUBROUTINE wrk_alloc_4dr( kidim, kjdim, kkdim, kldim, p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10,   &
-      &                      kistart, kjstart, kkstart, klstart )
-      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size
-      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   p4d01
-      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   p4d02,p4d03,p4d04,p4d05,p4d06,p4d07,p4d08,p4d09,p4d10
-      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart
-      !
-      CALL wrk_alloc_xd( kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart,              &
-         &               p4d01 = p4d01, p4d02 = p4d02, p4d03 = p4d03, p4d04 = p4d04, p4d05 = p4d05,   &
-         &               p4d06 = p4d06, p4d07 = p4d07, p4d08 = p4d08, p4d09 = p4d09, p4d10 = p4d10    )
-      !
-   END SUBROUTINE wrk_alloc_4dr
-
-
-   SUBROUTINE wrk_alloc_4di( kidim, kjdim, kkdim, kldim, k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10,   &
-      &                      kistart, kjstart, kkstart, klstart )
-      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size
-      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   k4d01
-      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   k4d02,k4d03,k4d04,k4d05,k4d06,k4d07,k4d08,k4d09,k4d10
-      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart
-      !
-      CALL wrk_alloc_xd( kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart,              &
-         &               k4d01 = k4d01, k4d02 = k4d02, k4d03 = k4d03, k4d04 = k4d04, k4d05 = k4d05,   &
-         &               k4d06 = k4d06, k4d07 = k4d07, k4d08 = k4d08, k4d09 = k4d09, k4d10 = k4d10    )
-      !
-   END SUBROUTINE wrk_alloc_4di
-
-
-   SUBROUTINE wrk_dealloc_1dr( kidim, p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10, kistart )
-      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size
-      REAL(wp), POINTER, DIMENSION(:), INTENT(inout)           ::   p1d01
-      REAL(wp), POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   p1d02,p1d03,p1d04,p1d05,p1d06,p1d07,p1d08,p1d09,p1d10
-      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart
-      !
-      INTEGER :: icnt, jn
-      icnt = 1 + COUNT( (/                PRESENT(p1d02),PRESENT(p1d03),PRESENT(p1d04),PRESENT(p1d05),   &
-         &                 PRESENT(p1d06),PRESENT(p1d07),PRESENT(p1d08),PRESENT(p1d09),PRESENT(p1d10) /) )
-      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, 0, 0, 0, kistart, 1, 1, 1)   ;   END DO
-      !
-   END SUBROUTINE wrk_dealloc_1dr
-
-
-   SUBROUTINE wrk_dealloc_1di( kidim, k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10, kistart )
-      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size
-      INTEGER , POINTER, DIMENSION(:), INTENT(inout)           ::   k1d01
-      INTEGER , POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   k1d02,k1d03,k1d04,k1d05,k1d06,k1d07,k1d08,k1d09,k1d10
-      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart
-      !
-      INTEGER :: icnt, jn
-      icnt = 1 + COUNT( (/                PRESENT(k1d02),PRESENT(k1d03),PRESENT(k1d04),PRESENT(k1d05),   &
-         &                 PRESENT(k1d06),PRESENT(k1d07),PRESENT(k1d08),PRESENT(k1d09),PRESENT(k1d10) /) )
-      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, 0, 0, 0, kistart, 1, 1, 1 )   ;   END DO
-      !
-   END SUBROUTINE wrk_dealloc_1di
-
-
-   SUBROUTINE wrk_dealloc_2dr( kidim, kjdim, p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10, kistart,kjstart )
-      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size
-      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout)           ::   p2d01
-      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   p2d02,p2d03,p2d04,p2d05,p2d06,p2d07,p2d08,p2d09,p2d10
-      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart
-      !
-      INTEGER :: icnt, jn
-      icnt = 1 + COUNT( (/                PRESENT(p2d02),PRESENT(p2d03),PRESENT(p2d04),PRESENT(p2d05),   &
-         &                 PRESENT(p2d06),PRESENT(p2d07),PRESENT(p2d08),PRESENT(p2d09),PRESENT(p2d10) /) )
-      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, kjdim, 0, 0, kistart, kjstart, 1, 1 )   ;   END DO
-      !
-   END SUBROUTINE wrk_dealloc_2dr
-
-
-   SUBROUTINE wrk_dealloc_2di( kidim, kjdim, k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10, kistart,kjstart )
-      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size
-      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout)           ::   k2d01
-      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   k2d02,k2d03,k2d04,k2d05,k2d06,k2d07,k2d08,k2d09,k2d10
-      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart
-      !
-      INTEGER :: icnt, jn
-      icnt = 1 + COUNT( (/                PRESENT(k2d02),PRESENT(k2d03),PRESENT(k2d04),PRESENT(k2d05),   &
-         &                 PRESENT(k2d06),PRESENT(k2d07),PRESENT(k2d08),PRESENT(k2d09),PRESENT(k2d10) /) )
-      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, kjdim, 0, 0, kistart, kjstart, 1, 1 )   ;   END DO
-      !
-   END SUBROUTINE wrk_dealloc_2di
-
-
-   SUBROUTINE wrk_dealloc_3dr( kidim, kjdim, kkdim, p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10,   &
-      &                        kistart, kjstart, kkstart )
-      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size
-      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   p3d01
-      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   p3d02,p3d03,p3d04,p3d05,p3d06,p3d07,p3d08,p3d09,p3d10
-      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart
-      !
-      INTEGER :: icnt, jn
-      icnt = 1 + COUNT( (/                PRESENT(p3d02),PRESENT(p3d03),PRESENT(p3d04),PRESENT(p3d05),   &
-         &                 PRESENT(p3d06),PRESENT(p3d07),PRESENT(p3d08),PRESENT(p3d09),PRESENT(p3d10) /) )
-      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1 )   ;   END DO
-      !
-   END SUBROUTINE wrk_dealloc_3dr
-
-
-   SUBROUTINE wrk_dealloc_3di( kidim, kjdim, kkdim, k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10,   &
-      &                        kistart, kjstart, kkstart )
-      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size
-      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   k3d01
-      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   k3d02,k3d03,k3d04,k3d05,k3d06,k3d07,k3d08,k3d09,k3d10
-      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart
-      !
-      INTEGER :: icnt, jn
-      icnt = 1 + COUNT( (/                PRESENT(k3d02),PRESENT(k3d03),PRESENT(k3d04),PRESENT(k3d05),   &
-         &                 PRESENT(k3d06),PRESENT(k3d07),PRESENT(k3d08),PRESENT(k3d09),PRESENT(k3d10) /) )
-      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1 )   ;   END DO
-      !
-   END SUBROUTINE wrk_dealloc_3di
-
-
-   SUBROUTINE wrk_dealloc_4dr( kidim, kjdim, kkdim, kldim, p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10,   &
-      &                        kistart, kjstart, kkstart, klstart )
-      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size
-      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   p4d01
-      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   p4d02,p4d03,p4d04,p4d05,p4d06,p4d07,p4d08,p4d09,p4d10
-      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart
-      !
-      INTEGER :: icnt, jn
-      icnt = 1 + COUNT( (/                PRESENT(p4d02),PRESENT(p4d03),PRESENT(p4d04),PRESENT(p4d05),   &
-         &                 PRESENT(p4d06),PRESENT(p4d07),PRESENT(p4d08),PRESENT(p4d09),PRESENT(p4d10) /) )
-      DO jn = 1, icnt ; CALL wrk_deallocbase( jpreal, kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart ) ; END DO
-      !
-   END SUBROUTINE wrk_dealloc_4dr
-
-
-   SUBROUTINE wrk_dealloc_4di( kidim, kjdim, kkdim, kldim, k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10,   &
-      &                        kistart, kjstart, kkstart, klstart )
-      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size
-      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   k4d01
-      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   k4d02,k4d03,k4d04,k4d05,k4d06,k4d07,k4d08,k4d09,k4d10
-      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart
-      !
-      INTEGER :: icnt, jn
-      icnt = 1 + COUNT( (/                PRESENT(k4d02),PRESENT(k4d03),PRESENT(k4d04),PRESENT(k4d05),   &
-         &                 PRESENT(k4d06),PRESENT(k4d07),PRESENT(k4d08),PRESENT(k4d09),PRESENT(k4d10) /) )
-      DO jn = 1, icnt ; CALL wrk_deallocbase( jpinteger, kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart ) ; END DO
-      !
-   END SUBROUTINE wrk_dealloc_4di
-
-
-   SUBROUTINE wrk_alloc_xd( kidim, kjdim, kkdim, kldim,                                             &
-      &                     kisrt, kjsrt, kksrt, klsrt,                                             &
-      &                     k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10,   &
-      &                     k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10,   &
-      &                     k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10,   &
-      &                     k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10,   &
-      &                     p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10,   &
-      &                     p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10,   &
-      &                     p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10,   &
-      &                     p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10    )
-      INTEGER                              ,INTENT(in   )         ::   kidim, kjdim, kkdim, kldim   ! dimensions size
-      INTEGER                              ,INTENT(in   ),OPTIONAL::   kisrt, kjsrt, kksrt, klsrt
-      INTEGER , POINTER, DIMENSION(:      ),INTENT(inout),OPTIONAL::   k1d01,k1d02,k1d03,k1d04,k1d05,k1d06,k1d07,k1d08,k1d09,k1d10
-      INTEGER , POINTER, DIMENSION(:,:    ),INTENT(inout),OPTIONAL::   k2d01,k2d02,k2d03,k2d04,k2d05,k2d06,k2d07,k2d08,k2d09,k2d10
-      INTEGER , POINTER, DIMENSION(:,:,:  ),INTENT(inout),OPTIONAL::   k3d01,k3d02,k3d03,k3d04,k3d05,k3d06,k3d07,k3d08,k3d09,k3d10
-      INTEGER , POINTER, DIMENSION(:,:,:,:),INTENT(inout),OPTIONAL::   k4d01,k4d02,k4d03,k4d04,k4d05,k4d06,k4d07,k4d08,k4d09,k4d10
-      REAL(wp), POINTER, DIMENSION(:      ),INTENT(inout),OPTIONAL::   p1d01,p1d02,p1d03,p1d04,p1d05,p1d06,p1d07,p1d08,p1d09,p1d10
-      REAL(wp), POINTER, DIMENSION(:,:    ),INTENT(inout),OPTIONAL::   p2d01,p2d02,p2d03,p2d04,p2d05,p2d06,p2d07,p2d08,p2d09,p2d10
-      REAL(wp), POINTER, DIMENSION(:,:,:  ),INTENT(inout),OPTIONAL::   p3d01,p3d02,p3d03,p3d04,p3d05,p3d06,p3d07,p3d08,p3d09,p3d10
-      REAL(wp), POINTER, DIMENSION(:,:,:,:),INTENT(inout),OPTIONAL::   p4d01,p4d02,p4d03,p4d04,p4d05,p4d06,p4d07,p4d08,p4d09,p4d10
-      !
-      LOGICAL ::   llpres
-      INTEGER ::   jn, iisrt, ijsrt, iksrt, ilsrt
-      !
-      IF( .NOT. linit ) THEN
-         tree(:)%itype = jpnotdefined
-         DO jn = 1, jparray   ;   tree(jn)%ishape(:) = 0   ;   tree(jn)%istart(:) = 0   ;   END DO
-         linit = .TRUE.
-      ENDIF
-
-      IF( PRESENT(kisrt) ) THEN   ;   iisrt =  kisrt   ;   ELSE   ;   iisrt = 1   ;   ENDIF 
-      IF( PRESENT(kjsrt) ) THEN   ;   ijsrt =  kjsrt   ;   ELSE   ;   ijsrt = 1   ;   ENDIF 
-      IF( PRESENT(kksrt) ) THEN   ;   iksrt =  kksrt   ;   ELSE   ;   iksrt = 1   ;   ENDIF 
-      IF( PRESENT(klsrt) ) THEN   ;   ilsrt =  klsrt   ;   ELSE   ;   ilsrt = 1   ;   ENDIF 
-
-      llpres =  PRESENT(k1d01) .OR. PRESENT(k2d01) .OR. PRESENT(k3d01) .OR. PRESENT(k4d01)   &
-         & .OR. PRESENT(p1d01) .OR. PRESENT(p2d01) .OR. PRESENT(p3d01) .OR. PRESENT(p4d01)
-      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
-         &                             k1d01, k2d01, k3d01, k4d01, p1d01, p2d01, p3d01, p4d01    )
-      llpres =  PRESENT(k1d02) .OR. PRESENT(k2d02) .OR. PRESENT(k3d02) .OR. PRESENT(k4d02)   &
-         & .OR. PRESENT(p1d02) .OR. PRESENT(p2d02) .OR. PRESENT(p3d02) .OR. PRESENT(p4d02)
-      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
-         &                             k1d02, k2d02, k3d02, k4d02, p1d02, p2d02, p3d02, p4d02    )
-      llpres =  PRESENT(k1d03) .OR. PRESENT(k2d03) .OR. PRESENT(k3d03) .OR. PRESENT(k4d03)   &
-         & .OR. PRESENT(p1d03) .OR. PRESENT(p2d03) .OR. PRESENT(p3d03) .OR. PRESENT(p4d03)
-      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
-         &                             k1d03, k2d03, k3d03, k4d03, p1d03, p2d03, p3d03, p4d03    )
-      llpres =  PRESENT(k1d04) .OR. PRESENT(k2d04) .OR. PRESENT(k3d04) .OR. PRESENT(k4d04)   &
-         & .OR. PRESENT(p1d04) .OR. PRESENT(p2d04) .OR. PRESENT(p3d04) .OR. PRESENT(p4d04)
-      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
-         &                             k1d04, k2d04, k3d04, k4d04, p1d04, p2d04, p3d04, p4d04    )
-      llpres =  PRESENT(k1d05) .OR. PRESENT(k2d05) .OR. PRESENT(k3d05) .OR. PRESENT(k4d05)   &
-         & .OR. PRESENT(p1d05) .OR. PRESENT(p2d05) .OR. PRESENT(p3d05) .OR. PRESENT(p4d05)
-      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
-         &                             k1d05, k2d05, k3d05, k4d05, p1d05, p2d05, p3d05, p4d05    )
-      llpres =  PRESENT(k1d06) .OR. PRESENT(k2d06) .OR. PRESENT(k3d06) .OR. PRESENT(k4d06)   &
-         & .OR. PRESENT(p1d06) .OR. PRESENT(p2d06) .OR. PRESENT(p3d06) .OR. PRESENT(p4d06)
-      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
-         &                             k1d06, k2d06, k3d06, k4d06, p1d06, p2d06, p3d06, p4d06    )
-      llpres =  PRESENT(k1d07) .OR. PRESENT(k2d07) .OR. PRESENT(k3d07) .OR. PRESENT(k4d07)   &
-         & .OR. PRESENT(p1d07) .OR. PRESENT(p2d07) .OR. PRESENT(p3d07) .OR. PRESENT(p4d07)
-      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
-         &                             k1d07, k2d07, k3d07, k4d07, p1d07, p2d07, p3d07, p4d07    )
-      llpres =  PRESENT(k1d08) .OR. PRESENT(k2d08) .OR. PRESENT(k3d08) .OR. PRESENT(k4d08)   &
-         & .OR. PRESENT(p1d08) .OR. PRESENT(p2d08) .OR. PRESENT(p3d08) .OR. PRESENT(p4d08)
-      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
-         &                             k1d08, k2d08, k3d08, k4d08, p1d08, p2d08, p3d08, p4d08    )
-      llpres =  PRESENT(k1d09) .OR. PRESENT(k2d09) .OR. PRESENT(k3d09) .OR. PRESENT(k4d09)   &
-         & .OR. PRESENT(p1d09) .OR. PRESENT(p2d09) .OR. PRESENT(p3d09) .OR. PRESENT(p4d09)
-      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
-         &                             k1d09, k2d09, k3d09, k4d09, p1d09, p2d09, p3d09, p4d09    )
-      llpres =  PRESENT(k1d10) .OR. PRESENT(k2d10) .OR. PRESENT(k3d10) .OR. PRESENT(k4d10)   &
-         & .OR. PRESENT(p1d10) .OR. PRESENT(p2d10) .OR. PRESENT(p3d10) .OR. PRESENT(p4d10)
-      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
-         &                             k1d10, k2d10, k3d10, k4d10, p1d10, p2d10, p3d10, p4d10    )
-
-   END SUBROUTINE wrk_alloc_xd
-
-
-   SUBROUTINE wrk_allocbase( kidim , kjdim , kkdim , kldim , kisrt , kjsrt , kksrt , klsrt ,   &
-      &                      kwrk1d, kwrk2d, kwrk3d, kwrk4d, pwrk1d, pwrk2d, pwrk3d, pwrk4d    )
-      INTEGER                              , INTENT(in   )           :: kidim, kjdim, kkdim, kldim
-      INTEGER                              , INTENT(in   )           :: kisrt, kjsrt, kksrt, klsrt
-      INTEGER , POINTER, DIMENSION(:)      , INTENT(inout), OPTIONAL :: kwrk1d  
-      INTEGER , POINTER, DIMENSION(:,:)    , INTENT(inout), OPTIONAL :: kwrk2d  
-      INTEGER , POINTER, DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL :: kwrk3d  
-      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL :: kwrk4d  
-      REAL(wp), POINTER, DIMENSION(:)      , INTENT(inout), OPTIONAL :: pwrk1d  
-      REAL(wp), POINTER, DIMENSION(:,:)    , INTENT(inout), OPTIONAL :: pwrk2d  
-      REAL(wp), POINTER, DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL :: pwrk3d  
-      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL :: pwrk4d  
-      !
-      INTEGER, DIMENSION(jpmaxdim) :: ishape, isrt, iend
-      INTEGER :: itype
-      INTEGER :: ii
-
-      ! define the shape to be given to the work array
-      ishape(:) = (/ kidim, kjdim, kkdim, kldim /)
-      ! define the starting index of the dimension shape to be given to the work array
-      isrt  (:) = (/ kisrt, kjsrt, kksrt, klsrt /)
-      iend  (:) = ishape(:) + isrt(:) - 1
-
-      ! is it integer or real array?
-      IF( PRESENT(kwrk1d) .OR. PRESENT(kwrk2d) .OR. PRESENT(kwrk3d) .OR. PRESENT(kwrk4d) )   itype = jpinteger   
-      IF( PRESENT(pwrk1d) .OR. PRESENT(pwrk2d) .OR. PRESENT(pwrk3d) .OR. PRESENT(pwrk4d) )   itype = jpreal         
-
-      ! find the branch with the matching shape, staring index and type or get the first "free" branch 
-      ii = 1                          
-      DO WHILE(       ( ANY( tree(ii)%ishape /= ishape ) .OR. ANY( tree(ii)%istart /= isrt ) .OR. tree(ii)%itype /= itype )   &
-         &      .AND. SUM( tree(ii)%ishape ) /= 0 )
-         ii = ii + 1
-         IF (ii > jparray) STOP   ! increase the value of jparray (should not be needed as already very big!)
-      END DO
-      
-      IF( SUM( tree(ii)%ishape ) == 0 ) THEN                    ! create a new branch 
-         IF(ldebug) PRINT *, 'create new branch ', ii,ishape, isrt, itype
-         tree(ii)%itype = itype                                        ! define the type of this branch 
-         tree(ii)%ishape(:) = ishape(:)                                ! define the shape of this branch 
-         tree(ii)%istart(:) = isrt(:)                                  ! define the lower bounds of this branch 
-         ALLOCATE( tree(ii)%start )                                    ! allocate its start
-         ALLOCATE( tree(ii)%current)                                   ! allocate the current leaf (the first leaf)
-
-         tree(ii)%start%in_use = .FALSE.                               ! Never use the start as work array
-         tree(ii)%start%indic = 0
-         tree(ii)%start%prev => NULL()                                 ! nothing before the start
-         tree(ii)%start%next => tree(ii)%current                       ! first leaf link to the start
-         
-         tree(ii)%current%in_use = .FALSE.                             ! first leaf is not yet used
-         tree(ii)%current%indic = 1                                    ! first leaf
-         tree(ii)%current%prev => tree(ii)%start                       ! previous leaf is the start
-         tree(ii)%current%next => NULL()                               ! next leaf is not yet defined
-         ! allocate the array of the first leaf
-         IF( PRESENT(kwrk1d) ) ALLOCATE( tree(ii)%current%iwrk1d(isrt(1):iend(1)                                                ) )
-         IF( PRESENT(kwrk2d) ) ALLOCATE( tree(ii)%current%iwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) )
-         IF( PRESENT(kwrk3d) ) ALLOCATE( tree(ii)%current%iwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) )
-         IF( PRESENT(kwrk4d) ) ALLOCATE( tree(ii)%current%iwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) )
-         IF( PRESENT(pwrk1d) ) ALLOCATE( tree(ii)%current%zwrk1d(isrt(1):iend(1)                                                ) )
-         IF( PRESENT(pwrk2d) ) ALLOCATE( tree(ii)%current%zwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) )
-         IF( PRESENT(pwrk3d) ) ALLOCATE( tree(ii)%current%zwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) )
-         IF( PRESENT(pwrk4d) ) ALLOCATE( tree(ii)%current%zwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) )
-                  
-      ELSE IF( .NOT. ASSOCIATED(tree(ii)%current%next) ) THEN   ! all leafs used -> define a new one
-         ALLOCATE( tree(ii)%current%next )                             ! allocate the new leaf
-         tree(ii)%current%next%in_use = .FALSE.                        ! this leaf is not yet used
-         tree(ii)%current%next%indic = tree(ii)%current%indic + 1      ! number of this leaf
-         IF(ldebug) PRINT *, 'add a leaf ', ii, tree(ii)%current%indic
-         tree(ii)%current%next%prev => tree(ii)%current                ! previous leaf of the new leaf is the current leaf
-         tree(ii)%current%next%next => NULL()                          ! next leaf is not yet defined
-
-         tree(ii)%current => tree(ii)%current%next                     ! the current leaf becomes the new one 
- 
-         ! allocate the array of the new leaf
-         IF( PRESENT(kwrk1d) ) ALLOCATE( tree(ii)%current%iwrk1d(isrt(1):iend(1)                                                ) )
-         IF( PRESENT(kwrk2d) ) ALLOCATE( tree(ii)%current%iwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) )
-         IF( PRESENT(kwrk3d) ) ALLOCATE( tree(ii)%current%iwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) )
-         IF( PRESENT(kwrk4d) ) ALLOCATE( tree(ii)%current%iwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) )
-         IF( PRESENT(pwrk1d) ) ALLOCATE( tree(ii)%current%zwrk1d(isrt(1):iend(1)                                                ) )
-         IF( PRESENT(pwrk2d) ) ALLOCATE( tree(ii)%current%zwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) )
-         IF( PRESENT(pwrk3d) ) ALLOCATE( tree(ii)%current%zwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) )
-         IF( PRESENT(pwrk4d) ) ALLOCATE( tree(ii)%current%zwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) )
-         
-      ELSE 
-         tree(ii)%current => tree(ii)%current%next                     ! the current leaf becomes the next one 
-      ENDIF   
-      !       
-      ! use the array of the current leaf as a work array
-      IF( PRESENT(kwrk1d) ) kwrk1d => tree(ii)%current%iwrk1d   
-      IF( PRESENT(kwrk2d) ) kwrk2d => tree(ii)%current%iwrk2d   
-      IF( PRESENT(kwrk3d) ) kwrk3d => tree(ii)%current%iwrk3d   
-      IF( PRESENT(kwrk4d) ) kwrk4d => tree(ii)%current%iwrk4d   
-      IF( PRESENT(pwrk1d) ) pwrk1d => tree(ii)%current%zwrk1d   
-      IF( PRESENT(pwrk2d) ) pwrk2d => tree(ii)%current%zwrk2d   
-      IF( PRESENT(pwrk3d) ) pwrk3d => tree(ii)%current%zwrk3d   
-      IF( PRESENT(pwrk4d) ) pwrk4d => tree(ii)%current%zwrk4d   
-      tree(ii)%current%in_use = .TRUE.   ! this leaf is now used
-      !      
-   END SUBROUTINE wrk_allocbase
-
-
-   SUBROUTINE wrk_deallocbase( ktype, kidim, kjdim, kkdim, kldim, kisrt, kjsrt, kksrt, klsrt )
-      INTEGER, INTENT(in   )           :: ktype
-      INTEGER, INTENT(in   )           :: kidim, kjdim, kkdim, kldim
-      INTEGER, INTENT(in   ), OPTIONAL :: kisrt, kjsrt, kksrt, klsrt
-      !
-      INTEGER, DIMENSION(jpmaxdim) :: ishape, istart
-      INTEGER :: ii
-
-      ishape(:) = (/ kidim, kjdim, kkdim, kldim /)
-      IF( PRESENT(kisrt) ) THEN   ;   istart(1) =  kisrt   ;   ELSE   ;   istart(1) = 1   ;   ENDIF 
-      IF( PRESENT(kjsrt) ) THEN   ;   istart(2) =  kjsrt   ;   ELSE   ;   istart(2) = 1   ;   ENDIF 
-      IF( PRESENT(kksrt) ) THEN   ;   istart(3) =  kksrt   ;   ELSE   ;   istart(3) = 1   ;   ENDIF 
-      IF( PRESENT(klsrt) ) THEN   ;   istart(4) =  klsrt   ;   ELSE   ;   istart(4) = 1   ;   ENDIF 
-
-      ! find the branch with the matcing shape and type or get the first "free" branch 
-      ii = 1                          
-      DO WHILE( ANY( tree(ii)%ishape /= ishape ) .OR. ANY( tree(ii)%istart /= istart ) .OR. tree(ii)%itype /= ktype )
-         ii = ii + 1
-      END DO
-      !
-      tree(ii)%current%in_use = .FALSE.           ! current leaf is no more used
-      tree(ii)%current => tree(ii)%current%prev   ! move back toward previous leaf   
-      ! 
-   END SUBROUTINE wrk_deallocbase
-
-
-   SUBROUTINE wrk_stop(cmsg)
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE wrk_stop  ***
-      !! ** Purpose :   to act as local alternative to ctl_stop. 
-      !!                Avoids dependency on in_out_manager module.
-      !!----------------------------------------------------------------------
-      CHARACTER(LEN=*), INTENT(in) :: cmsg
-      !!----------------------------------------------------------------------
-      !
-!      WRITE(kumout, cform_err2)
-      WRITE(*,*) TRIM(cmsg)
-      ! ARPDBG - would like to CALL mppstop here to force a stop but that
-      ! introduces a dependency on lib_mpp. Could CALL mpi_abort() directly
-      ! but that's fairly brutal. Better to rely on CALLing routine to
-      ! deal with the error passed back from the wrk_X routine?
-      !CALL mppstop
-      !
-   END SUBROUTINE wrk_stop
-
-   !!=====================================================================
-END MODULE wrk_nemo
