Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 6772)
@@ -17,6 +17,4 @@
    
    PUBLIC crs_dom_alloc  ! Called from crsini.F90
-   PUBLIC crs_dom_alloc1  ! Called from crsini.F90
-   PUBLIC crs_dom_alloc2  ! Called from crsini.F90
    PUBLIC dom_grid_glo   
    PUBLIC dom_grid_crs 
@@ -104,6 +102,17 @@
       REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1v_crs, e2v_crs ! horizontal scale factors grid type V
       REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1f_crs, e2f_crs ! horizontal scale factors grid type F
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_crs, e3u_crs, e3v_crs, e3f_crs, e3w_crs
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_crs, e3u_max_crs, e3v_max_crs, e3f_max_crs, e3w_max_crs
+
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ht_0_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_0_crs, e3u_0_crs, e3v_0_crs, e3f_0_crs, e3w_0_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_0_crs, e3u_max_0_crs, e3v_max_0_crs, e3f_max_0_crs, e3w_max_0_crs
+
+#if defined key_vvl
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_b_crs, e3u_b_crs, e3v_b_crs, e3f_b_crs, e3w_b_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_n_crs, e3u_n_crs, e3v_n_crs, e3f_n_crs, e3w_n_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_a_crs, e3u_a_crs, e3v_a_crs, e3f_a_crs, e3w_a_crs
+
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_n_crs, e3u_max_n_crs, e3v_max_n_crs, e3f_max_n_crs, e3w_max_n_crs
+#endif
+
       
       ! Surface
@@ -116,5 +125,9 @@
       REAL(wp), DIMENSION(:,:),   ALLOCATABLE,SAVE :: ff_crs
       INTEGER,  DIMENSION(:,:),   ALLOCATABLE,SAVE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs
+
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_0_crs, gdepu_0_crs, gdepv_0_crs, gdepw_0_crs
+#if defined key_vvl
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_n_crs, gdepu_n_crs, gdepv_n_crs, gdepw_n_crs
+#endif
 
       ! Weights
@@ -146,6 +159,9 @@
       REAL(wp)     ::  rfactxy 
 
+      INTEGER, DIMENSION(:)    , ALLOCATABLE      :: nfactx,nfacty
+
+
       ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsb_crs,tsn_crs,rab_crs_n
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsb_crs,tsn_crs,tsa_crs,rab_crs_n
       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs, rke_crs
       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: ub_crs, vb_crs
@@ -161,5 +177,7 @@
       REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: fmmflx_crs
       REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs, taum_crs
-      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs,rnf_b_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: trc_i_crs,trc_o_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: sbc_trc_crs, sbc_trc_b_crs
 
       REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE ::   uslp_crs, wslpi_crs          !: i_slope at U- and W-points
@@ -195,5 +213,5 @@
 CONTAINS
    
-   INTEGER FUNCTION crs_dom_alloc1()
+   INTEGER FUNCTION crs_dom_alloc()
       !!-------------------------------------------------------------------
       !!                     *** FUNCTION crs_dom_alloc ***
@@ -210,6 +228,13 @@
        &       mi0_crs (jpiglo_crs), mi1_crs (jpiglo_crs),  &
        &       mj0_crs (jpjglo_crs), mj1_crs (jpjglo_crs),  &
-       &       mig_crs (jpi_crs)   , mjg_crs (jpj_crs)   ,  STAT=ierr(1) ) 
-
+       &       mig_crs (jpi_crs)   , mjg_crs (jpj_crs)   ,  & 
+       &       mis_crs (jpi_crs)   , mie_crs (jpi_crs)   ,  &
+       &       mjs_crs (jpj_crs)   , mje_crs (jpj_crs)   ,  &
+       &       nfactx  (jpi_crs)   , nfacty  (jpj_crs)   ,  &
+       &       nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij) , &
+       &       nimppt_full(jpnij), nlcit_full(jpnij), nldit_full(jpnij), nleit_full(jpnij), &
+       &       njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij) , &
+       &       njmppt_full(jpnij), nlcjt_full(jpnij), nldjt_full(jpnij), nlejt_full(jpnij), &
+       &       nfiimpp_full(jpni,jpnj) , nfiimpp_crs(jpni,jpnj) , STAT=ierr(1) ) 
 
       ! Set up Mask and Mesh
@@ -232,12 +257,26 @@
          &      e1e2t_crs(jpi_crs,jpj_crs), STAT=ierr(5))
 
-      ALLOCATE( e3t_crs(jpi_crs,jpj_crs,jpk)    , e3w_crs(jpi_crs,jpj_crs,jpk)    , & 
-         &      e3u_crs(jpi_crs,jpj_crs,jpk)    , e3v_crs(jpi_crs,jpj_crs,jpk)    , &
-         &      e3f_crs(jpi_crs,jpj_crs,jpk)    , e1e2w_msk(jpi_crs,jpj_crs,jpk)  , & 
+      ALLOCATE( e3t_0_crs(jpi_crs,jpj_crs,jpk)    , e3w_0_crs(jpi_crs,jpj_crs,jpk)    , &
+         &      e3u_0_crs(jpi_crs,jpj_crs,jpk)    , e3v_0_crs(jpi_crs,jpj_crs,jpk)    , &
+         &           ht_0_crs(jpi_crs,jpj_crs),                                     &
+#if defined key_vvl
+         &      e3t_b_crs(jpi_crs,jpj_crs,jpk)    , e3w_b_crs(jpi_crs,jpj_crs,jpk)    , &
+         &      e3u_b_crs(jpi_crs,jpj_crs,jpk)    , e3v_b_crs(jpi_crs,jpj_crs,jpk)    , &
+         &      e3t_n_crs(jpi_crs,jpj_crs,jpk)    , e3w_n_crs(jpi_crs,jpj_crs,jpk)    , &
+         &      e3u_n_crs(jpi_crs,jpj_crs,jpk)    , e3v_n_crs(jpi_crs,jpj_crs,jpk)    , &
+         &      e3t_a_crs(jpi_crs,jpj_crs,jpk)    , e3w_a_crs(jpi_crs,jpj_crs,jpk)    , &
+         &      e3u_a_crs(jpi_crs,jpj_crs,jpk)    , e3v_a_crs(jpi_crs,jpj_crs,jpk)    , &
+#endif
+         &      e1e2w_msk(jpi_crs,jpj_crs,jpk)  , &
          &      e2e3u_msk(jpi_crs,jpj_crs,jpk)  , e1e3v_msk(jpi_crs,jpj_crs,jpk)  , &
          &      e1e2w_crs(jpi_crs,jpj_crs,jpk)  , e2e3u_crs(jpi_crs,jpj_crs,jpk)  , &
-         &      e1e3v_crs(jpi_crs,jpj_crs,jpk)  , e3t_max_crs(jpi_crs,jpj_crs,jpk), &
-         &      e3w_max_crs(jpi_crs,jpj_crs,jpk), e3u_max_crs(jpi_crs,jpj_crs,jpk), &
-         &      e3v_max_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(6))
+         &      e1e3v_crs(jpi_crs,jpj_crs,jpk)  , &
+         &      e3t_max_0_crs(jpi_crs,jpj_crs,jpk), e3w_max_0_crs(jpi_crs,jpj_crs,jpk) , &
+         &      e3u_max_0_crs(jpi_crs,jpj_crs,jpk), e3v_max_0_crs(jpi_crs,jpj_crs,jpk) , &
+#if defined key_vvl
+         &      e3t_max_n_crs(jpi_crs,jpj_crs,jpk), e3w_max_n_crs(jpi_crs,jpj_crs,jpk) , &
+         &      e3u_max_n_crs(jpi_crs,jpj_crs,jpk), e3v_max_n_crs(jpi_crs,jpj_crs,jpk) , &
+#endif
+         &      STAT=ierr(6))
 
 
@@ -255,6 +294,11 @@
          &      mbku_crs(jpi_crs,jpj_crs)  , mbkv_crs(jpi_crs,jpj_crs) , STAT=ierr(9))
 
-      ALLOCATE( gdept_crs(jpi_crs,jpj_crs,jpk), gdepu_crs(jpi_crs,jpj_crs,jpk) , &
-         &      gdepv_crs(jpi_crs,jpj_crs,jpk), gdepw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(10) )
+      ALLOCATE( gdept_0_crs(jpi_crs,jpj_crs,jpk), gdepu_0_crs(jpi_crs,jpj_crs,jpk) , &
+         &      gdepv_0_crs(jpi_crs,jpj_crs,jpk), gdepw_0_crs(jpi_crs,jpj_crs,jpk) , &
+#if defined key_vvl
+         &      gdept_n_crs(jpi_crs,jpj_crs,jpk), gdepu_n_crs(jpi_crs,jpj_crs,jpk) , &
+         &      gdepv_n_crs(jpi_crs,jpj_crs,jpk), gdepw_n_crs(jpi_crs,jpj_crs,jpk) , &
+#endif
+         & STAT=ierr(10))
 
 
@@ -270,7 +314,10 @@
 
      ALLOCATE( sshb_crs(jpi_crs,jpj_crs), sshn_crs(jpi_crs,jpj_crs),  ssha_crs(jpi_crs,jpj_crs), &
+         &     qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , &
+         &     vtau_crs(jpi_crs,jpj_crs), taum_crs(jpi_crs,jpj_crs),  &
+         &     rnf_crs (jpi_crs,jpj_crs), rnf_b_crs(jpi_crs ,jpj_crs), &
          &     emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), &
-         &     qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , &
-         &     vtau_crs(jpi_crs,jpj_crs), taum_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs ,jpj_crs), &
+         &     sbc_trc_crs (jpi_crs,jpj_crs,jpts), sbc_trc_b_crs(jpi_crs,jpj_crs,jpts), &
+         &     trc_i_crs (jpi_crs,jpj_crs,jpts), trc_o_crs(jpi_crs,jpj_crs,jpts), &
          &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), fmmflx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  )
 
@@ -285,5 +332,5 @@
 #endif
 
-     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsb_crs(jpi_crs,jpj_crs,jpk,jpts),  &
+     ALLOCATE( tsb_crs(jpi_crs,jpj_crs,jpk,jpts), tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsa_crs(jpi_crs,jpj_crs,jpk,jpts),  &
                en_crs(jpi_crs,jpj_crs,jpk),   avt_crs(jpi_crs,jpj_crs,jpk),    &
 # if defined key_zdfddm
@@ -295,46 +342,7 @@
          &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(15) )
 
-      crs_dom_alloc1 = MAXVAL(ierr)
-
-   END FUNCTION crs_dom_alloc1
-
-   INTEGER FUNCTION crs_dom_alloc()
-      !!-------------------------------------------------------------------
-      !!                     *** FUNCTION crs_dom_alloc ***
-      !!  ** Purpose :   Allocate public crs arrays  
-      !!-------------------------------------------------------------------
-      !! Local variables
-      INTEGER, DIMENSION(2) :: ierr
-
-      ierr(:) = 0
-         
-      ALLOCATE( nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij), &
-       &  nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   &
-                njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij), &
-       &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(1) )
-
-      ALLOCATE( nfiimpp_full(jpni,jpnj) , nfiimpp_crs(jpni,jpnj) ,STAT=ierr(2) )
-
       crs_dom_alloc = MAXVAL(ierr)
 
    END FUNCTION crs_dom_alloc
-   
-   INTEGER FUNCTION crs_dom_alloc2()
-      !!-------------------------------------------------------------------
-      !!                     *** FUNCTION crs_dom_alloc ***
-      !!  ** Purpose :   Allocate public crs arrays  
-      !!-------------------------------------------------------------------
-      !! Local variables
-      INTEGER, DIMENSION(1) :: ierr
-
-      ierr(:) = 0
-      
-      !cbr ALLOCATE( mjs_crs(nlej_crs) , mje_crs(nlej_crs), mis_crs(nlei_crs) , mie_crs(nlei_crs), STAT=ierr(1) )
-      !cbr pk on alloue ac nlej_crs ??????
-      !cbrALLOCATE( mjs_crs(nlcj_crs) , mje_crs(nlcj_crs), mis_crs(nlci_crs) , mie_crs(nlci_crs), STAT=ierr(1) )
-      ALLOCATE( mjs_crs(jpj_crs) , mje_crs(jpj_crs), mis_crs(jpi_crs) , mie_crs(jpi_crs), STAT=ierr(1) )
-      crs_dom_alloc2 = MAXVAL(ierr)
-
-      END FUNCTION crs_dom_alloc2
 
    SUBROUTINE dom_grid_glo
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90	(revision 6772)
@@ -38,5 +38,5 @@
    USE crslbclnk
    USE lib_mpp
-!cbr   USE ieee_arithmetic   
+   USE ieee_arithmetic   
 
    IMPLICIT NONE
@@ -61,129 +61,55 @@
 
    SUBROUTINE crs_dom_msk
+   !!===================================================================
+   !
+   !
+   !
+   !!===================================================================
+   INTEGER  ::  ji, jj, jk                   ! dummy loop indices
+   INTEGER  ::  ijis,ijie,ijjs,ijje
+   REAL(wp) ::  zmask
+   !!-------------------------------------------------------------------
       
-      INTEGER  ::  ji, jj, jk                   ! dummy loop indices
-      INTEGER  ::  ijie,ijis,ijje,ijjs,ij,je_2
-      INTEGER  ::  iji, ijj
-      REAL(wp) ::  zmask
-      INTEGER  :: ir,jr
-      
-      ! Initialize
-      tmask_crs(:,:,:) = 0.0
-      vmask_crs(:,:,:) = 0.0
-      umask_crs(:,:,:) = 0.0
-      fmask_crs(:,:,:) = 0.0
-      !
-      DO jk = 1, jpkm1
-         DO ji = 2, nlei_crs
-            ijie = mie_crs(ji)
-            ijis = mis_crs(ji)
-
-            IF( nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2) )THEN     !!cc bande du sud style ORCA2
-
-               IF( mje_crs(2) - mjs_crs(2) == 1 )THEN
-
-                  jj = mje_crs(2)
-
-                  zmask = 0.0
-                  zmask = SUM( tmask(ijis:ijie,jj,jk) )
-                  IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0
-
-                  zmask = 0.0
-                  zmask = SUM( vmask(ijis:ijie,jj     ,jk) )
-                  IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0
-
-                  zmask = 0.0
-                  zmask = umask(ijie     ,jj,jk)
-                  IF( zmask > 0.0 )umask_crs(ji,2,jk) = 1.0
-
-                  fmask_crs(ji,jj,jk) = fmask(ijie,2,jk)
-               ENDIF
-            ELSE
-
-               jj   = mje_crs(2)
-               ij   = mjs_crs(2)
-
-               zmask = 0.0
-               zmask = SUM( tmask(ijis:ijie,ij:jj,jk) )
-               IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0
-
-               zmask = 0.0
-               zmask = SUM( vmask(ijis:ijie,jj     ,jk) )
-               IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0
-
-               zmask = 0.0
-               zmask = SUM(umask(ijie,ij:jj,jk))
-               IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0
-
-               fmask_crs(ji,jj,jk) = fmask(ijie,2,jk)
-
-            ENDIF
- 
-            DO jj = 3, nlej_crs
-               ijje = mje_crs(jj)
-               ijjs = mjs_crs(jj)
-
-               !iji=117 ; ijj=211
-               !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1
-               !IF( ji ==iji .AND. jj==ijj .AND. jk==74 )THEN
-               !write(narea+5000,*)"mask ",ji,jj
-               !write(narea+5000,*)"mask ",ijie,ijis,ijjs,ijje
-               !ENDIF
-
-               ir=303-nimpp_crs+1 ; jr=302-njmpp_crs+1
-               IF( ji==ir .AND. jj==jr )THEN
-                   WRITE(narea+2000,*)"mask",ir,jr,ijis+nimpp-1,ijjs+njmpp-1
-               ENDIF
-
-               !IF( ijje .GT. jpj )WRITE(narea+200,*)"BUG",jj,ijjs,ijje,SHAPE(tmask) ; call flush(narea+200)
-               zmask = 0.0
-               zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) )
-               IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0
-
-               zmask = 0.0
-               zmask = SUM( vmask(ijis:ijie,ijje     ,jk) )
-               IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0
-
-               zmask = 0.0
-               zmask = SUM( umask(ijie     ,ijjs:ijje,jk) )
-               IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0
-
-               fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk)
-
-            ENDDO
+   ! Initialize
+   tmask_crs(:,:,:) = 0.0
+   vmask_crs(:,:,:) = 0.0
+   umask_crs(:,:,:) = 0.0
+   fmask_crs(:,:,:) = 0.0
+   !
+   DO jk = 1, jpkm1
+      DO ji = nldi_crs, nlei_crs
+
+         ijis = mis_crs(ji)
+         ijie = mie_crs(ji)
+
+         DO jj = nldj_crs, nlej_crs
+
+            ijjs = mjs_crs(jj)
+            ijje = mje_crs(jj)
+
+            zmask = 0.0
+            zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) )
+            IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0
+
+            zmask = 0.0
+            zmask = SUM( vmask(ijis:ijie,ijje     ,jk) )
+            IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0
+
+            zmask = 0.0
+            zmask = SUM( umask(ijie     ,ijjs:ijje,jk) )
+            IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0
+
+            fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk)
+
+
          ENDDO
       ENDDO
-      CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 )
-      !cbr
-      !DO ji=1,jpi_crs-1
-      !DO jj=1,jpj_crs-1
-      !DO jk=1,jpk
-      !   umask_crs(ji,jj,jk) = tmask_crs(ji  ,jj  ,jk) * tmask_crs(ji+1,jj  ,jk)
-      !   vmask_crs(ji,jj,jk) = tmask_crs(ji  ,jj  ,jk) * tmask_crs(ji  ,jj+1,jk)
-      !   fmask_crs(ji,jj,jk) = tmask_crs(ji  ,jj  ,jk) * tmask_crs(ji  ,jj+1,jk) *  tmask_crs(ji+1,jj  ,jk) *   tmask_crs(ji+1,jj+1,jk) 
-      !ENDDO
-      !ENDDO
-      !ENDDO
-      !
-      CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 )
-      CALL crs_lbc_lnk( umask_crs, 'U', 1.0 )
-      CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 )
-      !
-      !cbr
-      !DO ji=2,jpi_crs-1
-      !DO jj=2,jpj_crs-1
-      !DO jk=1,jpk
-      !   IF( tmask(ji-1,jj  ,jk)==1. .AND. tmask(ji  ,jj  ,jk)==1. .AND. umask(ji-1,jj  ,jk)==0. )WRITE(narea+5000,*)"MASK1",ji,jj,jk
-      !   IF( tmask(ji  ,jj  ,jk)==1. .AND. tmask(ji+1,jj  ,jk)==1. .AND. umask(ji  ,jj  ,jk)==0. )WRITE(narea+5000,*)"MASK2",ji,jj,jk
-      !   IF( tmask(ji  ,jj-1,jk)==1. .AND. tmask(ji  ,jj  ,jk)==1. .AND. vmask(ji  ,jj-1,jk)==0. )WRITE(narea+5000,*)"MASK3",ji,jj,jk
-      !   IF( tmask(ji  ,jj  ,jk)==1. .AND. tmask(ji  ,jj+1,jk)==1. .AND. vmask(ji  ,jj  ,jk)==0. )WRITE(narea+5000,*)"MASK4",ji,jj,jk
-      !   IF( umask(ji-1,jj  ,jk)==1. .AND. ( tmask(ji-1,jj  ,jk)==0. .OR. tmask(ji  ,jj  ,jk)==0. ) )WRITE(narea+5000,*)"MASK5",ji,jj,jk
-      !   IF( umask(ji  ,jj  ,jk)==1. .AND. ( tmask(ji  ,jj  ,jk)==0. .OR. tmask(ji+1,jj  ,jk)==0. ) )WRITE(narea+5000,*)"MASK6",ji,jj,jk
-      !   IF( vmask(ji  ,jj-1,jk)==1. .AND. ( tmask(ji  ,jj-1,jk)==0. .OR. tmask(ji  ,jj  ,jk)==0. ) )WRITE(narea+5000,*)"MASK7",ji,jj,jk
-      !   IF( vmask(ji  ,jj  ,jk)==1. .AND. ( tmask(ji  ,jj  ,jk)==0. .OR. tmask(ji  ,jj+1,jk)==0. ) )WRITE(narea+5000,*)"MASK8",ji,jj,jk
-      !ENDDO
-      !ENDDO
-      !ENDDO
-      !
+   ENDDO
+
+   CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 )
+   CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 )
+   CALL crs_lbc_lnk( umask_crs, 'U', 1.0 )
+   CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 )
+   !
    END SUBROUTINE crs_dom_msk
 
@@ -219,6 +145,9 @@
       !! Local variables
       INTEGER :: ji, jj, jk                   ! dummy loop indices
-      INTEGER :: ijis, ijjs
+      INTEGER :: iji, ijj
       INTEGER  :: ir,jr
+      !!----------------------------------------------------------------
+      p_gphi_crs(:,:)=0._wp
+      p_glam_crs(:,:)=0._wp
 
   
@@ -226,41 +155,37 @@
          CASE ( 'T' )
             DO jj =  nldj_crs, nlej_crs
-               ijjs = mjs_crs(jj) + mybinctr
-               DO ji = 2, nlei_crs
-                  ijis = mis_crs(ji) + mxbinctr 
-                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
-                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
-                  ir=303-nimpp_crs+1 ; jr=302-njmpp_crs+1
-                  WRITE(narea+2000,*)"coordT1",ir,jr
-                  IF( ji==ir .AND. jj==jr )THEN
-                     WRITE(narea+2000,*)"coordT",ir,jr,ijis+nimpp-1,ijjs+njmpp-1
-                  ENDIF
+               ijj = mjs_crs(jj) + 1
+               DO ji = nldi_crs, nlei_crs
+                  iji = mis_crs(ji) + 1
+                  p_gphi_crs(ji,jj) = p_gphi(iji,ijj)
+                  p_glam_crs(ji,jj) = p_glam(iji,ijj)
                ENDDO
             ENDDO
          CASE ( 'U' )
             DO jj =  nldj_crs, nlej_crs
-               ijjs = mjs_crs(jj) + mybinctr                  
-               DO ji = 2, nlei_crs
-                  ijis = mis_crs(ji)
-                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
-                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ijj = mjs_crs(jj) + 1
+               DO ji = nldi_crs, nlei_crs
+                  iji = mie_crs(ji)
+                  p_gphi_crs(ji,jj) = p_gphi(iji,ijj)
+                  p_glam_crs(ji,jj) = p_glam(iji,ijj)
+ 
                ENDDO
             ENDDO
          CASE ( 'V' )
             DO jj =  nldj_crs, nlej_crs
-               ijjs = mjs_crs(jj)
-               DO ji = 2, nlei_crs
-                  ijis = mis_crs(ji) + mxbinctr 
-                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
-                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ijj = mje_crs(jj)
+               DO ji = nldi_crs, nlei_crs
+                  iji = mis_crs(ji) + 1
+                  p_gphi_crs(ji,jj) = p_gphi(iji,ijj)
+                  p_glam_crs(ji,jj) = p_glam(iji,ijj)
                ENDDO
             ENDDO
          CASE ( 'F' )
             DO jj =  nldj_crs, nlej_crs
-               ijjs = mjs_crs(jj)
-               DO ji = 2, nlei_crs
-                  ijis = mis_crs(ji)
-                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
-                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ijj = mje_crs(jj)
+               DO ji = nldi_crs, nlei_crs
+                  iji = mie_crs(ji)
+                  p_gphi_crs(ji,jj) = p_gphi(iji,ijj)
+                  p_glam_crs(ji,jj) = p_glam(iji,ijj)
                ENDDO
             ENDDO
@@ -271,19 +196,19 @@
       CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0 )
          
-      ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd
-      SELECT CASE ( cd_type )
-         CASE ( 'T', 'V' )
-            DO ji = 2, nlei_crs
-               ijis = mis_crs(ji) + mxbinctr 
-               p_gphi_crs(ji,1) = p_gphi(ijis,1)
-               p_glam_crs(ji,1) = p_glam(ijis,1)
-            ENDDO
-         CASE ( 'U', 'F' )
-            DO ji = 2, nlei_crs
-               ijis = mis_crs(ji) 
-               p_gphi_crs(ji,1) = p_gphi(ijis,1)
-               p_glam_crs(ji,1) = p_glam(ijis,1)
-            ENDDO
-      END SELECT
+!cbr???      ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd
+!      SELECT CASE ( cd_type )
+!         CASE ( 'T', 'V' )
+!            DO ji = 2, nlei_crs
+!               ijis = mis_crs(ji) + mxbinctr 
+!               p_gphi_crs(ji,1) = p_gphi(ijis,1)
+!               p_glam_crs(ji,1) = p_glam(ijis,1)
+!            ENDDO
+!         CASE ( 'U', 'F' )
+!            DO ji = 2, nlei_crs
+!               ijis = mis_crs(ji) 
+!               p_gphi_crs(ji,1) = p_gphi(ijis,1)
+!               p_glam_crs(ji,1) = p_glam(ijis,1)
+!            ENDDO
+!      END SELECT
       !
    END SUBROUTINE crs_dom_coordinates
@@ -317,47 +242,50 @@
       !! Local variables
       INTEGER :: ji, jj, jk     ! dummy loop indices
-      INTEGER :: ijie,ijje,ijrs
+      INTEGER :: ijis,ijie,ijjs,ijje
+      INTEGER :: ji1, jj1
   
       !!----------------------------------------------------------------  
       ! Initialize      
 
-      DO jk = 1, jpk    
-         DO ji = 2, nlei_crs
+         DO ji = nldi_crs, nlei_crs
+
+            ijis = mis_crs(ji)
             ijie = mie_crs(ji)
+
             DO jj = nldj_crs, nlej_crs
-               ijje = mje_crs(jj)   ;   ijrs =  mje_crs(jj) - mjs_crs(jj)
+
+               ijjs = mjs_crs(jj)
+               ijje = mje_crs(jj)
+
                ! Only for a factro 3 coarsening
                SELECT CASE ( cd_type )
                    CASE ( 'T' )
-                      IF( ijrs == 0 .OR. ijrs == 1 ) THEN
-                        ! Si à la frontière sud on a pas assez de maille de la grille mère
-                         p_e1_crs(ji,jj) = p_e1(ijie-1,ijje) * nn_factx
-                         p_e2_crs(ji,jj) = p_e2(ijie-1,ijje) * nn_facty
-                      ELSE
-                         p_e1_crs(ji,jj) = p_e1(ijie-1,ijje-1) * nn_factx
-                         p_e2_crs(ji,jj) = p_e2(ijie-1,ijje-1) * nn_facty
-                      ENDIF
+                      !p_e1_crs(ji,jj) = SUM( p_e1(ijis:ijie     ,ijjs+1       ) )
+                      !p_e2_crs(ji,jj) = SUM( p_e2(ijis+1        ,ijjs:ijje    ) )
+                      p_e1_crs(ji,jj) = REAL(nn_factx,wp)*p_e1(ijis+1,ijjs+1)
+                      p_e2_crs(ji,jj) = REAL(nn_facty,wp)*p_e2(ijis+1,ijjs+1)
                    CASE ( 'U' )
-                      IF( ijrs == 0 .OR. ijrs == 1 ) THEN
-                         ! Si à la frontière sud on a pas assez de maille de la grille mère
-                         p_e1_crs(ji,jj) = p_e1(ijie,ijje) * nn_factx                            
-                         p_e2_crs(ji,jj) = p_e2(ijie,ijje) * nn_facty
-                      ELSE
-                         p_e1_crs(ji,jj) = p_e1(ijie,ijje-1) * nn_factx
-                         p_e2_crs(ji,jj) = p_e2(ijie,ijje-1) * nn_facty
-                      ENDIF
+                      !p_e1_crs(ji,jj) = SUM( p_e1(ijis+1:ijie+1 ,ijjs+1       ) )
+                      !p_e2_crs(ji,jj) = SUM( p_e2(ijie          ,ijjs:ijje    ) )
+                      p_e1_crs(ji,jj) = REAL(nn_factx,wp)*p_e1(ijis+1,ijjs+1       ) 
+                      p_e2_crs(ji,jj) = REAL(nn_facty,wp)*p_e2(ijie  ,ijjs+1       ) 
+
                    CASE ( 'V' )
-                         p_e1_crs(ji,jj) = p_e1(ijie-1,ijje) * nn_factx                            
-                         p_e2_crs(ji,jj) = p_e2(ijie-1,ijje) * nn_facty
+                      !p_e1_crs(ji,jj) = SUM( p_e1(ijis:ijie     ,ijje         ) )
+                      !p_e2_crs(ji,jj) = SUM( p_e2(ijis+1        ,ijjs+1:ijje+1) )
+                      p_e1_crs(ji,jj) = REAL(nn_factx,wp)*p_e1(ijis+1,ijje       ) 
+                      p_e2_crs(ji,jj) = REAL(nn_facty,wp)*p_e2(ijis+1,ijjs+1     ) 
                    CASE ( 'F' )
-                         p_e1_crs(ji,jj) = p_e1(ijie,ijje) * nn_factx                            
-                         p_e2_crs(ji,jj) = p_e2(ijie,ijje) * nn_facty
+                      !p_e1_crs(ji,jj) = SUM( p_e1(ijis+1:ijie+1 ,ijje         ) )
+                      !p_e2_crs(ji,jj) = SUM( p_e2(ijie          ,ijjs+1:ijje+1) )
+                      p_e1_crs(ji,jj) = REAL(nn_factx,wp)*p_e1(ijis+1,ijje       ) 
+                      p_e2_crs(ji,jj) = REAL(nn_facty,wp)*p_e2(ijie  ,ijjs+1     ) 
                END SELECT
             ENDDO
          ENDDO
-      ENDDO
-
-      CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0, pval=1.0 )
-      CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0, pval=1.0 )
+
+
+      CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0 ) !cbr , pval=1.0 )
+      CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0 ) !cbr , pval=1.0 )
 
    END SUBROUTINE crs_dom_hgr
@@ -416,5 +344,6 @@
       !! Local variables
       REAL(wp)                                :: zdAm
-      INTEGER                                 :: ji, jj, jk , ii, ij, je_2
+      INTEGER                                 :: ji, jj, jk
+      INTEGER :: ijis,ijie,ijjs,ijje
 
       REAL(wp), DIMENSION(:,:,:), POINTER     :: zvol, zmask      
@@ -427,81 +356,22 @@
 
       DO jk = 1, jpk
-         zvol(:,:,jk) =  p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk) 
+         zvol (:,:,jk) = p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk) 
+         zmask(:,:,jk) = p_mask(:,:,jk) 
       ENDDO
 
-      zmask(:,:,:) = 0.0
-      !IF( cd_type == 'W' ) THEN
-      !   zmask(:,:,1) = p_mask(:,:,1) 
-      !   DO jk = 2, jpk
-      !      zmask(:,:,jk) = p_mask(:,:,jk-1) 
-      !   ENDDO
-      !ELSE
-         DO jk = 1, jpk
-             zmask(:,:,jk) = p_mask(:,:,jk) 
-         ENDDO
-      !ENDIF
-
-      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-            je_2 = mje_crs(2)
-            DO jk = 1, jpk           
-               DO ji = nistr, niend, nn_factx
-                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                  p_fld1_crs(ii,2,jk) =  zvol(ji,je_2  ,jk) + zvol(ji+1,je_2  ,jk) + zvol(ji+2,je_2  ,jk)  &
-                     &                 + zvol(ji,je_2-1,jk) + zvol(ji+1,je_2-1,jk) + zvol(ji+2,je_2-1,jk) 
-                  !
-                  zdAm =  zvol(ji  ,je_2,jk) * zmask(ji  ,je_2,jk)  &
-                    &   + zvol(ji+1,je_2,jk) * zmask(ji+1,je_2,jk)  &
-                    &   + zvol(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) 
-                  ! 
-                  p_fld2_crs(ii,2,jk) = zdAm / p_fld1_crs(ii,2,jk) 
-               ENDDO
-            ENDDO
-         ENDIF
-      ELSE
-         je_2 = mjs_crs(2)
-         DO jk = 1, jpk           
-            DO ji = nistr, niend, nn_factx
-               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
-               p_fld1_crs(ii,2,jk) =  zvol(ji,je_2  ,jk) + zvol(ji+1,je_2  ,jk) + zvol(ji+2,je_2  ,jk)  &
-                   &                + zvol(ji,je_2+1,jk) + zvol(ji+1,je_2+1,jk) + zvol(ji+2,je_2+1,jk)  &
-                   &                + zvol(ji,je_2+2,jk) + zvol(ji+1,je_2+2,jk) + zvol(ji+2,je_2+2,jk)  
-              !
-               zdAm = zvol(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk)  &
-                 &  + zvol(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk)  &
-                 &  + zvol(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk)  &
-                 &  + zvol(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk)  &
-                 &  + zvol(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk)  &
-                 &  + zvol(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk)  &
-                 &  + zvol(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk)  &
-                 &  + zvol(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk)  &
-                 &  + zvol(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk)
-                 ! 
-                 p_fld2_crs(ii,2,jk) = zdAm / p_fld1_crs(ii,2,jk) 
-            ENDDO
-         ENDDO
-      ENDIF
-
-      DO jk = 1, jpk           
-         DO jj  = njstr, njend, nn_facty
-            DO ji = nistr, niend, nn_factx
-               ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-               ij  = ( jj - njstr ) * rfacty_r + 3
-               !
-               p_fld1_crs(ii,ij,jk) =  zvol(ji,jj  ,jk) + zvol(ji+1,jj  ,jk) + zvol(ji+2,jj  ,jk)  &
-                   &                 + zvol(ji,jj+1,jk) + zvol(ji+1,jj+1,jk) + zvol(ji+2,jj+1,jk)  &
-                   &                 + zvol(ji,jj+2,jk) + zvol(ji+1,jj+2,jk) + zvol(ji+2,jj+2,jk) 
-               !
-               zdAm =  zvol(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk)  &
-                 &   + zvol(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk)  &
-                 &   + zvol(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk)  &
-                 &   + zvol(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk)  &
-                 &   + zvol(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk)  &
-                 &   + zvol(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk)  &
-                 &   + zvol(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk)  &
-                 &   + zvol(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk)  &
-                 &   + zvol(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk)
-                 ! 
-                p_fld2_crs(ii,ij,jk) = zdAm / p_fld1_crs(ii,ij,jk) 
+      DO jk = 1, jpk
+         DO ji = nldi_crs, nlei_crs
+
+            ijis = mis_crs(ji)
+            ijie = mie_crs(ji)
+
+            DO jj = nldj_crs, nlej_crs
+
+               ijjs = mjs_crs(jj)
+               ijje = mje_crs(jj)
+
+               p_fld1_crs(ji,jj,jk) =  SUM( zvol(ijis:ijie,ijjs:ijje,jk) )
+               zdAm                 =  SUM( zvol(ijis:ijie,ijjs:ijje,jk) * zmask(ijis:ijie,ijjs:ijje,jk) )
+               p_fld2_crs(ji,jj,jk) = zdAm / p_fld1_crs(ji,jj,jk) 
             ENDDO
          ENDDO
@@ -551,13 +421,11 @@
       REAL(wp),                                 INTENT(in)           :: psgn    ! sign 
 
-
       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity 
 
       !! Local variables
       INTEGER  :: ji, jj, jk 
-      INTEGER  :: ii, ij, ijie, ijje, je_2
+      INTEGER  :: ijis, ijie, ijjs, ijje
       REAL(wp) :: zflcrs, zsfcrs   
       REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask,ztabtmp
-      INTEGER  :: iji, ijj
       INTEGER  :: ir,jr
       REAL(wp), DIMENSION(nn_factx,nn_facty):: ztmp
@@ -579,251 +447,96 @@
             
                CASE( 'T', 'W' )
