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