-                  !IF( cd_type == 'T' ) THEN
-                     DO jk = 1, jpk
-                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk) 
-                        zsurfmsk(:,:,jk) =  zsurf(:,:,jk) 
-                    ENDDO
-                  !ELSE
-                  !  !cbr ????????????????????????????????
-                  !   zsurf   (:,:,1) =  p_e12(:,:) * p_e3(:,:,1)
-                  !   zsurfmsk(:,:,1) =  zsurf(:,:,1) *  p_mask(:,:,1) 
-                  !   DO jk = 2, jpk
-                  !      zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk)
-                  !      zsurfmsk(:,:,jk) =  zsurf(:,:,jk) * p_mask(:,:,jk-1) 
-                  !   ENDDO
-                  !ENDIF
-         
-                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-                        je_2 = mje_crs(2)
-                        DO jk = 1, jpk           
-                           DO ji = nistr, niend, nn_factx
-                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2       
-                              zflcrs =  p_fld(ji  ,je_2,jk) * zsurfmsk(ji  ,je_2,jk)   &
-                                &     + p_fld(ji+1,je_2,jk) * zsurfmsk(ji+1,je_2,jk)   &
-                                &     + p_fld(ji+2,je_2,jk) * zsurfmsk(ji+2,je_2,jk) 
- 
-                              zsfcrs =  zsurf(ji,je_2,jk) + zsurf(ji+1,je_2,jk) + zsurf(ji+2,je_2,jk) 
-                              !
-                              p_fld_crs(ii,2,jk) = zflcrs
-                              IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
-                           ENDDO
-                        ENDDO
-                     ENDIF
-                  ELSE
-                     je_2 = mjs_crs(2)
-                     DO jk = 1, jpk           
-                        DO ji = nistr, niend, nn_factx
-                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
-                           zflcrs =  p_fld(ji  ,je_2  ,jk) * zsurfmsk(ji  ,je_2  ,jk) &
-                             &     + p_fld(ji+1,je_2  ,jk) * zsurfmsk(ji+1,je_2  ,jk) &
-                             &     + p_fld(ji+2,je_2  ,jk) * zsurfmsk(ji+2,je_2  ,jk) &
-                             &     + p_fld(ji  ,je_2+1,jk) * zsurfmsk(ji  ,je_2+1,jk) &
-                             &     + p_fld(ji+1,je_2+1,jk) * zsurfmsk(ji+1,je_2+1,jk) &
-                             &     + p_fld(ji+2,je_2+1,jk) * zsurfmsk(ji+2,je_2+1,jk) &
-                             &     + p_fld(ji  ,je_2+2,jk) * zsurfmsk(ji  ,je_2+2,jk) &
-                             &     + p_fld(ji+1,je_2+2,jk) * zsurfmsk(ji+1,je_2+2,jk) &
-                             &     + p_fld(ji+2,je_2+2,jk) * zsurfmsk(ji+2,je_2+2,jk) 
-
-                           zsfcrs =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) &
-                             &     + zsurf(ji,je_2+1,jk) + zsurf(ji+1,je_2+1,jk) + zsurf(ji+2,je_2+1,jk) &
-                             &     + zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk) 
-                            !
-                            p_fld_crs(ii,2,jk) = zflcrs
-                            IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
-                        ENDDO
-                     ENDDO
-                  ENDIF
+                  DO jk = 1, jpk
+                     zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk) 
+                     zsurfmsk(:,:,jk) =  zsurf(:,:,jk) 
+                  ENDDO
                   !
-                  DO jk = 1, jpk           
-                     DO jj  = njstr, njend, nn_facty
-                        DO ji = nistr, niend, nn_factx
-                           ii = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                           ij = ( jj - njstr ) * rfacty_r + 3
-                           zflcrs =  p_fld(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk) &
-                             &     + p_fld(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk) &
-                             &     + p_fld(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk) &
-                             &     + p_fld(ji  ,jj+1,jk) * zsurfmsk(ji  ,jj+1,jk) &
-                             &     + p_fld(ji+1,jj+1,jk) * zsurfmsk(ji+1,jj+1,jk) &
-                             &     + p_fld(ji+2,jj+1,jk) * zsurfmsk(ji+2,jj+1,jk) &
-                             &     + p_fld(ji  ,jj+2,jk) * zsurfmsk(ji  ,jj+2,jk) &
-                             &     + p_fld(ji+1,jj+2,jk) * zsurfmsk(ji+1,jj+2,jk) &
-                             &     + p_fld(ji+2,jj+2,jk) * zsurfmsk(ji+2,jj+2,jk) 
-                           zsfcrs =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk) &
-                             &     + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk) &
-                             &     + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk) 
-                            !
-!cbr                            IF( ieee_is_nan(p_fld_crs(ii,ij,jk))) THEN
-
-                           p_fld_crs(ii,ij,jk) = zflcrs
-                           IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs
+                  DO jk = 1, jpk          
+                     DO jj  = nldj_crs,nlej_crs
+                        ijjs = mjs_crs(jj)
+                        ijje = mje_crs(jj)
+                        DO ji = nldi_crs, nlei_crs
+
+                           ijis = mis_crs(ji)
+                           ijie = mie_crs(ji)
+
+                           zflcrs = SUM( p_fld(ijis:ijie,ijjs:ijje,jk) * zsurfmsk(ijis:ijie,ijjs:ijje,jk) )
+                           zsfcrs = SUM(                                 zsurfmsk(ijis:ijie,ijjs:ijje,jk) )
+
+                           p_fld_crs(ji,jj,jk) = zflcrs
+                           IF( zsfcrs /= 0.0 )  p_fld_crs(ji,jj,jk) = zflcrs / zsfcrs
                         ENDDO      
                      ENDDO
                   ENDDO  
+                  !
                CASE DEFAULT
                     STOP
-               END SELECT
-
-              CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk )
+            END SELECT
+
+            CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk )
+
          CASE ( 'LOGVOL' )
 
             CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk, ztabtmp )
-
-            zmin=MINVAL(p_fld) ; zmax=MAXVAL(p_fld);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"p_fld",zmin,zmax; CALL flush(numout)
 
             ztabtmp(:,:,:)=0._wp
             WHERE(p_fld* p_mask .NE. 0._wp ) ztabtmp =  LOG10(p_fld * p_mask)*p_mask
-            zmin=MINVAL(ztabtmp) ; zmax=MAXVAL(ztabtmp);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"LOG()",zmin,zmax; CALL flush(numout)
             ztabtmp = ztabtmp * p_mask
-            zmin=MINVAL(ztabtmp) ; zmax=MAXVAL(ztabtmp);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"LOG()*tmask",zmin,zmax; CALL flush(numout)
 
             SELECT CASE ( cd_type )
 
                CASE( 'T', 'W' )
-                     DO jk = 1, jpk
-                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk)
-                        zsurfmsk(:,:,jk) =  zsurf(:,:,jk)
-                    ENDDO
-
-                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-                        je_2 = mje_crs(2)
-                        DO jk = 1, jpk
-                           DO ji = nistr, niend, nn_factx
-                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-                              zflcrs =  ztabtmp(ji  ,je_2,jk) * zsurfmsk(ji  ,je_2,jk)   &
-                                &     + ztabtmp(ji+1,je_2,jk) * zsurfmsk(ji+1,je_2,jk)   &
-                                &     + ztabtmp(ji+2,je_2,jk) * zsurfmsk(ji+2,je_2,jk)
-
-                              zsfcrs =  zsurf(ji,je_2,jk) + zsurf(ji+1,je_2,jk) + zsurf(ji+2,je_2,jk)
-                              !
-                              p_fld_crs(ii,2,jk) = 0._wp
-                              IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
-                              p_fld_crs(ii,2,jk) = 10 ** ( p_fld_crs(ii,2,jk) * p_mask_crs(ii,2,jk) ) * p_mask_crs(ii,2,jk)
-                           ENDDO
-                        ENDDO
-                     ENDIF
-                  ELSE
-                     je_2 = mjs_crs(2)
-                     DO jk = 1, jpk
-                        DO ji = nistr, niend, nn_factx
-                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-                           zflcrs =  ztabtmp(ji  ,je_2  ,jk) * zsurfmsk(ji  ,je_2  ,jk) &
-                             &     + ztabtmp(ji+1,je_2  ,jk) * zsurfmsk(ji+1,je_2  ,jk) &
-                             &     + ztabtmp(ji+2,je_2  ,jk) * zsurfmsk(ji+2,je_2  ,jk) &
-                             &     + ztabtmp(ji  ,je_2+1,jk) * zsurfmsk(ji  ,je_2+1,jk) &
-                             &     + ztabtmp(ji+1,je_2+1,jk) * zsurfmsk(ji+1,je_2+1,jk) &
-                             &     + ztabtmp(ji+2,je_2+1,jk) * zsurfmsk(ji+2,je_2+1,jk) &
-                             &     + ztabtmp(ji  ,je_2+2,jk) * zsurfmsk(ji  ,je_2+2,jk) &
-                             &     + ztabtmp(ji+1,je_2+2,jk) * zsurfmsk(ji+1,je_2+2,jk) &
-                             &     + ztabtmp(ji+2,je_2+2,jk) * zsurfmsk(ji+2,je_2+2,jk)
-
-                           zsfcrs =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) &
-                             &     + zsurf(ji,je_2+1,jk) + zsurf(ji+1,je_2+1,jk) + zsurf(ji+2,je_2+1,jk) &
-                             &     + zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk)
-                            !
-                            p_fld_crs(ii,2,jk) = 0._wp
-                            IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
-                            p_fld_crs(ii,2,jk) = 10 ** ( p_fld_crs(ii,2,jk) * p_mask_crs(ii,2,jk) ) * p_mask_crs(ii,2,jk)
+
+                  DO jk = 1, jpk
+                     zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk)
+                     zsurfmsk(:,:,jk) =  zsurf(:,:,jk)
+                  ENDDO
+                  !
+                  DO jk = 1, jpk
+                     DO jj  = nldj_crs,nlej_crs
+                        ijjs = mjs_crs(jj)
+                        ijje = mje_crs(jj)
+                        DO ji = nldi_crs, nlei_crs
+                           ijis = mis_crs(ji)
+                           ijie = mie_crs(ji)
+                           zflcrs = SUM( p_fld(ijis:ijie,ijjs:ijje,jk) * zsurfmsk(ijis:ijie,ijjs:ijje,jk) )
+                           zsfcrs = SUM(                                 zsurfmsk(ijis:ijie,ijjs:ijje,jk) )
+                           p_fld_crs(ji,jj,jk) = zflcrs
+                           IF( zsfcrs /= 0.0 )  p_fld_crs(ji,jj,jk) = zflcrs / zsfcrs
+                           p_fld_crs(ji,jj,jk) = 10 ** ( p_fld_crs(ji,jj,jk) *  p_mask_crs(ji,jj,jk) ) * p_mask_crs(ji,jj,jk)
                         ENDDO
                      ENDDO
-                  ENDIF
+                  ENDDO
+               CASE DEFAULT
+                    STOP
+            END SELECT
+
+            CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ,ztabtmp )
+
+         CASE ( 'MED' )
+
+            CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk )
+
+            SELECT CASE ( cd_type )
+
+               CASE( 'T', 'W' )
+                  DO jk = 1, jpk
+                     zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk)
+                     zsurfmsk(:,:,jk) =  zsurf(:,:,jk)
+                  ENDDO
                   !
                   DO jk = 1, jpk
-                     DO jj  = njstr, njend, nn_facty
-                        DO ji = nistr, niend, nn_factx
-                           ii = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                           ij = ( jj - njstr ) * rfacty_r + 3
-                           zflcrs =  ztabtmp(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk) &
-                             &     + ztabtmp(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk) &
-                             &     + ztabtmp(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk) &
-                             &     + ztabtmp(ji  ,jj+1,jk) * zsurfmsk(ji  ,jj+1,jk) &
-                             &     + ztabtmp(ji+1,jj+1,jk) * zsurfmsk(ji+1,jj+1,jk) &
-                             &     + ztabtmp(ji+2,jj+1,jk) * zsurfmsk(ji+2,jj+1,jk) &
-                             &     + ztabtmp(ji  ,jj+2,jk) * zsurfmsk(ji  ,jj+2,jk) &
-                             &     + ztabtmp(ji+1,jj+2,jk) * zsurfmsk(ji+1,jj+2,jk) &
-                             &     + ztabtmp(ji+2,jj+2,jk) * zsurfmsk(ji+2,jj+2,jk)
-                           zsfcrs =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk) &
-                             &     + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk) &
-                             &     + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk)
-                            !
-                           p_fld_crs(ii,ij,jk) = 0._wp
-                           IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs
-                           p_fld_crs(ii,ij,jk) = 10 ** ( p_fld_crs(ii,ij,jk) *  p_mask_crs(ii,ij,jk) ) * p_mask_crs(ii,ij,jk)
-                        ENDDO
-                     ENDDO
-                  ENDDO
-               CASE DEFAULT
-                    STOP
-               END SELECT
-
-
-              !WHERE( p_fld .NE. 0._wp ) p_fld=10**(p_fld)
-              !zmin=MINVAL(p_fld) ; zmax=MAXVAL(p_fld);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"10**(p_fld)",zmin,zmax ; CALL flush(numout)
-              !p_fld = p_fld * p_mask
-              !zmin=MINVAL(p_fld) ; zmax=MAXVAL(p_fld);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"10**(p_fld)*tmask",zmin,zmax ; CALL flush(numout)
-
-              zmin=MINVAL(p_fld_crs) ; zmax=MAXVAL(p_fld_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"p_fld_crs",zmin,zmax; CALL flush(numout)
-              !p_fld_crs=10**(p_fld_crs*p_mask_crs)
-              !zmin=MINVAL(p_fld_crs) ; zmax=MAXVAL(p_fld_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"10**(p_fld_crs)",zmin,zmax; CALL flush(numout)
-              !p_fld_crs=p_fld_crs*p_mask_crs
-              !zmin=MINVAL(p_fld_crs) ; zmax=MAXVAL(p_fld_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"10**(p_fld_crs)*tmask",zmin,zmax; CALL flush(numout)
-
-              CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ,ztabtmp )
-         CASE ( 'MED' )
-
-            CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk )
-
-            SELECT CASE ( cd_type )
-
-               CASE( 'T', 'W' )
-                     DO jk = 1, jpk
-                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk)
-                        zsurfmsk(:,:,jk) =  zsurf(:,:,jk)
-                    ENDDO
-
-                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-                        je_2 = mje_crs(2)
-                        DO jk = 1, jpk
-                           DO ji = nistr, niend, nn_factx
-                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-
-                              ztmp1(:) = 0._wp
-                              ztmp1(1:3) =  p_fld(ji:ji+2,je_2,jk)
-                              CALL PIKSRT(nn_factx*nn_facty,ztmp1)
-                              ir=0
-                              jr=1
-                              DO WHILE( jr .LE. nn_factx*nn_facty )
-                                 IF( ztmp1(jr) == 0. )THEN
-                                    ir=jr
-                                    jr=jr+1
-                                 ELSE
-                                    EXIT
-                                 ENDIF
-                              ENDDO
-                              IF( ir .LE. nn_factx*nn_facty-1 )THEN
-                                 ALLOCATE( ztmp2(nn_factx*nn_facty-ir) )
-                                 ztmp2(1:nn_factx*nn_facty-ir) = ztmp1(1+ir:nn_factx*nn_facty)
-                                 jr=INT( 0.5 * REAL(nn_factx*nn_facty-ir,wp) )+1
-                                 p_fld_crs(ii,2,jk) = ztmp2(jr)
-                                 DEALLOCATE( ztmp2 )
-                              ELSE
-                                 p_fld_crs(ii,ij,jk) = 0._wp
-                              ENDIF
-
-                           ENDDO
-                        ENDDO
-                     ENDIF
-                  ELSE
-                     je_2 = mjs_crs(2)
-                     DO jk = 1, jpk
-                        DO ji = nistr, niend, nn_factx
-                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-                           
-                           ztmp(:,:)= p_fld(ji:ji+2,je_2:je_2+2,jk)
-                           zdim1(1)=nn_factx*nn_facty
+                     DO jj  = nldj_crs,nlej_crs
+                        ijjs = mjs_crs(jj)
+                        ijje = mje_crs(jj)
+                        DO ji = nldi_crs, nlei_crs
+                           ijis = mis_crs(ji)
+                           ijie = mie_crs(ji)
+
+                           ztmp(:,:)= p_fld(ijis:ijie,ijjs:ijje,jk)
+                           zdim1(1) = nn_factx*nn_facty
                            ztmp1(:) = RESHAPE( ztmp(:,:) , zdim1 )
                            CALL PIKSRT(nn_factx*nn_facty,ztmp1)
+
                            ir=0
                            jr=1
@@ -840,52 +553,18 @@
                               ztmp2(1:nn_factx*nn_facty-ir) = ztmp1(1+ir:nn_factx*nn_facty)
                               jr=INT( 0.5 * REAL(nn_factx*nn_facty-ir,wp) )+1
-                              p_fld_crs(ii,2,jk) = ztmp2(jr)
+                              p_fld_crs(ji,jj,jk) = ztmp2(jr)
                               DEALLOCATE( ztmp2 )
                            ELSE
-                           p_fld_crs(ii,ij,jk) = 0._wp
+                              p_fld_crs(ji,jj,jk) = 0._wp
                            ENDIF
 
                         ENDDO
                      ENDDO
-                  ENDIF
-                  !
-                  DO jk = 1, jpk
-                     DO jj  = njstr, njend, nn_facty
-                        DO ji = nistr, niend, nn_factx
-                           ii = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                           ij = ( jj - njstr ) * rfacty_r + 3
-
-                           ztmp(:,:)= p_fld(ji:ji+2,jj:jj+2,jk) 
-                           zdim1(1)=nn_factx*nn_facty
-                           ztmp1(:) = RESHAPE( ztmp(:,:) , zdim1 )
-                           CALL PIKSRT(nn_factx*nn_facty,ztmp1)
-                           ir=0
-                           jr=1
-                           DO WHILE( jr .LE. nn_factx*nn_facty )
-                              IF( ztmp1(jr) == 0. ) THEN
-                                 ir=jr
-                                 jr=jr+1
-                              ELSE
-                                 EXIT
-                              ENDIF
-                           ENDDO
-                           IF( ir .LE. nn_factx*nn_facty-1 )THEN
-                              ALLOCATE( ztmp2(nn_factx*nn_facty-ir) )
-                              ztmp2(1:nn_factx*nn_facty-ir) = ztmp1(1+ir:nn_factx*nn_facty)
-                              jr=INT( 0.5 * REAL(nn_factx*nn_facty-ir,wp) )+1
-                              p_fld_crs(ii,ij,jk) = ztmp2(jr)
-                              DEALLOCATE( ztmp2 )
-                           ELSE
-                              p_fld_crs(ii,ij,jk) = 0._wp
-                           ENDIF
-
-                        ENDDO
-                     ENDDO
                   ENDDO
                CASE DEFAULT
                     STOP
-               END SELECT
-
-              CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk )
+            END SELECT
+
+           CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk )
  
          CASE ( 'SUM' )
@@ -893,213 +572,61 @@
             CALL wrk_alloc( jpi, jpj, jpk, zsurfmsk )
 
-            SELECT CASE ( cd_type )
-              CASE( 'W' )
-                  IF( PRESENT( p_e3 ) ) THEN
-                    !cbr ?????????????
-                    !zsurfmsk(:,:,1) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 
-                    !DO jk = 2, jpk
-                    !  zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk-1) 
-                    !ENDDO
-                    DO jk = 1, jpk
-                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk) 
-                    ENDDO
-                 ELSE
-                    !zsurfmsk(:,:,1) =  p_e12(:,:) * p_mask(:,:,1) 
-                    !DO jk = 2, jpk
-                    !  zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk-1) 
-                    !ENDDO
-                    DO jk = 1, jpk
-                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk) 
-                    ENDDO
-                 ENDIF
-              CASE DEFAULT
-                 IF( PRESENT( p_e3 ) ) THEN
-                    DO jk = 1, jpk
-                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk) 
-                    ENDDO
-                 ELSE
-                    DO jk = 1, jpk
-                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk) 
-                    ENDDO
-                 ENDIF
-              END SELECT
+            IF( PRESENT( p_e3 ) ) THEN
+               DO jk = 1, jpk
+                  zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk) 
+               ENDDO
+            ELSE
+               DO jk = 1, jpk
+                  zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk) 
+               ENDDO
+            ENDIF
 
             SELECT CASE ( cd_type )
             
                CASE( 'T', 'W' )
-         
-                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-                        je_2 = mje_crs(2)
-                        DO jk = 1, jpk           
-                           DO ji = nistr, niend, nn_factx
-                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2          
-                              zflcrs  =  p_fld(ji  ,je_2,jk) * zsurfmsk(ji  ,je_2,jk) &
-                                &      + p_fld(ji+1,je_2,jk) * zsurfmsk(ji+1,je_2,jk) &
-                                &      + p_fld(ji+2,je_2,jk) * zsurfmsk(ji+2,je_2,jk) 
-                               !
-                              p_fld_crs(ii,2,jk) = zflcrs
-                           ENDDO
-                        ENDDO
-                      ENDIF
-                  ELSE
-                     je_2 = mjs_crs(2)
-                     DO jk = 1, jpk           
-                        DO ji = nistr, niend, nn_factx
-                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
-                           zflcrs  =  p_fld(ji  ,je_2  ,jk) * zsurfmsk(ji  ,je_2  ,jk)  &
-                             &      + p_fld(ji+1,je_2  ,jk) * zsurfmsk(ji+1,je_2  ,jk)  &
-                             &      + p_fld(ji+2,je_2  ,jk) * zsurfmsk(ji+2,je_2  ,jk)  &
-                             &      + p_fld(ji  ,je_2+1,jk) * zsurfmsk(ji  ,je_2+1,jk)  &
-                             &      + p_fld(ji+1,je_2+1,jk) * zsurfmsk(ji+1,je_2+1,jk)  &
-                             &      + p_fld(ji+2,je_2+1,jk) * zsurfmsk(ji+2,je_2+1,jk)  &
-                             &      + p_fld(ji  ,je_2+2,jk) * zsurfmsk(ji  ,je_2+2,jk)  &
-                             &      + p_fld(ji+1,je_2+2,jk) * zsurfmsk(ji+1,je_2+2,jk)  &
-                             &      + p_fld(ji+2,je_2+2,jk) * zsurfmsk(ji+2,je_2+2,jk)  
-                            !
-                            p_fld_crs(ii,2,jk) = zflcrs
+        
+                  DO jk = 1, jpk
+                     DO jj  = nldj_crs,nlej_crs
+                        ijjs = mjs_crs(jj)
+                        ijje = mje_crs(jj)
+                        DO ji = nldi_crs, nlei_crs
+                           ijis = mis_crs(ji)
+                           ijie = mie_crs(ji)
+
+                           p_fld_crs(ji,jj,jk) = SUM( p_fld(ijis:ijie,ijjs:ijje,jk) * zsurfmsk(ijis:ijie,ijjs:ijje,jk) )
                         ENDDO
                      ENDDO
-                  ENDIF
-                  !
-                  DO jk = 1, jpk           
-                     DO jj  = njstr, njend, nn_facty
-                        DO ji = nistr, niend, nn_factx
-                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                           ij  = ( jj - njstr ) * rfacty_r + 3
-                           zflcrs  =  p_fld(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk)  &
-                             &      + p_fld(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk)  &
-                             &      + p_fld(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk)  &
-                             &      + p_fld(ji  ,jj+1,jk) * zsurfmsk(ji  ,jj+1,jk)  &
-                             &      + p_fld(ji+1,jj+1,jk) * zsurfmsk(ji+1,jj+1,jk)  &
-                             &      + p_fld(ji+2,jj+1,jk) * zsurfmsk(ji+2,jj+1,jk)  &
-                             &      + p_fld(ji  ,jj+2,jk) * zsurfmsk(ji  ,jj+2,jk)  &
-                             &      + p_fld(ji+1,jj+2,jk) * zsurfmsk(ji+1,jj+2,jk)  &
-                             &      + p_fld(ji+2,jj+2,jk) * zsurfmsk(ji+2,jj+2,jk)  
-                            !
-                            p_fld_crs(ii,ij,jk) = zflcrs
-                            ! 
-                        ENDDO      
-                     ENDDO
-                  ENDDO   
-            
+                  ENDDO
+
                CASE( 'V' )
 
+
                   DO jk = 1, jpk
-                     DO ji = nistr, niend, nn_factx
-                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-                        IF( nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2) )THEN     !!cc bande du sud style ORCA2
-                           IF( mje_crs(2) - mjs_crs(2) == 1 )THEN
-                              jj = mje_crs(2)
-                              zflcrs  = p_fld(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk) &
-                               &      + p_fld(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk) &
-                               &      + p_fld(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk)
-
-                              !zsfcrs = zsurfmsk(ji  ,jj  ,jk) &
-                              ! &     + zsurfmsk(ji+1,jj  ,jk) &
-                              ! &     + zsurfmsk(ji+2,jj  ,jk)
-
-                              !IF( zsfcrs == 0 ) THEN  ; p_fld_crs(ii,2,jk) = zflcrs
-                              !ELSE                    ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
-                              !ENDIF
-                           ENDIF
-                        ELSE
-                           ijje = mje_crs(2)
-                           zflcrs  =  p_fld(ji  ,ijje,jk) * zsurfmsk(ji  ,ijje,jk) &
-                             &      + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) &
-                             &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk)
-                           !
-                           !zsfcrs =  zsurfmsk(ji  ,ijje,jk) &
-                           !  &     + zsurfmsk(ji+1,ijje,jk) &
-                           !  &     + zsurfmsk(ji+2,ijje,jk)
-
-                           p_fld_crs(ii,2,jk) = zflcrs
-                           !IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,2,jk) = zflcrs
-                           !ELSE                   ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
-                           !ENDIF
-
-                        ENDIF
-
-                        DO jj = njstr, njend, nn_facty
-                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-                           ij   = ( jj - njstr ) * rfacty_r + 3
-                           ijje = mje_crs(ij)
-                           ijie = mie_crs(ii)
-                           !                  
-                           zflcrs  =  p_fld(ji  ,ijje,jk) * zsurfmsk(ji  ,ijje,jk) &
-                             &      + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) &
-                             &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk) 
-                           !
-                           !zsfcrs =  zsurfmsk(ji  ,ijje,jk)  &
-                           !  &     + zsurfmsk(ji+1,ijje,jk)  &
-                           !  &     + zsurfmsk(ji+2,ijje,jk) 
-
-                           p_fld_crs(ii,ij,jk) = zflcrs
-                           !cbr1
-               !iji=117 ; ijj=210
-               !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1
-               !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN
-               !WRITE(narea+5000,*)"OPE V =======> "
-               !WRITE(narea+5000,*)ii,ij,jk
-               !WRITE(narea+5000,*)ji,jj,ijje
-               !WRITE(narea+5000,*)p_fld(ji  ,ijje,jk)
-               !WRITE(narea+5000,*)p_fld(ji+1,ijje,jk)
-               !WRITE(narea+5000,*)p_fld(ji+2,ijje,jk)
-               !WRITE(narea+5000,*)zflcrs
-               !ENDIF
-
-                           !IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,ij,jk) = zflcrs
-                           !ELSE                   ; p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs
-                           !ENDIF
-                           !
-               !IF( ii==iji .AND. ij==ijj .AND. jk==74 )WRITE(narea+5000,*)" p_fld_crs(ii,ij,jk) = ", p_fld_crs(ii,ij,jk)
+                     DO jj  = nldj_crs,nlej_crs
+                        ijjs = mjs_crs(jj)
+                        ijje = mje_crs(jj)
+                        DO ji = nldi_crs, nlei_crs
+                           ijis = mis_crs(ji)
+                           ijie = mie_crs(ji)
+
+                           p_fld_crs(ji,jj,jk) = SUM( p_fld(ijis:ijie,ijje,jk) * zsurfmsk(ijis:ijie,ijje,jk) )
                         ENDDO
                      ENDDO
                   ENDDO
- 
+
                CASE( 'U' )
 
-                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-                        je_2 = mje_crs(2)
-                        DO jk = 1, jpk           
-                           DO ji = nistr, niend, nn_factx
-                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2  
-                              ijie = mie_crs(ii)
-                              zflcrs  =  p_fld(ijie,je_2,jk) * zsurfmsk(ijie,je_2,jk)  
-                              p_fld_crs(ii,2,jk) = zflcrs
-                           ENDDO
-                        ENDDO
-                      ENDIF
-                  ELSE
-                     je_2 = mjs_crs(2)
-                     DO jk = 1, jpk           
-                        DO ji = nistr, niend, nn_factx
-                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
-                           ijie = mie_crs(ii)
-                           zflcrs =  p_fld(ijie,je_2  ,jk) * zsurfmsk(ijie,je_2  ,jk)  &
-                             &     + p_fld(ijie,je_2+1,jk) * zsurfmsk(ijie,je_2+1,jk)  &
-                             &     + p_fld(ijie,je_2+2,jk) * zsurfmsk(ijie,je_2+2,jk) 
-
-                           p_fld_crs(ii,2,jk) = zflcrs
+                  DO jk = 1, jpk
+                     DO jj  = nldj_crs,nlej_crs
+                        ijjs = mjs_crs(jj)
+                        ijje = mje_crs(jj)
+                        DO ji = nldi_crs, nlei_crs
+                           ijis = mis_crs(ji)
+                           ijie = mie_crs(ji)
+
+                           p_fld_crs(ji,jj,jk) = SUM( p_fld(ijie,ijjs:ijje,jk) * zsurfmsk(ijie,ijjs:ijje,jk) )
                         ENDDO
                      ENDDO
-                  ENDIF
-                  !
-                  DO jk = 1, jpk           
-                     DO jj  = njstr, njend, nn_facty
-                        DO ji = nistr, niend, nn_factx
-                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-                           ij   = ( jj - njstr ) * rfacty_r + 3
-                           ijie = mie_crs(ii)
-                           zflcrs =  p_fld(ijie,jj  ,jk) * zsurfmsk(ijie,jj  ,jk)  &
-                              &    + p_fld(ijie,jj+1,jk) * zsurfmsk(ijie,jj+1,jk)  &
-                              &    + p_fld(ijie,jj+2,jk) * zsurfmsk(ijie,jj+2,jk) 
-                             !
-                           p_fld_crs(ii,ij,jk) = zflcrs
-                           ! 
-                        ENDDO      
-                     ENDDO
-                  ENDDO   
+                  ENDDO
 
               END SELECT
@@ -1109,5 +636,4 @@
               ENDIF
 
-         !IF(narea==267)WRITE(5000+narea,*)"vn_crs(17,5,74) end SUM = ",p_fld(17,5,74)
               CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk )
 
@@ -1116,339 +642,65 @@
             CALL wrk_alloc( jpi, jpj, jpk, zmask )
 
-            SELECT CASE ( cd_type )
-              CASE( 'W' )
-                  zmask(:,:,1) = p_mask(:,:,1) 
-                  DO jk = 2, jpk
-                     zmask(:,:,jk) = p_mask(:,:,jk-1) 
-                  ENDDO
-              CASE ( 'T' )
-                  DO jk = 1, jpk
-                     zmask(:,:,jk) = p_mask(:,:,jk) 
-                  ENDDO
-            END SELECT
+            DO jk = 1, jpk
+               zmask(:,:,jk) = p_mask(:,:,jk) 
+            ENDDO
 
             SELECT CASE ( cd_type )
             
                CASE( 'T', 'W' )
-         
-                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-                        je_2 = mje_crs(2)
-                        DO jk = 1, jpk           
-                           DO ji = nistr, niend, nn_factx
-                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2        
-                              zflcrs =  &
-                                & MAX( p_fld(ji  ,je_2,jk) * zmask(ji  ,je_2,jk) - ( 1.- zmask(ji  ,je_2,jk) ) * r_inf ,  &
-                                &      p_fld(ji+1,je_2,jk) * zmask(ji+1,je_2,jk) - ( 1.- zmask(ji+1,je_2,jk) ) * r_inf ,  &
-                                &      p_fld(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) - ( 1.- zmask(ji+2,je_2,jk) ) * r_inf  )
-                              !
-                              p_fld_crs(ii,2,jk) = zflcrs
-                           ENDDO
-                        ENDDO
-                      ENDIF
-                  ELSE
-                     je_2 = mjs_crs(2)
-                     DO jk = 1, jpk           
-                        DO ji = nistr, niend, nn_factx
-                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
-                           zflcrs =  &
-                             & MAX( p_fld(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk) - ( 1.- zmask(ji  ,je_2  ,jk) ) * r_inf ,  &
-                             &      p_fld(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk) - ( 1.- zmask(ji+1,je_2  ,jk) ) * r_inf ,  &
-                             &      p_fld(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk) - ( 1.- zmask(ji+2,je_2  ,jk) ) * r_inf ,  &
-                             &      p_fld(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk) - ( 1.- zmask(ji  ,je_2+1,jk) ) * r_inf ,  &
-                             &      p_fld(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk) - ( 1.- zmask(ji+1,je_2+1,jk) ) * r_inf ,  &
-                             &      p_fld(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk) - ( 1.- zmask(ji+2,je_2+1,jk) ) * r_inf ,  &
-                             &      p_fld(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk) - ( 1.- zmask(ji  ,je_2+2,jk) ) * r_inf ,  &
-                             &      p_fld(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk) - ( 1.- zmask(ji+1,je_2+2,jk) ) * r_inf ,  &
-                             &      p_fld(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) - ( 1.- zmask(ji+2,je_2+2,jk) ) * r_inf   )
-                           !
-                           p_fld_crs(ii,2,jk) = zflcrs
+        
+                  DO jk = 1, jpk
+                     DO jj  = nldj_crs,nlej_crs
+                        ijjs = mjs_crs(jj)
+                        ijje = mje_crs(jj)
+                        DO ji = nldi_crs, nlei_crs
+                           ijis = mis_crs(ji)
+                           ijie = mie_crs(ji)
+                           p_fld_crs(ji,jj,jk) = MAXVAL( p_fld(ijis:ijie,ijjs:ijje,jk) * zmask(ijis:ijie,ijjs:ijje,jk) - &
+                                                       & ( ( 1._wp - zmask(ijis:ijie,ijjs:ijje,jk))* r_inf )                )
                         ENDDO
                      ENDDO
-                  ENDIF
-                  !
-                  DO jk = 1, jpk           
-                     DO jj  = njstr, njend, nn_facty
-                        DO ji = nistr, niend, nn_factx
-                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                           ij  = ( jj - njstr ) * rfacty_r + 3
-                           zflcrs =  &
-                             & MAX( p_fld(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk) - ( 1.- zmask(ji  ,jj  ,jk) ) * r_inf ,  &
-                             &      p_fld(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk) - ( 1.- zmask(ji+1,jj  ,jk) ) * r_inf ,  &
-                             &      p_fld(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk) - ( 1.- zmask(ji+2,jj  ,jk) ) * r_inf ,  &
-                             &      p_fld(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk) - ( 1.- zmask(ji  ,jj+1,jk) ) * r_inf ,  &
-                             &      p_fld(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk) - ( 1.- zmask(ji+1,jj+1,jk) ) * r_inf ,  &
-                             &      p_fld(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk) - ( 1.- zmask(ji+2,jj+1,jk) ) * r_inf ,  &
-                             &      p_fld(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk) - ( 1.- zmask(ji  ,jj+2,jk) ) * r_inf ,  &
-                             &      p_fld(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk) - ( 1.- zmask(ji+1,jj+2,jk) ) * r_inf ,  &
-                             &      p_fld(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) - ( 1.- zmask(ji+2,jj+2,jk) ) * r_inf   )
-                           !
-                           p_fld_crs(ii,ij,jk) = zflcrs
-                           !
-                        ENDDO      
-                     ENDDO
-                  ENDDO   
-            
+                  ENDDO
+ 
                CASE( 'V' )
-
-!                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-!                        ijje = mje_crs(2)
-!                      ENDIF
-!                  ELSE
-!                     ijje = mjs_crs(2)
-!                  ENDIF
-!
-!                  DO jk = 1, jpk
-!                     DO ji = nistr, niend, nn_factx
-!                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-!                        zflcrs = &
-!                          & MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
-!                          &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
-!                          &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf )
-!                          !
-!                        p_fld_crs(ii,2,jk) = zflcrs
-!                     ENDDO
-!                  ENDDO
-!                  !
-!                  DO jk = 1, jpk           
-!                     DO jj  = njstr, njend, nn_facty
-!                        DO ji = nistr, niend, nn_factx
-!                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-!                           ij  = ( jj - njstr ) * rfacty_r + 3
-!                           ijje = mje_crs(ij)
-!                           !                  
-!                           zflcrs = &
-!                             & MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
-!                             &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
-!                             &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf )
-!                           !
-!                           p_fld_crs(ii,ij,jk) = zflcrs
-!                           !
-!                        ENDDO      
-!                     ENDDO
-!                  ENDDO   
                   CALL ctl_stop('MAX operator and V case not available')
             
                CASE( 'U' )
-
-!                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-!                        je_2 = mje_crs(2)
-!                        DO jk = 1, jpk           
-!                           DO ji = nistr, niend, nn_factx
-!                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2  
-!                              ijie = mie_crs(ii)
-!                              zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf 
-!                              !
-!                              p_fld_crs(ii,2,jk) = zflcrs
-!                            ENDDO
-!                        ENDDO
-!                      ENDIF
-!                  ELSE
-!                     je_2 = mjs_crs(2)
-!                     DO jk = 1, jpk           
-!                        DO ji = nistr, niend, nn_factx
-!                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
-!                           ijie = mie_crs(ii)
-!                           zflcrs = &
-!                             & MAX( p_fld(ijie,je_2  ,jk) * p_mask(ijie,je_2  ,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  &
-!                             &      p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  &
-!                             &      p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  )
-!                            !
-!                           p_fld_crs(ii,2,jk) = zflcrs
-!                        ENDDO
-!                     ENDDO
-!                  ENDIF
-!                  !
-!                  DO jk = 1, jpk           
-!                     DO jj  = njstr, njend, nn_facty
-!                        DO ji = nistr, niend, nn_factx
-!                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-!                           ij   = ( jj - njstr ) * rfacty_r + 3
-!                           ijie = mie_crs(ii)
-!                           zflcrs =  &
-!                             & MAX( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  &
-!                             &      p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  &
-!                             &      p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf  )
-!                           ! 
-!                           p_fld_crs(ii,ij,jk) = zflcrs
-!                           ! 
-!                        ENDDO      
-!                     ENDDO
-!                  ENDDO   
                   CALL ctl_stop('MAX operator and U case not available')
 
-              END SELECT
-
-              CALL wrk_dealloc( jpi, jpj, jpk, zmask )
+            END SELECT
+
+            CALL wrk_dealloc( jpi, jpj, jpk, zmask )
 
          CASE ( 'MIN' )      !   Search the min of unmasked grid cells
 
             CALL wrk_alloc( jpi, jpj, jpk, zmask )
-
-            !SELECT CASE ( cd_type )
-            !  CASE( 'W' )
-            !      !cbr ?????????????????????????????
-            !      zmask(:,:,1) = p_mask(:,:,1) 
-            !      DO jk = 2, jpk
-            !         zmask(:,:,jk) = p_mask(:,:,jk-1) 
-            !      ENDDO
-            !  CASE ( 'T' )
+            DO jk = 1, jpk
+               zmask(:,:,jk) = p_mask(:,:,jk)
+            ENDDO
+
+            SELECT CASE ( cd_type )
+
+               CASE( 'T', 'W' )
+
                   DO jk = 1, jpk
-                     zmask(:,:,jk) = p_mask(:,:,jk) 
-                  ENDDO
-            !END SELECT
-
-            SELECT CASE ( cd_type )
-
-               CASE( 'T', 'W' )
-         
-                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-                        je_2 = mje_crs(2)
-                        DO jk = 1, jpk           
-                           DO ji = nistr, niend, nn_factx
-                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2        
-                              zflcrs =  &
-                                & MIN( p_fld(ji  ,je_2,jk) * zmask(ji  ,je_2,jk) + ( 1.- zmask(ji  ,je_2,jk) ) * r_inf ,  &
-                                &      p_fld(ji+1,je_2,jk) * zmask(ji+1,je_2,jk) + ( 1.- zmask(ji+1,je_2,jk) ) * r_inf ,  &
-                                &      p_fld(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) + ( 1.- zmask(ji+2,je_2,jk) ) * r_inf  )
-                              !
-                              p_fld_crs(ii,2,jk) = zflcrs
-                           ENDDO
-                        ENDDO
-                      ENDIF
-                  ELSE
-                     je_2 = mjs_crs(2)
-                     DO jk = 1, jpk           
-                        DO ji = nistr, niend, nn_factx
-                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
-                           zflcrs =  &
-                             & MIN( p_fld(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk) + ( 1.- zmask(ji  ,je_2  ,jk) ) * r_inf ,  &
-                             &      p_fld(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk) + ( 1.- zmask(ji+1,je_2  ,jk) ) * r_inf ,  &
-                             &      p_fld(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk) + ( 1.- zmask(ji+2,je_2  ,jk) ) * r_inf ,  &
-                             &      p_fld(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk) + ( 1.- zmask(ji  ,je_2+1,jk) ) * r_inf ,  &
-                             &      p_fld(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk) + ( 1.- zmask(ji+1,je_2+1,jk) ) * r_inf ,  &
-                             &      p_fld(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk) + ( 1.- zmask(ji+2,je_2+1,jk) ) * r_inf ,  &
-                             &      p_fld(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk) + ( 1.- zmask(ji  ,je_2+2,jk) ) * r_inf ,  &
-                             &      p_fld(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk) + ( 1.- zmask(ji+1,je_2+2,jk) ) * r_inf ,  &
-                             &      p_fld(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) + ( 1.- zmask(ji+2,je_2+2,jk) ) * r_inf   )
-                           !
-                           p_fld_crs(ii,2,jk) = zflcrs
+                     DO jj  = nldj_crs,nlej_crs
+                        ijjs = mjs_crs(jj)
+                        ijje = mje_crs(jj)
+                        DO ji = nldi_crs, nlei_crs
+                           ijis = mis_crs(ji)
+                           ijie = mie_crs(ji)
+
+                           p_fld_crs(ji,jj,jk) = MINVAL( p_fld(ijis:ijie,ijjs:ijje,jk) * zmask(ijis:ijie,ijjs:ijje,jk) + &
+                                                       & ( 1._wp - zmask(ijis:ijie,ijjs:ijje,jk)* r_inf )                )
                         ENDDO
                      ENDDO
-                  ENDIF
-                  !
-                  DO jk = 1, jpk           
-                     DO jj  = njstr, njend, nn_facty
-                        DO ji = nistr, niend, nn_factx
-                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                           ij  = ( jj - njstr ) * rfacty_r + 3
-                           zflcrs =  &
-                             & MIN( p_fld(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk) + ( 1.- zmask(ji  ,jj  ,jk) ) * r_inf ,  &
-                             &      p_fld(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk) + ( 1.- zmask(ji+1,jj  ,jk) ) * r_inf ,  &
-                             &      p_fld(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk) + ( 1.- zmask(ji+2,jj  ,jk) ) * r_inf ,  &
-                             &      p_fld(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk) + ( 1.- zmask(ji  ,jj+1,jk) ) * r_inf ,  &
-                             &      p_fld(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk) + ( 1.- zmask(ji+1,jj+1,jk) ) * r_inf ,  &
-                             &      p_fld(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk) + ( 1.- zmask(ji+2,jj+1,jk) ) * r_inf ,  &
-                             &      p_fld(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk) + ( 1.- zmask(ji  ,jj+2,jk) ) * r_inf ,  &
-                             &      p_fld(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk) + ( 1.- zmask(ji+1,jj+2,jk) ) * r_inf ,  &
-                             &      p_fld(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) + ( 1.- zmask(ji+2,jj+2,jk) ) * r_inf   )
-                           !
-                           p_fld_crs(ii,ij,jk) = zflcrs
-                           !
-                        ENDDO      
-                     ENDDO
-                  ENDDO   
+                  ENDDO
+
             
                CASE( 'V' )
-
-!                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-!                        ijje = mje_crs(2)
-!                      ENDIF
-!                  ELSE
-!                     ijje = mjs_crs(2)
-!                  ENDIF
-!
-!                  DO jk = 1, jpk
-!                     DO ji = nistr, niend, nn_factx
-!                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-!                        zflcrs = &
-!                          & MIN( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
-!                          &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
-!                          &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf )
-!                          !
-!                        p_fld_crs(ii,2,jk) = zflcrs
-!                     ENDDO
-!                  ENDDO
-!                  !
-!                  DO jk = 1, jpk           
-!                     DO jj  = njstr, njend, nn_facty
-!                        DO ji = nistr, niend, nn_factx
-!                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-!                           ij  = ( jj - njstr ) * rfacty_r + 3
-!                           ijje = mje_crs(ij)
-!                           zflcrs = &
-!                             & MIN( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
-!                             &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
-!                             &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf )
-!                           !
-!                           p_fld_crs(ii,ij,jk) = zflcrs
-!                           !
-!                        ENDDO      
-!                     ENDDO
-!                  ENDDO   
                   CALL ctl_stop('MIN operator and V case not available')
-
             
                CASE( 'U' )
-
-!                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-!                        je_2 = mje_crs(2)
-!                        DO jk = 1, jpk           
-!                           DO ji = nistr, niend, nn_factx
-!                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2  
-!                              ijie = mie_crs(ii)
-!                              zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf 
-!                              !
-!                              p_fld_crs(ii,2,jk) = zflcrs
-!                            ENDDO
-!                        ENDDO
-!                      ENDIF
-!                  ELSE
-!                     je_2 = mjs_crs(2)
-!                     DO jk = 1, jpk           
-!                        DO ji = nistr, niend, nn_factx
-!                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
-!                           ijie = mie_crs(ii)
-!                           zflcrs = &
-!                             & MIN( p_fld(ijie,je_2  ,jk) * p_mask(ijie,je_2  ,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  &
-!                             &      p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  &
-!                             &      p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  )
-!                            !
-!                           p_fld_crs(ii,2,jk) = zflcrs
-!                        ENDDO
-!                     ENDDO
-!                  ENDIF
-!                  !
-!                  DO jk = 1, jpk           
-!                     DO jj  = njstr, njend, nn_facty
-!                        DO ji = nistr, niend, nn_factx
-!                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-!                           ij   = ( jj - njstr ) * rfacty_r + 3
-!                           ijie = mie_crs(ii)
-!                           zflcrs = &
-!                             & MIN( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  &
-!                             &      p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  &
-!                             &      p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf  )
-!                           ! 
-!                           p_fld_crs(ii,ij,jk) = zflcrs
-!                           ! 
-!                        ENDDO      
-!                     ENDDO
-!                  ENDDO   
                   CALL ctl_stop('MIN operator and U case not available')
           
@@ -1459,7 +711,5 @@
          END SELECT
          !
-         !IF(narea==267)WRITE(5000+narea,*)"vn_crs(17,5,74) avt lbc = ",p_fld(17,5,74)
          CALL crs_lbc_lnk( p_fld_crs, cd_type, psgn )
-         !IF(narea==267)WRITE(5000+narea,*)"vn_crs(17,5,74) apr lbc = ",p_fld(17,5,74)
          !
     END SUBROUTINE crs_dom_ope_3d
@@ -1504,5 +754,5 @@
       !! Local variables
       INTEGER  :: ji, jj, jk                 ! dummy loop indices
-      INTEGER  :: ijie, ijje, ii, ij, je_2
+      INTEGER ::  ijis, ijie, ijjs, ijje
       REAL(wp) :: zflcrs, zsfcrs   
       REAL(wp), DIMENSION(:,:), POINTER :: zsurfmsk   
@@ -1515,70 +765,24 @@
       
         CASE ( 'VOL' )
-      
+
             CALL wrk_alloc( jpi, jpj, zsurfmsk )
             zsurfmsk(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1)
 
-            IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-               IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-                  je_2 = mje_crs(2)
-                  DO ji = nistr, niend, nn_factx
-                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2       
-                     zflcrs =  p_fld(ji  ,je_2) * zsurfmsk(ji  ,je_2)   &
-                       &     + p_fld(ji+1,je_2) * zsurfmsk(ji+1,je_2)   &
-                       &     + p_fld(ji+2,je_2) * zsurfmsk(ji+2,je_2) 
-
-                     zsfcrs =  zsurfmsk(ji,je_2) + zsurfmsk(ji+1,je_2) + zsurfmsk(ji+2,je_2) 
-                     !
-                     p_fld_crs(ii,2) = zflcrs
-                     IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2) = zflcrs / zsfcrs
-                  ENDDO
-               ENDIF
-            ELSE
-               je_2 = mjs_crs(2)
-               DO ji = nistr, niend, nn_factx
-                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
-                  zflcrs =  p_fld(ji  ,je_2  ) * zsurfmsk(ji  ,je_2  ) &
-                    &     + p_fld(ji+1,je_2  ) * zsurfmsk(ji+1,je_2  ) &
-                    &     + p_fld(ji+2,je_2  ) * zsurfmsk(ji+2,je_2  ) &
-                    &     + p_fld(ji  ,je_2+1) * zsurfmsk(ji  ,je_2+1) &
-                    &     + p_fld(ji+1,je_2+1) * zsurfmsk(ji+1,je_2+1) &
-                    &     + p_fld(ji+2,je_2+1) * zsurfmsk(ji+2,je_2+1) &
-                    &     + p_fld(ji  ,je_2+2) * zsurfmsk(ji  ,je_2+2) &
-                    &     + p_fld(ji+1,je_2+2) * zsurfmsk(ji+1,je_2+2) &
-                    &     + p_fld(ji+2,je_2+2) * zsurfmsk(ji+2,je_2+2) 
-
-                   zsfcrs =  zsurfmsk(ji,je_2  ) + zsurfmsk(ji+1,je_2  ) + zsurfmsk(ji+2,je_2  ) &
-                     &     + zsurfmsk(ji,je_2+1) + zsurfmsk(ji+1,je_2+1) + zsurfmsk(ji+2,je_2+1) &
-                     &     + zsurfmsk(ji,je_2+2) + zsurfmsk(ji+1,je_2+2) + zsurfmsk(ji+2,je_2+2) 
-                    !
-                    p_fld_crs(ii,2) = zflcrs
-                    IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2) = zflcrs / zsfcrs
-                ENDDO
-            ENDIF
-                  !
-            DO jj  = njstr, njend, nn_facty
-               DO ji = nistr, niend, nn_factx
-                  ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                  ij  = ( jj - njstr ) * rfacty_r + 3
-                  zflcrs =  p_fld(ji  ,jj  ) * zsurfmsk(ji  ,jj  ) &
-                    &     + p_fld(ji+1,jj  ) * zsurfmsk(ji+1,jj  ) &
-                    &     + p_fld(ji+2,jj  ) * zsurfmsk(ji+2,jj  ) &
-                    &     + p_fld(ji  ,jj+1) * zsurfmsk(ji  ,jj+1) &
-                    &     + p_fld(ji+1,jj+1) * zsurfmsk(ji+1,jj+1) &
-                    &     + p_fld(ji+2,jj+1) * zsurfmsk(ji+2,jj+1) &
-                    &     + p_fld(ji  ,jj+2) * zsurfmsk(ji  ,jj+2) &
-                    &     + p_fld(ji+1,jj+2) * zsurfmsk(ji+1,jj+2) &
-                    &     + p_fld(ji+2,jj+2) * zsurfmsk(ji+2,jj+2) 
-  
-                  zsfcrs =  zsurfmsk(ji,jj  ) + zsurfmsk(ji+1,jj  ) + zsurfmsk(ji+2,jj  ) &
-                    &     + zsurfmsk(ji,jj+1) + zsurfmsk(ji+1,jj+1) + zsurfmsk(ji+2,jj+1) &
-                    &     + zsurfmsk(ji,jj+2) + zsurfmsk(ji+1,jj+2) + zsurfmsk(ji+2,jj+2) 
-                   !
-                  p_fld_crs(ii,ij) = zflcrs
-                  IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij) = zflcrs / zsfcrs
-               ENDDO      
-            ENDDO
-
+            DO jj  = nldj_crs,nlej_crs
+               ijjs = mjs_crs(jj)
+               ijje = mje_crs(jj)
+               DO ji = nldi_crs, nlei_crs
+                  ijis = mis_crs(ji)
+                  ijie = mie_crs(ji)
+
+                  zflcrs = SUM( p_fld(ijis:ijie,ijjs:ijje) * zsurfmsk(ijis:ijie,ijjs:ijje) )
+                  zsfcrs = SUM(                              zsurfmsk(ijis:ijie,ijjs:ijje) )
+
+                  p_fld_crs(ji,jj) = zflcrs
+                  IF( zsfcrs /= 0.0 )  p_fld_crs(ji,jj) = zflcrs / zsfcrs
+               ENDDO
+            ENDDO
             CALL wrk_dealloc( jpi, jpj, zsurfmsk )
+            !
 
          CASE ( 'SUM' )
@@ -1595,126 +799,37 @@
                CASE( 'T', 'W' )
 
-                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-                         je_2 = mje_crs(2)
-                         DO ji = nistr, niend, nn_factx
-                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-                            zflcrs  =  p_fld(ji  ,je_2) * zsurfmsk(ji  ,je_2) &
-                              &      + p_fld(ji+1,je_2) * zsurfmsk(ji+1,je_2) &
-                              &      + p_fld(ji+2,je_2) * zsurfmsk(ji+2,je_2) 
-                              !
-                             p_fld_crs(ii,2) = zflcrs
-                         ENDDO
-                      ENDIF
-                   ELSE
-                      je_2 = mjs_crs(2)
-                      DO ji = nistr, niend, nn_factx
-                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-                         zflcrs  =  p_fld(ji  ,je_2  ) * zsurfmsk(ji  ,je_2  )  &
-                           &      + p_fld(ji+1,je_2  ) * zsurfmsk(ji+1,je_2  )  &
-                           &      + p_fld(ji+2,je_2  ) * zsurfmsk(ji+2,je_2  )  &
-                           &      + p_fld(ji  ,je_2+1) * zsurfmsk(ji  ,je_2+1)  &
-                           &      + p_fld(ji+1,je_2+1) * zsurfmsk(ji+1,je_2+1)  &
-                           &      + p_fld(ji+2,je_2+1) * zsurfmsk(ji+2,je_2+1)  &
-                           &      + p_fld(ji  ,je_2+2) * zsurfmsk(ji  ,je_2+2)  &
-                           &      + p_fld(ji+1,je_2+2) * zsurfmsk(ji+1,je_2+2)  &
-                           &      + p_fld(ji+2,je_2+2) * zsurfmsk(ji+2,je_2+2)  
-                            !
-                            p_fld_crs(ii,2) = zflcrs
-                      ENDDO
-                   ENDIF
-                   !
-                   DO jj = njstr, njend, nn_facty
-                      DO ji = nistr, niend, nn_factx
-                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
-                         ij   = ( jj - njstr ) * rfacty_r + 3
-                         zflcrs  =  p_fld(ji  ,jj  ) * zsurfmsk(ji  ,jj  )  &
-                           &      + p_fld(ji+1,jj  ) * zsurfmsk(ji+1,jj  )  &
-                           &      + p_fld(ji+2,jj  ) * zsurfmsk(ji+2,jj  )  &
-                           &      + p_fld(ji  ,jj+1) * zsurfmsk(ji  ,jj+1)  &
-                           &      + p_fld(ji+1,jj+1) * zsurfmsk(ji+1,jj+1)  &
-                           &      + p_fld(ji+2,jj+1) * zsurfmsk(ji+2,jj+1)  &
-                           &      + p_fld(ji  ,jj+2) * zsurfmsk(ji  ,jj+2)  &
-                           &      + p_fld(ji+1,jj+2) * zsurfmsk(ji+1,jj+2)  &
-                           &      + p_fld(ji+2,jj+2) * zsurfmsk(ji+2,jj+2)  
-                          !
-                          p_fld_crs(ii,ij) = zflcrs
-                          ! 
-                      ENDDO      
-                   ENDDO
+                  DO jj  = nldj_crs,nlej_crs
+                     ijjs = mjs_crs(jj)
+                     ijje = mje_crs(jj)
+                     DO ji = nldi_crs, nlei_crs
+                        ijis = mis_crs(ji)
+                        ijie = mie_crs(ji)
+                        p_fld_crs(ji,jj) = SUM( p_fld(ijis:ijie,ijjs:ijje) * zsurfmsk(ijis:ijie,ijjs:ijje) )
+                     ENDDO
+                  ENDDO
             
                CASE( 'V' )
-                   DO ji = nistr, niend, nn_factx
-                      ii  = ( ji - mis_crs(2) ) * rfactx_r + 2
-                      IF( nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2) )THEN     !!cc bande du sud style ORCA2
-                         IF( mje_crs(2) - mjs_crs(2) == 1 )THEN
-                            jj = mje_crs(2)
-                            zflcrs  = p_fld(ji  ,jj  ) * zsurfmsk(ji  ,jj  )  &
-                             &      + p_fld(ji+1,jj  ) * zsurfmsk(ji+1,jj  )  &
-                             &      + p_fld(ji+2,jj  ) * zsurfmsk(ji+2,jj  )
-                            p_fld_crs(ii,2) = zflcrs
-                         ENDIF
-                      ELSE
-                         ijje = mje_crs(2)
-                         zflcrs  = p_fld(ji  ,ijje) * zsurfmsk(ji  ,ijje)  &
-                           &     + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje)  &
-                           &     + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje)
-                         !
-                         p_fld_crs(ii,2) = zflcrs
-                      ENDIF
-
-                      DO jj = njstr, njend, nn_facty
-                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-                         ij   = ( jj - njstr ) * rfacty_r + 3
-                         ijje = mje_crs(ij)
-                         ijie = mie_crs(ii)
-                         !                  
-                         zflcrs  = p_fld(ji  ,ijje) * zsurfmsk(ji  ,ijje)  &
-                          &      + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje)  &
-                          &      + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje)
-                         !
-                         p_fld_crs(ii,ij) = zflcrs
-                         !
-                      ENDDO
-                   ENDDO
-            
+
+                  DO jj  = nldj_crs,nlej_crs
+                     ijjs = mjs_crs(jj)
+                     ijje = mje_crs(jj)
+                     DO ji = nldi_crs, nlei_crs
+                        ijis = mis_crs(ji)
+                        ijie = mie_crs(ji)
+                        p_fld_crs(ji,jj) = SUM( p_fld(ijis:ijie,ijje) * zsurfmsk(ijis:ijie,ijje) )
+                     ENDDO
+                  ENDDO
+
                CASE( 'U' )
 
-                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-                        je_2 = mje_crs(2)
-                        DO ji = nistr, niend, nn_factx
-                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
-                           ijie = mie_crs(ii)
-                           zflcrs  =  p_fld(ijie,je_2) * zsurfmsk(ijie,je_2)  
-                           p_fld_crs(ii,2) = zflcrs
-                        ENDDO
-                     ENDIF
-                  ELSE
-                     je_2 = mjs_crs(2)
-                     DO ji = nistr, niend, nn_factx
-                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
-                        ijie = mie_crs(ii)
-                        zflcrs =  p_fld(ijie,je_2  ) * zsurfmsk(ijie,je_2  )  &
-                          &     + p_fld(ijie,je_2+1) * zsurfmsk(ijie,je_2+1)  &
-                          &     + p_fld(ijie,je_2+2) * zsurfmsk(ijie,je_2+2) 
-   
-                        p_fld_crs(ii,2) = zflcrs
+                  DO jj  = nldj_crs,nlej_crs
+                     ijjs = mjs_crs(jj)
+                     ijje = mje_crs(jj)
+                     DO ji = nldi_crs, nlei_crs
+                        ijis = mis_crs(ji)
+                        ijie = mie_crs(ji)
+                        p_fld_crs(ji,jj) = SUM( p_fld(ijie,ijjs:ijje) * zsurfmsk(ijie,ijjs:ijje) )
                      ENDDO
-                 ENDIF
-
-                 DO jj = njstr, njend, nn_facty
-                    DO ji = nistr, niend, nn_factx
-                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-                       ij   = ( jj - njstr ) * rfacty_r + 3
-                       ijie = mie_crs(ii)
-                       zflcrs =  p_fld(ijie,jj  ) * zsurfmsk(ijie,jj  )  &
-                          &    + p_fld(ijie,jj+1) * zsurfmsk(ijie,jj+1)  &
-                          &    + p_fld(ijie,jj+2) * zsurfmsk(ijie,jj+2) 
-                         !
-                       p_fld_crs(ii,ij) = zflcrs
-                       ! 
-                    ENDDO      
-                 ENDDO
+                  ENDDO
 
               END SELECT
@@ -1731,123 +846,20 @@
             
                CASE( 'T', 'W' )
-  
-                   DO ji = nistr, niend, nn_factx
-                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-                      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-                         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-                            je_2 = mje_crs(2)
-                            zflcrs =  &
-                              & MAX( p_fld(ji  ,je_2) * p_mask(ji  ,je_2,1) - ( 1.- p_mask(ji  ,je_2,1) ) * r_inf ,  &
-                              &      p_fld(ji+1,je_2) * p_mask(ji+1,je_2,1) - ( 1.- p_mask(ji+1,je_2,1) ) * r_inf ,  &
-                              &      p_fld(ji+2,je_2) * p_mask(ji+2,je_2,1) - ( 1.- p_mask(ji+2,je_2,1) ) * r_inf  )
-                            !
-                            p_fld_crs(ii,2) = zflcrs
-                         ENDIF
-                      ELSE
-                         je_2 = mjs_crs(2) 
-                         zflcrs =  &
-                           &  MAX( p_fld(ji  ,je_2  ) * p_mask(ji  ,je_2  ,1) - ( 1.- p_mask(ji  ,je_2  ,1) ) * r_inf ,  &
-                           &       p_fld(ji+1,je_2  ) * p_mask(ji+1,je_2  ,1) - ( 1.- p_mask(ji+1,je_2  ,1) ) * r_inf ,  &
-                           &       p_fld(ji+2,je_2  ) * p_mask(ji+2,je_2  ,1) - ( 1.- p_mask(ji+2,je_2  ,1) ) * r_inf ,  &
-                           &       p_fld(ji  ,je_2+1) * p_mask(ji  ,je_2+1,1) - ( 1.- p_mask(ji  ,je_2+1,1) ) * r_inf ,  &
-                           &       p_fld(ji+1,je_2+1) * p_mask(ji+1,je_2+1,1) - ( 1.- p_mask(ji+1,je_2+1,1) ) * r_inf ,  &
-                           &       p_fld(ji+2,je_2+1) * p_mask(ji+2,je_2+1,1) - ( 1.- p_mask(ji+2,je_2+1,1) ) * r_inf ,  &
-                           &       p_fld(ji  ,je_2+2) * p_mask(ji  ,je_2+2,1) - ( 1.- p_mask(ji  ,je_2+2,1) ) * r_inf ,  &
-                           &       p_fld(ji+1,je_2+2) * p_mask(ji+1,je_2+2,1) - ( 1.- p_mask(ji+1,je_2+2,1) ) * r_inf ,  &
-                           &       p_fld(ji+2,je_2+2) * p_mask(ji+2,je_2+2,1) - ( 1.- p_mask(ji+2,je_2+2,1) ) * r_inf   )
-                         !
-                         p_fld_crs(ii,2) = zflcrs
-                      ENDIF
-
-                      DO jj = njstr, njend, nn_facty
-                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-                         ij   = ( jj - njstr ) * rfacty_r + 3
-                         zflcrs = &
-                          &  MAX( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1) - ( 1.- p_mask(ji  ,jj  ,1) ) * r_inf ,  &
-                          &       p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1) - ( 1.- p_mask(ji+1,jj  ,1) ) * r_inf ,  &
-                          &       p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1) - ( 1.- p_mask(ji+2,jj  ,1) ) * r_inf ,  &
-                          &       p_fld(ji  ,jj+1) * p_mask(ji  ,jj+1,1) - ( 1.- p_mask(ji  ,jj+1,1) ) * r_inf ,  &
-                          &       p_fld(ji+1,jj+1) * p_mask(ji+1,jj+1,1) - ( 1.- p_mask(ji+1,jj+1,1) ) * r_inf ,  &
-                          &       p_fld(ji+2,jj+1) * p_mask(ji+2,jj+1,1) - ( 1.- p_mask(ji+2,jj+1,1) ) * r_inf ,  &
-                          &       p_fld(ji  ,jj+2) * p_mask(ji  ,jj+2,1) - ( 1.- p_mask(ji  ,jj+2,1) ) * r_inf ,  &
-                          &       p_fld(ji+1,jj+2) * p_mask(ji+1,jj+2,1) - ( 1.- p_mask(ji+1,jj+2,1) ) * r_inf ,  &
-                          &       p_fld(ji+2,jj+2) * p_mask(ji+2,jj+2,1) - ( 1.- p_mask(ji+2,jj+2,1) ) * r_inf   )
-                         !
-                         p_fld_crs(ii,ij) = zflcrs
-                         !
-                      ENDDO      
-                   ENDDO
+ 
+                  DO jj  = nldj_crs,nlej_crs
+                     ijjs = mjs_crs(jj)
+                     ijje = mje_crs(jj)
+                     DO ji = nldi_crs, nlei_crs
+                        ijis = mis_crs(ji)
+                        ijie = mie_crs(ji)
+                        p_fld_crs(ji,jj) = MAXVAL( p_fld(ijis:ijie,ijjs:ijje) * p_mask(ijis:ijie,ijjs:ijje,1) - &
+                                                 & ( 1._wp - p_mask(ijis:ijie,ijjs:ijje,1) )                    )
+                     ENDDO
+                  ENDDO
             
                CASE( 'V' )
-
-!                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-!                        ijje = mje_crs(2)
-!                      ENDIF
-!                  ELSE
-!                     ijje = mjs_crs(2)
-!                  ENDIF
-!
-!                  DO ji = nistr, niend, nn_factx
-!                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
-!                     zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
-!                       &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
-!                       &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf )
-!                       !
-!                     p_fld_crs(ii,2) = zflcrs
-!                  ENDDO      
-!                  DO jj = njstr, njend, nn_facty
-!                     DO ji = nistr, niend, nn_factx
-!                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
-!                        ij   = ( jj - njstr ) * rfacty_r + 3               
-!                        ijje = mje_crs(ij) 
-!                        !                  
-!                        zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
-!                          &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
-!                          &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf )
-!                        !
-!                        p_fld_crs(ii,ij) = zflcrs
-!                        !
-!                     ENDDO      
-!                  ENDDO
                   CALL ctl_stop('MAX operator and V case not available')
             
                CASE( 'U' )
-
-!                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-!                        je_2 = mje_crs(2)
-!                        DO ji = nistr, niend, nn_factx
-!                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
-!                           ijie = mie_crs(ii)
-!                           zflcrs  =  p_fld(ijie,je_2) * p_mask(ijie,je_2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf 
-!                           p_fld_crs(ii,2) = zflcrs
-!                        ENDDO
-!                     ENDIF
-!                 ELSE
-!                     je_2 = mjs_crs(2)
-!                     DO ji = nistr, niend, nn_factx
-!                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
-!                        ijie = mie_crs(ii)
-!                        zflcrs =  &
-!                          &  MAX( p_fld(ijie,je_2  ) * p_mask(ijie,je_2  ,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  &
-!                          &       p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  &
-!                          &       p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf  )
-!                        p_fld_crs(ii,2) = zflcrs
-!                     ENDDO
-!                 ENDIF
-!                 DO jj = njstr, njend, nn_facty
-!                    DO ji = nistr, niend, nn_factx
-!                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-!                       ij   = ( jj - njstr ) * rfacty_r + 3
-!                       ijie = mie_crs(ii)
-!                       zflcrs =  &
-!                         &  MAX( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  &
-!                         &       p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  &
-!                          &      p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf  )
-!                        p_fld_crs(ii,ij) = zflcrs
-!                        ! 
-!                     ENDDO      
-!                  ENDDO
                   CALL ctl_stop('MAX operator and U case not available')
 
@@ -1859,129 +871,20 @@
 
               CASE( 'T', 'W' )
-  
-                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-                         je_2 = mje_crs(2)
-                         DO ji = nistr, niend, nn_factx
-                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-                            zflcrs =  &
-                              & MIN( p_fld(ji  ,je_2) * p_mask(ji  ,je_2,1) + ( 1.- p_mask(ji  ,je_2,1) ) * r_inf ,  &
-                             &       p_fld(ji+1,je_2) * p_mask(ji+1,je_2,1) + ( 1.- p_mask(ji+1,je_2,1) ) * r_inf ,  &
-                             &       p_fld(ji+2,je_2) * p_mask(ji+2,je_2,1) + ( 1.- p_mask(ji+2,je_2,1) ) * r_inf  )
-                            !
-                            p_fld_crs(ii,2) = zflcrs
-                         ENDDO
-                      ENDIF
-                   ELSE
-                      DO ji = nistr, niend, nn_factx
-                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-                      je_2 = mjs_crs(2) 
-                      zflcrs =  &
-                        &  MIN( p_fld(ji  ,je_2  ) * p_mask(ji  ,je_2  ,1) + ( 1.- p_mask(ji  ,je_2  ,1) ) * r_inf ,  &
-                        &       p_fld(ji+1,je_2  ) * p_mask(ji+1,je_2  ,1) + ( 1.- p_mask(ji+1,je_2  ,1) ) * r_inf ,  &
-                        &       p_fld(ji+2,je_2  ) * p_mask(ji+2,je_2  ,1) + ( 1.- p_mask(ji+2,je_2  ,1) ) * r_inf ,  &
-                        &       p_fld(ji  ,je_2+1) * p_mask(ji  ,je_2+1,1) + ( 1.- p_mask(ji  ,je_2+1,1) ) * r_inf ,  &
-                        &       p_fld(ji+1,je_2+1) * p_mask(ji+1,je_2+1,1) + ( 1.- p_mask(ji+1,je_2+1,1) ) * r_inf ,  &
-                        &       p_fld(ji+2,je_2+1) * p_mask(ji+2,je_2+1,1) + ( 1.- p_mask(ji+2,je_2+1,1) ) * r_inf ,  &
-                        &       p_fld(ji  ,je_2+2) * p_mask(ji  ,je_2+2,1) + ( 1.- p_mask(ji  ,je_2+2,1) ) * r_inf ,  &
-                        &       p_fld(ji+1,je_2+2) * p_mask(ji+1,je_2+2,1) + ( 1.- p_mask(ji+1,je_2+2,1) ) * r_inf ,  &
-                        &       p_fld(ji+2,je_2+2) * p_mask(ji+2,je_2+2,1) + ( 1.- p_mask(ji+2,je_2+2,1) ) * r_inf   )
-                      !
-                      p_fld_crs(ii,2) = zflcrs
-                      ENDDO
-                   ENDIF
-
-                   DO jj = njstr, njend, nn_facty
-                      DO ji = nistr, niend, nn_factx
-                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-                         ij   = ( jj - njstr ) * rfacty_r + 3
-                         zflcrs = &
-                          &  MIN( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1) + ( 1.- p_mask(ji  ,jj  ,1) ) * r_inf ,  &
-                          &       p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1) + ( 1.- p_mask(ji+1,jj  ,1) ) * r_inf ,  &
-                          &       p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1) + ( 1.- p_mask(ji+2,jj  ,1) ) * r_inf ,  &
-                          &       p_fld(ji  ,jj+1) * p_mask(ji  ,jj+1,1) + ( 1.- p_mask(ji  ,jj+1,1) ) * r_inf ,  &
-                          &       p_fld(ji+1,jj+1) * p_mask(ji+1,jj+1,1) + ( 1.- p_mask(ji+1,jj+1,1) ) * r_inf ,  &
-                          &       p_fld(ji+2,jj+1) * p_mask(ji+2,jj+1,1) + ( 1.- p_mask(ji+2,jj+1,1) ) * r_inf ,  &
-                          &       p_fld(ji  ,jj+2) * p_mask(ji  ,jj+2,1) + ( 1.- p_mask(ji  ,jj+2,1) ) * r_inf ,  &
-                          &       p_fld(ji+1,jj+2) * p_mask(ji+1,jj+2,1) + ( 1.- p_mask(ji+1,jj+2,1) ) * r_inf ,  &
-                          &       p_fld(ji+2,jj+2) * p_mask(ji+2,jj+2,1) + ( 1.- p_mask(ji+2,jj+2,1) ) * r_inf   )
-                         !
-                         p_fld_crs(ii,ij) = zflcrs
-                         !
-                      ENDDO      
-                   ENDDO
+
+                  DO jj  = nldj_crs,nlej_crs
+                     ijjs = mjs_crs(jj)
+                     ijje = mje_crs(jj)
+                     DO ji = nldi_crs, nlei_crs
+                        ijis = mis_crs(ji)
+                        ijie = mie_crs(ji)
+                        p_fld_crs(ji,jj) = MINVAL( p_fld(ijis:ijie,ijjs:ijje) * p_mask(ijis:ijie,ijjs:ijje,1) + &
+                                                 & ( 1._wp - p_mask(ijis:ijie,ijjs:ijje,1) )                    )
+                     ENDDO
+                  ENDDO
             
                CASE( 'V' )
-
-!                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-!                        ijje = mje_crs(2)
-!                      ENDIF
-!                  ELSE
-!                     ijje = mjs_crs(2)
-!                  ENDIF
-!
-!                  DO ji = nistr, niend, nn_factx
-!                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
-!                     zflcrs = MIN( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
-!                       &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
-!                       &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf )
-!                       !
-!                     p_fld_crs(ii,2) = zflcrs
-!                  ENDDO      
-!                  DO jj = njstr, njend, nn_facty
-!                     DO ji = nistr, niend, nn_factx
-!                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
-!                        ij   = ( jj - njstr ) * rfacty_r + 3               
-!                        ijje = mje_crs(ij) 
-!                        !                  
-!                        zflcrs = MIN( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
-!                          &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
-!                          &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf )
-!                        !
-!                        p_fld_crs(ii,ij) = zflcrs
-!                        !
-!                     ENDDO      
-!                  ENDDO
                   CALL ctl_stop('MIN operator and V case not available')
             
                CASE( 'U' )
-
-!                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-!                        je_2 = mje_crs(2)
-!                        DO ji = nistr, niend, nn_factx
-!                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
-!                           ijie = mie_crs(ii)
-!                           zflcrs  =  p_fld(ijie,je_2) * p_mask(ijie,je_2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf 
-! 
-!                           p_fld_crs(ii,2) = zflcrs
-!                        ENDDO
-!                     ENDIF
-!                 ELSE
-!                     je_2 = mjs_crs(2)
-!                     DO ji = nistr, niend, nn_factx
-!                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
-!                        ijie = mie_crs(ii)
-!                        zflcrs =  &
-!                          &  MIN( p_fld(ijie,je_2  ) * p_mask(ijie,je_2  ,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  &
-!                          &       p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  &
-!                          &       p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf  )
-!                        p_fld_crs(ii,2) = zflcrs
-!                     ENDDO
-!                 ENDIF
-!                 DO jj = njstr, njend, nn_facty
-!                    DO ji = nistr, niend, nn_factx
-!                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
-!                       ij   = ( jj - njstr ) * rfacty_r + 3
-!                       ijie = mie_crs(ii)
-!                       zflcrs =  &
-!                         &  MIN( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  &
-!                         &       p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  &
-!                          &      p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf  )
-!                        p_fld_crs(ii,ij) = zflcrs
-!                        ! 
-!                     ENDDO      
-!                  ENDDO
                   CALL ctl_stop('MIN operator and U case not available')
 
@@ -1994,113 +897,50 @@
    END SUBROUTINE crs_dom_ope_2d
 
-   SUBROUTINE crs_dom_e3( p_e1, p_e2, p_e3, p_sfc_crs, cd_type, p_mask, p_e3_crs, p_e3_max_crs)
+   SUBROUTINE crs_dom_e3( p_e1, p_e2, p_e3, p_sfc_2d_crs,  p_sfc_3d_crs, cd_type, p_mask, p_e3_crs, p_e3_max_crs)
       !!----------------------------------------------------------------  
+      !!
+      !!
+      !!
+      !!
+      !!----------------------------------------------------------------
       !!  Arguments
-      CHARACTER(len=1),                         INTENT(in) :: cd_type      ! grid type T, W ( U, V, F)
-      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in) :: p_mask       ! Parent grid T mask
-      REAL(wp), DIMENSION(jpi,jpj)    ,         INTENT(in) :: p_e1, p_e2   ! 2D tracer T or W on parent grid
-      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in) :: p_e3         ! 3D tracer T or W on parent grid
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in) :: p_sfc_crs ! Coarse grid box east or north face quantity
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: p_e3_crs ! Coarse grid box east or north face quantity 
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: p_e3_max_crs ! Coarse grid box east or north face quantity 
+      CHARACTER(len=1),                         INTENT(in)          :: cd_type           ! grid type T, W ( U, V, F)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)          :: p_mask            ! Parent grid T mask
+      REAL(wp), DIMENSION(jpi,jpj)    ,         INTENT(in)          :: p_e1, p_e2        ! 2D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)          :: p_e3              ! 3D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(in),OPTIONAL :: p_sfc_2d_crs      ! Coarse grid box east or north face quantity
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in),OPTIONAL :: p_sfc_3d_crs      ! Coarse grid box east or north face quantity
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)       :: p_e3_crs          ! Coarse grid box east or north face quantity 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)       :: p_e3_max_crs      ! Coarse grid box east or north face quantity 
 
       !! Local variables
       INTEGER ::  ji, jj, jk                   ! dummy loop indices
-      INTEGER ::  ijie, ijje, ii, ij, je_2
+      INTEGER ::  ijis, ijie, ijjs, ijje 
       REAL(wp) :: ze3crs  
-      !REAL(wp), DIMENSION(:,:,:), POINTER :: zmask, zsurf   
 
       !!----------------------------------------------------------------  
-
-       p_e3_crs    (:,:,:) = 0.
-       p_e3_max_crs(:,:,:) = 1.
+      p_e3_crs    (:,:,:) = 0._wp
+      p_e3_max_crs(:,:,:) = 0._wp
    
 
-       !CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf )
-
-       SELECT CASE ( cd_type )
+      SELECT CASE ( cd_type )
 
          CASE ('T')
 
-            DO jk = 1 , jpk
-               DO ji = nistr, niend, nn_factx
-
-                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
-
-                  IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-
-                    jj = mje_crs(2)
-
-
-                    ze3crs = MAX(  p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
-                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
-                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk))
-
-                    p_e3_max_crs(ii,2,jk) = ze3crs
-
-                    ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  &
-                        &     p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  &
-                        &     p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk)
-
-
-                    p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
-                  ENDIF
-                  ELSE
-                     jj = mjs_crs(2)
-
-                     ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
-                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
-                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  &
-                        &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  &
-                        &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  &
-                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  &
-                        &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  &
-                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  &
-                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
-
-                     p_e3_max_crs(ii,2,jk) = ze3crs
-
-                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  &
-                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  &
-                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  &
-                        &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk) +  &
-                        &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk) +  &
-                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  &
-                        &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  &
-                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  &
-                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
-
-                       p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
-                  ENDIF
-
-                  DO jj = njstr, njend, nn_facty
-                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                     ij   = ( jj - njstr ) * rfacty_r + 3
-                     ijje = mje_crs(ij)
-                     ijie = mie_crs(ii)
-                     !  
-                     ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
-                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
-                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  &
-                        &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  &
-                        &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  &
-                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  &
-                        &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  &
-                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  &
-                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
-
-                     p_e3_max_crs(ii,ij,jk) = ze3crs
-                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  &
-                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  &
-                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  &
-                        &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk) +  &
-                        &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk) +  &
-                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  &
-                        &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  &
-                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  &
-                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
-
-                       p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
+            DO jk = 1, jpk
+               DO ji = nldi_crs, nlei_crs
+
+                  ijis = mis_crs(ji)
+                  ijie = mie_crs(ji)
+
+                  DO jj = nldj_crs, nlej_crs
+
+                     ijjs = mjs_crs(jj)
+                     ijje = mje_crs(jj)
+
+                     p_e3_max_crs(ji,jj,jk) = MAXVAL( p_e3(ijis:ijie,ijjs:ijje,jk) * p_mask(ijis:ijie,ijjs:ijje,jk) )
+
+                     ze3crs = SUM( p_e1(ijis:ijie,ijjs:ijje) * p_e2(ijis:ijie,ijjs:ijje) * p_e3(ijis:ijie,ijjs:ijje,jk) * p_mask(ijis:ijie,ijjs:ijje,jk) )
+                     IF( p_sfc_3d_crs(ji,jj,jk) .NE. 0._wp )p_e3_crs(ji,jj,jk) = ze3crs / p_sfc_3d_crs(ji,jj,jk)
 
                   ENDDO
@@ -2110,56 +950,19 @@
          CASE ('U')
 
-         DO jk = 1 , jpk
-               DO ji = nistr, niend, nn_factx
-                 ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
-
-                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-
-                    jj = mje_crs(2)
-
-
-                    ze3crs = p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)
-
-                    p_e3_max_crs(ii,2,jk) = ze3crs
-
-                    ze3crs =  p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk)
-
-
-                     p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
-                     ENDIF
-                  ELSE
-                     jj = mjs_crs(2)
-
-                     ze3crs = MAX( p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  &
-                                   p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  &
-                                   p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
-
-                     p_e3_max_crs(ii,2,jk) = ze3crs
-
-                     ze3crs =  p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  &
-                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  &
-                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
-
-                       p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
-                  ENDIF
-                  DO jj = njstr, njend, nn_facty
-                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                     ij   = ( jj - njstr ) * rfacty_r + 3
-                     ijje = mje_crs(ij)
-                     ijie = mie_crs(ii)
-                     !  
-                     ze3crs = MAX( p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  &
-                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  &
-                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
-
-                     p_e3_max_crs(ii,ij,jk) = ze3crs
-
-                     ze3crs =  p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  &
-                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  &
-                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
-
-                       p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
-
+            DO jk = 1, jpk
+               DO ji = nldi_crs, nlei_crs
+
+                  ijis = mis_crs(ji)
+                  ijie = mie_crs(ji)
+
+                  DO jj = nldj_crs, nlej_crs
+
+                     ijjs = mjs_crs(jj)
+                     ijje = mje_crs(jj)
+
+                     p_e3_max_crs(ji,jj,jk) = MAXVAL( p_e3(ijie,ijjs:ijje,jk) * p_mask(ijie,ijjs:ijje,jk) )
+
+                     ze3crs = SUM( p_e2(ijie,ijjs:ijje) * p_e3(ijie,ijjs:ijje,jk) * p_mask(ijie,ijjs:ijje,jk) )
+                     IF( p_sfc_2d_crs(ji,jj) .NE. 0._wp )p_e3_crs(ji,jj,jk) = ze3crs / p_sfc_2d_crs(ji,jj)
                   ENDDO
                ENDDO
@@ -2167,147 +970,42 @@
 
          CASE ('V')
-         DO jk = 1 , jpk
-               DO ji = nistr, niend, nn_factx
-
-                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
-
-                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-
-                    jj = mje_crs(2)
-
-
-                    ze3crs = MAX(  p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
-                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
-                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk))
-
-                    p_e3_max_crs(ii,2,jk) = ze3crs
-
-                    ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  &
-                        &     p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  &
-                        &     p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk)
-
-
-                     p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
-                     ENDIF
-                  ELSE
-                     jj = mjs_crs(2)
-
-                     ze3crs = MAX( p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  &
-                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  &
-                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
-
-                     p_e3_max_crs(ii,2,jk) = ze3crs
-
-                     ze3crs =  p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  &
-                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  &
-                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
-
-                       p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
-                  ENDIF
-
-                  DO jj = njstr, njend, nn_facty
-                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                     ij   = ( jj - njstr ) * rfacty_r + 3
-                     ijje = mje_crs(ij)
-                     ijie = mie_crs(ii)
-                     !  
-                     ze3crs = MAX( p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  &
-                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  &
-                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
-
-                     p_e3_max_crs(ii,ij,jk) = ze3crs
-
-                     ze3crs =  p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  &
-                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  &
-                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
-
-                       p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
+
+            DO jk = 1, jpk
+               DO ji = nldi_crs, nlei_crs
+
+                  ijis = mis_crs(ji)
+                  ijie = mie_crs(ji)
+
+                  DO jj = nldj_crs, nlej_crs
+
+                     ijjs = mjs_crs(jj)
+                     ijje = mje_crs(jj)
+
+                     p_e3_max_crs(ji,jj,jk) = MAXVAL( p_e3(ijis:ijie,ijje,jk) * p_mask(ijis:ijie,ijje,jk) )
+
+                     ze3crs = SUM( p_e1(ijis:ijie,ijje) * p_e3(ijis:ijie,ijje,jk) * p_mask(ijis:ijie,ijje,jk) )
+                     IF( p_sfc_2d_crs(ji,jj) .NE. 0._wp )p_e3_crs(ji,jj,jk) = ze3crs / p_sfc_2d_crs(ji,jj)
 
                   ENDDO
                ENDDO
             ENDDO
+
          CASE ('W')
 
-            DO jk = 2 , jpk
-               DO ji = nistr, niend, nn_factx
-               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-               IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
-
-                 IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-
-                    jj = mje_crs(2)
-
-
-                    ze3crs = MAX(  p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  &
-                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  &
-                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1))
-
-                     p_e3_max_crs(ii,2,jk) = ze3crs
-
-                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  &
-                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  &
-                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1)
-
-
-                       p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
-                  ENDIF
-               ELSE
-                  jj = mjs_crs(2)
-
-                  ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  &
-                     &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  &
-                     &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  &
-                     &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  &
-                     &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  &
-                     &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  &
-                     &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  &
-                     &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  &
-                     &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) )
-
-                  p_e3_max_crs(ii,2,jk) = ze3crs
-                  ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  &
-                     &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  &
-                     &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) +  &
-                     &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk-1) +  &
-                     &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1) +  &
-                     &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1) +  &
-                     &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk-1) +  &
-                     &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1) +  &
-                     &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1)
-
-                  p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
-               ENDIF
-
-
-                  DO jj = njstr, njend, nn_facty
-                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                     ij   = ( jj - njstr ) * rfacty_r + 3
-                     ijje = mje_crs(ij)
-                     ijie = mie_crs(ii)
-                     !  
-                     ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  &
-                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  &
-                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  &
-                        &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  &
-                        &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  &
-                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  &
-                        &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  &
-                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  &
-                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) )
-
-                     p_e3_max_crs(ii,ij,jk) = ze3crs
-
-                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  &
-                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  &
-                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) +  &
-                        &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk-1) +  &
-                        &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1) +  &
-                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1) +  &
-                        &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk-1) +  &
-                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1) +  &
-                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1)
-
-                       p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
+            DO jk = 1, jpk
+               DO ji = nldi_crs, nlei_crs
+
+                  ijis = mis_crs(ji)
+                  ijie = mie_crs(ji)
+
+                  DO jj = nldj_crs, nlej_crs
+
+                     ijjs = mjs_crs(jj)
+                     ijje = mje_crs(jj)
+
+                     p_e3_max_crs(ji,jj,jk) = MAXVAL( p_e3(ijis:ijie,ijjs:ijje,jk) * p_mask(ijis:ijie,ijjs:ijje,jk) )
+
+                     ze3crs = SUM( p_e1(ijis:ijie,ijjs:ijje) * p_e2(ijis:ijie,ijjs:ijje) * p_e3(ijis:ijie,ijjs:ijje,jk) * p_mask(ijis:ijie,ijjs:ijje,jk) )
+                     IF( p_sfc_3d_crs(ji,jj,jk) .NE. 0._wp )p_e3_crs(ji,jj,jk) = ze3crs / p_sfc_3d_crs(ji,jj,jk)
 
                   ENDDO
@@ -2315,97 +1013,16 @@
             ENDDO
 
-
-            !first level
-            DO ji = nistr, niend, nn_factx
-               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-               IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
-
-                 IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-
-                    jj = mje_crs(2)
-
-                    ze3crs = MAX(  p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  &
-                        &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  &
-                        &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1))
-
-                    p_e3_max_crs(ii,2,1) = ze3crs
-
-                    ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  &
-                        &      p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  &
-                        &      p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1)
-
-                    p_e3_crs(ii,2,1) = ze3crs / p_sfc_crs(ii,2,1)
-                  ENDIF
-               ELSE
-                  jj = mjs_crs(2)
-
-                  ze3crs = MAX( p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  &
-                     &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  &
-                     &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  &
-                     &          p_e3(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  &
-                     &          p_e3(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  &
-                     &          p_e3(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  &
-                     &          p_e3(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  &
-                     &          p_e3(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  &
-                     &          p_e3(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) )
-
-                  p_e3_max_crs(ii,2,1) = ze3crs
-                  ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  &
-                        &    p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  &
-                        &    p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) +  &
-                        &    p_e3(ji  ,jj+1,1) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,1) +  &
-                        &    p_e3(ji+1,jj+1,1) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,1) +  &
-                        &    p_e3(ji+2,jj+1,1) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,1) +  &
-                        &    p_e3(ji  ,jj+2,1) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,1) +  &
-                        &    p_e3(ji+1,jj+2,1) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,1) +  &
-                        &    p_e3(ji+2,jj+2,1) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,1)
-
-                   p_e3_crs(ii,2,1) = ze3crs / p_sfc_crs(ii,2,1)
-
-               ENDIF
-               DO jj = njstr, njend, nn_facty
-                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
-                  ij   = ( jj - njstr ) * rfacty_r + 3
-                  ijje = mje_crs(ij)
-                  ijie = mie_crs(ii)
-                  !  
-                  ze3crs = MAX( p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  &
-                     &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  &
-                     &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  &
-                     &          p_e3(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  &
-                     &          p_e3(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  &
-                     &          p_e3(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  &
-                     &          p_e3(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  &
-                     &          p_e3(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  &
-                     &          p_e3(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) )
-
-                  p_e3_max_crs(ii,ij,1) = ze3crs
-
-                   ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  &
-                        &    p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  &
-                        &    p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) +  &
-                        &    p_e3(ji  ,jj+1,1) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,1) +  &
-                        &    p_e3(ji+1,jj+1,1) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,1) +  &
-                        &    p_e3(ji+2,jj+1,1) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,1) +  &
-                        &    p_e3(ji  ,jj+2,1) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,1) +  &
-                        &    p_e3(ji+1,jj+2,1) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,1) +  &
-                        &    p_e3(ji+2,jj+2,1) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,1)
-
-                       p_e3_crs(ii,ij,1) = ze3crs / p_sfc_crs(ii,ij,1)
-
-               ENDDO
-            ENDDO
-        !              
-       END SELECT
-
-         CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 )
-         CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pval=1.0 )
-       !              
-       !CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zmask )
-       !
+      END SELECT
+
+      CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 )
+      CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pval=1.0 )
+
    END SUBROUTINE crs_dom_e3
 
-   SUBROUTINE crs_dom_sfc( p_mask, cd_type, p_surf_crs, p_surf_crs_msk,  p_e1, p_e2, p_e3 )
-
+   SUBROUTINE crs_dom_sfc(p_mask, cd_type, p_surf_crs, p_surf_crs_msk,  p_e1, p_e2, p_e3 )
+      !!=========================================================================================
+      !!
+      !!
+      !!=========================================================================================
       !!  Arguments
       CHARACTER(len=1),                         INTENT(in)           :: cd_type      ! grid type T, W ( U, V, F)
@@ -2418,6 +1035,5 @@
       !! Local variables
       INTEGER  :: ji, jj, jk                   ! dummy loop indices
-      INTEGER  :: ii, ij, je_2
-      INTEGER  :: iji,ijj
+      INTEGER  :: ijis,ijie,ijjs,ijje
       REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk   
       !!----------------------------------------------------------------  
@@ -2434,10 +1050,4 @@
                zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:) 
             ENDDO
-            !zsurfmsk(:,:,1) = zsurf(:,:,1) * p_mask(:,:,1) 
-            !cbr DO jk = 2, jpk
-            DO jk = 1, jpk
-               !cbr zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk-1) 
-               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk) 
-            ENDDO
 
          CASE ('V')     
@@ -2445,15 +1055,9 @@
                zsurf(:,:,jk) = p_e1(:,:) * p_e3(:,:,jk) 
             ENDDO
-            DO jk = 1, jpk
-               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk) 
-            ENDDO
-
+ 
          CASE ('U')     
             DO jk = 1, jpk
                zsurf(:,:,jk) = p_e2(:,:) * p_e3(:,:,jk) 
             ENDDO
-            DO jk = 1, jpk
-               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk) 
-            ENDDO
 
          CASE DEFAULT
@@ -2461,172 +1065,61 @@
                zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:) 
             ENDDO
+      END SELECT
+
+      DO jk = 1, jpk
+         zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk)
+      ENDDO
+
+      SELECT CASE ( cd_type )
+
+         CASE ('W')
+
             DO jk = 1, jpk
-               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk) 
-            ENDDO
+               DO jj = nldj_crs,nlej_crs
+                  ijjs=mjs_crs(jj)
+                  ijje=mje_crs(jj)
+                  DO ji = nldi_crs,nlei_crs
+                     ijis=mis_crs(ji)
+                     ijie=mie_crs(ji)
+                     p_surf_crs    (ji,jj,jk) =  SUM(zsurf   (ijis:ijie,ijjs:ijje,jk) )
+                     p_surf_crs_msk(ji,jj,jk) =  SUM(zsurfmsk(ijis:ijie,ijjs:ijje,jk) )
+                  ENDDO      
+               ENDDO
+            ENDDO   
+
+         CASE ('U')
+
+            DO jk = 1, jpk
+               DO jj = nldj_crs,nlej_crs
+                  ijjs=mjs_crs(jj)
+                  ijje=mje_crs(jj)
+                  DO ji = nldi_crs,nlei_crs
+                     ijis=mis_crs(ji)
+                     ijie=mie_crs(ji)
+                     p_surf_crs    (ji,jj,jk) =  SUM(zsurf   (ijie,ijjs:ijje,jk) )
+                     p_surf_crs_msk(ji,jj,jk) =  SUM(zsurfmsk(ijie,ijjs:ijje,jk) )
+                  ENDDO
+               ENDDO
+            ENDDO
+
+         CASE ('V')
+
+            DO jk = 1, jpk
+               DO jj = nldj_crs,nlej_crs
+                  ijjs=mjs_crs(jj)
+                  ijje=mje_crs(jj)
+                  DO ji = nldi_crs,nlei_crs
+                     ijis=mis_crs(ji)
+                     ijie=mie_crs(ji)
+                     p_surf_crs    (ji,jj,jk) =  SUM(zsurf   (ijis:ijie,ijje,jk) )
+                     p_surf_crs_msk(ji,jj,jk) =  SUM(zsurfmsk(ijis:ijie,ijje,jk) )
+                  ENDDO
+               ENDDO
+            ENDDO
+
       END SELECT
 
-      !WRITE(narea+200,*)"TOTO",nldj_crs,mjs_crs(1), mje_crs(1),mjs_crs(2), mje_crs(2),mjs_crs(3), mje_crs(3),mjs_crs(4), mje_crs(4) ; CALL FLUSH(narea+200)
-
-      SELECT CASE ( cd_type )
-
-      CASE ('W')
-
-      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-            je_2 = mje_crs(2)
-            DO jk = 1, jpk
-               DO ji = nistr, niend, nn_factx
-                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
-                  !    
-                  p_surf_crs    (ii,2,jk) =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) &
-                    &                      + zsurf(ji,je_2-1,jk) + zsurf(ji+1,je_2-1,jk) + zsurf(ji+2,je_2-1,jk)  ! Why ?????
-                  !
-                  p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji,je_2,jk) + zsurfmsk(ji+1,je_2,jk) + zsurfmsk(ji+2,je_2,jk) 
-                  !
-               ENDDO
-            ENDDO
-         ENDIF
-      ELSE
-         je_2 = mjs_crs(2)
-         DO jk = 1, jpk
-            DO ji = nistr, niend, nn_factx
-               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
-               !  
-               p_surf_crs    (ii,2,jk) =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk)  &
-                    &                   + zsurf(ji,je_2+1,jk) + zsurf(ji+1,je_2+1,jk) + zsurf(ji+2,je_2+1,jk)  &
-                    &                   + zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk)  
-
-               p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji,je_2  ,jk) + zsurfmsk(ji+1,je_2  ,jk) + zsurfmsk(ji+2,je_2  ,jk)  &
-                    &                   + zsurfmsk(ji,je_2+1,jk) + zsurfmsk(ji+1,je_2+1,jk) + zsurfmsk(ji+2,je_2+1,jk)  &
-                    &                   + zsurfmsk(ji,je_2+2,jk) + zsurfmsk(ji+1,je_2+2,jk) + zsurfmsk(ji+2,je_2+2,jk)  
-                ENDDO
-            ENDDO
-      ENDIF
-         
-      DO jk = 1, jpk
-         DO jj = njstr, njend, nn_facty
-            DO ji = nistr, niend, nn_factx
-               ii = ( ji - mis_crs(2) ) * rfactx_r + 2  
-               ij = ( jj - njstr ) * rfacty_r + 3
-               !
-               p_surf_crs    (ii,ij,jk) =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk)  &
-                    &                    + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk)  &
-                    &                    + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk)  
-               p_surf_crs_msk(ii,ij,jk) =  zsurfmsk(ji,jj  ,jk) + zsurfmsk(ji+1,jj  ,jk) + zsurfmsk(ji+2,jj  ,jk)  &
-                    &                    + zsurfmsk(ji,jj+1,jk) + zsurfmsk(ji+1,jj+1,jk) + zsurfmsk(ji+2,jj+1,jk)  &
-                    &                    + zsurfmsk(ji,jj+2,jk) + zsurfmsk(ji+1,jj+2,jk) + zsurfmsk(ji+2,jj+2,jk)  
-
-            ENDDO      
-         ENDDO
-      ENDDO   
-
-      CASE ('U')
-
-     IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-            je_2 = mje_crs(2)
-            DO jk = 1, jpk
-               DO ji = nistr, niend, nn_factx
-                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-                  !    
-                  p_surf_crs    (ii,2,jk) =  zsurf(ji+2,je_2  ,jk)
-                  !
-                  p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji+2,je_2,jk)
-                  !
-               ENDDO
-            ENDDO
-         ENDIF
-      ELSE
-         je_2 = mjs_crs(2)
-         DO jk = 1, jpk
-            DO ji = nistr, niend, nn_factx
-               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-               !  
-               p_surf_crs    (ii,2,jk) =  zsurf(ji+2,je_2  ,jk)  &
-                    &                   + zsurf(ji+2,je_2+1,jk)  &
-                    &                   + zsurf(ji+2,je_2+2,jk)
-
-               p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji+2,je_2  ,jk)  &
-                    &                   + zsurfmsk(ji+2,je_2+1,jk)  &
-                    &                   + zsurfmsk(ji+2,je_2+2,jk)
-                ENDDO
-            ENDDO
-      ENDIF
-
-      DO jk = 1, jpk
-         DO jj = njstr, njend, nn_facty
-            DO ji = nistr, niend, nn_factx
-               ii = ( ji - mis_crs(2) ) * rfactx_r + 2
-               ij = ( jj - njstr ) * rfacty_r + 3
-               !
-               p_surf_crs    (ii,ij,jk) =  zsurf(ji+2,jj  ,jk)  &
-                    &                    + zsurf(ji+2,jj+1,jk)  &
-                    &                    + zsurf(ji+2,jj+2,jk)
-               p_surf_crs_msk(ii,ij,jk) =  zsurfmsk(ji+2,jj  ,jk)  &
-                    &                    + zsurfmsk(ji+2,jj+1,jk)  &
-                    &                    + zsurfmsk(ji+2,jj+2,jk)
-            ENDDO
-         ENDDO
-      ENDDO
-
-      CASE ('V')
-
-      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
-         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
-            je_2 = mje_crs(2)
-            DO jk = 1, jpk
-               DO ji = nistr, niend, nn_factx
-                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-                  !    
-                  p_surf_crs    (ii,2,jk) =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk)
-                  !
-                  p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji,je_2,jk) + zsurfmsk(ji+1,je_2,jk) + zsurfmsk(ji+2,je_2,jk)
-                  !
-               ENDDO
-            ENDDO
-         ENDIF
-      ELSE
-         je_2 = mjs_crs(2)
-         DO jk = 1, jpk
-            DO ji = nistr, niend, nn_factx
-               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
-               !  
-               p_surf_crs    (ii,2,jk) = zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk)
-               p_surf_crs_msk(ii,2,jk) = zsurfmsk(ji,je_2+2,jk) + zsurfmsk(ji+1,je_2+2,jk) + zsurfmsk(ji+2,je_2+2,jk)
-            ENDDO
-         ENDDO
-      ENDIF
-
-      DO jk = 1, jpk
-         DO jj = njstr, njend, nn_facty
-            DO ji = nistr, niend, nn_factx
-               ii = ( ji - mis_crs(2) ) * rfactx_r + 2
-               ij = ( jj - njstr ) * rfacty_r + 3
-               !
-               p_surf_crs    (ii,ij,jk) =  zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk)
-               p_surf_crs_msk(ii,ij,jk) =  zsurfmsk(ji,jj+2,jk) + zsurfmsk(ji+1,jj+2,jk) + zsurfmsk(ji+2,jj+2,jk)
-               !iji=117 ; ijj=210
-               !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1
-               !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN
-               !WRITE(narea+5000,*)"SFC V =======> "
-               !WRITE(narea+5000,*)ii,ij,jk
-               !WRITE(narea+5000,*)ji,jj
-               !WRITE(narea+5000,*)zsurfmsk(ji,jj+2,jk),zsurfmsk(ji+1,jj+2,jk),zsurfmsk(ji+2,jj+2,jk)
-               !WRITE(narea+5000,*)p_surf_crs    (ii,ij,jk),p_surf_crs_msk(ii,ij,jk)
-               !ENDIF
-            ENDDO
-         ENDDO
-      ENDDO
-
-     END SELECT
-      !DO jk=1,jpk
-      !DO ji=1,jpi_crs
-      !DO jj=1,jpj_crs
-      !   IF( p_surf_crs_msk(ji,jj,jk) .NE. p_surf_crs_msk(ji,jj,jk) )WRITE(narea+200,*)"SFC 4 ",ji,jj,jk,p_surf_crs_msk(ji,jj,jk)  ; call flush(narea+200)
-      !ENDDO
-      !ENDDO
-      !ENDDO
-      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0, pval=1.0 )
-      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 )
+      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0 ) !cbr , pval=1.0 )
+      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0 ) !cbr , pval=1.0 )
 
       CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk )
@@ -2647,5 +1140,6 @@
       INTEGER  :: ji,jj,jk,ijjgloT,ijis,ijie,ijjs,ijje,jn      ! dummy indices
       INTEGER  :: ierr                                ! allocation error status
-      INTEGER :: ii,ij,iproc,iprocno,iprocso,iimppt_crs
+      INTEGER :: iproci,iprocj,iproc,iprocno,iprocso,iimppt_crs
+      INTEGER :: ii_start,ii_end,ij_start,ij_end
  
   
@@ -2654,13 +1148,14 @@
   !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 2  ! the -2 removes j=1, j=jpj
   !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 3
-      jpjglo_crs   = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 3
+      jpjglo_crs   = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 2
       jpiglo_crsm1 = jpiglo_crs - 1
       jpjglo_crsm1 = jpjglo_crs - 1  
 
       jpi_crs = ( jpiglo_crs   - 2 * jpreci + (jpni-1) ) / jpni + 2 * jpreci
-      jpj_crs = ( jpjglo_crsm1 - 2 * jprecj + (jpnj-1) ) / jpnj + 2 * jprecj   
-      !WRITE(narea+200,*)"jpj_crs noso = ", jpj_crs , noso        
-      IF( noso < 0 ) jpj_crs = jpj_crs + 1    ! add a local band on southern processors   ! celle qui est faite de zeros
-      !WRITE(narea+200,*)"jpj_crs = ", jpj_crs
+      jpj_crs = ( jpjglo_crsm1 - 2 * jprecj + (jpnj-1) ) / jpnj + 2 * jprecj
+!cbr?      IF( njmpp==1 )THEN
+!         jpj_crs=jpj_crs+1
+!      ENDIF
+
        
       jpi_crsm1   = jpi_crs - 1
@@ -2695,162 +1190,240 @@
         ! mpp_ini2
         !==============================================================================================
-
-        !cbr
-        DO jn = 1, jpnij
-           !WRITE(narea+200,*)"=====> jn",jn  ; call flush(narea+200)
-
-           !proc jn
-           DO ji = 1 , jpni
-              DO jj = 1 ,jpnj
-                 IF( nfipproc(ji,jj)  == jn-1 )THEN
-                    ii=ji
-                    ij=jj
-                 ENDIF
-              ENDDO 
-           ENDDO 
-           iproc =  ii + jpni * ( ij-1 ) - 1
-           ! mppini :  
-           !iprocso =  ii + jpni * ( ij-2 ) - 1 
-           ! mppini2:          
-           IF( ij .GT. 1 )THEN ; iprocso =  nfipproc(ii,ij-1)
-           ELSE                ; iprocso =  -1
+        DO ji = 1 , jpni
+           DO jj = 1 ,jpnj
+              IF( nfipproc(ji,jj)  == narea-1 )THEN
+                 iproci=ji
+                 iprocj=jj
+              ENDIF
+           ENDDO
+        ENDDO
+
+        !WRITE(narea+8000-1,*)"nfipproc(ji,jj),narea :",nfipproc(iproci,iprocj),narea
+        !WRITE(narea+8000-1,*)"proc i,j ",iproci,iprocj
+        !WRITE(narea+8000-1,*)"nowe noea",nowe,noea
+        !WRITE(narea+8000-1,*)"noso nono",noso,nono
+        !WRITE(narea+8000-1,*)"nbondi nbondj ",nbondi,nbondj
+        !WRITE(narea+8000-1,*)"jpiglo jpjglo ",jpiglo,jpjglo
+        !WRITE(narea+8000-1,*)"jpi jpj ",jpi,jpj
+        !WRITE(narea+8000-1,*)"nbondi nbondj",nbondi,nbondj
+        !WRITE(narea+8000-1,*)"nimpp njmpp ",nimpp,njmpp
+        !WRITE(narea+8000-1,*)"loc jpi nldi,nlei,nlci ",jpi, nldi        ,nlei         ,nlci
+        !WRITE(narea+8000-1,*)"glo jpi nldi,nlei      ",jpi, nldi+nimpp-1,nlei+nimpp-1
+        !WRITE(narea+8000-1,*)"loc jpj nldj,nlej,nlcj ",jpj, nldj        ,nlej         ,nlcj
+        !WRITE(narea+8000-1,*)"glo jpj nldj,nlej      ",jpj, nldj+njmpp-1,nlej+njmpp-1
+        !WRITE(narea+8000-1,*)"jpiglo_crs jpjglo_crs ",jpiglo_crs,jpjglo_crs
+        !WRITE(narea+8000-1,*)"jpi_crs jpj_crs ",jpi_crs,jpj_crs
+        !WRITE(narea+8000-1,*)"jpni  jpnj jpnij ",jpni,jpnj,jpnij
+        !WRITE(narea+8000-1,*)"glamt gphit ",glamt(1,1),gphit(jpi,jpj),glamt(jpi,jpj),gphit(jpi,jpj)
+        !==========================================================================
+        ! dim along I
+        !==========================================================================
+        SELECT CASE ( nperio )
+        CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold
+
+           DO ji=1,jpiglo_crs
+              ijis=nn_factx*(ji-1)-2
+              ijie=nn_factx*(ji-1)
+              mis2_crs(ji)=ijis
+              mie2_crs(ji)=ijie
+           ENDDO
+
+           ji=1
+           DO WHILE( mis2_crs(ji) - nimpp + 1 .LT. 1 ) 
+              ji=ji+1
+              IF( ji==jpiglo_crs )EXIT
+           END DO
+           ijis=ji
+
+           !mjs2_crs(ijis)=indice global ds la grille no crs de la premiere maille du premier pavé contenu ds le domaine intérieur
+           !ijis          =indice global ds la grille    crs de la premire maille qui est ds le domaine intérieur
+           !ii_start      =indice local de mjs2_crs(jj)
+           ii_start = mis2_crs(ijis)-nimpp+1
+           nimpp_crs = ijis-1
+
+           nldi_crs = 2
+           IF( nowe == -1 )THEN
+
+               mie2_crs(ijis-1) = mis2_crs(ijis)-1
+              
+               SELECT CASE(ii_start)
+                  CASE(1)
+                     nldi_crs=2
+                     mie2_crs(ijis-1) = -1
+                     mis2_crs(ijis-1) = -1
+                  CASE(2)
+!CBR?                     nldi_crs=1
+                     nldi_crs=2
+                     mis2_crs(ijis-1) = mie2_crs(ijis-1)
+                  CASE(3)
+!CBR?                     nldi_crs=1
+                     nldi_crs=2
+                     mis2_crs(ijis-1) = mie2_crs(ijis-1) -1
+                  CASE DEFAULT
+                     WRITE(narea+8000-1,*)"WRONG VALUE FOR iistart ",ii_start
+               END SELECT
+
+           ENDIF
+
+           IF( nimpp==1 )nimpp_crs=1
+
+           !----------------------------------------
+           ji=jpiglo_crs
+           DO WHILE( mie2_crs(ji) - nimpp + 1 .GT. jpi )
+              ji=ji-1
+              IF( ji==1 )EXIT
+           END DO
+           ijie=ji
+           nlei_crs=ijie-nimpp_crs+1
+           nlci_crs=nlei_crs+jpreci
+
+           !----------------------------------------
+           DO ji = 1, jpi_crs
+              mig_crs(ji) = ji + nimpp_crs - 1
+           ENDDO
+           DO ji = 1, jpiglo_crs
+              mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) )
+              mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs     ) )
+           ENDDO
+
+           !----------------------------------------
+           DO ji = 1, nlei_crs
+              mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1
+              mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1
+              nfactx(ji)  = mie_crs(ji)-mie_crs(ji)+1
+           ENDDO
+
+           IF( iproci == jpni )THEN
+              nlei_crs=nlci_crs
+              mis_crs(nlei_crs)=mis_crs(nlei_crs-1)
+              mie_crs(nlei_crs)=mie_crs(nlei_crs-1)
+           ENDIF
+
+           !----------------------------------------
+
+        CASE DEFAULT
+           WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported'
+        END SELECT
+
+        !==========================================================================
+        ! dim along J
+        !==========================================================================
+        SELECT CASE ( nperio )
+        CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold
+
+           DO jj=1,jpjglo_crs
+              ijjs=nn_facty*(jj)-5
+              ijje=nn_facty*(jj)-3
+              mjs2_crs(jj)=ijjs
+              mje2_crs(jj)=ijje
+           ENDDO
+
+           jj=1
+           DO WHILE( mjs2_crs(jj) - njmpp + 1 .LT. 1 )
+              jj=jj+1
+              IF( jj==jpjglo_crs )EXIT
+           END DO
+           ijjs=jj
+
+           !mjs2_crs(jj)=indice global ds la grille no crs de la premiere maille du premier pavé contenu ds le domaine intérieur
+           !ijjs        =indice global ds la grille    crs de la premire maille qui est ds le domaine intérieur
+           !ij_start    =indice local de mjs2_crs(jj)
+           ij_start = mjs2_crs(ijjs)-njmpp+1
+           njmpp_crs = ijjs-1
+
+           nldj_crs = 2
+           IF( noso == -1 )THEN
+
+               mje2_crs(ijjs-1) = mjs2_crs(ijjs)-1
+
+               SELECT CASE(ij_start)
+                  CASE(1)
+                     nldj_crs=2
+                     mje2_crs(ijjs-1) = -1
+                     mjs2_crs(ijjs-1) = -1
+                  CASE(2)
+!CBR?                     nldj_crs=1
+                     nldj_crs=2
+                     mjs2_crs(ijjs-1) = mje2_crs(ijjs-1)
+                  CASE(3)
+!CBR?                     nldj_crs=1
+                     nldj_crs=2
+                     mjs2_crs(ijjs-1) = mje2_crs(ijjs-1) -1
+                  CASE DEFAULT
+                     WRITE(narea+8000-1,*)"WRONG VALUE FOR iistart ",ii_start
+               END SELECT
+
+           ENDIF
+           IF( njmpp==1 )njmpp_crs=1
+
+
+           !----------------------------------------
+           jj=jpjglo_crs
+           DO WHILE( mje2_crs(jj) - njmpp + 1 .GT. nlcj )
+              jj=jj-1
+              IF( jj==1 )EXIT
+           END DO
+           ijje=jj
+
+           nlej_crs=ijje-njmpp_crs+1
+
+           !----------------------------------------
+           nlcj_crs=nlej_crs+jprecj
+           IF( iprocj == jpnj )THEN
+              nlej_crs=jpj_crs ! cbr -1 ????????????????????
+              nlcj_crs=nlej_crs
            ENDIF
  
-           !WRITE(narea+200,*)ii,ij  ; call flush(narea+200)
-           !WRITE(narea+200,*)"iproc iprocso ",iproc,iprocso
-           !WRITE(narea+200,*)"jpiglo jpjglo ",jpiglo,jpjglo
-           !WRITE(narea+200,*)"ibonit(jn) ibonjt(jn) ",ibonit(jn),ibonjt(jn) ; call flush(narea+200)
-           !WRITE(narea+200,*)"nimppt(jn) njmppt(jn) ",nimppt(jn),njmppt(jn) ; call flush(narea+200)
-           !WRITE(narea+200,*)"loc jpj nldjt(jn),nlejt(jn),nlcjt(jn) ",jpj, nldjt(jn),nlejt(jn),nlcjt(jn) ; call flush(narea+200)
-           !WRITE(narea+200,*)"glo jpj nldjt(jn),nlejt(jn),nlcjt(jn) ",jpj, nldjt(jn)+njmppt(jn)-1,nlejt(jn)+njmppt(jn)-1,nlcjt(jn) ; call flush(narea+200)
-
-           !dimension selon j
-           !-------------------
-           IF( ibonjt(jn) .NE. 1 )THEN !on a besoin de savoir si jn est au nord
-              !iprocno=nfipproc(ii,ij+1) 
-                 !iprocno=iprocno+1
-                 !WRITE(narea+200,*)"ii,ij+1 ",ii,ij+1; call flush(narea+200)
-                 !WRITE(narea+200,*)"njmppt  jn njmpptno(jn) ",njmppt(jn),njmpptno(jn); call flush(narea+200)
-                 !WRITE(narea+200,*)"jpjglo",jpjglo ; call flush(narea+200)
-
-                 !WRITE(narea+200,*)REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ),REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ); call flush(narea+200)
-                 !WRITE(narea+200,*)AINT( REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ) ),AINT( REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ) ); call flush(narea+200)
-
-                 nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ) ) &
-                      &        - AINT( REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ) )
-           ELSE ! ibonjt=1 : au nord
-              nlejt_crs(jn) = AINT( REAL(  nlejt(jn) / nn_facty, wp ) ) + 1
+           !----------------------------------------
+           DO jj = 1, jpj_crs
+              mjg_crs(jj) = jj + njmpp_crs - 1
+           ENDDO
+           DO jj = 1, jpjglo_crs
+              mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) )
+              mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs     ) )
+           ENDDO
+
+           !----------------------------------------
+           DO jj = 1, nlej_crs
+              mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1
+              mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1
+              nfacty(jj)   = mje_crs(jj)-mje_crs(jj)+1
+           ENDDO
+
+           IF( iprocj == jpnj )THEN
+              mjs_crs(nlej_crs)=mjs_crs(nlej_crs-1)
+              mje_crs(nlej_crs)=mje_crs(nlej_crs-1)
            ENDIF
-           !==> nbondj = -1 au sud, 0 au milieu, 1 au nord, 2 si jpnj=1
-           !WRITE(narea+200,*)"nlejt_crs(jn) ",nlejt_crs(jn) ; call flush(narea+200)
-           !!!noso== nbre de proc sud du proc sur lequel on tourne !!!! ; dangeureux car on est ds une boucle sur jn
-           IF( iprocso < 0 .AND. ibonjt(jn) == -1 ) nlejt_crs(jn) = nlejt_crs(jn) + 1
-           SELECT CASE( ibonjt(jn) )
-              CASE ( -1 )
-                !WRITE(narea+200,*)"MOD( jpjglo - njmppt(jn), nn_facty)",MOD( jpjglo - njmppt(jn), nn_facty) ; call flush(narea+200)
-                IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nlejt_crs(jn) = nlejt_crs(jn) + 1  ! au cas où il reste des lignes en bas
-                IF( nldjt(jn) == 1 )  nlejt_crs(jn) = nlejt_crs(jn) + 1
-                nlcjt_crs(jn) = nlejt_crs(jn) + jprecj
-                nldjt_crs(jn) = nldjt(jn)
-                !???nlejt_crs(jn) = nlejt_crs(jn) + 1 ! 2 !cbr  
-              CASE ( 0 )
-
-                nldjt_crs(jn) = nldjt(jn)
-                IF( nldjt(jn) == 1 )  nlejt_crs(jn) = nlejt_crs(jn) + 1
-                nlejt_crs(jn) = nlejt_crs(jn) + jprecj
-                nlcjt_crs(jn) = nlejt_crs(jn) + jprecj
-
-              CASE ( 1, 2 )
-   
-                nlejt_crs(jn) = nlejt_crs(jn) + jprecj
-                nlcjt_crs(jn) = nlejt_crs(jn)
-                nldjt_crs(jn) = nldjt(jn)
-              CASE DEFAULT
-                 STOP
-           END SELECT
-           !WRITE(narea+200,*)"jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) " ; call flush(narea+200)
-           !WRITE(narea+200,*) jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) ; call flush(narea+200)
-           IF( nlcjt_crs(jn) > jpj_crs )THEN
-              jpj_crs = jpj_crs + 1
-              nlejt_crs(jn) = nlejt_crs(jn) + 1
-           ENDIF
-           !cbr pas bon !!!!
-           !on augmente la taille des domaines alors que les tblx st deja alloués
-           !du coup on alloue les tblx apres:
-           IF(nldjt_crs(jn) == 1 ) THEN
-              njmppt_crs(jn) = 1
-           ELSE
-              njmppt_crs(jn) = 2 + ANINT(REAL((njmppt(jn) + 1 - MOD( jpjglo , nn_facty )) / nn_facty, wp ) )
-           ENDIF
-           !WRITE(narea+200,*)"tutu loc ",jn,jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) ; call flush(narea+200)
-           !WRITE(narea+200,*)"tutu glo ",jn,jpj_crs, nldjt_crs(jn)+njmppt_crs(jn)-1,nlejt_crs(jn)+njmppt_crs(jn)-1,nlcjt_crs(jn)+njmppt_crs(jn)-1 ; call flush(narea+200)
-
-
-           !dimensions selon i
-           !-------------------
-           !IF( jn == 1 ) THEN
-           !IF( ibonit(jn)==-1 )THEN !on a besoin de savoir si jn est un proc west
-           IF( ii==1 )THEN !on a besoin de savoir si jn est un proc west
-              nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) )
-           ELSE
-              !WRITE(narea+200,*)"njmppt  jn njmpptea(jn) ",nimppt(jn),nimpptea(jn); call flush(narea+200)
-              !WRITE(narea+200,*)"nlcit  (jn) nlcitea(jn) ) ",nlcit  (jn),nlcitea(jn); call flush(narea+200)
-              nleit_crs(jn) = AINT( REAL( ( nimppt  (jn) - 1 + nlcit  (jn) )  / nn_factx, wp) ) &
-                 &          - AINT( REAL( ( nimpptea(jn) - 1 + nlcitea(jn) )  / nn_factx, wp) )
-           ENDIF
-           !WRITE(narea+200,*)"nleji_crs(jn),noso ",nleit_crs(jn); call flush(narea+200)
-
-
-           SELECT CASE( ibonit(jn) )
-              CASE ( -1 )
-                 nleit_crs(jn) = nleit_crs(jn) + jpreci
-                 nlcit_crs(jn) = nleit_crs(jn) + jpreci
-                 nldit_crs(jn) = nldit(jn)
-
-              CASE ( 0 )
-                 nleit_crs(jn) = nleit_crs(jn) + jpreci
-                 nlcit_crs(jn) = nleit_crs(jn) + jpreci
-                 nldit_crs(jn) = nldit(jn)
-
-              CASE ( 1, 2 )
-                 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )  nleit_crs(jn) = nleit_crs(jn) + 1
-                 nleit_crs(jn) = nleit_crs(jn) + jpreci
-                 nlcit_crs(jn) = nleit_crs(jn)
-                 nldit_crs(jn) = nldit(jn)
-
-              CASE DEFAULT
-                 STOP
-           END SELECT
-           !WRITE(narea+200,*)"jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ",jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ; call flush(narea+200)
-           nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1
-
-           !WRITE(narea+200,*)"tutu loc ",jn,jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ; call flush(narea+200)
-           !WRITE(narea+200,*)"tutu glo ",jn,jpi_crs, nldit_crs(jn)+nimppt_crs(jn)-1,nleit_crs(jn)+nimppt_crs(jn)-1,nlcit_crs(jn)+nimppt_crs(jn)-1 ; call flush(narea+200)
-
-           nfiimpp_crs(ii,ij) = nimppt_crs(jn)
-           !WRITE(narea+200,*)"tutu nimppt_crs(jn) ",ii,ij,nimppt_crs(jn) ; call flush(narea+200)
-          
-        ENDDO
-
-        DO ji = 1 , jpni
-           DO jj = 1 ,jpnj
+
+           !----------------------------------------
+
+        CASE DEFAULT
+           WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported'
+        END SELECT
+
+        !==========================================================================
+        IF( nlci_crs .GT. jpi_crs .OR. nlei_crs .GT. jpi_crs )WRITE(narea+8000-1,*)"BUGDIM ",nlei_crs,nlci_crs,jpi_crs; CALL FLUSH(narea+8000-1)
+        IF( nlcj_crs .GT. jpj_crs .OR. nlej_crs .GT. jpj_crs )WRITE(narea+8000-1,*)"BUGDIM ",nlej_crs,nlcj_crs,jpj_crs; CALL FLUSH(narea+8000-1)
+        !==========================================================================
+
+        nldit_crs(:)=0 ; nleit_crs(:)=0 ; nlcit_crs(:)=0 ; nimppt_crs(:)=0
+        nldjt_crs(:)=0 ; nlejt_crs(:)=0 ; nlcjt_crs(:)=0 ; njmppt_crs(:)=0
+
+        CALL mppgatheri((/nlci_crs/),0,nlcit_crs) ; CALL mppgatheri((/nlcj_crs/),0,nlcjt_crs) 
+        CALL mppgatheri((/nldi_crs/),0,nldit_crs) ; CALL mppgatheri((/nldj_crs/),0,nldjt_crs) 
+        CALL mppgatheri((/nlei_crs/),0,nleit_crs) ; CALL mppgatheri((/nlej_crs/),0,nlejt_crs) 
+        CALL mppgatheri((/nimpp_crs/),0,nimppt_crs) ; CALL mppgatheri((/njmpp_crs/),0,njmppt_crs) 
+
+        DO jj = 1 ,jpnj
+           DO ji = 1 , jpni
               jn=nfipproc(ji,jj)+1
-              iimppt_crs = ANINT( REAL( (nfiimpp(ji,jj) + 1 ) / nn_factx, wp ) ) + 1
-              nfiimpp_crs(ji,jj) = iimppt_crs
-              IF( jn .GE. 1 )nimppt_crs(jn) = iimppt_crs
-              !PRINT*," nfiimpp_crs(ji,jj) ",ji,jj,jn,nfiimpp(ji,jj),nfiimpp_crs(ji,jj)
+              IF( jn .GE. 1 )THEN
+                 nfiimpp_crs(ji,jj)=nimppt_crs(jn)
+              ELSE
+                 nfiimpp_crs(ji,jj) = ANINT( REAL( (nfiimpp(ji,jj) + 1 ) / nn_factx, wp ) ) + 1
+              ENDIF
            ENDDO
         ENDDO
-
-        nlej_crs  = nlejt_crs(nproc + 1)
-        nlcj_crs  = nlcjt_crs(nproc + 1)
-        nldj_crs  = nldjt_crs(nproc + 1)
-        njmpp_crs = njmppt_crs(nproc + 1)
-
-        nlei_crs  = nleit_crs(nproc + 1)
-        nlci_crs  = nlcit_crs(nproc + 1)
-        nldi_crs  = nldit_crs(nproc + 1)
-        nimpp_crs = nimppt_crs(nproc + 1)
-
+ 
         !nogather=T
         nfsloop_crs = 1
@@ -2867,40 +1440,11 @@
         END DO
 
+        !WRITE(narea+8000-1,*)"loc crs jpi nldi,nlei,nlci ",jpi_crs, nldi_crs            ,nlei_crs             ,nlci_crs
+        !WRITE(narea+8000-1,*)"glo crs jpi nldi,nlei      ",jpi_crs, nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1
+        !WRITE(narea+8000-1,*)"loc crs jpj nldj,nlej,nlcj ",jpj_crs, nldj_crs            ,nlej_crs             ,nlcj_crs
+        !WRITE(narea+8000-1,*)"glo crs jpj nldj,nlej      ",jpj_crs, nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1
         !==============================================================================================
-         !write(narea+200,*)"jpi_crs,nldi_crs,nlei_crs,nlci_crs,nimpp_crs,nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1" ; call flush(narea+200)
-         !write(narea+200,*)jpi_crs,nldi_crs,nlei_crs,nlci_crs,nimpp_crs,nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1 ; call flush(narea+200)
-         !write(narea+200,*)"jpj_crs,nldj_crs,nlej_crs,nlcj_crs,njmpp_crs,nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1" ; call flush(narea+200)
-         !write(narea+200,*)jpj_crs,nldj_crs,nlej_crs,nlcj_crs,njmpp_crs,nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 ; call flush(narea+200)
-         !write(narea+200,*)"nfsloop_crs nfeloop_crs ",nfsloop_crs,nfeloop_crs ; call flush(narea+200)
-
-         ! No coarsening with zoom
          IF( jpizoom /= 1 .OR. jpjzoom /= 1)    STOP 
 
-         !cbr
-         ierr = crs_dom_alloc1() 
-
-         DO ji = 1, jpi_crs
-            mig_crs(ji) = ji + nimpp_crs - 1
-            !WRITE(narea+200,*)"fifi ",ji,mig_crs(ji)  ; call flush(narea+200)
-         ENDDO
-         DO jj = 1, jpj_crs
-            mjg_crs(jj) = jj + njmpp_crs - 1!
-            !WRITE(narea+200,*)"fufu ",jj,mjg_crs(jj)  ; call flush(narea+200)
-         ENDDO
-       
-         DO ji = 1, jpiglo_crs
-            mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) )
-            mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs     ) )
-            !WRITE(narea+200,*)"mi ",ji,mi0_crs(ji),mi1_crs(ji)  ; call flush(narea+200)
-         ENDDO
-         
-         DO jj = 1, jpjglo_crs
-            mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) )
-            mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs     ) )
-            !WRITE(narea+200,*)"mj ",jj, mj0_crs(jj),mj1_crs(jj) ; call flush(narea+200)
-         ENDDO
-
-      ENDIF
-      
       !                         Save the parent grid information
       jpi_full    = jpi
@@ -2987,118 +1531,9 @@
       rfactxy = nn_factx * nn_facty
       
-      ! 2.b. Set up bins for coarse grid, horizontal only.
-      ierr = crs_dom_alloc2()
-     
-      mis2_crs(:) = 0      ;      mie2_crs(:) = 0
-      mjs2_crs(:) = 0      ;      mje2_crs(:) = 0
-
-      
-      SELECT CASE ( nn_binref )
-
-      CASE ( 0 ) 
-
-         SELECT CASE ( nperio )
-     
- 
-        CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold
-        
-            DO ji = 2, jpiglo_crsm1
-               ijie = ( ji * nn_factx ) - nn_factx   !cc
-               ijis = ijie - nn_factx + 1
-               mis2_crs(ji) = ijis
-               mie2_crs(ji) = ijie
-            ENDDO
-            IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie2_crs(jpiglo_crsm1) = jpiglo - 2  
-
-            ! Handle first the northernmost bin
-            IF ( nn_facty == 2 ) THEN   ;    ijjgloT = jpjglo - 1 
-            ELSE                        ;    ijjgloT = jpjglo
-            ENDIF
-
-            DO jj = 2, jpjglo_crs
-                ijje = ijjgloT - nn_facty * ( jj - 3 )
-                ijjs = ijje - nn_facty + 1                   
-                mjs2_crs(jpjglo_crs-jj+2) = ijjs
-                mje2_crs(jpjglo_crs-jj+2) = ijje
-               !WRITE(narea+200,*)"jpjglo_crs-jj+2,ijje,ijjs ",jpjglo_crs-jj+2,ijjs,ijje ; call flush(narea+200)
-            ENDDO
-
-         CASE ( 2 ) 
-            WRITE(numout,*)  'crs_init, jperio=2 not supported' 
-        
-         CASE ( 5, 6 )    ! F-pivot at North Fold
-
-            DO ji = 2, jpiglo_crsm1
-               ijie = ( ji * nn_factx ) - nn_factx 
-               ijis = ijie - nn_factx + 1
-               mis2_crs(ji) = ijis
-               mie2_crs(ji) = ijie
-            ENDDO
-            IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie_crs(jpiglo_crsm1)  = jpiglo - 2 
-
-            ! Treat the northernmost bin separately.
-            jj = 2
-            ijje = jpj - nn_facty * ( jj - 2 )
-            IF ( nn_facty == 3 ) THEN   ;  ijjs = ijje - 1 
-            ELSE                        ;  ijjs = ijje - nn_facty + 1
-            ENDIF
-            mjs2_crs(jpj_crs-jj+1) = ijjs
-            mje2_crs(jpj_crs-jj+1) = ijje
-
-            ! Now bin the rest, any remainder at the south is lumped in the southern bin
-            DO jj = 3, jpjglo_crsm1
-                ijje = jpjglo - nn_facty * ( jj - 2 )
-                ijjs = ijje - nn_facty + 1                  
-                IF ( ijjs <= nn_facty )  ijjs = 2
-                WRITE(narea+200,*)"fufu",jj,ijjs,ijje ; call flush(narea+200)
-                mjs2_crs(jpj_crs-jj+1)   = ijjs
-                mje2_crs(jpj_crs-jj+1)   = ijje
-            ENDDO
-
-         CASE DEFAULT
-            WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4, 5, 6 supported' 
- 
-         END SELECT
-
-      CASE (1 )
-         WRITE(numout,*) 'crs_init.  Equator-centered bins option not yet available' 
-
-      END SELECT
-
-     ! Pad the boundaries, do not know if it is necessary
-      mis2_crs(2) = 1             ;  mis2_crs(jpiglo_crs) = mie2_crs(jpiglo_crs - 1) + 1   
-      mie2_crs(2) = nn_factx      ;  mie2_crs(jpiglo_crs) = jpiglo                         
-      !
-      mjs2_crs(1) = 1
-      mje2_crs(1) = 1
-      !
-      mje2_crs(2) = mjs2_crs(3)-1 ;  mje2_crs(jpjglo_crs) = jpjglo
-      mjs2_crs(2) = 1             ;  mjs2_crs(jpjglo_crs) = mje2_crs(jpjglo_crs) - nn_facty + 1 
- 
-      IF( .NOT. lk_mpp ) THEN     
-        mis_crs(:) = mis2_crs(:) 
-        mie_crs(:) = mie2_crs(:)
-        mjs_crs(:) = mjs2_crs(:) 
-        mje_crs(:) = mje2_crs(:) 
-      ELSE
-       !write(narea+200,*)"njmpp ",njmpp
-        DO jj = 1, nlej_crs
-           !write(narea+200,*)jj,"mjs2_crs mje2_crs ",mjg_crs(jj),mjs2_crs(mjg_crs(jj)),mje2_crs(mjg_crs(jj)) ; call flush(narea+200)
-           mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1
-           mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1
-           !write(narea+200,*)"mjs_crs mje_crs ",mjs_crs(jj),mje_crs(jj) ; call flush(narea+200)
-        ENDDO
-        !write(narea+200,*)"nimpp ",nimpp
-        DO ji = 1, nlei_crs
-           !write(narea+200,*)ji,"mis2_crs mie2_crs ",mig_crs(ji),mis2_crs(mig_crs(ji)),mie2_crs(mig_crs(ji)) ; call flush(narea+200)
-           mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1
-           mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1
-           !write(narea+200,*)"mis_crs mie_crs ",mis_crs(jj),mie_crs(jj) ; call flush(narea+200)
-        ENDDO
       ENDIF
       !
-      !IF( nlcj_crs -1 .GT. nlej_crs )WRITE(narea+200,*)"tutututu",nlcj_crs,nlej_crs ; call flush(narea+200)
       nistr = mis_crs(2)  ;   niend = mis_crs(nlci_crs - 1)
       njstr = mjs_crs(3)  ;   njend = mjs_crs(nlcj_crs - 1)
+      !
       !
    END SUBROUTINE crs_dom_def
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90	(revision 6772)
@@ -33,5 +33,4 @@
    PUBLIC crs_dom_wri        ! routine called by crsini.F90
 
-   !! $Id$
 CONTAINS
 
@@ -65,4 +64,5 @@
       CHARACTER(len=21) ::   clnam4   ! filename (vertical   mesh informations)
       INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      INTEGER           ::   iji,ijj
       !                                   !  workspaces
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw 
@@ -122,4 +122,5 @@
       !========================================================
       !                                                         ! masks (inum2) 
+
       CALL iom_rstput( 0, 0, inum2, 'tmask', tmask_crs, ktype = jp_i1 )     !    ! land-sea mask
       CALL iom_rstput( 0, 0, inum2, 'umask', umask_crs, ktype = jp_i1 )
@@ -202,15 +203,15 @@
             
          IF ( nn_msh_crs <= 6 ) THEN
-            CALL iom_rstput( 0, 0, inum4, 'e3t', e3t_crs )      
-            CALL iom_rstput( 0, 0, inum4, 'e3w', e3w_crs )      
-            CALL iom_rstput( 0, 0, inum4, 'e3u', e3u_crs )      
-            CALL iom_rstput( 0, 0, inum4, 'e3v', e3v_crs )      
-            CALL iom_rstput( 0, 0, inum4, 'e3t_max_crs', e3t_max_crs )      
-            CALL iom_rstput( 0, 0, inum4, 'e3w_max_crs', e3w_max_crs )      
+            CALL iom_rstput( 0, 0, inum4, 'e3t', e3t_0_crs )      
+            CALL iom_rstput( 0, 0, inum4, 'e3w', e3w_0_crs )      
+            CALL iom_rstput( 0, 0, inum4, 'e3u', e3u_0_crs )      
+            CALL iom_rstput( 0, 0, inum4, 'e3v', e3v_0_crs )      
+            CALL iom_rstput( 0, 0, inum4, 'e3t_max_crs', e3t_max_0_crs )      
+            CALL iom_rstput( 0, 0, inum4, 'e3w_max_crs', e3w_max_0_crs )      
          ELSE
             DO jj = 1,jpj_crs   
                DO ji = 1,jpi_crs
-                  ze3tp(ji,jj) = e3t_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1)
-                  ze3wp(ji,jj) = e3w_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1)
+                  ze3tp(ji,jj) = e3t_0_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1)
+                  ze3wp(ji,jj) = e3w_0_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1)
                END DO
             END DO
@@ -224,10 +225,10 @@
 
          IF ( nn_msh_crs <= 3 ) THEN
-            CALL iom_rstput( 0, 0, inum4, 'gdept', gdept_crs, ktype = jp_r4 ) 
+            CALL iom_rstput( 0, 0, inum4, 'gdept', gdept_0_crs, ktype = jp_r4 ) 
             DO jk = 1,jpk   
                DO jj = 1, jpj_crsm1   
                   DO ji = 1, jpi_crsm1  ! jes what to do for fs_jpim1??vector opt.
-                     zdepu(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji+1,jj  ,jk) ) * umask_crs(ji,jj,jk)
-                     zdepv(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji  ,jj+1,jk) ) * vmask_crs(ji,jj,jk)
+                     zdepu(ji,jj,jk) = MIN( gdept_0_crs(ji,jj,jk) , gdept_0_crs(ji+1,jj  ,jk) ) * umask_crs(ji,jj,jk)
+                     zdepv(ji,jj,jk) = MIN( gdept_0_crs(ji,jj,jk) , gdept_0_crs(ji  ,jj+1,jk) ) * vmask_crs(ji,jj,jk)
                   END DO   
                END DO   
@@ -237,5 +238,5 @@
             CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r4 )
             CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r4 )
-            CALL iom_rstput( 0, 0, inum4, 'gdepw', gdepw_crs, ktype = jp_r4 )
+            CALL iom_rstput( 0, 0, inum4, 'gdepw', gdepw_0_crs, ktype = jp_r4 )
          ELSE
             DO jj = 1,jpj_crs   
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 6772)
@@ -24,4 +24,6 @@
    USE crs
    USE crsdom
+   USE domvvl
+   USE domvvl_crs
    USE crslbclnk
    USE iom
@@ -32,5 +34,5 @@
    USE zdftke_crs
 
-!   USE ieee_arithmetic
+   USE ieee_arithmetic
 
    IMPLICIT NONE
@@ -77,5 +79,6 @@
       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: avte_crs
       REAL(wp)       :: z2dcrsu, z2dcrsv
-      REAL(wp)       :: zmin,zmax,icnt1,icnt2
+      REAL(wp)       :: z1_2dt
+      REAL(wp)       :: icnt1,icnt2
       INTEGER :: i,j,ijis,ijie,ijjs,ijje
       REAL(wp)       :: zw,zwp1,zum1,zu,zvm1,zv,zsnm,zsm,z
@@ -85,4 +88,5 @@
       INTEGER ::  iji,ijj
       INTEGER :: jl,jm,jn
+      REAL(wp)       :: zmin,zmax,zsuma0,zsuma1,zsuma2,zsuma3,zsumb0,zsumb1,zsumb2,zsumb3,zsumb4
       !!
       !!----------------------------------------------------------------------
@@ -101,9 +105,4 @@
       CALL wrk_alloc( jpi_crs, jpj_crs, z2d_crs     )
 
-      ! Depth work arrrays
-      zfse3t(:,:,:) = fse3t(:,:,:)
-      zfse3u(:,:,:) = fse3u(:,:,:)
-      zfse3v(:,:,:) = fse3v(:,:,:)
-      zfse3w(:,:,:) = fse3w(:,:,:)
 
       IF( kt == nit000  ) THEN
@@ -124,4 +123,5 @@
          emp_b_crs(:,:    ) = 0._wp    ! emp
          rnf_crs  (:,:    ) = 0._wp    ! runoff
+         rnf_b_crs(:,:    ) = 0._wp    ! runoff
          fr_i_crs (:,:    ) = 0._wp    ! ice cover
       ENDIF
@@ -129,11 +129,78 @@
       CALL iom_swap( "nemo_crs" )    ! swap on the coarse grid
 
-      ! 2. Coarsen fields at each time step
-      ! --------------------------------------------------------
+      !---------------------------------------------------------------------------------------------------
+      !variables domaine au temps before : swap 
+      !---------------------------------------------------------------------------------------------------
+#if defined key_vvl
+      e3t_b_crs(:,:,:) = e3t_n_crs(:,:,:)
+      e3u_b_crs(:,:,:) = e3u_n_crs(:,:,:)
+      e3v_b_crs(:,:,:) = e3v_n_crs(:,:,:)
+      e3w_b_crs(:,:,:) = e3w_n_crs(:,:,:)
+      e3t_n_crs(:,:,:) = e3t_a_crs(:,:,:)
+      e3u_n_crs(:,:,:) = e3u_a_crs(:,:,:)
+      e3v_n_crs(:,:,:) = e3v_a_crs(:,:,:)
+      e3w_n_crs(:,:,:) = e3w_a_crs(:,:,:)
+#endif
+
+      IF( kt /= nit000 )THEN
+         tsb_crs(:,:,:,jp_tem) = tsn_crs(:,:,:,jp_tem) 
+         tsb_crs(:,:,:,jp_sal) = tsn_crs(:,:,:,jp_sal) 
+         ub_crs(:,:,:)         = un_crs(:,:,:) 
+         vb_crs(:,:,:)         = vn_crs(:,:,:) 
+         sshb_crs(:,:)         = sshb_crs(:,:)
+         emp_b_crs(:,:)        = emp_crs(:,:)
+         rnf_b_crs(:,:)        = rnf_crs(:,:)
+         rb2_crs(:,:,:)        = rn2_crs(:,:,:)
+      ENDIF
+
+      !---------------------------------------------------------------------------------------------------
+      !variables domaine au temps now : 
+      !---------------------------------------------------------------------------------------------------
+#if defined key_vvl
+      zfse3t(:,:,:) = e3t_n(:,:,:)
+      zfse3u(:,:,:) = e3u_n(:,:,:)
+      zfse3v(:,:,:) = e3v_n(:,:,:)
+      zfse3w(:,:,:) = e3w_n(:,:,:)
+
+      CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u )
+      CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v )
+      !                                                                                 
+      CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=zs_crs, p_e3_max_crs=e3t_max_0_crs)
+      CALL crs_dom_e3( e1t, e2t, zfse3w, p_sfc_3d_crs=e1e2w_crs, cd_type='W', p_mask=tmask, p_e3_crs=zs_crs, p_e3_max_crs=e3w_max_0_crs)
+      CALL crs_dom_e3( e1u, e2u, zfse3u, p_sfc_2d_crs=e2u_crs  , cd_type='U', p_mask=umask, p_e3_crs=zs_crs, p_e3_max_crs=e3u_max_0_crs)
+      CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs  , cd_type='V', p_mask=vmask, p_e3_crs=zs_crs, p_e3_max_crs=e3v_max_0_crs)
+
+      CALL crs_dom_ope( gdepw_n, 'MAX', 'T', tmask, gdept_n_crs, p_e3=zfse3t, psgn=1.0 )
+      CALL crs_dom_ope( gdepw_n, 'MAX', 'W', tmask, gdepw_n_crs, p_e3=zfse3w, psgn=1.0 )
+
+      CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, ocean_volume_crs_t, facvol_t )
+      CALL iom_put("ocean_volume_crs_t",ocean_volume_crs_t)
+      !
+      bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:)*tmask_crs(:,:,:)
+      !
+      r1_bt_crs(:,:,:) = 0._wp
+      WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:)
+
+      CALL crs_dom_facvol( tmask, 'W', e1t, e2t, zfse3w, ocean_volume_crs_w, facvol_w )
+
+#endif
+
+#if defined key_vvl
+      zfse3t(:,:,:) = e3t_n(:,:,:)
+      zfse3u(:,:,:) = e3u_n(:,:,:)
+      zfse3v(:,:,:) = e3v_n(:,:,:)
+      zfse3w(:,:,:) = e3w_n(:,:,:)
+      CALL iom_put("e3t",e3t_n_crs)
+      CALL iom_put("e3u",e3u_n_crs)
+      CALL iom_put("e3v",e3v_n_crs)
+      CALL iom_put("e3w",e3w_n_crs)
+#else
+      zfse3t(:,:,:) = e3t_0(:,:,:)
+      zfse3u(:,:,:) = e3u_0(:,:,:)
+      zfse3v(:,:,:) = e3v_0(:,:,:)
+      zfse3w(:,:,:) = e3w_0(:,:,:)
+#endif
 
       !  Temperature
-      zt(:,:,:) = tsb(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
-      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
-      tsb_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
       zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
       CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
@@ -143,14 +210,5 @@
       CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) )    ! sst
 
-      !n2 before
-      zt(:,:,:) = rn2b(:,:,:)  ;      zt_crs(:,:,:) = 0._wp
-      CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
-      rb2_crs(:,:,:) = zt_crs(:,:,:)
-      CALL iom_put("rb2_crs",rb2_crs)
-
       !  Salinity
-      zs(:,:,:) = tsb(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
-      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
-      tsb_crs(:,:,:,jp_sal) = zs_crs(:,:,:)
       zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
       CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
@@ -161,84 +219,25 @@
 
       !  U-velocity
-      CALL crs_dom_ope( ub, 'SUM', 'U', umask, ub_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
       CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
-      !cbr
-      ub_crs(:,:,:) = ub_crs(:,:,:)*umask_crs(:,:,:)
       un_crs(:,:,:) = un_crs(:,:,:)*umask_crs(:,:,:)
-      !
-      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
+      CALL iom_put( "uoce"  , un_crs )   ! i-current 
+
+      !  V-velocity
+      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+      vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:)
+      CALL iom_put( "voce"  , vn_crs )   ! i-current 
+     
+      !  Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 ) 
+      hdivn_crs(:,:,:)=0._wp
+
       DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   
-               zt(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
-               zs(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
-            END DO
-         END DO
-      END DO
-      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
-      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
-
-      CALL iom_put( "uoce"  , un_crs )   ! i-current 
-      CALL iom_put( "uocet" , zt_crs )   ! uT
-      CALL iom_put( "uoces" , zs_crs )   ! uS
-
-      !  V-velocity
-      CALL crs_dom_ope( vb, 'SUM', 'V', vmask, vb_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
-      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
-      vb_crs(:,:,:) = vb_crs(:,:,:)*vmask_crs(:,:,:)
-      vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:)
-      !                                                                                 
-      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   
-               zt(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
-               zs(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
-            END DO
-         END DO
-      END DO
-      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
-      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
- 
-      CALL iom_put( "voce"  , vn_crs )   ! i-current 
-      CALL iom_put( "vocet" , zt_crs )   ! vT
-      CALL iom_put( "voces" , zs_crs )   ! vS
-
-     
-      !  Kinetic energy
-      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
-      CALL iom_put( "eken", rke_crs )
-
-      !  Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 ) 
-      DO jk = 1, jpkm1
-         DO ji = 2, jpi_crsm1
-            DO jj = 2, jpj_crsm1
-               IF( tmask_crs(ji,jj,jk ) > 0 ) THEN
-                  !z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * crs_surfu_wgt(ji  ,jj  ,jk) ) &
-                  !   &     - ( un_crs(ji-1,jj  ,jk) * crs_surfu_wgt(ji-1,jj  ,jk) )
-                  !z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * crs_surfv_wgt(ji  ,jj  ,jk) ) &
-                  !   &     - ( vn_crs(ji  ,jj-1,jk) * crs_surfv_wgt(ji  ,jj-1,jk) )
-                  !
-                  !IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk)
-                  z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * e2e3u_msk(ji  ,jj  ,jk) ) &
-                     &     - ( un_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) )
-                  z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * e1e3v_msk(ji  ,jj  ,jk) ) &
-                     &     - ( vn_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk) )
-                  !
-                  !cbr
-                  !bug1: il manquait le facvol_t(ji,jj,jk) ds la division ; ca creait des grosses erreurs de Wcrs ( vu en recalculant la divergence 3D )
-                  !bug2: mm test que bug1: on n'obtient tjs pas zero
-                  !on a la div calculée via ocean_volume_crs_t puis w via  e3t_crs ; or ,e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk) NE ocean_volume_crs_t*crs_volt_wgt(ji,jj,jk)
-                  !exp (117,211,74) : e1*e2*e3=235206030060.005 / ocean_volume_crs_t * facvol = 235205585307.810
-                  !                   e1*e2*e3-cean_volume_crs_t * facvol/(cean_volume_crs_t * facvol) ~1.e-6)  
-                  IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv )
-
-                  z2dcrsu =  ( ub_crs(ji  ,jj  ,jk) * e2e3u_msk(ji  ,jj  ,jk) ) &
-                     &     - ( ub_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) )
-                  z2dcrsv =  ( vb_crs(ji  ,jj  ,jk) * e1e3v_msk(ji  ,jj  ,jk) ) &
-                     &     - ( vb_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk) )
-                  !
-                  IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivb_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk) )
-               ENDIF
+         DO jj = 2,jpj_crs
+            DO ji = 2,jpi_crs
+               z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * e2e3u_msk(ji  ,jj  ,jk) ) &
+                 &      - ( un_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) )
+               z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * e1e3v_msk(ji  ,jj  ,jk) ) &
+                 &      - ( vn_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk) )
+
+               hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv )
             ENDDO
          ENDDO
@@ -248,18 +247,4 @@
       CALL iom_put( "hdiv", hdivn_crs )  
 
-
-      !  W-velocity
-      IF( ln_crs_wn ) THEN
-         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
-      ELSE
-        wn_crs(:,:,jpk) = 0._wp
-        DO jk = jpkm1, 1, -1
-           wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk)
-           WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp )  wn_crs(:,:,jk) =  wn_crs(:,:,jk) /e1e2w_msk(:,:,jk) 
-        ENDDO
-      ENDIF
-
-      CALL iom_put( "woce", wn_crs  )   ! vertical velocity
-      !  free memory
 
       !  avt, avs
@@ -276,4 +261,5 @@
             CALL crs_dom_ope( avt, 'MED', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
          CASE ( 5 )
+#if defined key_zdftke
             CALL crs_dom_ope( en , 'VOL', 'W', tmask, en_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
             CALL crs_dom_ope( taum , 'SUM', 'T', tmask, taum_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
@@ -282,4 +268,5 @@
             CALL tke_avn_crs
             CALL zdf_evd_crs(kt)
+#endif
          CASE ( 6 )
 
@@ -295,10 +282,6 @@
             CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )
             CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )
-            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax 
-            zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax 
             zt_crs=tmask_crs*zt_crs
-            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax 
             WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,1) = zt_crs / zs_crs
-            zmin=MINVAL(avte_crs(:,:,:,1));zmax=MAXVAL(avte_crs(:,:,:,1));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax 
 
             zt(:,:,:) = 0._wp
@@ -310,10 +293,6 @@
             CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )
             CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )
-            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte2_crs",zmin,zmax 
-            zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte2_crs",zmin,zmax 
             zt_crs=tmask_crs*zt_crs
-            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax
             WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,2) = zt_crs / zs_crs
-            zmin=MINVAL(avte_crs(:,:,:,2));zmax=MAXVAL(avte_crs(:,:,:,2));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte2_crs",zmin,zmax
 
             zt(:,:,:) = 0._wp
@@ -326,10 +305,6 @@
             CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )
             CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )
-            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax 
-            zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax 
             zt_crs=tmask_crs*zt_crs
-            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax
             WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,3) = zt_crs / zs_crs
-            zmin=MINVAL(avte_crs(:,:,:,3));zmax=MAXVAL(avte_crs(:,:,:,3));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax
 
             zt(:,:,:) = 0._wp
@@ -342,10 +317,6 @@
             CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )
             CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )
-            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax 
-            zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax 
             zt_crs=tmask_crs*zt_crs
-            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax
             WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,4) = zt_crs / zs_crs
-            zmin=MINVAL(avte_crs(:,:,:,4));zmax=MAXVAL(avte_crs(:,:,:,4));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax
 
             CALL iom_put( "avte_crs1", avte_crs(:,:,:,1) )   !  Kz
@@ -353,15 +324,10 @@
             CALL iom_put( "avte_crs3", avte_crs(:,:,:,3) )   !  Kz
             CALL iom_put( "avte_crs4", avte_crs(:,:,:,4) )   !  Kz
-!--------------------- 
+
             CALL crs_dom_ope( avt, 'MED', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3w, p_mask_crs=tmask_crs, psgn=1.0 )
-!?            zmin=MINVAL(zs_crs*tmask_crs);zmax=MAXVAL(zs_crs*tmask_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"logvol zs_crs*tmask ",zmin,zmax ; call flush(numout)
             CALL iom_put( "zs_crs", zs_crs )   !  Kzlogvol
-!--------------------- ok
 
             CALL crs_dom_ope( avt, 'VOL', 'W', tmask, zmax_crs, p_e12=e1e2t, p_e3=zfse3w,  psgn=1.0 )
-            WRITE(narea+200,*)"zmax_crs ",SHAPE(zmax_crs) ; call flush(narea+200)
             CALL iom_put( "zmax_crs", zmax_crs )   !  Kzlogvol
-            zmin=MINVAL(zmax_crs*tmask_crs);zmax=MAXVAL(zmax_crs*tmask_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"vol zmax_crs*tmask ",zmin,zmax ; call flush(numout)
-!-------------------------nok
             avt_crs=zs_crs
 
@@ -379,8 +345,6 @@
 
  
-!--------------
                zwgt(1:4)=0._wp
                DO jm=1,4 ; IF( avte_crs(ji,jj,jk,jm)  .GE. 0._wp .AND.  avte_crs(ji,jj,jk,jm)  .LE. zmax_crs(ji,jj,jk)  ) zwgt(jm) = 1._wp ; ENDDO
-!--------------
                IF( SUM(zwgt(1:4)) .NE. 0._wp ) THEN  
                   zmean = SUM( zwgt(1:4)*avte_crs(ji,jj,jk,1:4)) / SUM(zwgt(1:4) )
@@ -390,5 +354,4 @@
                  zerr=1.e10
                ENDIF
-!--------------
 
                zerr_crs(ji,jj,jk)=zerr
@@ -400,16 +363,8 @@
                IF( tmask_crs(ji,jj,jk) == 1 .AND.  zerr .LE. zerr0 .AND. zmean .GT. 0._wp ) icnt2=icnt2+1
 
-               !IF( ieee_is_nan(  zt_crs(ji,jj,jk))   )WRITE(narea+200,*)"NANMEANEFF ",ji,jj,jk,tmask_crs(ji,jj,jk)  ; call flush(narea+200)
-               !IF( ieee_is_nan(  zs_crs(ji,jj,jk))   )WRITE(narea+200,*)"NANLOG ",ji,jj,jk,tmask_crs(ji,jj,jk)  ; call flush(narea+200)
-               !IF( ieee_is_nan( avt_crs(ji,jj,jk))   )WRITE(narea+200,*)"NANAVT ",ji,jj,jk,tmask_crs(ji,jj,jk)  ; call flush(narea+200)
-            ENDDO
-            ENDDO
-            ENDDO
-            zmin=MINVAL(avt_crs);zmax=MAXVAL(avt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avt_crs ",zmin,zmax  ; call flush(numout)
-            zmin=MINVAL(avt_crs*tmask_crs);zmax=MAXVAL(avt_crs*tmask_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avt_crs*tmask ",zmin,zmax  ; call flush(numout)
-
-            CALL mpp_sum(icnt1)
-            CALL mpp_sum(icnt2)
-            IF(lwp)WRITE(numout,*)"TOTO",kt,icnt1,icnt2
+            ENDDO
+            ENDDO
+            ENDDO
+
             CALL iom_put( "zt_crs", zt_crs )   !  Kz
             CALL iom_put( "zerr_crs", zerr_crs )   !  Kz
@@ -419,12 +374,5 @@
       CALL iom_put( "avt", avt_crs )   !  Kz
      
-      !deja dasn step CALL zdf_mxl_crs(kt)
-
- 
-      !  sbc fields  
-
-      CALL crs_dom_ope( sshb , 'VOL', 'T', tmask, sshb_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )  
       CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )  
-      CALL crs_dom_ope( ssha , 'VOL', 'T', tmask, ssha_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )  
       CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 )
       CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 )
@@ -432,6 +380,12 @@
       CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0 )
       CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
-      CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
+#if defined key_vvl
+      CALL crs_dom_ope( gdepw_n, 'MAX', 'W', tmask, gdepw_n_crs, p_e3=zfse3w, psgn=1.0 )
+#else
+      CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_0_crs, p_e3=zfse3w, psgn=1.0 )
+#endif
+
       CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
+
       CALL crs_dom_ope( fmmflx,'SUM', 'T', tmask, fmmflx_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
       CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
@@ -453,4 +407,69 @@
       CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output 
 
+#if defined key_vvl
+     !---------------------------------------------------------------------------------------------------
+     !variables au temps after
+     !---------------------------------------------------------------------------------------------------
+
+     zfse3t(:,:,:) = 1._wp
+     zt(:,:,:) = tmask(:,:,:)
+     ssha(:,:) = ssha(:,:) * tmask(:,:,1)
+     CALL crs_dom_ope( ssha , 'VOL', 'T', zt, ssha_crs , p_e12=e1e2t,  p_e3=zfse3t , psgn=1.0 )
+     CALL crs_lbc_lnk( ssha_crs, 'T', 1.0 ) !!!!!!!!!!!!!!!!!!! pas utile !!!!!!!!!!!!!!!!!!!!!!!!!
+
+     zfse3t(:,:,:) = e3t_a(:,:,:)
+     zfse3u(:,:,:) = e3u_a(:,:,:)
+     zfse3v(:,:,:) = e3v_a(:,:,:)
+     CALL dom_vvl_interpol( zfse3t(:,:,:), zfse3w(:,:,:), 'W'   )
+
+     CALL crs_dom_sfc( umask, 'U', zt_crs, zs_crs, p_e2=e2u, p_e3=zfse3u ) ! zt_crs=e2e3u_crs,zs_crs=e2e3u_msk
+     CALL crs_dom_sfc( vmask, 'V', zt_crs, zs_crs, p_e1=e2v, p_e3=zfse3v ) ! zt_crs=e1e3v_crs,zs_crs=e1e3v_msk
+     CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=e3t_a_crs, p_e3_max_crs=zs_crs)
+     CALL crs_dom_e3( e1t, e2t, zfse3w, p_sfc_3d_crs=e1e2w_crs, cd_type='W', p_mask=tmask, p_e3_crs=e3w_a_crs, p_e3_max_crs=zs_crs)
+     CALL crs_dom_e3( e1u, e2u, zfse3u, p_sfc_2d_crs=e2u_crs  , cd_type='U', p_mask=umask, p_e3_crs=e3u_a_crs, p_e3_max_crs=zs_crs)
+     CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs  , cd_type='V', p_mask=vmask, p_e3_crs=e3v_a_crs, p_e3_max_crs=zs_crs)
+
+
+     DO jk = 1, jpk
+        DO ji = 1, jpi_crs
+           DO jj = 1, jpj_crs
+              IF( e3t_a_crs(ji,jj,jk) == 0._wp ) e3t_a_crs(ji,jj,jk) = e3t_1d(jk)
+              IF( e3w_a_crs(ji,jj,jk) == 0._wp ) e3w_a_crs(ji,jj,jk) = e3w_1d(jk)
+              IF( e3u_a_crs(ji,jj,jk) == 0._wp ) e3u_a_crs(ji,jj,jk) = e3t_1d(jk)
+              IF( e3v_a_crs(ji,jj,jk) == 0._wp ) e3v_a_crs(ji,jj,jk) = e3t_1d(jk)
+           ENDDO
+       ENDDO
+     ENDDO
+
+     !zt_crs=ocean_volume_crs_t ; zs_crs=facvol_t after time !!!
+     CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, zt_crs, zs_crs )
+
+#endif
+
+#if defined key_vvl
+      z1_2dt = 1._wp / ( 2. * rdt )                         ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1._wp / rdt
+      wn_crs(:,:,jpk) = 0._wp
+      DO jk = jpkm1, 1, -1
+         wn_crs(:,:,jk) = wn_crs(:,:,jk+1)*e1e2w_msk(:,:,jk+1) - (  hdivn_crs(:,:,jk)                                   &
+               &                          + z1_2dt * e1e2w_crs(:,:,jk) * ( e3t_a_crs(:,:,jk) - e3t_b_crs(:,:,jk) ) ) * tmask_crs(:,:,jk)
+         WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp )  wn_crs(:,:,jk) =  wn_crs(:,:,jk) /e1e2w_msk(:,:,jk)
+      ENDDO
+#else
+      IF( ln_crs_wn ) THEN
+         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
+      ELSE
+         wn_crs(:,:,jpk) = 0._wp
+         DO jk = jpkm1, 1, -1
+            wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk)
+            WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp )  wn_crs(:,:,jk) =  wn_crs(:,:,jk) /e1e2w_msk(:,:,jk)
+         ENDDO
+       ENDIF
+
+#endif
+      CALL crs_lbc_lnk( wn_crs, 'W', 1.0 )   !!!!!!!pas utile, nan ??????????????????????
+      wn_crs(:,:,:) = wn_crs(:,:,:) * tmask_crs(:,:,:)
+      CALL iom_put( "woce", wn_crs  )   ! vertical velocity
+
       !  free memory
       CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w )
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 6772)
@@ -21,4 +21,5 @@
    USE lib_mpp
    USE ldftra_crs
+   USE ieee_arithmetic
 
    IMPLICIT NONE
@@ -30,5 +31,4 @@
 #  include "domzgr_substitute.h90"
 
-   !! $Id$
 CONTAINS
    
@@ -111,8 +111,11 @@
      rfacty_r = 1. / nn_facty
 
+write(narea+200,*)"crsini0",nstop; call flush(narea+200)
+
      !---------------------------------------------------------
      ! 2. Define Global Dimensions of the coarsened grid
      !---------------------------------------------------------
      CALL crs_dom_def      
+write(narea+200,*)"crsini1",nstop; call flush(narea+200)
 
      !---------------------------------------------------------
@@ -125,5 +128,13 @@
  
      CALL crs_dom_msk
-
+write(narea+200,*)"crsini2",nstop; call flush(narea+200)
+      CALL mppsync()
+
+     !IF( narea==279 )THEN
+     !WRITE(narea+200,*)"tutu1 ",jpi,jpj,nldi,nlei,nldj,nlej
+     !DO jj=1,jpj
+     !   WRITE(narea+200,*)"tutu2 ",jj,MINVAL(tmask(:,jj,:)),MAXVAL(tmask(:,jj,:))
+     !ENDDO
+     !ENDIF
 
      !  3.b. Get the coordinates
@@ -131,26 +142,28 @@
      !      Even-numbered reduction factor, center coordinate on U-,V- faces or f-corner.
      !      
-     IF ( nresty /= 0 .AND. nrestx /= 0 ) THEN
+     !IF ( nresty /= 0 .AND. nrestx /= 0 ) THEN
         CALL crs_dom_coordinates( gphit, glamt, 'T', gphit_crs, glamt_crs ) 
         CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )       
         CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs ) 
         CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs ) 
-     ELSEIF ( nresty /= 0 .AND. nrestx == 0 ) THEN
-        CALL crs_dom_coordinates( gphiu, glamu, 'T', gphit_crs, glamt_crs )
-        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
-     ELSEIF ( nresty == 0 .AND. nrestx /= 0 ) THEN
-        CALL crs_dom_coordinates( gphiv, glamv, 'T', gphit_crs, glamt_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
-        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
-     ELSE 
-        CALL crs_dom_coordinates( gphif, glamf, 'T', gphit_crs, glamt_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
-     ENDIF
-
+     !ELSEIF ( nresty /= 0 .AND. nrestx == 0 ) THEN
+     !   CALL crs_dom_coordinates( gphiu, glamu, 'T', gphit_crs, glamt_crs )
+     !   CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )
+     !   CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
+     !   CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+     !ELSEIF ( nresty == 0 .AND. nrestx /= 0 ) THEN
+     !   CALL crs_dom_coordinates( gphiv, glamv, 'T', gphit_crs, glamt_crs )
+     !   CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
+     !   CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs )
+     !   CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+     !ELSE 
+     !   CALL crs_dom_coordinates( gphif, glamf, 'T', gphit_crs, glamt_crs )
+     !   CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
+     !   CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
+     !   CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+     !ENDIF
+      CALL mppsync()
+
+write(narea+200,*)"crsini3",nstop; call flush(narea+200)
 
      !  3.c. Get the horizontal mesh
@@ -162,4 +175,18 @@
      CALL crs_dom_hgr( e1v, e2v, 'V', e1v_crs, e2v_crs )
      CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs )
+
+     DO ji=nldi_crs,nlei_crs
+     DO jj=nldj_crs,nlej_crs
+        IF( e1t_crs(ji,jj)==0._wp .AND. tmask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e1t_crs=0",ji,jj;CALL FLUSH(narea+8000-1) 
+        IF( e1u_crs(ji,jj)==0._wp .AND. umask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e1u_crs=0",ji,jj;CALL FLUSH(narea+8000-1) 
+        IF( e1v_crs(ji,jj)==0._wp .AND. vmask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e1v_crs=0",ji,jj;CALL FLUSH(narea+8000-1) 
+        IF( e1f_crs(ji,jj)==0._wp .AND. fmask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e1f_crs=0",ji,jj;CALL FLUSH(narea+8000-1) 
+        IF( e2t_crs(ji,jj)==0._wp .AND. tmask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e2t_crs=0",ji,jj;CALL FLUSH(narea+8000-1) 
+        IF( e2u_crs(ji,jj)==0._wp .AND. umask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e2u_crs=0",ji,jj;CALL FLUSH(narea+8000-1) 
+        IF( e2v_crs(ji,jj)==0._wp .AND. vmask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e2v_crs=0",ji,jj;CALL FLUSH(narea+8000-1) 
+        IF( e2f_crs(ji,jj)==0._wp .AND. fmask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e2f_crs=0",ji,jj;CALL FLUSH(narea+8000-1) 
+     ENDDO
+     ENDDO
+
 
      WHERE(e1t_crs == 0._wp) e1t_crs=r_inf
@@ -172,6 +199,17 @@
      WHERE(e2f_crs == 0._wp) e2f_crs=r_inf
 
+     zmin=MINVAL(e1t_crs,mask=(tmask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1t_crs,mask=(tmask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1t_crs ",zmin,zmax
+     zmin=MINVAL(e1u_crs,mask=(umask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1u_crs,mask=(umask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1u_crs ",zmin,zmax
+     zmin=MINVAL(e1v_crs,mask=(vmask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1v_crs,mask=(vmask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1v_crs ",zmin,zmax
+     zmin=MINVAL(e1f_crs,mask=(fmask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1f_crs,mask=(fmask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1f_crs ",zmin,zmax
+     zmin=MINVAL(e2t_crs,mask=(tmask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e2t_crs,mask=(tmask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e2t_crs ",zmin,zmax
+     zmin=MINVAL(e2u_crs,mask=(umask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e2u_crs,mask=(umask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e2u_crs ",zmin,zmax
+     zmin=MINVAL(e2v_crs,mask=(vmask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e2v_crs,mask=(vmask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e2v_crs ",zmin,zmax
+     zmin=MINVAL(e2f_crs,mask=(fmask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e2f_crs,mask=(fmask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e2f_crs ",zmin,zmax
+
+
      e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:)
      
+write(narea+200,*)"crsini4",nstop; call flush(narea+200)
      
      !      3.c.2 Coriolis factor  
@@ -196,8 +234,8 @@
      CALL wrk_alloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w )
      !
-     zfse3t(:,:,:) = fse3t(:,:,:)
-     zfse3u(:,:,:) = fse3u(:,:,:)
-     zfse3v(:,:,:) = fse3v(:,:,:)
-     zfse3w(:,:,:) = fse3w(:,:,:)
+     zfse3t(:,:,:) = e3t_0(:,:,:) !fse3t(:,:,:)
+     zfse3u(:,:,:) = e3u_0(:,:,:) !fse3u(:,:,:)
+     zfse3v(:,:,:) = e3v_0(:,:,:) !fse3v(:,:,:)
+     zfse3w(:,:,:) = e3w_0(:,:,:) !fse3w(:,:,:)
 
      !    3.d.2   Surfaces 
@@ -209,4 +247,31 @@
      CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u )
      CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v )
+
+     DO ji=nldi_crs,nlei_crs
+     DO jj=nldj_crs,nlej_crs
+     DO jk=1,jpk   
+        IF( e1e2w_crs(ji,jj,jk)==0._wp .AND. tmask_crs(ji,jj,jk)==1._wp )WRITE(narea+8000-1,*)"e1e2w_crs=0",ji,jj,jk;CALL FLUSH(narea+8000-1)
+        IF( e1e2w_msk(ji,jj,jk)==0._wp .AND. tmask_crs(ji,jj,jk)==1._wp )WRITE(narea+8000-1,*)"e1e2w_msk=0",ji,jj,jk;CALL FLUSH(narea+8000-1)
+        IF( e2e3u_crs(ji,jj,jk)==0._wp .AND. umask_crs(ji,jj,jk)==1._wp )WRITE(narea+8000-1,*)"e2e3u_crs=0",ji,jj,jk;CALL FLUSH(narea+8000-1)
+        IF( e2e3u_msk(ji,jj,jk)==0._wp .AND. umask_crs(ji,jj,jk)==1._wp )WRITE(narea+8000-1,*)"e2e3u_msk=0",ji,jj,jk;CALL FLUSH(narea+8000-1)
+        IF( e1e3v_crs(ji,jj,jk)==0._wp .AND. vmask_crs(ji,jj,jk)==1._wp )WRITE(narea+8000-1,*)"e1e3v_crs=0",ji,jj,jk;CALL FLUSH(narea+8000-1)
+        IF( e1e3v_msk(ji,jj,jk)==0._wp .AND. vmask_crs(ji,jj,jk)==1._wp )WRITE(narea+8000-1,*)"e1e3v_msk=0",ji,jj,jk;CALL FLUSH(narea+8000-1)
+     ENDDO
+     ENDDO
+     ENDDO
+write(narea+200,*)"crsini5",nstop; call flush(narea+200)
+
+!     WHERE(e1e2w_crs == 0._wp) e1e2w_crs=r_inf
+!     WHERE(e2e3u_crs == 0._wp) e2e3u_crs=r_inf
+!     WHERE(e1e3v_crs == 0._wp) e1e3v_crs=r_inf
+!     WHERE(e1e2w_msk == 0._wp) e1e2w_msk=r_inf
+!     WHERE(e2e3u_msk == 0._wp) e2e3u_msk=r_inf
+!     WHERE(e1e3v_msk == 0._wp) e1e3v_msk=r_inf
+     zmin=MINVAL(e1e2w_crs,mask=(tmask_crs(:,:,:)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1e2w_crs,mask=(tmask_crs(:,:,:)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1e2w_crs ",zmin,zmax
+     zmin=MINVAL(e2e3u_crs,mask=(umask_crs(:,:,:)==1));CALL mpp_min(zmin);zmax=MAXVAL(e2e3u_crs,mask=(umask_crs(:,:,:)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e2e3u_crs ",zmin,zmax
+     zmin=MINVAL(e1e3v_crs,mask=(vmask_crs(:,:,:)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1e3v_crs,mask=(vmask_crs(:,:,:)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1e3v_crs ",zmin,zmax
+     zmin=MINVAL(e1e2w_msk,mask=(tmask_crs(:,:,:)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1e2w_msk,mask=(tmask_crs(:,:,:)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1e2w_msk ",zmin,zmax
+     zmin=MINVAL(e2e3u_msk,mask=(umask_crs(:,:,:)==1));CALL mpp_min(zmin);zmax=MAXVAL(e2e3u_msk,mask=(umask_crs(:,:,:)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e2e3u_msk ",zmin,zmax
+     zmin=MINVAL(e1e3v_msk,mask=(vmask_crs(:,:,:)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1e3v_msk,mask=(vmask_crs(:,:,:)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1e3v_msk ",zmin,zmax
    
      !cbr facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:)
@@ -226,33 +291,89 @@
      ENDDO
 
+        DO ji=nldi_crs,nlei_crs
+           DO jj=nldj_crs,nlej_crs
+        IF( ABS(e2u_crs(ji,jj)) .LE. 1.e-5 )WRITE(narea+8000-1,*)"UNDERFLOW e2u_crs",ji,jj,e2u_crs(ji,jj),umask_crs(ji,jj,1) ; CALL FLUSH(narea+8000-1)
+        IF( ABS(e1v_crs(ji,jj)) .LE. 1.e-5 )WRITE(narea+8000-1,*)"UNDERFLOW e1v_crs",ji,jj,e1v_crs(ji,jj),vmask_crs(ji,jj,1) ; CALL FLUSH(narea+8000-1)
+           ENDDO
+        ENDDO
+
+
      !    3.d.3   Vertical scale factors
      !
-   
-  
-     CALL crs_dom_e3( e1t, e2t, zfse3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs)
-     CALL crs_dom_e3( e1u, e2u, zfse3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
-     CALL crs_dom_e3( e1v, e2v, zfse3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
-     CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
-     WHERE(e3t_max_crs == 0._wp) e3t_max_crs=r_inf
-     WHERE(e3u_max_crs == 0._wp) e3u_max_crs=r_inf
-     WHERE(e3v_max_crs == 0._wp) e3v_max_crs=r_inf
-     WHERE(e3w_max_crs == 0._wp) e3w_max_crs=r_inf
-
+     zmin=MINVAL(e2u_crs(nldi_crs:nlei_crs,nldj_crs:nlej_crs));zmax=MAXVAL(e2u_crs(nldi_crs:nlei_crs,nldj_crs:nlej_crs));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"e2u_crs",zmin,zmax;CALL FLUSH(numout)  
+     zmin=MINVAL(e1v_crs(nldi_crs:nlei_crs,nldj_crs:nlej_crs));zmax=MAXVAL(e1v_crs(nldi_crs:nlei_crs,nldj_crs:nlej_crs));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"e1v_crs",zmin,zmax;CALL FLUSH(numout)  
+     zmin=MINVAL(e1e2w_crs(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:));zmax=MAXVAL(e1e2w_crs(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"e1e2w_crs",zmin,zmax;CALL FLUSH(numout)  
+     zmin=MINVAL(zfse3u);zmax=MAXVAL(zfse3u);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"zfse3u",zmin,zmax;CALL FLUSH(numout)  
+     zmin=MINVAL(zfse3v);zmax=MAXVAL(zfse3v);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"zfse3v",zmin,zmax;CALL FLUSH(numout)  
+
+     CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=e3t_0_crs, p_e3_max_crs=e3t_max_0_crs)
+     CALL crs_dom_e3( e1t, e2t, zfse3w, p_sfc_3d_crs=e1e2w_crs, cd_type='W', p_mask=tmask, p_e3_crs=e3w_0_crs, p_e3_max_crs=e3w_max_0_crs)
+     CALL crs_dom_e3( e1u, e2u, zfse3u, p_sfc_2d_crs=e2u_crs  , cd_type='U', p_mask=umask, p_e3_crs=e3u_0_crs, p_e3_max_crs=e3u_max_0_crs)
+     CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs  , cd_type='V', p_mask=vmask, p_e3_crs=e3v_0_crs, p_e3_max_crs=e3v_max_0_crs)
+     WHERE(e3t_max_0_crs == 0._wp) e3t_max_0_crs=r_inf
+     WHERE(e3u_max_0_crs == 0._wp) e3u_max_0_crs=r_inf
+     WHERE(e3v_max_0_crs == 0._wp) e3v_max_0_crs=r_inf
+     WHERE(e3w_max_0_crs == 0._wp) e3w_max_0_crs=r_inf
+
+write(narea+200,*)"crsini6",nstop; call flush(narea+200)
+#if defined key_vvl
+     e3t_max_n_crs=e3t_max_0_crs
+     e3u_max_n_crs=e3u_max_0_crs
+     e3v_max_n_crs=e3v_max_0_crs
+     e3w_max_n_crs=e3w_max_0_crs
+#endif
+
+     ht_0_crs(:,:)=0._wp
+     DO jk = 1, jpk
+        ht_0_crs(:,:)=ht_0_crs(:,:)+e3t_0_crs(:,:,jk)*tmask_crs(:,:,jk)
+     ENDDO
+
+#if defined key_vvl
+     e3t_0_crs(:,:,:) = e3t_0_crs(:,:,:) * tmask_crs(:,:,:)
+     e3u_0_crs(:,:,:) = e3u_0_crs(:,:,:) * umask_crs(:,:,:)
+     e3v_0_crs(:,:,:) = e3v_0_crs(:,:,:) * vmask_crs(:,:,:)
+     e3w_0_crs(:,:,:) = e3w_0_crs(:,:,:) * tmask_crs(:,:,:)
+#endif
+
+write(narea+200,*)"crsini7",nstop; call flush(narea+200)
      ! Reset 0 to e3t_0 or e3w_0
      DO jk = 1, jpk
         DO ji = 1, jpi_crs
            DO jj = 1, jpj_crs
-              IF( e3t_crs(ji,jj,jk) == 0._wp ) e3t_crs(ji,jj,jk) = e3t_1d(jk)
-              IF( e3w_crs(ji,jj,jk) == 0._wp ) e3w_crs(ji,jj,jk) = e3w_1d(jk)
-              IF( e3u_crs(ji,jj,jk) == 0._wp ) e3u_crs(ji,jj,jk) = e3t_1d(jk)
-              IF( e3v_crs(ji,jj,jk) == 0._wp ) e3v_crs(ji,jj,jk) = e3t_1d(jk)
+              IF( e3t_0_crs(ji,jj,jk) == 0._wp ) e3t_0_crs(ji,jj,jk) = e3t_1d(jk)
+              IF( e3w_0_crs(ji,jj,jk) == 0._wp ) e3w_0_crs(ji,jj,jk) = e3w_1d(jk)
+              IF( e3u_0_crs(ji,jj,jk) == 0._wp ) e3u_0_crs(ji,jj,jk) = e3t_1d(jk)
+              IF( e3v_0_crs(ji,jj,jk) == 0._wp ) e3v_0_crs(ji,jj,jk) = e3t_1d(jk)
            ENDDO
         ENDDO
      ENDDO
 
+#if defined key_vvl
+     e3t_b_crs(:,:,:) = e3t_0_crs(:,:,:)
+     e3u_b_crs(:,:,:) = e3u_0_crs(:,:,:)
+     e3v_b_crs(:,:,:) = e3v_0_crs(:,:,:)
+     e3w_b_crs(:,:,:) = e3w_0_crs(:,:,:)
+
+     e3t_n_crs(:,:,:) = e3t_0_crs(:,:,:)
+     e3u_n_crs(:,:,:) = e3u_0_crs(:,:,:)
+     e3v_n_crs(:,:,:) = e3v_0_crs(:,:,:)
+     e3w_n_crs(:,:,:) = e3w_0_crs(:,:,:)
+
+     e3t_a_crs(:,:,:) = e3t_0_crs(:,:,:)
+     e3u_a_crs(:,:,:) = e3u_0_crs(:,:,:)
+     e3v_a_crs(:,:,:) = e3v_0_crs(:,:,:)
+     e3w_a_crs(:,:,:) = e3w_0_crs(:,:,:)
+#endif
+
      !    3.d.3   Vertical depth (meters)
      !cbr: il semblerait que p_e3=... ne soit pas utile ici !!!!!!!!!
-     CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=zfse3t, psgn=1.0 ) 
-     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=zfse3w, psgn=1.0 )
+     CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_0_crs, p_e3=zfse3t, psgn=1.0 ) 
+     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_0_crs, p_e3=zfse3w, psgn=1.0 )
+#if defined key_vvl
+     gdept_n_crs(:,:,:) = gdept_0_crs(:,:,:)
+     gdepw_n_crs(:,:,:) = gdepw_0_crs(:,:,:)
+#endif
+
+write(narea+200,*)"crsini8",nstop; call flush(narea+200)
 
      !---------------------------------------------------------
@@ -276,4 +397,5 @@
      !CALL dom_grid_glo   ! Return to parent grid domain
 
+write(narea+200,*)"crsini9",nstop; call flush(narea+200)
 
      !
@@ -291,4 +413,5 @@
       rhop_crs(:,:,:)=0._wp ; rhd_crs(:,:,:)=0._wp ; rb2_crs(:,:,:)=0._wp
 
+write(narea+200,*)"crsini10",nstop; call flush(narea+200)
  
      !---------------------------------------------------------
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl_crs.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl_crs.F90	(revision 6772)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl_crs.F90	(revision 6772)
@@ -0,0 +1,135 @@
+MODULE domvvl_crs
+   !!======================================================================
+   !!                       ***  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
+   !!----------------------------------------------------------------------
+   !!   'key_vvl'                              variable volume
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   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
+   !!   dom_vvl_orca_fix : Recompute some area-weighted interpolations of vertical scale factors 
+   !!                    : to account for manual changes to e[1,2][u,v] in some Straits 
+   !!----------------------------------------------------------------------
+   !! * Modules used
+!   USE oce             ! ocean dynamics and tracers
+   USE crs             ! ocean space and time domain
+   USE sbc_oce         ! ocean surface boundary condition
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager library
+   USE restart         ! ocean restart
+   USE lib_mpp         ! distributed memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+   USE crslbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC  dom_vvl_interpol_crs   ! called by dynnxt.F90
+
+   !                                                                                            ! conservation: not used yet
+
+   !! * Module variables
+!#  include "domzgr_substitute.h90"
+!#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO-Consortium (2010) 
+   !! $Id: domvvl.F90 4998 2014-12-22 16:16:45Z mocavero $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dom_vvl_interpol_crs( 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
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( in    ) ::  pe3_in     ! input e3 to be interpolated
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,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'
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk                                          ! dummy loop indices
+      REAL(wp)::   zz 
+      !!----------------------------------------------------------------------
+      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_interpol')
+         !
+      SELECT CASE ( pout )
+         !               ! ------------------------------------- !
+      CASE( 'U' )        ! interpolation from T-point to U-point !
+         !               ! ------------------------------------- !
+         ! horizontal surface weighted interpolation
+         DO jk = 1, jpk
+            DO jj = 1, jpj_crs-1
+               DO ji = 1, jpi_crs-1   ! vector opt.
+                  zz=1._wp/(e1u_crs(ji,jj)*e2u_crs(ji,jj))
+                  pe3_out(ji,jj,jk) = 0.5_wp * umask_crs(ji,jj,jk) * zz                                           &
+                     &                       * (   e1t_crs(ji  ,jj) * e2t_crs(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0_crs(ji  ,jj,jk) )     &
+                     &                           + e1t_crs(ji+1,jj) * e2t_crs(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0_crs(ji+1,jj,jk) ) )
+               END DO
+            END DO
+         END DO
+         !
+         ! boundary conditions
+         CALL crs_lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )
+         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0_crs(:,:,:)
+         !               ! ------------------------------------- !
+      CASE( 'V' )        ! interpolation from T-point to V-point !
+         !               ! ------------------------------------- !
+         ! horizontal surface weighted interpolation
+         DO jk = 1, jpk
+            DO jj = 1, jpj_crs
+               DO ji = 1, jpi_crs   ! vector opt.
+                  zz=1._wp/(e1v_crs(ji,jj)*e2v_crs(ji,jj))
+                  pe3_out(ji,jj,jk) = 0.5_wp * vmask_crs(ji,jj,jk) * zz                                               &
+                     &                       * (   e1t_crs(ji,jj  ) * e2t_crs(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
+                     &                           + e1t_crs(ji,jj+1) * e2t_crs(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
+               END DO
+            END DO
+         END DO
+         !
+         ! boundary conditions
+         CALL crs_lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )
+         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0_crs(:,:,:)
+         !               ! ------------------------------------- !
+      CASE( 'W' )        ! interpolation from T-point to W-point !
+         !               ! ------------------------------------- !
+         ! vertical simple interpolation
+         pe3_out(:,:,1) = e3w_0_crs(:,:,1) + pe3_in(:,:,1) - e3t_0_crs(:,:,1)
+         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
+         DO jk = 2, jpk
+            pe3_out(:,:,jk) = e3w_0_crs(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask_crs(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0_crs(:,:,jk-1) )   &
+               &                                +            0.5_wp * tmask_crs(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3t_0_crs(:,:,jk  ) )
+         END DO
+      END SELECT
+      !
+
+      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_interpol')
+
+   END SUBROUTINE dom_vvl_interpol_crs
+
+
+   !!======================================================================
+END MODULE domvvl_crs
+
+
+
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90	(revision 6772)
@@ -8,4 +8,5 @@
    !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate
    !!----------------------------------------------------------------------
+
 
 #if defined key_vvl
@@ -116,4 +117,68 @@
 
 #endif
+
+
+#if defined key_vvl
+! s* or z*-coordinate (3D + time dependency) + use of additional now arrays (..._n)
+
+#   define  fse3t_crs(i,j,k)   e3t_n_crs(i,j,k)
+#   define  fse3u_crs(i,j,k)   e3u_n_crs(i,j,k)
+#   define  fse3v_crs(i,j,k)   e3v_n_crs(i,j,k)
+#   define  fse3w_crs(i,j,k)   e3w_n_crs(i,j,k)
+
+#   define  fse3t_b_crs(i,j,k)   e3t_b_crs(i,j,k)
+#   define  fse3u_b_crs(i,j,k)   e3u_b_crs(i,j,k)
+#   define  fse3v_b_crs(i,j,k)   e3v_b_crs(i,j,k)
+#   define  fse3w_b_crs(i,j,k)   e3w_b_crs(i,j,k)
+#   define  fse3t_n_crs(i,j,k)   e3t_n_crs(i,j,k)
+#   define  fse3u_n_crs(i,j,k)   e3u_n_crs(i,j,k)
+#   define  fse3v_n_crs(i,j,k)   e3v_n_crs(i,j,k)
+#   define  fse3w_n_crs(i,j,k)   e3w_n_crs(i,j,k)
+#   define  fse3t_a_crs(i,j,k)   e3t_a_crs(i,j,k)
+#   define  fse3u_a_crs(i,j,k)   e3u_a_crs(i,j,k)
+#   define  fse3v_a_crs(i,j,k)   e3v_a_crs(i,j,k)
+#   define  fse3w_a_crs(i,j,k)   e3w_a_crs(i,j,k)
+
+#   define  fse3t_max_crs(i,j,k)   e3t_max_n_crs(i,j,k)
+#   define  fse3u_max_crs(i,j,k)   e3u_max_n_crs(i,j,k)
+#   define  fse3v_max_crs(i,j,k)   e3v_max_n_crs(i,j,k)
+#   define  fse3w_max_crs(i,j,k)   e3w_max_n_crs(i,j,k)
+
+#   define  fsdept_crs(i,j,k)   gdept_n_crs(i,j,k)
+#   define  fsdepw_crs(i,j,k)   gdepw_n_crs(i,j,k)
+
+#else
+! z- or s-coordinate (1D or 3D + no time dependency) use reference in all cases
+
+#   define  fse3t_crs(i,j,k)   e3t_0_crs(i,j,k)
+#   define  fse3u_crs(i,j,k)   e3u_0_crs(i,j,k)
+#   define  fse3v_crs(i,j,k)   e3v_0_crs(i,j,k)
+#   define  fse3w_crs(i,j,k)   e3w_0_crs(i,j,k)
+
+#   define  fse3t_b_crs(i,j,k)   e3t_0_crs(i,j,k)
+#   define  fse3u_b_crs(i,j,k)   e3u_0_crs(i,j,k)
+#   define  fse3v_b_crs(i,j,k)   e3v_0_crs(i,j,k)
+#   define  fse3w_b_crs(i,j,k)   e3w_0_crs(i,j,k)
+#   define  fse3t_n_crs(i,j,k)   e3t_0_crs(i,j,k)
+#   define  fse3u_n_crs(i,j,k)   e3u_0_crs(i,j,k)
+#   define  fse3v_n_crs(i,j,k)   e3v_0_crs(i,j,k)
+#   define  fse3w_n_crs(i,j,k)   e3w_0_crs(i,j,k)
+#   define  fse3t_a_crs(i,j,k)   e3t_0_crs(i,j,k)
+#   define  fse3u_a_crs(i,j,k)   e3u_0_crs(i,j,k)
+#   define  fse3v_a_crs(i,j,k)   e3v_0_crs(i,j,k)
+#   define  fse3w_a_crs(i,j,k)   e3w_0_crs(i,j,k)
+
+#   define  fse3t_max_crs(i,j,k)   e3t_max_0_crs(i,j,k)
+#   define  fse3u_max_crs(i,j,k)   e3u_max_0_crs(i,j,k)
+#   define  fse3v_max_crs(i,j,k)   e3v_max_0_crs(i,j,k)
+#   define  fse3w_max_crs(i,j,k)   e3w_max_0_crs(i,j,k)
+
+#   define  fsdept_crs(i,j,k)   gdept_0_crs(i,j,k)
+#   define  fsdepw_crs(i,j,k)   gdepw_0_crs(i,j,k)
+
+#endif
+
+
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 6772)
@@ -72,5 +72,5 @@
    PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
    PUBLIC   mpp_lnk_2d_9 
-   PUBLIC   mppscatter, mppgather
+   PUBLIC   mppscatter, mppgather, mppgatheri
    PUBLIC   mpp_ini_ice, mpp_ini_znl
    PUBLIC   mppsize
@@ -1475,4 +1475,26 @@
    END SUBROUTINE mppgather
 
+   SUBROUTINE mppgatheri( ptab, kp, pio )
+      !!----------------------------------------------------------------------
+      !!                   ***  routine mppgather  ***
+      !!
+      !! ** Purpose :   Transfert between a local subdomain array and a work
+      !!     array which is distributed following the vertical level.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(1,1),   INTENT(in   ) ::   ptab   ! subdomain input array
+      INTEGER,                   INTENT(in   ) ::   kp     ! record length
+      INTEGER, DIMENSION(jpnij), INTENT(  out) ::   pio    ! subdomain input array
+      !!
+      INTEGER :: itaille, ierror   ! temporary integer
+      !!---------------------------------------------------------------------
+      !
+      itaille = 1
+      CALL mpi_allgather( ptab, itaille, mpi_integer, pio, itaille     ,   &
+         &                            mpi_integer, mpi_comm_opa, ierror )
+! CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_opa, ierr )
+      !
+   END SUBROUTINE mppgatheri
+
 
    SUBROUTINE mppscatter( pio, kp, ptab )
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 6772)
@@ -72,5 +72,5 @@
 
       ! read namelist for ln_zco
-      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
 
       !!----------------------------------------------------------------------
@@ -310,6 +310,6 @@
 
          isurf = 0
-         DO jj = 1+jprecj, ilj-jprecj
-            DO  ji = 1+jpreci, ili-jpreci
+         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
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 6772)
@@ -464,12 +464,4 @@
       ENDIF
 
-      CALL iom_put("zgru",zgru)
-      CALL iom_put("zgrv",zgrv)
-      CALL iom_put("zdzr",zdzr)
-      CALL iom_put("zwz",zwz)
-      CALL iom_put("zww",zww)
-      CALL iom_put("uslp",uslp)
-      CALL iom_put("vslp",vslp)
-      
       CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv )
       CALL wrk_dealloc( jpi,jpj,     zhmlpu, zhmlpv)
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp_crs.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp_crs.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp_crs.F90	(revision 6772)
@@ -35,4 +35,5 @@
    USE crs
    USE iom
+   USE ieee_arithmetic
 
    IMPLICIT NONE
@@ -168,8 +169,6 @@
                !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
                !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-               zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/e3u_max_crs(ji,jj,jk)* ABS( zau )  )
-               zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/e3v_max_crs(ji,jj,jk)* ABS( zav )  )
-               !cc zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/e3u_crs(ji,jj,jk)* ABS( zau )  )
-               !cc zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/e3v_crs(ji,jj,jk)* ABS( zav )  )
+               zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/fse3u_max_crs(ji,jj,jk)* ABS( zau )  )
+               zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v_max_crs(ji,jj,jk)* ABS( zav )  )
                !                                      ! uslp and vslp output in zwz and zww, resp.
                zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
@@ -177,9 +176,9 @@
                zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                              &
                   &                   + zfi  * uslpml(ji,jj)                                                     &
-                  &                          * 0.5_wp * ( gdept_crs(ji+1,jj,jk)+gdept_crs(ji,jj,jk) - e3u_max_crs(ji,jj,1) )   &
+                  &                          * 0.5_wp * ( fsdept_crs(ji+1,jj,jk)+fsdept_crs(ji,jj,jk) - fse3u_max_crs(ji,jj,1) )   &
                   &                          / MAX( hmlpt_crs(ji,jj), hmlpt_crs(ji+1,jj), 5._wp ) ) * umask_crs(ji,jj,jk)
                zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                              &
                   &                   + zfj  * vslpml(ji,jj)                                                     &
-                  &                          * 0.5_wp * ( gdept_crs(ji,jj+1,jk)+ gdept_crs(ji,jj,jk)-e3v_max_crs(ji,jj,1) )   &
+                  &                          * 0.5_wp * ( fsdept_crs(ji,jj+1,jk)+ fsdept_crs(ji,jj,jk)-fse3v_max_crs(ji,jj,1) )   &
                   &                          / MAX( hmlpt_crs(ji,jj), hmlpt_crs(ji,jj+1), 5. ) ) * vmask_crs(ji,jj,jk)
 !!gm  modif to suppress omlmask.... (as in Griffies case)
@@ -196,6 +195,4 @@
       END DO
       CALL crs_lbc_lnk( zwz, 'U', -1. )   ;   CALL crs_lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions
-      CALL iom_put("zwz_crs",zwz)
-      CALL iom_put("zww_crs",zww)
       !
       !                                            !* horizontal Shapiro filter
@@ -262,9 +259,9 @@
                !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
                !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/e3w_max_crs(ji,jj,jk)* ABS( zai )  )
-               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_max_crs(ji,jj,jk)* ABS( zaj )  )
+               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w_max_crs(ji,jj,jk)* ABS( zai )  )
+               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w_max_crs(ji,jj,jk)* ABS( zaj )  )
                !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
                zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0
-               zck = gdepw_crs(ji,jj,jk) / MAX( hmlp_crs(ji,jj), 10._wp )
+               zck = fsdepw_crs(ji,jj,jk) / MAX( hmlp_crs(ji,jj), 10._wp )
                zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask_crs(ji,jj,jk)
                zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask_crs(ji,jj,jk)
@@ -333,9 +330,4 @@
       !
       CALL iom_swap( "nemo_crs" )    ! swap on the coarse grid
-      CALL iom_put("zgru_crs",zgru)
-      CALL iom_put("zgrv_crs",zgrv)
-      CALL iom_put("zdzr_crs",zdzr)
-      CALL iom_put("zwz_crs",zwz)
-      CALL iom_put("zww_crs",zww)
       CALL iom_put("uslp_crs",uslp_crs)
       CALL iom_put("vslp_crs",vslp_crs)
@@ -411,6 +403,6 @@
       !-----------------------------------------------------------------------
       !
-      DO jj = 2, jpj_crsm1
-         DO ji = 2, jpi_crsm1
+      DO jj = 2, nldi_crs
+         DO ji = 2, nldj_crs
             !                        !==   Slope at u- & v-points just below the Mixed Layer   ==!
             !
@@ -425,6 +417,6 @@
             !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0
             !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-            zbu = MIN(  zbu , -100._wp* ABS( zau ) , -7.e+3_wp/e3u_max_crs(ji,jj,iku)* ABS( zau )  )
-            zbv = MIN(  zbv , -100._wp* ABS( zav ) , -7.e+3_wp/e3v_max_crs(ji,jj,ikv)* ABS( zav )  )
+            zbu = MIN(  zbu , -100._wp* ABS( zau ) , -7.e+3_wp/fse3u_max_crs(ji,jj,iku)* ABS( zau )  )
+            zbv = MIN(  zbv , -100._wp* ABS( zav ) , -7.e+3_wp/fse3v_max_crs(ji,jj,ikv)* ABS( zav )  )
             !                        !- Slope at u- & v-points (uslpml, vslpml)
             uslpml(ji,jj) = zau / ( zbu - zeps ) * umask_crs(ji,jj,iku)
@@ -448,6 +440,6 @@
             !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0.
             !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-            zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/e3w_max_crs(ji,jj,ik)* ABS( zai )  )
-            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_max_crs(ji,jj,ik)* ABS( zaj )  )
+            zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/fse3w_max_crs(ji,jj,ik)* ABS( zai )  )
+            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w_max_crs(ji,jj,ik)* ABS( zaj )  )
             !                        !- i- & j-slope at w-points (wslpiml, wslpjml)
             wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask_crs (ji,jj,ik)
@@ -493,9 +485,6 @@
          !
       ELSE                             ! Madec operator : slopes at u-, v-, and w-points
-         ALLOCATE( uslp_crs(jpi_crs,jpj_crs,jpk) , vslp_crs(jpi_crs,jpj_crs,jpk) , & 
-                 & wslpi_crs(jpi_crs,jpj_crs,jpk) , wslpj_crs(jpi_crs,jpj_crs,jpk) ,  &
-                 & omlmask(jpi_crs,jpj_crs,jpk) ,  &
-                 & uslpml(jpi_crs,jpj_crs)   ,  vslpml(jpi_crs,jpj_crs)  , & 
-                 & wslpiml(jpi_crs,jpj_crs)   , wslpjml(jpi_crs,jpj_crs) , STAT=ierr )
+         ALLOCATE( uslp_crs(jpi_crs,jpj_crs,jpk) , vslp_crs(jpi_crs,jpj_crs,jpk) , wslpi_crs(jpi_crs,jpj_crs,jpk) , wslpj_crs(jpi_crs,jpj_crs,jpk) ,  &
+            &   omlmask(jpi_crs,jpj_crs,jpk) , uslpml(jpi_crs,jpj_crs)   , vslpml(jpi_crs,jpj_crs)    , wslpiml(jpi_crs,jpj_crs)   , wslpjml(jpi_crs,jpj_crs) , STAT=ierr )
          IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' )
 
@@ -520,15 +509,11 @@
                DO jj = 2, jpj_crsm1
                   DO ji = 2, jpi_crsm1   ! vector opt.
-                  !cbr uslp_crs (ji,jj,jk) = -1./e1u_crs(ji,jj) * ( gdept_crs(ji+1,jj,jk) - gdept_crs(ji ,jj ,jk) ) * umask_crs(ji,jj,jk)
-                  !vslp_crs (ji,jj,jk) = -1./e2v_crs(ji,jj) * ( gdept_crs(ji,jj+1,jk) - gdept_crs(ji ,jj ,jk) ) * vmask_crs(ji,jj,jk)
-                  !wslpi_crs(ji,jj,jk) = -1./e1t_crs(ji,jj) * ( gdepw_crs(ji+1,jj,jk) - gdepw_crs(ji-1,jj,jk) ) * tmask_crs(ji,jj,jk) * 0.5
-                  !wslpj_crs(ji,jj,jk) = -1./e2t_crs(ji,jj) * ( gdepw_crs(ji,jj+1,jk) - gdepw_crs(ji,jj-1,jk) ) * tmask_crs(ji,jj,jk) * 0.5
-                  uslp_crs (ji,jj,jk) = -1. * ( gdept_crs(ji+1,jj,jk) - gdept_crs(ji ,jj ,jk) ) * umask_crs(ji,jj,jk)
+                  uslp_crs (ji,jj,jk) = -1. * ( fsdept_crs(ji+1,jj,jk) - fsdept_crs(ji ,jj ,jk) ) * umask_crs(ji,jj,jk)
                   IF( e1u_crs(ji,jj) .NE. 0._wp ) uslp_crs (ji,jj,jk) = uslp_crs (ji,jj,jk) / e1u_crs(ji,jj)
-                  vslp_crs (ji,jj,jk) = -1. * ( gdept_crs(ji,jj+1,jk) - gdept_crs(ji ,jj ,jk) ) * vmask_crs(ji,jj,jk)
+                  vslp_crs (ji,jj,jk) = -1. * ( fsdept_crs(ji,jj+1,jk) - fsdept_crs(ji ,jj ,jk) ) * vmask_crs(ji,jj,jk)
                   IF( e2v_crs(ji,jj) .NE. 0._wp ) vslp_crs (ji,jj,jk) = vslp_crs (ji,jj,jk) / e2v_crs(ji,jj)
-                  wslpi_crs(ji,jj,jk) = -1. * ( gdepw_crs(ji+1,jj,jk) - gdepw_crs(ji-1,jj,jk) ) * tmask_crs(ji,jj,jk) * 0.5
+                  wslpi_crs(ji,jj,jk) = -1. * ( fsdepw_crs(ji+1,jj,jk) - fsdepw_crs(ji-1,jj,jk) ) * tmask_crs(ji,jj,jk) * 0.5
                   IF( e1t_crs(ji,jj) .NE. 0._wp ) wslpi_crs(ji,jj,jk) =  wslpi_crs(ji,jj,jk) / e1t_crs(ji,jj)
-                  wslpj_crs(ji,jj,jk) = -1. * ( gdepw_crs(ji,jj+1,jk) - gdepw_crs(ji,jj-1,jk) ) * tmask_crs(ji,jj,jk) * 0.5
+                  wslpj_crs(ji,jj,jk) = -1. * ( fsdepw_crs(ji,jj+1,jk) - fsdepw_crs(ji,jj-1,jk) ) * tmask_crs(ji,jj,jk) * 0.5
                   IF( e2t_crs(ji,jj) .NE. 0._wp ) wslpj_crs(ji,jj,jk) = wslpj_crs(ji,jj,jk) / e2t_crs(ji,jj)
                   END DO
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_crs.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_crs.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_crs.F90	(revision 6772)
@@ -8,5 +8,5 @@
    !!             2.0  ! 2005-11  (G. Madec)  
    !!----------------------------------------------------------------------
-
+#if defined key_top && defined key_crs
    !!----------------------------------------------------------------------
    !!   ldf_tra_init : initialization, namelist read, and parameters control
@@ -88,3 +88,10 @@
 
    !!======================================================================
+#else
+   PUBLIC   ldf_tra_crs_init
+CONTAINS
+   SUBROUTINE ldf_tra_crs_init
+   END SUBROUTINE ldf_tra_crs_init
+
+#endif
 END MODULE ldftra_crs
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 6772)
@@ -44,9 +44,10 @@
    USE sbc_ice         ! Surface boundary condition: ice fields
    USE lib_fortran     ! to use key_nosignedzero
+   USE sbcapr
 #if defined key_lim3
    USE ice, ONLY       : u_ice, v_ice, jpl, pfrld, a_i_b
    USE limthd_dh       ! for CALL lim_thd_snwblow
 #elif defined key_lim2
-   USE ice_2, ONLY     : u_ice, v_ice
+   USE ice_2, ONLY     : u_ice, v_ice, pfrld
    USE par_ice_2
 #endif
@@ -83,4 +84,6 @@
    REAL(wp), PARAMETER ::   Cice =    1.4e-3      ! iovi 1.63e-3     ! transfer coefficient over ice
    REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be constant
+   REAL(wp), PARAMETER ::   rgas =  287.1         ! gas const. dry air (J/kg/K)
+   REAL(wp), PARAMETER ::   rvap =  461.51        ! gas const. vapour  (J/kg/K)
 
    !                                  !!* Namelist namsbc_core : CORE bulk parameters
@@ -91,4 +94,11 @@
    REAL(wp) ::   rn_zqt      ! z(q,t) : height of humidity and temperature measurements
    REAL(wp) ::   rn_zu       ! z(u)   : height of wind measurements
+   !
+   LOGICAL  ::   ln_tair_celsius  !: logical flag for Read Tair: Tair in NEMO is Kelvin
+   LOGICAL  ::   ln_humi_rel      !: logical flag for Read relative humidity (T) or specific humidity (F)
+   LOGICAL  ::   ln_cohum_arc     !: logical flag for Correction of Humidity in the Arctic Ocean
+   LOGICAL  ::   ln_cotair_arc    !: logical flag for Correction of Air Temperature in the Arctic Ocean
+   LOGICAL  ::   ln_corad_antar   !: logical flag for Correction of radiatives fluxes in the Southern Ocean
+
 
    !! * Substitutions
@@ -143,4 +153,10 @@
       INTEGER  ::   ios      ! Local integer output status for namelist read
       !
+      INTEGER  ::   ji,jj
+      REAL(wp) ::   zzlat, zzlat1, zzlat2, zfm, zfrld
+      REAL(wp) ::   zmin,zmax
+      REAL(wp), DIMENSION(:,:), POINTER :: xyt,z_qsr,z_qlw,z_qsr1,z_qlw1, z_hum, z_tair
+      REAL(wp), DIMENSION(:,:), POINTER :: zqsr_lr, zqsr_hr, zqlw_lr, zqlw_hr
+     
       CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core files
       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read
@@ -151,7 +167,12 @@
          &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           &
          &                  sn_qlw , sn_tair, sn_prec  , sn_snow,           &
-         &                  sn_tdif, rn_zqt,  rn_zu
+         &                  sn_tdif, rn_zqt,  rn_zu , ln_tair_celsius,   &
+         &                  ln_humi_rel  , ln_cohum_arc,      &
+         &                  ln_cotair_arc, ln_corad_antar
+
       !!---------------------------------------------------------------------
       !
+      CALL wrk_alloc( jpi,jpj, xyt,z_qsr,z_qlw,z_qsr1,z_qlw1, z_hum, z_tair )
+      CALL wrk_alloc( jpi,jpj, zqsr_lr, zqsr_hr, zqlw_lr, zqlw_hr )
       !                                         ! ====================== !
       IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
@@ -194,4 +215,13 @@
          CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' )
          !
+         !
+         IF(lwp) WRITE(numout,*) 'sbc_blk_core: jfld = ',jfld
+         IF( ln_cohum_arc   ) CALL ctl_warn( 'sbc_blk_core: correction of humidity in arctic' )
+         IF( ln_cotair_arc  ) CALL ctl_warn( 'sbc_blk_core: correction of air temperature in arctic' )
+         IF( ln_corad_antar ) CALL ctl_warn( 'sbc_blk_core: correction of short radiation in antartic' )
+         IF( ln_humi_rel    ) CALL ctl_warn( 'sbc_blk_core: use relative humidity instead of specific humidity')
+         IF( ln_tair_celsius) CALL ctl_warn( 'sbc_blk_core: Tair is read in Celsius')
+         IF(lwp) WRITE(numout,*) 'sbc_blk_core: rn_pfac = ',rn_pfac
+         !
          sfx(:,:) = 0._wp                          ! salt flux; zero unless ice is present (computed in limsbc(_2).F90)
          !
@@ -199,4 +229,102 @@
 
       CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step
+
+      !=========================================
+      !  ONLINE CORRECTIONS
+      !=========================================
+      !
+      ! Correction of Tair
+      !
+      IF( ln_tair_celsius .AND. MOD( kt-1, nn_fsbc ) == 0 ) THEN
+         sf(jp_tair)%fnow = sf(jp_tair)%fnow + 273.15_wp  ! Conversion of the Temperature °C --> Kelvin
+      ENDIF
+      !
+      ! Correction of SW and LW in the Southern Ocean
+      !
+      IF( ln_corad_antar .AND. .NOT. sf(jp_qsr)%ln_tint .AND. MOD( kt-1, 86400/INT(rdt) ) == 0 ) THEN
+         z_qsr(:,:) = 0.8 * sf(jp_qsr)%fnow(:,:,1)
+         xyt(:,:) = 0.e0 ; zzlat1 = -65. ; zzlat2 = -60.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zzlat = gphit(ji,jj)
+               IF( zzlat >= zzlat1 .AND. zzlat <= zzlat2 ) THEN
+                  xyt(ji,jj) = (zzlat2-zzlat)/(zzlat2-zzlat1)
+               ELSE IF ( zzlat < zzlat1 ) THEN
+                  xyt(ji,jj) = 1
+               ENDIF
+            END DO
+         END DO
+         IF(lwp) WRITE(numout,*) 'Correc ln_corad_antar'
+         z_qsr1(:,:) = z_qsr(:,:) * xyt(:,:) + ( 1.0 - xyt(:,:) ) * sf(jp_qsr)%fnow(:,:,1)
+         sf(jp_qsr)%fnow(:,:,1) = z_qsr1(:,:)
+      ENDIF
+
+      IF( MOD( kt-1, nn_fsbc ) == 0 )THEN
+         !
+         IF ( nmonth >= 5 .AND. nmonth <= 9 ) THEN
+            !
+            ! Correction of Humidity in the Arctic Ocean
+            !
+            IF( ln_cohum_arc ) THEN
+               z_hum(:,:) = 0.85 * sf(jp_humi)%fnow(:,:,1)
+               xyt(:,:) = 0.e0 ; zzlat1 = 78. ; zzlat2 = 82.
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zzlat = gphit(ji,jj)
+#if defined key_lim2 ||  defined key_lim3 
+                     IF ( ALLOCATED(pfrld) ) THEN ; zfrld = pfrld(ji,jj) ; ELSE ; zfrld = 0 ; ENDIF
+#endif
+                     IF( zzlat >= zzlat1 .AND. zzlat <= zzlat2 .AND. zfrld < 0.85 ) THEN
+                        xyt(ji,jj) = ( zzlat - zzlat1 ) / ( zzlat2 - zzlat1 )
+                     ELSE IF ( zzlat > zzlat2 .AND. zfrld < 0.85 ) THEN
+                        xyt(ji,jj) = 1._wp
+                     ENDIF
+                  ENDDO
+               ENDDO
+               IF(lwp) WRITE(numout,*) 'Correc ln_cohum_arc'
+               sf(jp_humi)%fnow(:,:,1) = z_hum(:,:) * xyt(:,:) + ( 1.0 - xyt(:,:) ) * sf(jp_humi)%fnow(:,:,1)
+            ENDIF
+            !
+            ! Correction of Air Temperature in the Arctic Ocean
+            !
+            IF( ln_cotair_arc ) THEN
+               z_tair(:,:) = sf(jp_tair)%fnow(:,:,1) - 2.0
+               xyt(:,:) = 0.e0 ; zzlat1 = 78. ; zzlat2 = 82.
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zzlat = gphit(ji,jj)
+#if defined key_lim2 ||  defined key_lim3 
+                     IF( ALLOCATED(pfrld) ) THEN ; zfrld = pfrld(ji,jj) ; ELSE ; zfrld=0 ; ENDIF
+#endif
+                     IF( zzlat >= zzlat1 .AND. zzlat <= zzlat2 .AND. zfrld < 0.85 ) THEN
+                        xyt(ji,jj) = ( zzlat - zzlat1 ) / ( zzlat2 - zzlat1 )
+                     ELSE IF( zzlat > zzlat2 .AND. zfrld < 0.85 ) THEN
+                        xyt(ji,jj) = 1._wp
+                     ENDIF
+                  END DO
+               ENDDO
+               IF(lwp) WRITE(numout,*) 'Correc ln_cotair_arc'
+               sf(jp_tair)%fnow(:,:,1) = z_tair(:,:) * xyt(:,:) + ( 1.0 - xyt(:,:) ) * sf(jp_tair)%fnow(:,:,1)
+            ENDIF
+            !
+         ENDIF ! 5 <= nmonth <= 9
+
+         !
+      ENDIF ! IF MOD( kt-1, nn_fsbc )
+
+      DO jj=1,jpj
+         DO ji=1,jpi
+            sf(jp_humi)%fnow(ji,jj,1) = MAX( MIN( sf(jp_humi)%fnow(ji,jj,1) ,1.0 ) , 0.0 )
+            sf(jp_prec)%fnow(ji,jj,1) = MAX(      sf(jp_prec)%fnow(ji,jj,1) ,0.0 )
+            sf(jp_qsr )%fnow(ji,jj,1) = MAX(      sf(jp_qsr )%fnow(ji,jj,1) ,0.0 )
+            sf(jp_qlw )%fnow(ji,jj,1) = MAX(      sf(jp_qlw )%fnow(ji,jj,1) ,0.0 )
+         ENDDO
+      END DO
+
+      !
+      !=========================================
+      ! END OF ONLINE CORRECTIONS
+      !=========================================
+      !
 
       !                                            ! compute the surface ocean fluxes using CORE bulk formulea
@@ -215,4 +343,7 @@
       ENDIF
 #endif
+      !
+      CALL wrk_dealloc( jpi,jpj, xyt,z_qsr,z_qlw,z_qsr1,z_qlw1, z_hum, z_tair )
+      CALL wrk_dealloc( jpi,jpj, zqsr_lr, zqsr_hr, zqlw_lr, zqlw_hr )
       !
    END SUBROUTINE sbc_blk_core
@@ -257,4 +388,6 @@
       REAL(wp), DIMENSION(:,:), POINTER ::   zt_zu             ! air temperature at wind speed height
       REAL(wp), DIMENSION(:,:), POINTER ::   zq_zu             ! air spec. hum.  at wind speed height
+      REAL(wp), DIMENSION(:,:), POINTER ::   zqatm , zpatm     ! specific humidity and mean sea level pressure (Pa)
+      REAL(wp) :: vt, vp, vq, zqa, zq0, zq1, zq2, zee
       !!---------------------------------------------------------------------
       !
@@ -262,5 +395,5 @@
       !
       CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j, zqsatw, zqlw, zqsb, zqla, zevap )
-      CALL wrk_alloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu )
+      CALL wrk_alloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu ,zqatm, zpatm )
       !
       ! local scalars ( place there for vector optimisation purposes)
@@ -314,7 +447,30 @@
       ! ... specific humidity at SST and IST
       zqsatw(:,:) = zcoef_qsatw * EXP( -5107.4 / zst(:,:) )
-
+      !
+      IF ( ln_humi_rel ) THEN
+         zq0    = rvap / rgas - 1.0
+         zq1    = rgas / rvap
+         zq2    = 1.0 - zq1
+         zpatm(:,:) = 100800.                   ! atmospheric pressure (assumed constant  here)
+         IF ( ln_apr_dyn ) zpatm(:,:) = apr(:,:)
+         DO jj = 1 , jpj
+            DO ji = 1 , jpi
+               vt  = sf(jp_tair)%fnow(ji,jj,1) - rt0  ! air temperature (Celsius)
+               vp  = zpatm(ji,jj) / 100.              ! mean sea level pressure (mb or hPa)
+               vq  = sf(jp_humi)%fnow(ji,jj,1)        ! relative humidity (fraction of 1)
+               ! Convert RH at the air/sea interface in specific humidity (kg/kg)
+               ! Teten's formula for qsat (mb)
+               zqa = ( 1.0007 + 3.46e-6 * vp) * 6.1121 * EXP( 17.502 * vt / ( 240.97+vt ) )
+               zee = zqa * vq                         ! vapour partial pressure (mb)
+               vq  = zq1 * zee / ( vp - zq2 * zee )   ! specific humidity (kg/kg)
+               zqatm(ji,jj) = vq
+            ENDDO
+         ENDDO
+      ELSE
+         zqatm(:,:)=sf(jp_humi)%fnow(:,:,1)
+      ENDIF
+      !
       ! ... NCAR Bulk formulae, computation of Cd, Ch, Ce at T-point :
-      CALL turb_core_2z( rn_zqt, rn_zu, zst, sf(jp_tair)%fnow, zqsatw, sf(jp_humi)%fnow, wndm,   &
+      CALL turb_core_2z( rn_zqt, rn_zu, zst, sf(jp_tair)%fnow, zqsatw, zqatm, wndm,   &
          &               Cd, Ch, Ce, zt_zu, zq_zu )
     
@@ -354,5 +510,6 @@
       IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN
          !! q_air and t_air are (or "are almost") given at 10m (wind reference height)
-         zevap(:,:) = rn_efac*MAX( 0._wp,     rhoa*Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) )*wndm(:,:) ) ! Evaporation
+         !zevap(:,:) = rn_efac*MAX( 0._wp,     rhoa*Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) )*wndm(:,:) ) ! Evaporation
+          zevap(:,:) = rn_efac*MAX( 0._wp,     rhoa*Ce(:,:)*( zqsatw(:,:) - zqatm(:,:)              )*wndm(:,:) ) ! Evaporation
          zqsb (:,:) =                     cpa*rhoa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) )*wndm(:,:)   ! Sensible Heat
       ELSE
@@ -414,5 +571,5 @@
       !
       CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j, zqsatw, zqlw, zqsb, zqla, zevap )
-      CALL wrk_dealloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu )
+      CALL wrk_dealloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu, zqatm, zpatm )
       !
       IF( nn_timing == 1 )  CALL timing_stop('blk_oce_core')
@@ -437,5 +594,5 @@
       REAL(wp) ::             zwndi_t , zwndj_t               ! relative wind components at T-point
       !!---------------------------------------------------------------------
-      !
+
       IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_tau')
       !
@@ -530,4 +687,5 @@
       REAL(wp) ::   zcoef_dqlw, zcoef_dqla, zcoef_dqsb
       REAL(wp) ::   zztmp, z1_lsub                               ! temporary variable
+      REAL(wp) ::   ztamr,zmt1,zmt2,zmt3,zev,zes
       !!
       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice
@@ -536,4 +694,5 @@
       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice
       REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw       ! evaporation and snw distribution after wind blowing (LIM3)
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zqatm, zpatm , ztatm            ! specific humidity
       !!---------------------------------------------------------------------
       !
@@ -541,4 +700,25 @@
       !
       CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
+      CALL wrk_alloc( jpi,jpj, zqatm, zpatm, ztatm )
+ 
+     IF ( ln_humi_rel ) THEN
+         zpatm(:,:) = 100800.                   ! atmospheric pressure (assumed constant here)
+         IF (ln_apr_dyn) zpatm(:,:) = apr(:,:)
+         DO jj=1,jpj
+            DO ji=1,jpi
+               ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1)                   ! air temperature in Kelvins
+               ztamr = ztatm(ji,jj) - rtt                                  ! Saturation water vapour
+               zmt1  = SIGN( 17.269,  ztamr )
+               zmt2  = SIGN( 21.875,  ztamr )
+               zmt3  = SIGN( 28.200, -ztamr )
+               zes   = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &
+                  &                / ( ztatm(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  )
+               zev = sf(jp_humi)%fnow(ji,jj,1) * zes                       ! vapour pressure
+               zqatm(ji,jj) = 0.622 * zev / ( zpatm(ji,jj) - 0.378 * zev ) ! specific humidity
+            ENDDO
+         ENDDO
+      ELSE
+         zqatm(:,:) = sf(jp_humi)%fnow(:,:,1)
+      ENDIF
 
       ! local scalars ( place there for vector optimisation purposes)
@@ -574,5 +754,5 @@
                ! Latent Heat
                qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * wndm_ice(ji,jj)   &                           
-                  &                         * (  11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) )
+                  &                         * (  11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - zqatm(ji,jj)  ) )
               ! Latent heat sensitivity for ice (Dqla/Dt)
                IF( qla_ice(ji,jj,jl) > 0._wp ) THEN
@@ -659,4 +839,5 @@
       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_flx')
       
+      CALL wrk_dealloc( jpi,jpj, zqatm, zpatm, ztatm )
    END SUBROUTINE blk_ice_core_flx
 #endif
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2_crs.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2_crs.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2_crs.F90	(revision 6772)
@@ -61,5 +61,4 @@
    !
    PUBLIC   eos_crs        ! called by step, istate, tranpc and zpsgrd modules
-   PUBLIC   bn2_crs        ! called by step module
    PUBLIC   eos_rab_crs    ! called by ldfslp, zdfddm, trabbl
    PUBLIC   eos_init_crs   ! called by istate module
@@ -392,5 +391,5 @@
                DO ji = 1, jpi_crs
                   !
-                  zh  = gdept_crs(ji,jj,jk) * r1_Z0                                ! depth
+                  zh  = fsdept_crs(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
@@ -450,5 +449,5 @@
                   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_crs(ji,jj,jk)                 ! depth in meters at t-point
+                  zh  = fsdept_crs(ji,jj,jk)                 ! depth in meters at t-point
                   ztm = tmask_crs(ji,jj,jk)                  ! land/sea bottom mask = surf. mask
                   !
@@ -689,60 +688,4 @@
       !
    END SUBROUTINE rab_crs_0d
-
-
-   SUBROUTINE bn2_crs( 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_crs,jpj_crs,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celcius,psu]
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celcius-1,psu-1]
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,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
-      !!----------------------------------------------------------------------
-      !
-      pn2(:,:,:)=0._wp
-
-      IF( nn_timing == 1 ) CALL timing_start('bn2')
-      !
-      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 )
-         DO jj = 1, jpj_crs          ! surface and bottom value set to zero one for all in istate.F90
-            DO ji = 1, jpi_crs
-               !zrw =   ( gdepw_crs(ji,jj,jk  ) - gdept_crs(ji,jj,jk) )   &
-               !   &  / ( gdept_crs(ji,jj,jk-1) - gdept_crs(ji,jj,jk) ) 
-               zrw =   gdepw_crs(ji,jj,jk  ) - gdept_crs(ji,jj,jk)    
-               !?IF( gdept_crs(ji,jj,jk-1) - gdept_crs(ji,jj,jk) .NE. 0._wp )THEN
-               IF( gdept_crs(ji,jj,jk-1) - gdept_crs(ji,jj,jk) .LT. 0._wp )THEN
-                  zrw = zrw  / ( gdept_crs(ji,jj,jk-1) - gdept_crs(ji,jj,jk) ) 
-               ELSE
-                  zrw = 0._wp
-               ENDIF
-               !
-               zaw = pab(ji,jj,jk,jp_tem) * (1._wp - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 
-               zbw = pab(ji,jj,jk,jp_sal) * (1._wp - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw
-               !
-               IF( e3w_max_crs(ji,jj,jk) .NE. 0._wp ) THEN
-                  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) )  )  &
-                  &                    * tmask_crs(ji,jj,jk)  / e3w_max_crs(ji,jj,jk)
-               ENDIF
-            END DO
-         END DO
-      END DO
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('bn2')
-      !
-   END SUBROUTINE bn2_crs
 
    SUBROUTINE eos_init_crs
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90	(revision 6772)
@@ -91,4 +91,5 @@
       !!----------------------------------------------------------------------
       !
+
       IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd')
       !
@@ -126,6 +127,6 @@
          ! upstream tracer flux in the i and j direction
          DO jk = 1, jpkm1
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
+            DO jj = 2, jpj_crs-1
+               DO ji = 2, jpi_crs-1
                   ! upstream scheme
                   zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
@@ -138,13 +139,15 @@
             END DO
          END DO
+         CALL crs_lbc_lnk( zwx, 'U', -1._wp )  
+         CALL crs_lbc_lnk( zwy, 'V', -1._wp )  
          ! upstream tracer flux in the k direction
          ! Surface value
          IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
-         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface 
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) !cbr * ptb(:,:,1,jn)   ! linear free surface 
          ENDIF
          ! Interior value
          DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
+            DO jj = 2,  jpj_crs-1
+               DO ji = nldi_crs, nlei_crs
                   zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
                   zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
@@ -153,9 +156,11 @@
             END DO
          END DO
+         CALL crs_lbc_lnk( zwz, 'T', 1. )  
+
          ! total advective trend
          DO jk = 1, jpkm1
             z2dtt = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
+            DO jj = 2, jpj_crs-1
+               DO ji = 2, jpi_crs-1
                   zbtr = r1_bt_crs(ji,jj,jk) 
                   ! total intermediate advective trends
@@ -163,5 +168,5 @@
                      &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
                      &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
-                  ! update and guess with monotonic sheme
+
                   pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra
                   zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask_crs(ji,jj,jk)
@@ -169,4 +174,5 @@
             END DO
          END DO
+ 
          !                             ! Lateral boundary conditions on zwi  (unchanged sign)
          CALL crs_lbc_lnk( zwi, 'T', 1. )  
@@ -187,6 +193,6 @@
          ! antidiffusive flux on i and j
          DO jk = 1, jpkm1
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
+            DO jj = 2, jpj_crs-1
+               DO ji = 2, jpi_crs-1
                   zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
                   zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
@@ -198,10 +204,10 @@
          !
          DO jk = 2, jpkm1          ! Interior value
-            DO jj = 1, jpj
-               DO ji = 1, jpi
+            DO jj = 2, jpj_crs-1
+               DO ji = 2, jpi_crs-1
                   zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk)
                END DO
             END DO
-         END DO
+        END DO
          CALL crs_lbc_lnk( zwx, 'U', -1. )   ;   CALL crs_lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
          CALL crs_lbc_lnk( zwz, 'W',  1. )
@@ -214,6 +220,6 @@
          ! ------------------------------------
          DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.  
+            DO jj = 2, jpj_crs-1
+               DO ji = 2, jpi_crs-1
                   zbtr = r1_bt_crs(ji,jj,jk)
                   ! total advective trends
@@ -247,4 +253,5 @@
       END DO
       !
+
                    CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz , zwx, zwy )
       IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
@@ -302,6 +309,6 @@
          ikm1 = MAX(jk-1,1)
          z2dtt = p2dt(jk)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
+         DO jj = 2, jpj_crs-1
+            DO ji = 2, jpi_crs-1
 
                ! search maximum in neighbourhood
@@ -339,6 +346,6 @@
       ! ----------------------------------------
       DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
+         DO jj = 2, jpj_crs-1
+            DO ji = 2, jpi_crs-1
                zau = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
                zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_crs.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_crs.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_crs.F90	(revision 6772)
@@ -10,5 +10,5 @@
    !!            3.3  !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
    !!----------------------------------------------------------------------
-#if   defined key_ldfslp   ||   defined key_esopa
+#if   ( defined key_ldfslp   ||   defined key_esopa ) && defined key_crs
    !!----------------------------------------------------------------------
    !!   'key_ldfslp'               slope of the lateral diffusive direction
@@ -19,10 +19,4 @@
    !!                  the isopycnal or geopotential s-coord. operator 
    !!----------------------------------------------------------------------
-!   USE oce             ! ocean dynamics and active tracers
-!   USE dom_oce         ! ocean space and time domain
-!   USE trc_oce         ! share passive tracers/Ocean variables
-!   USE zdf_oce         ! ocean vertical physics
-!   USE ldftra_oce      ! ocean active tracers: lateral physics
-!   USE ldfslp          ! iso-neutral slopes
    USE ldfslp_crs          ! iso-neutral slopes
    USE diaptr          ! poleward transport diagnostics
@@ -35,5 +29,4 @@
    USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing
-!   USE crs
    USE oce_trc
    USE iom, ONLY : iom_put,iom_swap
@@ -113,4 +106,5 @@
       REAL(wp)                         ::   zztmp               ! local scalar
 #endif
+      REAL(wp)                         ::   zmin,zmax
       REAL(wp), POINTER, DIMENSION(:,:  ) ::  zdkt, zdk1t, z2d
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdit, zdjt, ztfw , zftu,  zftv 
@@ -188,6 +182,6 @@
                      &             + tmask_crs(ji,jj+1,jk+1) + tmask_crs(ji,jj,jk  ), 1. )
                   !
-                  zcof1 = - fsahtu(ji,jj,jk) * e2e3u_msk(ji,jj,jk) * uslp_crs(ji,jj,jk) * zmsku / MAX( 1._wp , e3u_max_crs(ji,jj,jk))
-                  zcof2 = - fsahtv(ji,jj,jk) * e1e3v_msk(ji,jj,jk) * vslp_crs(ji,jj,jk) * zmskv / MAX( 1._wp , e3v_max_crs(ji,jj,jk))
+                  zcof1 = - fsahtu(ji,jj,jk) * e2e3u_msk(ji,jj,jk) * uslp_crs(ji,jj,jk) * zmsku / MAX( 1._wp , fse3u_max_crs(ji,jj,jk))
+                  zcof2 = - fsahtv(ji,jj,jk) * e1e3v_msk(ji,jj,jk) * vslp_crs(ji,jj,jk) * zmskv / MAX( 1._wp , fse3v_max_crs(ji,jj,jk))
                   !
                   zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk)   &
@@ -199,8 +193,4 @@
                END DO
             END DO
-            CALL iom_swap( "nemo_crs"  )
-            CALL iom_put( "zftu" , zftu )
-            CALL iom_put( "zftv" , zftv )
-            CALL iom_swap( "nemo" )
 
             ! II.4 Second derivative (divergence) and add to the general trend
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_crs.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_crs.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_crs.F90	(revision 6772)
@@ -124,9 +124,9 @@
                      ikv = mbkv_crs(ji,jj)
                      IF( iku == jk ) THEN
-                        zabe1 = fsahtu(ji,jj,iku) * umask_crs(ji,jj,iku) * e1ur(ji,jj) * e3u_crs(ji,jj,iku)
+                        zabe1 = fsahtu(ji,jj,iku) * umask_crs(ji,jj,iku) * e1ur(ji,jj) * fse3u_crs(ji,jj,iku)
                         ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn)
                      ENDIF
                      IF( ikv == jk ) THEN
-                        zabe2 = fsahtv(ji,jj,ikv) * vmask_crs(ji,jj,ikv) * e2vr(ji,jj) * e3v_crs(ji,jj,ikv)
+                        zabe2 = fsahtv(ji,jj,ikv) * vmask_crs(ji,jj,ikv) * e2vr(ji,jj) * fse3v_crs(ji,jj,ikv)
                         ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn)
                      ENDIF
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 6772)
@@ -49,4 +49,5 @@
    USE agrif_opa_interp
 #endif
+   USE crs
 
    IMPLICIT NONE
@@ -56,4 +57,5 @@
    PUBLIC   tra_nxt_fix   ! to be used in trcnxt
    PUBLIC   tra_nxt_vvl   ! to be used in trcnxt
+   PUBLIC   tra_nxt_vvl_crs ! to be used in trcnxt
 
    REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
@@ -349,4 +351,112 @@
    END SUBROUTINE tra_nxt_vvl
 
+  SUBROUTINE tra_nxt_vvl_crs( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_nxt_vvl  ***
+      !!
+      !! ** Purpose :   Time varying volume: apply the Asselin time filter  
+      !!                and swap the tracer fields.
+      !! 
+      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
+      !!              - save in (ta,sa) a thickness weighted average over the three 
+      !!             time levels which will be used to compute rdn and thus the semi-
+      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
+      !!              - swap tracer fields to prepare the next time_step.
+      !!                This can be summurized for tempearture as:
+      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
+      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
+      !!             ztm = 0                                                       otherwise
+      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
+      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
+      !!             tn  = ta 
+      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
+      !!
+      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
+      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
+      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step
+      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content
+
+      !!     
+      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf   ! local logical
+      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
+      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
+      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      IF( cdtype == 'TRA' )  THEN
+         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
+         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
+         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
+      ELSE
+         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
+         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
+         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
+      ENDIF
+      !
+      DO jn = 1, kjpt
+         DO jk = 1, jpkm1
+            zfact1 = atfp * p2dt(jk)
+            zfact2 = zfact1 / rau0
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ze3t_b = fse3t_b_crs(ji,jj,jk)
+                  ze3t_n = fse3t_n_crs(ji,jj,jk)
+                  ze3t_a = fse3t_a_crs(ji,jj,jk)
+                  !                                         ! tracer content at Before, now and after
+                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
+                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
+                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
+                  !
+                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
+                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
+                  !
+                  ze3t_f = ze3t_n + atfp * ze3t_d
+                  ztc_f  = ztc_n  + atfp * ztc_d
+                  !
+                  IF( jk == 1 ) THEN           ! first level 
+                     ze3t_f = ze3t_f - zfact2 * ( emp_b_crs(ji,jj) - emp_crs(ji,jj) + rnf_crs(ji,jj) - rnf_b_crs(ji,jj) )
+                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
+                  ENDIF
+!cbr as it is a subroutine dedicated to crs, TRA options are not necessary
+!cbr                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only)
+!cbr                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )
+!cbr
+!cbr                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )   &                  ! river runoffs
+!cbr                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &
+!cbr                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
+
+                  ze3t_f = 1.e0 / ze3t_f
+                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
+                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
+                  !
+                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
+                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
+                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         ! 
+      END DO
+      !
+   END SUBROUTINE tra_nxt_vvl_crs
+
+
    !!======================================================================
 END MODULE tranxt
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp_crs.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp_crs.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp_crs.F90	(revision 6772)
@@ -78,4 +78,5 @@
       !! ** Action  : - pta  becomes the after tracer
       !!---------------------------------------------------------------------
+      USE ieee_arithmetic
       !
       INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
@@ -90,4 +91,5 @@
       REAL(wp) ::  zrhs, ze3tb, ze3tn, ze3ta   ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt,zwd,zws
+      REAL(wp) ::  zmin,zmax
       !!---------------------------------------------------------------------
       !
@@ -135,7 +137,7 @@
                END DO
             ELSE IF( l_traldf_rot ) THEN     ! standard isoneutral diff
-               DO jk = 2, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt.
+              DO jk = 2, jpkm1
+                  DO jj = 2, jpj_crs-1
+                     DO ji = 2, jpi_crs-1
                         zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk)                       &
                            &                          * (  wslpi_crs(ji,jj,jk) * wslpi_crs(ji,jj,jk)   &
@@ -148,12 +150,18 @@
 #endif
             DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ta =  ( 1. - r_vvl ) +        r_vvl   * e3t_crs(ji,jj,jk)   ! after scale factor at T-point
-                     ze3tn =         r_vvl   + ( 1. - r_vvl ) * e3t_crs(ji,jj,jk)   ! now   scale factor at T-point
+               DO jj = 2, jpj_crs-1
+                  DO ji = 2, jpi_crs-1
+
+#if defined key_vvl
+                     ze3ta =  ( 1. - r_vvl ) +        r_vvl   * fse3t_a_crs(ji,jj,jk)   ! after scale factor at T-point
+                     ze3tn =         r_vvl   + ( 1. - r_vvl ) * fse3t_n_crs(ji,jj,jk)   ! now   scale factor at T-point
+#else
+                     ze3ta =  ( 1. - r_vvl ) +        r_vvl   * e3t_0_crs(ji,jj,jk)   ! after scale factor at T-point
+                     ze3tn =         r_vvl   + ( 1. - r_vvl ) * e3t_0_crs(ji,jj,jk)   ! now   scale factor at T-point
+#endif
                      !cbr zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * e3w_1d(jk  ) )  !cc
                      !cbr zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * e3w_1d(jk+1) )  !cc
-                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * e3w_max_crs(ji,jj,jk) )
-                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * e3w_max_crs(ji,jj,jk+1) )
+                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * fse3w_max_crs(ji,jj,jk) )
+                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w_max_crs(ji,jj,jk+1) )
                      zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk)
                  END DO
@@ -182,12 +190,12 @@
             ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
             ! done once for all passive tracers (so included in the IF instruction)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
+            DO jj = 2, jpj_crs-1
+               DO ji = 2, jpi_crs-1
                   zwt(ji,jj,1) = zwd(ji,jj,1)
                END DO
             END DO
             DO jk = 2, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
+               DO jj = 2, jpj_crs-1
+                  DO ji = 2, jpi_crs-1
                     zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
                   END DO
@@ -198,8 +206,13 @@
          !    
          ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,1)
-               ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,1)
+         DO jj = 2, jpj_crs-1
+            DO ji = 2, jpi_crs-1
+#if defined key_vvl
+               ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b_crs(ji,jj,1)
+               ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t_n_crs(ji,jj,1)
+#else
+               ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_0_crs(ji,jj,1)
+               ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_0_crs(ji,jj,1)
+#endif
                pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn)
             END DO
@@ -207,11 +220,15 @@
 
          DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,jk)
-                  ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,jk)
+            DO jj = 2, jpj_crs-1
+               DO ji = 2, jpi_crs-1
+#if defined key_vvl
+                  ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b_crs(ji,jj,jk)
+                  ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t_n_crs(ji,jj,jk)
+#else
+                  ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_0_crs(ji,jj,jk)
+                  ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_0_crs(ji,jj,jk)
+#endif
                   zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn)   ! zrhs=right hand side 
-                  pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn)
-                
+                  pta(ji,jj,jk,jn) = zrhs  - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn)
                END DO
             END DO
@@ -219,19 +236,17 @@
 
          ! third recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
+         DO jj = 2, jpj_crs-1
+            DO ji = 2, jpi_crs-1
                pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask_crs(ji,jj,jpkm1)
             END DO
          END DO
          DO jk = jpk-2, 1, -1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
+            DO jj = 2, jpj_crs-1
+               DO ji = 2, jpi_crs-1
                   pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) )   &
-                     &             / zwt(ji,jj,jk) * tmask_crs(ji,jj,jk)
-                 
-               END DO
-            END DO
-         END DO
-
+                    &             / zwt(ji,jj,jk) * tmask_crs(ji,jj,jk)
+              END DO
+            END DO
+         END DO
          !                                            ! ================= !
       END DO                                          !  end tracer loop  !
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde_crs.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde_crs.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde_crs.F90	(revision 6772)
@@ -96,6 +96,4 @@
       INTEGER  ::   iku, ikv, ikum1, ikvm1   ! partial step level (ocean bottom level) at u- and v-points
       REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars
-  !cc    REAL(wp), POINTER, DIMENSION(:,:  ) ::  zri, zrj, zhi, zhj
-  !cc    REAL(wp), POINTER, DIMENSION(:,:,:) ::  zti, zte    ! interpolated value of tracer
       REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) ::  zri, zrj, zhi, zhj
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  zti, zte    ! interpolated value of tracer
@@ -105,6 +103,4 @@
       IF( nn_timing == 1 )  CALL timing_start( 'zps_hde_crs')
       !
-!!      CALL wrk_alloc( jpi, jpj,       zri, zrj, zhi, zhj ) 
-!!      CALL wrk_alloc( jpi, jpj, kjpt, zti, zte           ) 
       ALLOCATE( zri(jpi_crs,jpj_crs) , zrj(jpi_crs,jpj_crs), zte(jpi_crs ,jpj_crs ,kjpt), &
          &      zhi(jpi_crs,jpj_crs) , zhj(jpi_crs,jpj_crs), zti(jpi_crs ,jpj_crs ,kjpt))
@@ -112,22 +108,19 @@
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
          !
-# if defined key_vectopt_loop
-         jj = 1
-         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
-# else
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
-# endif
+
                iku = mbku_crs(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
                ikv = mbkv_crs(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
-          !     ze3wu = e3w_crs(ji+1,jj  ,iku) - e3w_crs(ji,jj,iku)
-          !     ze3wv = e3w_crs(ji  ,jj+1,ikv) - e3w_crs(ji,jj,ikv)
-               ze3wu = e3w_max_crs(ji+1,jj  ,iku) - e3w_max_crs(ji,jj,iku)
-               ze3wv = e3w_max_crs(ji  ,jj+1,ikv) - e3w_max_crs(ji,jj,ikv)
+               ze3wu = e3w_max_0_crs(ji+1,jj  ,iku) - e3w_max_0_crs(ji,jj,iku)
+               ze3wv = e3w_max_0_crs(ji  ,jj+1,ikv) - e3w_max_0_crs(ji,jj,ikv)
                !
                ! i- direction
                IF( ze3wu >= 0._wp ) THEN      ! case 1
-                  zmaxu =  ze3wu / e3w_max_crs(ji+1,jj,iku)  
-                 !    zmaxu =  ze3wu / e3w_crs(ji+1,jj,iku)
+#if defined key_vvl
+                  zmaxu =  ze3wu / e3w_max_n_crs(ji+1,jj,iku)  
+#else
+                  zmaxu =  ze3wu / e3w_max_0_crs(ji+1,jj,iku)  
+#endif
                   ! interpolated values of tracers
                   zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
@@ -135,6 +128,9 @@
                   pgtu(ji,jj,jn) = umask_crs(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
                ELSE                           ! case 2
-                  zmaxu = -ze3wu / e3w_max_crs(ji,jj,iku)
-                 !    zmaxu = -ze3wu / e3w_crs(ji,jj,iku)
+#if defined key_vvl
+                  zmaxu = -ze3wu / e3w_max_n_crs(ji,jj,iku)
+#else
+                  zmaxu = -ze3wu / e3w_max_0_crs(ji,jj,iku)
+#endif
                   ! interpolated values of tracers
                   zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
@@ -145,6 +141,9 @@
                ! j- direction
                IF( ze3wv >= 0._wp ) THEN      ! case 1
-                  zmaxv =  ze3wv / e3w_max_crs(ji,jj+1,ikv)
-               !      zmaxv =  ze3wv / e3w_crs(ji,jj+1,ikv)
+#if defined key_vvl
+                  zmaxv =  ze3wv / e3w_max_n_crs(ji,jj+1,ikv)
+#else
+                  zmaxv =  ze3wv / e3w_max_0_crs(ji,jj+1,ikv)
+#endif
                   ! interpolated values of tracers
                   zte(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
@@ -152,6 +151,9 @@
                   pgtv(ji,jj,jn) = vmask_crs(ji,jj,1) * ( zte(ji,jj,jn) - pta(ji,jj,ikv,jn) )
                ELSE                           ! case 2
-                  zmaxv =  -ze3wv / e3w_max_crs(ji,jj,ikv)
-                !     zmaxv = -ze3wv / e3w_crs(ji,jj,ikv)
+#if defined key_vvl
+                  zmaxv =  -ze3wv / e3w_max_n_crs(ji,jj,ikv)
+#else
+                  zmaxv =  -ze3wv / e3w_max_0_crs(ji,jj,ikv)
+#endif
                   ! interpolated values of tracers
                   zte(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
@@ -160,53 +162,38 @@
                ENDIF
 
-# if ! defined key_vectopt_loop
             END DO
-# endif
          END DO
          CALL crs_lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL crs_lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
          !
       END DO
-!WRITE(numout,*) ' test24 ', e3w_max_crs
+
       ! horizontal derivative of density anomalies (rd)
       IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
-# if defined key_vectopt_loop
-         jj = 1
-         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
-# else
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
-# endif
+
                iku = mbku_crs(ji,jj)
                ikv = mbkv_crs(ji,jj)
-   !cc             ze3wu  = e3w_max_crs(ji+1,jj  ,iku) - e3w_max_crs(ji,jj,iku)   !gradiant horizontal pas de max
-               ze3wu  = e3w_crs(ji+1,jj  ,iku) - e3w_crs(ji,jj,iku)
-       !cc        ze3wv  = e3w_max_crs(ji  ,jj+1,ikv) - e3w_max_crs(ji,jj,ikv)
-               ze3wv  = e3w_crs(ji  ,jj+1,ikv) - e3w_crs(ji,jj,ikv)
-               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_crs(ji  ,jj,iku)     ! i-direction: case 1
-               ELSE                        ;   zhi(ji,jj) = gdept_crs(ji+1,jj,iku)     ! -     -      case 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_crs(ji,jj  ,ikv)     ! j-direction: case 1
-               ELSE                        ;   zhj(ji,jj) = gdept_crs(ji,jj+1,ikv)     ! -     -      case 2
-               ENDIF
-# if ! defined key_vectopt_loop
+               ze3wu  = e3w_0_crs(ji+1,jj  ,iku) - e3w_0_crs(ji,jj,iku)
+               ze3wv  = e3w_0_crs(ji  ,jj+1,ikv) - e3w_0_crs(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept_crs(ji  ,jj,iku)     ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = fsdept_crs(ji+1,jj,iku)     ! -     -      case 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept_crs(ji,jj  ,ikv)     ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = fsdept_crs(ji,jj+1,ikv)     ! -     -      case 2
+               ENDIF
+
             END DO
-# endif
          END DO
          CALL eos_crs( zti, zhi, zri )  
          CALL eos_crs( zte, zhj, zrj )
+
          ! Gradient of density at the last level 
-# if defined key_vectopt_loop
-         jj = 1
-         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
-# else
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
-# endif
                iku = mbku_crs(ji,jj)
                ikv = mbkv_crs(ji,jj)
-      !         ze3wu  = e3w_max_crs(ji+1,jj  ,iku) - e3w_max_crs(ji,jj,iku)         gradient horizontal
-                ze3wu  = e3w_crs(ji+1,jj  ,iku) - e3w_crs(ji,jj,iku)
-      !         ze3wv  = e3w_max_crs(ji  ,jj+1,ikv) - e3w_max_crs(ji,jj,ikv)         gradient horizontal
-                ze3wv  = e3w_crs(ji  ,jj+1,ikv) - e3w_crs(ji,jj,ikv)
+                ze3wu  = e3w_0_crs(ji+1,jj  ,iku) - e3w_0_crs(ji,jj,iku)
+                ze3wv  = e3w_0_crs(ji  ,jj+1,ikv) - e3w_0_crs(ji,jj,ikv)
                IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask_crs(ji,jj,1) * ( zri(ji  ,jj) - prd(ji,jj,iku) )   ! i: 1
                ELSE                        ;   pgru(ji,jj) = umask_crs(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) )   ! i: 2
@@ -215,9 +202,7 @@
                ELSE                        ;   pgrv(ji,jj) = vmask_crs(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )   ! j: 2
                ENDIF
-# if ! defined key_vectopt_loop
+
             END DO
-# endif
          END DO
-
 
          CALL crs_lbc_lnk( pgru , 'U', -1. )   ;   CALL crs_lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions
@@ -225,6 +210,4 @@
       END IF
       !
-      !!ccCALL wrk_dealloc( jpi, jpj,       zri, zrj, zhi, zhj ) 
-      !!ccCALL wrk_dealloc( jpi, jpj, kjpt, zti, zte           ) 
       DEALLOCATE( zri , zrj, zte, zhi, zhj, zti)
       !
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl_crs.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl_crs.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl_crs.F90	(revision 6772)
@@ -24,4 +24,5 @@
    USE trc_oce, ONLY : lk_offline ! offline flag
    USE crs
+   USE ieee_arithmetic
 
    IMPLICIT NONE
@@ -64,5 +65,4 @@
       REAL(wp) ::   zN2_c        ! local scalar
       INTEGER, POINTER, DIMENSION(:,:) ::   imld   ! 2D workspace
-      REAL(wp), POINTER, DIMENSION(:,:) ::  z2d   ! 2D workspace
       !!----------------------------------------------------------------------
       !
@@ -70,5 +70,4 @@
       !
       CALL wrk_alloc( jpi_crs,jpj_crs, imld )
-      CALL wrk_alloc( jpi_crs,jpj_crs, z2d )
 
       IF( kt == nit000 ) THEN
@@ -95,15 +94,11 @@
             iiki = imld(ji,jj)
             iikn = nmln_crs(ji,jj)
-            IF( iiki .NE. 0 ) hmld_crs (ji,jj) = ( gdepw_crs(ji,jj,iiki  ) - gdepw_crs(ji,jj,1 )            )   * tmask_crs(ji,jj,1)  ! Turbocline depth 
-            IF( iiki .NE. 0 ) hmlpt_crs(ji,jj) = ( gdept_crs(ji,jj,iikn-1) - gdepw_crs(ji,jj,1 )            )   * tmask_crs(ji,jj,1)  ! depth of the last T-point inside the mixed layer
+            hmld_crs (ji,jj) = ( fsdepw_crs(ji,jj,iiki  ) - fsdepw_crs(ji,jj,1    )  ) * tmask_crs(ji,jj,1)    ! Turbocline depth 
+            hmlp_crs (ji,jj) = ( fsdepw_crs(ji,jj,iikn  ) - fsdepw_crs(ji,jj,nla10)  ) * tmask_crs(ji,jj,1)    ! Mixed layer depth
+            hmlpt_crs(ji,jj) = ( fsdept_crs(ji,jj,iikn-1) - fsdepw_crs(ji,jj,1    )  ) * tmask_crs(ji,jj,1)    ! depth of the last T-point inside the mixed layer
          END DO
       END DO
       !
-      z2d=REAL(nmln_crs,wp)
-      CALL iom_put("nmln_crs",z2d)
-      CALL iom_put("hmlpt_crs",hmlpt_crs)
-      !
       CALL wrk_dealloc( jpi_crs,jpj_crs, imld )
-      CALL wrk_dealloc( jpi_crs,jpj_crs, z2d )
       !
       IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl_crs')
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke_crs.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke_crs.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke_crs.F90	(revision 6772)
@@ -260,8 +260,8 @@
             DO ji = 2, jpi_crs-1   ! vector opt.
                DO jk = 2, jpkm1         ! from the surface to the bottom : lup
-                  zmxld_crs(ji,jj,jk) = MIN( zmxld_crs(ji,jj,jk-1) + e3t_crs(ji,jj,jk-1), zmxlm_crs(ji,jj,jk) )
+                  zmxld_crs(ji,jj,jk) = MIN( zmxld_crs(ji,jj,jk-1) + fse3t_crs(ji,jj,jk-1), zmxlm_crs(ji,jj,jk) )
                END DO
                DO jk = jpkm1, 2 , -1     ! from the bottom to the surface : ldown
-                  zmxlm_crs(ji,jj,jk) = MIN( zmxlm_crs(ji,jj,jk+1) + e3t_crs(ji,jj,jk+1), zmxlm_crs(ji,jj,jk) )
+                  zmxlm_crs(ji,jj,jk) = MIN( zmxlm_crs(ji,jj,jk+1) + fse3t_crs(ji,jj,jk+1), zmxlm_crs(ji,jj,jk) )
                END DO
             END DO
@@ -312,5 +312,5 @@
             DO ji = 2, jpi_crs-1   ! vector opt.
                DO jk = 2, jpkm1
-                  zcoef = avm_crs(ji,jj,jk) * 2._wp * e3w_crs(ji,jj,jk) * e3w_crs(ji,jj,jk)
+                  zcoef = avm_crs(ji,jj,jk) * 2._wp * fse3w_crs(ji,jj,jk) * fse3w_crs(ji,jj,jk)
                   !                                          ! shear
                   zdku = avmu_crs(ji-1,jj,jk) * ( un_crs(ji-1,jj,jk-1) - un_crs(ji-1,jj,jk) ) * ( ub_crs(ji-1,jj,jk-1) - ub_crs(ji-1,jj,jk) )   &
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 6772)
@@ -56,4 +56,5 @@
    USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine)
    USE ldftra          ! lateral diffusivity setting    (ldftra_init routine)
+   USE ldftra_crs      ! lateral diffusivity setting    (ldftra_init routine)
    USE zdfini          ! vertical physics setting          (zdf_init routine)
    USE phycst          ! physical constant                  (par_cst routine)
@@ -118,5 +119,5 @@
       !!----------------------------------------------------------------------
       INTEGER ::   istp       ! time step index
-      CHARACTER(len=20) :: cmd 
+      CHARACTER(len=30) :: cmd 
       !!----------------------------------------------------------------------
       !
@@ -183,7 +184,12 @@
       IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
       !
-      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
+      IF( nstop /= 0 ) THEN   ! error print
+         cmd='touch nemo_NOK'
+         CALL system(cmd)
          WRITE(numout,cform_err)
          WRITE(numout,*) nstop, ' error have been found'
+      ELSE
+         cmd='touch nemo_OK'
+         CALL system(cmd)
       ENDIF
       !
@@ -460,4 +466,5 @@
       IF( ln_crs_top )      CALL dom_grid_crs
                             CALL     trc_init
+                            CALL ldf_tra_crs_init
       IF( ln_crs_top )      CALL dom_grid_glo
 #endif
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 6772)
@@ -257,7 +257,6 @@
                          CALL dom_grid_crs
 
-                         !CALL eos_rab_crs( tsn_crs, rab_crs_n )       ! now    local thermal/haline expension ratio at T-points
-                         !CALL bn2_crs    ( tsn_crs, rab_crs_n, rb2_crs  ) ! now    Brunt-Vaisala frequency
-                         CALL eos_crs ( tsn_crs, rhd_crs, rhop_crs, gdept_crs(:,:,:) ) ! now in situ density for hpg computation
+                         CALL zdf_mxl_crs(kstp)
+                         CALL eos_crs ( tsn_crs, rhd_crs, rhop_crs, fsdept_crs(:,:,:) ) ! now in situ density for hpg computation
                          CALL iom_put("rhop_crs",rhop_crs)
                          CALL iom_put("rhd_crs",rhd_crs)
@@ -270,5 +269,4 @@
 
       ENDIF
-                         CALL zdf_mxl_crs(kstp)
 
       IF( ln_crs_top )   CALL dom_grid_crs
Index: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 6101)
+++ branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 6772)
@@ -98,4 +98,5 @@
    USE floats           ! floats computation               (flo_stp routine)
 
+   USE crs
    USE crsfld           ! Standard output on coarse grid   (crs_fld routine)
    USE zdfmxl_crs
