Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 5105)
@@ -94,6 +94,6 @@
  
       ! Masks
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: tmask_crs, umask_crs, vmask_crs, fmask_crs
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE,SAVE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs
       
   !    REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask_i_crs, tpol, fpol      
@@ -112,9 +112,9 @@
                                                                   ! vertical scale factors 
       ! Coordinates
-      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs 
-      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs 
-      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: ff_crs
-      INTEGER,  DIMENSION(:,:),   ALLOCATABLE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE,SAVE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs 
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE,SAVE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs 
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE,SAVE :: ff_crs
+      INTEGER,  DIMENSION(:,:),   ALLOCATABLE,SAVE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs
 
       ! Weights
@@ -136,4 +136,5 @@
       INTEGER           :: nn_crs_kz    =    0       !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN) 
       LOGICAL           :: ln_crs_wn    = .FALSE.    !: coarsening wn or computation using horizontal divergence 
+      LOGICAL, PUBLIC   :: ln_crs_top = .FALSE.          !:coarsening online for the bio
       !
       INTEGER           :: nrestx, nresty       !: for determining odd or even reduction factor
@@ -146,12 +147,17 @@
 
       ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsn_crs
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsb_crs,tsn_crs
       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs, rke_crs
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivn_crs    
-      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshn_crs    
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: ub_crs, vb_crs
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivb_crs , hdivn_crs    
+      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshb_crs, sshn_crs , ssha_crs
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: rhop_crs,rhd_crs,rb2_crs
+      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: gru_crs, grv_crs
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: gtsu_crs, gtsv_crs
       ! 
       ! Surface fluxes to pass to TOP
       REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: qsr_crs, fr_i_crs, wndm_crs
       REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: emp_crs, emp_b_crs, sfx_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: fmmflx_crs
       REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs
       REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs
@@ -164,5 +170,6 @@
 
       ! Mixing and Mixed Layer Depth
-      INTEGER,  PUBLIC, ALLOCATABLE, DIMENSION(:,:)    ::  nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs                       
+      INTEGER,  PUBLIC, DIMENSION(:,:) , ALLOCATABLE ::  nmln_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: hmlp_crs , hmlpt_crs , hmld_crs
 
       ! Direction of lateral diffusion
@@ -235,14 +242,19 @@
 
 
-      ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , &
-         &      wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk),&
-         &      rke_crs(jpi_crs,jpj_crs,jpk),                                STAT=ierr(11))
-
-     ALLOCATE( sshn_crs(jpi_crs,jpj_crs), emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), &
+      ALLOCATE( ub_crs(jpi_crs,jpj_crs,jpk) , vb_crs(jpi_crs,jpj_crs,jpk) , &
+         &      un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk)    ,  wn_crs(jpi_crs,jpj_crs,jpk) , &
+         &      hdivb_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk) , &
+         &      rke_crs(jpi_crs,jpj_crs,jpk), rhop_crs(jpi_crs,jpj_crs,jpk)  , &
+         &      rb2_crs(jpi_crs,jpj_crs,jpk) ,rhd_crs(jpi_crs,jpj_crs,jpk)   , &
+         &      gtsu_crs(jpi_crs,jpj_crs,jpk) ,gtsv_crs(jpi_crs,jpj_crs,jpk) , &
+                gru_crs(jpi_crs,jpj_crs) ,grv_crs(jpi_crs,jpj_crs) , STAT=ierr(11))
+
+     ALLOCATE( sshb_crs(jpi_crs,jpj_crs), sshn_crs(jpi_crs,jpj_crs),  ssha_crs(jpi_crs,jpj_crs), &
+         &     emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), &
          &     qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , &
          &     vtau_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs ,jpj_crs), &
-         &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  )
-
-     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    &
+         &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), fmmflx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  )
+
+     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsb_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    &
 # if defined key_zdfddm
          &      avs_crs(jpi_crs,jpj_crs,jpk),    &
@@ -302,5 +314,4 @@
       !! ** Purpose : +Return back to parent grid domain 
       !!---------------------------------------------------------------------
-      write(narea+200,*)"dom_grid_glo";call flush(narea+200)
 
       !                         Return to parent grid domain
@@ -346,5 +357,4 @@
       !! ** Purpose :  Save the parent grid information & Switch to coarse grid domain
       !!---------------------------------------------------------------------
-      write(narea+200,*)"dom_grid_crs";call flush(narea+200)
       !
       !                        Switch to coarse grid domain
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 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90	(revision 5105)
@@ -52,5 +52,5 @@
    END INTERFACE
 
-   REAL(wp) :: r_inf = 1e+36
+   REAL(wp),PUBLIC :: r_inf = 1e+7 !cbr 1e+36
 
    !! Substitutions
@@ -64,4 +64,5 @@
       INTEGER  ::  ji, jj, jk                   ! dummy loop indices
       INTEGER  ::  ijie,ijis,ijje,ijjs,ij,je_2
+      INTEGER  ::  iji, ijj
       REAL(wp) ::  zmask
       
@@ -122,5 +123,12 @@
                ijjs = mjs_crs(jj)
 
-               IF( ijje .GT. jpj )WRITE(narea+200,*)"BUG",jj,ijjs,ijje,SHAPE(tmask) ; call flush(narea+200)
+               !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
+
+               !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) )
@@ -140,9 +148,35 @@
          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( 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 )
+      !
+      !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
       !
    END SUBROUTINE crs_dom_msk
@@ -385,14 +419,14 @@
 
       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
+      !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
+      !ENDIF
 
       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
@@ -513,4 +547,5 @@
       REAL(wp) :: zflcrs, zsfcrs   
       REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask  
+      INTEGER  :: iji, ijj
       !!----------------------------------------------------------------  
    
@@ -526,17 +561,18 @@
             
                CASE( 'T', 'W' )
-                  IF( cd_type == 'T' ) THEN
+                  !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
-                     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
+                  !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
@@ -619,12 +655,19 @@
               CASE( 'W' )
                   IF( PRESENT( p_e3 ) ) THEN
-                    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) 
+                    !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) 
+                    !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
@@ -712,11 +755,11 @@
                                &      + 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
+                              !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
@@ -726,11 +769,12 @@
                              &      + 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)
-
-                           IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,2,jk) = zflcrs
-                           ELSE                   ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
-                           ENDIF
+                           !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
@@ -746,12 +790,27 @@
                              &      + 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) 
-
-                           IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,ij,jk) = zflcrs
-                           ELSE                   ; p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs
-                           ENDIF
+                           !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)
                         ENDDO
                      ENDDO
@@ -809,4 +868,5 @@
               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 )
 
@@ -987,15 +1047,16 @@
             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' )
+            !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
-            END SELECT
+            !END SELECT
 
             SELECT CASE ( cd_type )
@@ -1157,5 +1218,7 @@
          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
@@ -1205,5 +1268,5 @@
 
       !!----------------------------------------------------------------  
-   
+ 
       p_fld_crs(:,:) = 0.0
 
@@ -1702,5 +1765,5 @@
       INTEGER ::  ijie, ijje, ii, ij, je_2
       REAL(wp) :: ze3crs  
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zmask, zsurf   
+      !REAL(wp), DIMENSION(:,:,:), POINTER :: zmask, zsurf   
 
       !!----------------------------------------------------------------  
@@ -1710,114 +1773,387 @@
    
 
-       CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf )
+       !CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf )
 
        SELECT CASE ( cd_type )
-          CASE( 'W' )
-              zmask(:,:,1) = p_mask(:,:,1) 
-              DO jk = 2, jpk
-                 zmask(:,:,jk) = p_mask(:,:,jk-1) 
-              ENDDO
-           CASE DEFAULT
-              DO jk = 1, jpk
-                 zmask(:,:,jk) = p_mask(:,:,jk) 
-              ENDDO
+
+         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)
+
+                  ENDDO
+               ENDDO
+            ENDDO
+
+         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)
+
+                  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)
+
+
+                    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)
+
+                  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)
+
+                  ENDDO
+               ENDDO
+            ENDDO
+            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
 
-       DO jk = 1, jpk
-          zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:) * p_e3(:,:,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     
-                   ze3crs =   zsurf(ji  ,je_2,jk) * zmask(ji  ,je_2,jk)   &
-                        &   + zsurf(ji+1,je_2,jk) * zmask(ji+1,je_2,jk)   &
-                        &   + zsurf(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) 
-
-                   p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
-                   !
-                   ze3crs = MAX( p_e3(ji  ,je_2,jk) * zmask(ji  ,je_2,jk),  &
-                      &          p_e3(ji+1,je_2,jk) * zmask(ji+1,je_2,jk),  &
-                      &          p_e3(ji+2,je_2,jk) * zmask(ji+2,je_2,jk)  )
-                   !
-                   p_e3_max_crs(ii,2,jk) = ze3crs
-                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     
-                ze3crs =  zsurf(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk)   &
-                   &    + zsurf(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk)   &
-                   &    + zsurf(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk)   &
-                   &    + zsurf(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk)   &
-                   &    + zsurf(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk)   &
-                   &    + zsurf(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk)   &
-                   &    + zsurf(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk)   &
-                   &    + zsurf(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk)   &
-                   &    + zsurf(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk)
-
-                p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
-                !
-                ze3crs = MAX( p_e3(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk),  &
-                   &          p_e3(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk),  &
-                   &          p_e3(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk),  &
-                   &          p_e3(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk),  &
-                   &          p_e3(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk),  &
-                   &          p_e3(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk),  &
-                   &          p_e3(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk),  &
-                   &          p_e3(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk),  &
-                   &          p_e3(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) )
-               
-                p_e3_max_crs(ii,2,jk) = ze3crs
-                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
-                   ze3crs =   zsurf(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk)   &
-                   &        + zsurf(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk)   &
-                   &        + zsurf(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk)   &
-                   &        + zsurf(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk)   &
-                   &        + zsurf(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk)   &
-                   &        + zsurf(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk)   &
-                   &        + zsurf(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk)   &
-                   &        + zsurf(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk)   &
-                   &        + zsurf(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk)
-
-                !cbr
-                !p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
-                IF( p_sfc_crs(ii,ij,jk) == 0.d0 )WRITE(narea+200,*)"crs_dom_e30 ",ii,ij,jk,p_sfc_crs(ii,ij,jk) ; call flush(narea+200)
-                IF( p_sfc_crs(ii,ij,jk) .NE. 0.d0 )THEN ;  p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
-                ELSE                                    ;  p_e3_crs(ii,ij,jk) =0.d0
-                ENDIF
-                !
-                ze3crs = MAX( p_e3(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk),  &
-                   &          p_e3(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk),  &
-                   &          p_e3(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk),  &
-                   &          p_e3(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk),  &
-                   &          p_e3(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk),  &
-                   &          p_e3(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk),  &
-                   &          p_e3(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk),  &
-                   &          p_e3(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk),  &
-                   &          p_e3(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) )
-               
-                p_e3_max_crs(ii,ij,jk) = ze3crs
-             ENDDO
-          ENDDO
-       ENDDO
-                  
-       CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pval=1.0 )  
-       CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 )  
+         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 )
+       !CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zmask )
        !
    END SUBROUTINE crs_dom_e3
@@ -1836,8 +2172,10 @@
       INTEGER  :: ji, jj, jk                   ! dummy loop indices
       INTEGER  :: ii, ij, je_2
+      INTEGER  :: iji,ijj
       REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk   
       !!----------------------------------------------------------------  
       ! Initialize
-
+      p_surf_crs(:,:,:)=0._wp
+      p_surf_crs_msk(:,:,:)=0._wp
 
       CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk )
@@ -1849,7 +2187,9 @@
                zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:) 
             ENDDO
-            zsurfmsk(:,:,1) = zsurf(:,:,1) * p_mask(:,:,1) 
-            DO jk = 2, jpk
-               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk-1) 
+            !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
 
@@ -1878,4 +2218,10 @@
             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
@@ -1916,25 +2262,160 @@
                ii = ( ji - mis_crs(2) ) * rfactx_r + 2  
                ij = ( jj - njstr ) * rfacty_r + 3
-               IF( jk==1 .AND. ii==2 .AND. ij==18 )THEN
-               WRITE(narea+200,*)"crs_dom_sfc ",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) 
-               call flush(narea+200)
-               ENDIF
                !
                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)  
-               IF( jk==1 .AND. ii==2 .AND. ij==18 )WRITE(narea+200,*)"crs_dom_sfc ",p_surf_crs    (ii,ij,jk) ; call flush(narea+200)
                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)  
+
+               !cbr
+               iji=117 ; ijj=211
+               iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1
+               IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN
+               WRITE(narea+5000,*)"SFC W =======> "
+               WRITE(narea+5000,*)ii,ij,jk
+               WRITE(narea+5000,*)ji,jj
+               WRITE(narea+5000,*)zsurfmsk(ji,jj  ,jk) , zsurfmsk(ji+1,jj  ,jk) , zsurfmsk(ji+2,jj  ,jk)
+               WRITE(narea+5000,*)zsurfmsk(ji,jj+1,jk) , zsurfmsk(ji+1,jj+1,jk) , zsurfmsk(ji+2,jj+1,jk)
+               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   
-      WRITE(narea+200,*)"crs_dom_sfc end ", p_surf_crs    (2,18,1)
+
+      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)
+               !cbr
+               !iji=117 ; ijj=211
+               !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1
+               !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN
+               !WRITE(narea+5000,*)"SFC U =======> "
+               !WRITE(narea+5000,*)ii,ij,jk
+               !WRITE(narea+5000,*)ji,jj
+               !WRITE(narea+5000,*)mis_crs(2),rfactx_r , ( ji - 1 - mis_crs(2) ) * rfactx_r 
+               !WRITE(narea+5000,*)zsurf(ji+2,jj  ,jk),zsurf(ji+2,jj+1,jk),zsurf(ji+2,jj+2,jk)
+               !WRITE(narea+5000,*)zsurfmsk(ji+2,jj  ,jk),zsurfmsk(ji+2,jj+1,jk),zsurfmsk(ji+2,jj+2,jk)
+               !WRITE(narea+5000,*)p_surf_crs    (ii,ij,jk),p_surf_crs_msk(ii,ij,jk)
+               !ENDIF
+               !iji=116 ; ijj=211
+               !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1
+               !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN
+               !WRITE(narea+5000,*)"SFC U =======> "
+               !WRITE(narea+5000,*)ii,ij,jk
+               !WRITE(narea+5000,*)ji,jj
+               !WRITE(narea+5000,*)zsurf(ji+2,jj  ,jk),zsurf(ji+2,jj+1,jk),zsurf(ji+2,jj+2,jk)
+               !WRITE(narea+5000,*)zsurfmsk(ji+2,jj  ,jk),zsurfmsk(ji+2,jj+1,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
+
+      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 )
-      WRITE(narea+200,*)"crs_dom_sfc end ", p_surf_crs    (2,18,1)
 
       CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 5105)
@@ -66,7 +66,12 @@
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs !
       REAL(wp)       :: z2dcrsu, z2dcrsv
+      REAL(wp)       :: zmin,zmax
+      INTEGER :: i,j,ijis,ijie,ijjs,ijje
+      REAL(wp)       :: zw,zwp1,zum1,zu,zvm1,zv,zsnm,zsm,z
+      INTEGER ::  iji,ijj
       !!
        !!----------------------------------------------------------------------
       ! 
+      !IF(narea==267)WRITE(narea+5000,*)"========================================> crsfldt ",kt
 
       IF( nn_timing == 1 )   CALL timing_start('crs_fld')
@@ -91,4 +96,5 @@
          wn_crs   (:,:,:  ) = 0._wp    ! w
          avt_crs  (:,:,:  ) = 0._wp    ! avt
+         hdivb_crs(:,:,:  ) = 0._wp    ! hdiv
          hdivn_crs(:,:,:  ) = 0._wp    ! hdiv
          rke_crs  (:,:,:  ) = 0._wp    ! rke
@@ -110,4 +116,7 @@
 
       !  Temperature
+      zt(:,:,:) = tsb(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
+      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
+      tsb_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
       zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
       CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
@@ -119,4 +128,7 @@
       
       !  Salinity
+      zs(:,:,:) = tsb(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
+      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
+      tsb_crs(:,:,:,jp_sal) = zt_crs(:,:,:)
       zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
       CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
@@ -127,5 +139,9 @@
 
       !  U-velocity
+      CALL crs_dom_ope( ub, 'SUM', 'U', umask, ub_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
       CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
+      !cbr
+      ub_crs(:,:,:) = ub_crs(:,:,:)*umask_crs(:,:,:)
+      un_crs(:,:,:) = un_crs(:,:,:)*umask_crs(:,:,:)
       !
       zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
@@ -146,5 +162,12 @@
 
       !  V-velocity
+      !IF(narea==267)WRITE(narea+5000,*)"deg vb_crs"
+      CALL crs_dom_ope( vb, 'SUM', 'V', vmask, vb_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+      !IF(narea==267)WRITE(narea+5000,*)"deg vn_crs"
       CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+      !IF(narea==267)WRITE(narea+5000,*)"1 vn_crs(17,5,74) = ",vn_crs(17,5,74),vmask_crs(17,5,74),vn(46,13,74),vn(47,13,74),vn(48,13,74)
+      vb_crs(:,:,:) = vb_crs(:,:,:)*vmask_crs(:,:,:)
+      vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:)
+      !IF(narea==267)WRITE(narea+5000,*)"2 vn_crs(17,5,74) = ",vn_crs(17,5,74),vmask_crs(17,5,74),vn(46,13,74),vn(47,13,74),vn(48,13,74)
       !                                                                                 
       zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
@@ -174,4 +197,10 @@
             DO jj = 2, jpj_crsm1
                IF( tmask_crs(ji,jj,jk ) > 0 ) THEN
+                  !z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * crs_surfu_wgt(ji  ,jj  ,jk) ) &
+                  !   &     - ( un_crs(ji-1,jj  ,jk) * crs_surfu_wgt(ji-1,jj  ,jk) )
+                  !z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * crs_surfv_wgt(ji  ,jj  ,jk) ) &
+                  !   &     - ( vn_crs(ji  ,jj-1,jk) * crs_surfv_wgt(ji  ,jj-1,jk) )
+                  !
+                  !IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk)
                   z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * e2e3u_msk(ji  ,jj  ,jk) ) &
                      &     - ( un_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) )
@@ -179,5 +208,38 @@
                      &     - ( vn_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk) )
                   !
-                  IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / ocean_volume_crs_t(ji,jj,jk)
+                  !cbr
+                  !
+                  !bug1: il manquait le facvol_t(ji,jj,jk) ds la division ; ca creait des grosses erreurs de Wcrs ( vu en recalculant la divergence 3D )
+                  !bug2: mm test que bug1: on n'obtient tjs pas zero
+                  !on a la div calculée via ocean_volume_crs_t puis w via  e3t_crs ; or ,e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk) NE ocean_volume_crs_t*crs_volt_wgt(ji,jj,jk)
+                  !exp (117,211,74) : e1*e2*e3=235206030060.005 / ocean_volume_crs_t * facvol = 235205585307.810
+                  !                   e1*e2*e3-cean_volume_crs_t * facvol/(cean_volume_crs_t * facvol) ~1.e-6)  
+                  !IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk))
+                  !IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk))
+                  IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv )
+
+               !iji=117 ; ijj=211
+               !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1
+               !IF( ji==iji .AND. jj==ijj )THEN
+               !WRITE(narea+5000,*)"hdivn_crs =======> "
+               !WRITE(narea+5000,*) "u"  ,jk,un_crs(ji  ,jj  ,jk) ,e2e3u_msk(ji  ,jj  ,jk),un_crs(ji  ,jj  ,jk)*e2e3u_msk(ji  ,jj  ,jk)
+               !WRITE(narea+5000,*) "um1",jk,un_crs(ji-1,jj  ,jk) , e2e3u_msk(ji-1,jj  ,jk),un_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk)
+               !WRITE(narea+5000,*) "v",jk,vn_crs(ji  ,jj  ,jk) , e1e3v_msk(ji  ,jj  ,jk),vn_crs(ji  ,jj  ,jk) * e1e3v_msk(ji  ,jj  ,jk)
+               !WRITE(narea+5000,*) "vm1",jk,vn_crs(ji  ,jj-1,jk) , e1e3v_msk(ji  ,jj-1,jk),vn_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk)
+               !WRITE(narea+5000,*) "t1 ",jk,z2dcrsu,z2dcrsv, z2dcrsu + z2dcrsv,hdivn_crs(ji,jj,jk)
+               !WRITE(narea+5000,*) "t2 ",jk,e1t_crs(ji,jj),e2t_crs(ji,jj),e3t_crs(ji,jj,jk),e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk)
+               !WRITE(narea+5000,*) "t3 ",jk,ocean_volume_crs_t(ji,jj,jk),facvol_t(ji,jj,jk),facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk)
+               !WRITE(narea+5000,*) "t4 ",jk, ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk))
+               !WRITE(narea+5000,*) "t5 ",jk, ( z2dcrsu + z2dcrsv ) / (e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk))
+               !ENDIF
+
+
+                  !IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk)
+                  z2dcrsu =  ( ub_crs(ji  ,jj  ,jk) * e2e3u_msk(ji  ,jj  ,jk) ) &
+                     &     - ( ub_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) )
+                  z2dcrsv =  ( vb_crs(ji  ,jj  ,jk) * e1e3v_msk(ji  ,jj  ,jk) ) &
+                     &     - ( vb_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk) )
+                  !
+                  IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivb_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk) )
                ENDIF
             ENDDO
@@ -189,14 +251,25 @@
 
 
+      ! DO jk = 1, jpkm1          ! Interior value
+      !      DO jj = 1, jpj_crs
+      !         DO ji = 1, jpi_crs
+      !            IF( e3t_crs(ji,jj,jk) .NE. e3t_crs(ji,jj,jk) )WRITE(narea+200,*)"e3t_crs",e3t_crs(ji,jj,jk) ; call flush(narea+200)
+      !            IF( hdivn_crs(ji,jj,jk) .NE. hdivn_crs(ji,jj,jk) )WRITE(narea+200,*)"hdivn_crs",hdivn_crs(ji,jj,jk) ; call flush(narea+200)
+      !         END DO
+      !      END DO
+      !   END DO
+
       !  W-velocity
       IF( ln_crs_wn ) THEN
          CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
-       !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=zfse3w )
       ELSE
         wn_crs(:,:,jpk) = 0._wp
         DO jk = jpkm1, 1, -1
-           wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk)
+           !cbr wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk)
+           wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk)
+           WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp )  wn_crs(:,:,jk) =  wn_crs(:,:,jk) /e1e2w_msk(:,:,jk) 
         ENDDO
       ENDIF
+
       CALL iom_put( "woce", wn_crs  )   ! vertical velocity
       !  free memory
@@ -216,5 +289,7 @@
       !  sbc fields  
 
+      CALL crs_dom_ope( sshb , 'VOL', 'T', tmask, sshb_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )  
       CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )  
+      CALL crs_dom_ope( ssha , 'VOL', 'T', tmask, ssha_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )  
       CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 )
       CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 )
@@ -224,4 +299,5 @@
       CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
       CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
+      CALL crs_dom_ope( fmmflx,'SUM', 'T', tmask, fmmflx_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
       CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
       CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
@@ -237,4 +313,115 @@
       CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output 
 
+      !cbr
+      !IF(narea==267)WRITE(narea+5000,*)"vn_crs(17,5,74) = ",vn_crs(17,5,74)
+      !ji=117 ; jj=211 ; jk=74
+      !ji=ji-nimpp_crs+1 ; jj=jj-njmpp_crs+1
+      !IF( ji .GE. 2 .AND. ji .LE. jpi_crs-1 .AND. jj .GE. 2 .AND. jj .LE. jpj_crs-1 )THEN
+      !WRITE(narea+5000,*)"=======> kt ",kt
+      !WRITE(narea+5000,*)ji,jj,glamt(ji,jj),gphit(ji,jj)
+      !WRITE(narea+5000,*)"um1  crs ",umask_crs(ji-1,jj,jk),e2e3u_msk(ji-1,jj,jk),un_crs(ji-1,jj,jk),umask_crs(ji-1,jj,jk)*e2e3u_msk(ji-1,jj,jk)*un_crs(ji-1,jj,jk)
+      !WRITE(narea+5000,*)"u    crs ",umask_crs(ji,jj,jk),e2e3u_msk(ji,jj,jk),un_crs(ji,jj,jk),umask_crs(ji,jj,jk)*e2e3u_msk(ji,jj,jk)*un_crs(ji,jj,jk)
+      !WRITE(narea+5000,*)"vm1  crs ",vmask_crs(ji,jj-1,jk),e1e3v_msk(ji,jj-1,jk),vn_crs(ji,jj-1,jk),vmask_crs(ji,jj-1,jk)*e1e3v_msk(ji,jj-1,jk)*vn_crs(ji,jj-1,jk)
+      !WRITE(narea+5000,*)"v    crs ",vmask_crs(ji,jj,jk),e1e3v_msk(ji,jj,jk),vn_crs(ji,jj,jk),vmask_crs(ji,jj,jk)*e1e3v_msk(ji,jj,jk)*vn_crs(ji,jj,jk)
+      !WRITE(narea+5000,*)"wp1  crs ",tmask_crs(ji,jj,jk+1),e1e2w_msk(ji,jj,jk+1),wn_crs(ji,jj,jk+1),tmask_crs(ji,jj,jk+1)*e1e2w_msk(ji,jj,jk+1)*wn_crs(ji,jj,jk+1)
+      !WRITE(narea+5000,*)"w    crs ",tmask_crs(ji,jj,jk),e1e2w_msk(ji,jj,jk),wn_crs(ji,jj,jk),tmask_crs(ji,jj,jk)*e1e2w_msk(ji,jj,jk)*wn_crs(ji,jj,jk)
+      !z = umask_crs(ji,jj,jk)*e2e3u_msk(ji,jj,jk)*un_crs(ji,jj,jk) - umask_crs(ji-1,jj,jk)*e2e3u_msk(ji-1,jj,jk)*un_crs(ji-1,jj,jk) + &
+      !    vmask_crs(ji,jj,jk)*e1e3v_msk(ji,jj,jk)*vn_crs(ji,jj,jk) - vmask_crs(ji,jj-1,jk)*e1e3v_msk(ji,jj-1,jk)*vn_crs(ji,jj-1,jk) + &
+      !    tmask_crs(ji,jj,jk)*e1e2w_msk(ji,jj,jk)*wn_crs(ji,jj,jk) - tmask_crs(ji,jj,jk+1)*e1e2w_msk(ji,jj,jk+1)*wn_crs(ji,jj,jk+1)
+      !WRITE(narea+5000,*)"sum ",z
+      !ijie = mie_crs(ji)
+      !ijis = mis_crs(ji)
+      !ijje = mje_crs(jj)
+      !ijjs = mjs_crs(jj)
+      !DO i=ijis,ijie
+      !   DO j=ijjs,ijje
+      !       WRITE(narea+5000,*)"tmask",i,j,tmask(i,j,jk)
+      !   ENDDO           
+      !ENDDO           
+
+      !z=0._wp
+      !zsm=0._wp
+      !DO i=ijis,ijie
+      !   DO j=ijjs,ijje
+      !       WRITE(narea+5000,*)"w",i,j,tmask(i,j,jk),e1t(i,j),e2t(i,j),e1t(i,j)*e2t(i,j),wn(i,j,jk)
+      !       z=z+tmask(i,j,jk)*e1t(i,j)*e2t(i,j)*wn(i,j,jk)
+      !       zsm=zsm+tmask(i,j,jk)*e1t(i,j)*e2t(i,j)
+      !   ENDDO           
+      !ENDDO   
+        
+      !zw=z
+      !WRITE(narea+5000,*)"w sum ",zsm,zw           
+      !z=0._wp
+      !zsm=0._wp
+      !DO i=ijis,ijie
+      !   DO j=ijjs,ijje
+      !       WRITE(narea+5000,*)"wp1 ",i,j,tmask(i,j,jk+1),e1t(i,j),e2t(i,j),e1t(i,j)*e2t(i,j),wn(i,j,jk+1)
+      !       z=z+tmask(i,j,jk+1)*e1t(i,j)*e2t(i,j)*wn(i,j,jk+1)
+      !       zsm=zsm+tmask(i,j,jk+1)*e1t(i,j)*e2t(i,j)
+      !   ENDDO
+      !ENDDO
+      !zwp1=z
+      !WRITE(narea+5000,*)"wp1 sum ",zsm,zwp1  
+      !z=0._wp
+      !zsm=0._wp
+      !i=ijis-1
+      !DO j=ijjs,ijje
+      !    WRITE(narea+5000,*)"um1",i,j,umask(i,j,jk),e2u(i,j),e3u_0(i,j,jk),e2u(i,j)*e3u_0(i,j,jk),un(i,j,jk)
+      !    z=z+e2u(i,j)*e3u_0(i,j,jk)*un(i,j,jk)
+      !    zsm=zsm+e2u(i,j)*e3u_0(i,j,jk)*umask(i,j,jk)
+      !ENDDO
+      !zum1=z
+      !WRITE(narea+5000,*)"um1 sum ",zsm,zum1          
+      !z=0._wp
+      !zsm=0._wp
+      !i=ijie
+      !DO j=ijjs,ijje
+      !    WRITE(narea+5000,*)"u",i,j,umask(i,j,jk),e2u(i,j),e3u_0(i,j,jk),e2u(i,j)*e3u_0(i,j,jk),un(i,j,jk)
+      !    z=z+e2u(i,j)*e3u_0(i,j,jk)*un(i,j,jk)
+      !    zsm=zsm+e2u(i,j)*e3u_0(i,j,jk)*umask(i,j,jk)
+      !ENDDO           
+      !zu=z
+      !WRITE(narea+5000,*)"u   sum ",zsm,zu          
+      !z=0._wp
+      !zsm=0._wp
+      !j=ijjs-1
+      !DO i=ijis,ijie
+      !    WRITE(narea+5000,*)"vm1",i,j,vmask(i,j,jk),e1v(i,j),e3v_0(i,j,jk),e1v(i,j)*e3v_0(i,j,jk),vn(i,j,jk)
+      !    z=z+e1v(i,j)*e3v_0(i,j,jk)*vn(i,j,jk)
+      !    zsm=zsm+e1v(i,j)*e3v_0(i,j,jk)*vmask(i,j,jk)
+      !ENDDO           
+      !zvm1=z
+      !WRITE(narea+5000,*)"vm1 sum ",zsm,zvm1           
+      !z=0._wp
+      !zsm=0._wp
+      !j=ijje
+      !DO i=ijis,ijie
+      !    WRITE(narea+5000,*)"v",i,j,vmask(i,j,jk),e1v(i,j),e3v_0(i,j,jk),e1v(i,j)*e3v_0(i,j,jk),vn(i,j,jk)
+      !    z=z+e1v(i,j)*e3v_0(i,j,jk)*vn(i,j,jk)
+      !    zsm=zsm+e1v(i,j)*e3v_0(i,j,jk)*vmask(i,j,jk)
+      !ENDDO           
+      !zv=z
+      !WRITE(narea+5000,*)"v   sum ",zv           
+      !WRITE(narea+5000,*)"sum ",zw+zwp1+zum1+zu+zvm1+zv
+      !DO i=ijis,ijie
+      !   DO j=ijjs,ijje
+      !       WRITE(narea+5000,*)"msk",i,j,tmask(i,j,jk),umask(i,j,jk),vmask(i,j,jk)
+      !       WRITE(narea+5000,*)"vel",i,j,un(i,j,jk),vn(i,j,jk),wn(i,j,jk)
+      !   ENDDO
+      !ENDDO
+
+      !DO i=ijis,ijie
+      !   DO j=ijjs,ijje
+      !      z = un(i,j,jk)*e2u(i,j)*e3u_0(i,j,jk)*umask(i,j,jk) - un(i-1,j,jk)*e2u(i-1,j)*e3u_0(i-1,j,jk)*umask(i-1,j,jk) + &
+      !          vn(i,j,jk)*e1v(i,j)*e3v_0(i,j,jk)*vmask(i,j,jk) - vn(i,j-1,jk)*e1v(i,j-1)*e3v_0(i,j-1,jk)*vmask(i,j-1,jk) + &
+      !          wn(i,j,jk)*e2t(i,j)*e1t(i,j)*tmask(i,j,jk)     - wn(i,j,jk+1)*e2t(i,j)*e1t(i,j)*tmask(i,j,jk+1)
+      !       WRITE(narea+5000,*)"div ",i,j,jk,z
+      !   ENDDO
+      !ENDDO
+
+      !ENDIF
+      
+  
+
       !  free memory
       CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 5105)
@@ -68,7 +68,8 @@
       INTEGER  :: ierr                                ! allocation error status
       INTEGER  ::   ios                 ! Local integer output status for namelist read
+      REAL(wp) :: zmin,zmax
       REAL(wp), DIMENSION(:,:,:), POINTER :: zfse3t, zfse3u, zfse3v, zfse3w
 
-      NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn
+      NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn, ln_crs_top
       !!----------------------------------------------------------------------
       !
@@ -160,4 +161,13 @@
      CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs )
 
+     WHERE(e1t_crs == 0._wp) e1t_crs=r_inf
+     WHERE(e1u_crs == 0._wp) e1u_crs=r_inf
+     WHERE(e1v_crs == 0._wp) e1v_crs=r_inf
+     WHERE(e1f_crs == 0._wp) e1f_crs=r_inf
+     WHERE(e2t_crs == 0._wp) e2t_crs=r_inf
+     WHERE(e2u_crs == 0._wp) e2u_crs=r_inf
+     WHERE(e2v_crs == 0._wp) e2v_crs=r_inf
+     WHERE(e2f_crs == 0._wp) e2f_crs=r_inf
+
      e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:)
      
@@ -169,4 +179,5 @@
       CASE ( 0, 1, 4 )           ! mesh on the sphere
 
+         zmin=MINVAL(ABS(gphif_crs(:,:)));zmax=MAXVAL(ABS(gphif_crs(:,:)));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"gphif_crs",zmin,zmax
          ff_crs(:,:) = 2. * omega * SIN( rad * gphif_crs(:,:) )
 
@@ -190,4 +201,8 @@
 
      !    3.d.2   Surfaces 
+     e2e3u_crs(:,:,:)=0._wp
+     e2e3u_msk(:,:,:)=0._wp
+     e1e3v_crs(:,:,:)=0._wp
+     e1e3v_msk(:,:,:)=0._wp
      CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t    )
      WRITE(narea+200,*)"e1e2w_crs(2,18,1) ",e1e2w_crs(2,18,1)
@@ -207,5 +222,12 @@
 
               facsurfu(ji,jj,jk) = umask_crs(ji,jj,jk) * e2e3u_msk(ji,jj,jk)  
-              IF( e2e3u_crs(ji,jj,jk) .NE. 0._wp ) facsurfu(ji,jj,jk) = facsurfu(ji,jj,jk) / e2e3u_crs(ji,jj,jk)
+
+              IF( facsurfu(ji,jj,jk) .NE. facsurfu(ji,jj,jk) )WRITE(narea+200,*)'BUG1',facsurfu(ji,jj,jk);call flush(narea+200)
+              IF( e2e3u_crs(ji,jj,jk) .NE. e2e3u_crs(ji,jj,jk) ) WRITE(narea+200,*)'BUG2',e2e3u_crs(ji,jj,jk);call flush(narea+200)
+              IF( e2e3u_msk(ji,jj,jk) .NE. e2e3u_msk(ji,jj,jk) ) WRITE(narea+200,*)'BUG3',e2e3u_msk(ji,jj,jk) ;call flush(narea+200)
+              IF( e1e2w_msk(ji,jj,jk) .NE. e1e2w_msk(ji,jj,jk) ) WRITE(narea+200,*)'BUG4',ji,jj,jk,e1e2w_msk(ji,jj,jk) ;call flush(narea+200)
+              IF( tmask(ji,jj,jk) .NE. tmask(ji,jj,jk) ) WRITE(narea+200,*)'BUG4',tmask(ji,jj,jk) ;call flush(narea+200)
+              IF( e1t(ji,jj) .NE. e1t(ji,jj) ) WRITE(narea+200,*)'BUG5',e1t(ji,jj) ;call flush(narea+200)
+              IF( e1t(ji,jj) .NE. e2t(ji,jj) ) WRITE(narea+200,*)'BUG6',e2t(ji,jj) ;call flush(narea+200)
 
               facsurfv(ji,jj,jk) = vmask_crs(ji,jj,jk) * e1e3v_msk(ji,jj,jk)  
@@ -224,4 +246,8 @@
      CALL crs_dom_e3( e1v, e2v, zfse3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
      CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
+     WHERE(e3t_max_crs == 0._wp) e3t_max_crs=r_inf
+     WHERE(e3u_max_crs == 0._wp) e3u_max_crs=r_inf
+     WHERE(e3v_max_crs == 0._wp) e3v_max_crs=r_inf
+     WHERE(e3w_max_crs == 0._wp) e3w_max_crs=r_inf
 
      ! Reset 0 to e3t_0 or e3w_0
@@ -264,5 +290,9 @@
         CALL dom_grid_glo   ! Return to parent grid domain
      ENDIF
-     
+    
+
+      rhop_crs(:,:,:)=0._wp ; rhd_crs(:,:,:)=0._wp ; rb2_crs(:,:,:)=0._wp
+
+ 
      !---------------------------------------------------------
      ! 7. Finish and clean-up
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 5105)
@@ -149,6 +149,8 @@
    !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain)
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimpptea, njmpptno !: i-, j-indexes for each processor's northern and eastern neighbour
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcit , nlcjt    !: dimensions of every subdomain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcitea          !: dimensions of every subdomain eastern neighbour
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain
@@ -337,5 +339,6 @@
       !
       ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj),  &
-         &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) )
+         &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), &
+         &      njmpptno(jpnij), nimpptea(jpnij), nlcitea(jpnij), STAT=ierr(1) )
          !
       ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     &
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 5105)
@@ -18,5 +18,10 @@
    !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
    !!--------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
+   USE dom_oce, ONLY : nimpp, njmpp, nlci, nlcj, nldi, nldj, nlei, nlej, & 
+                       mig, mjg, narea, &
+                       gphiv, gphif, &
+                       agrif_root, agrif_cfixed, lk_agrif, &
+                       rdt,rdttra, gdept_0, ln_crs, gdepw_0,  adatrj, fjulday
+
    USE c1d             ! 1D vertical configuration
    USE flo_oce         ! floats module declarations
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp_crs.F90	(revision 5105)
@@ -0,0 +1,860 @@
+MODULE ldfslp_crs
+   !!======================================================================
+   !!                       ***  MODULE  ldfslp  ***
+   !! Ocean physics: slopes of neutral surfaces
+   !!======================================================================
+   !! History :  OPA  ! 1994-12  (G. Madec, M. Imbard)  Original code
+   !!            8.0  ! 1997-06  (G. Madec)  optimization, lbc
+   !!            8.1  ! 1999-10  (A. Jouzeau)  NEW profile in the mixed layer
+   !!   NEMO     1.0  ! 2002-10  (G. Madec)  Free form, F90
+   !!             -   ! 2005-10  (A. Beckmann)  correction for s-coordinates
+   !!            3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  add Griffies operator
+   !!             -   ! 2010-11  (F. Dupond, G. Madec)  bug correction in slopes just below the ML
+   !!----------------------------------------------------------------------
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                      Rotation of lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   ldf_slp_grif : calculates the triads of isoneutral slopes (Griffies operator)
+   !!   ldf_slp      : calculates the slopes of neutral surface   (Madec operator)
+   !!   ldf_slp_mxl  : calculates the slopes at the base of the mixed layer (Madec operator)
+   !!   ldf_slp_init : initialization of the slopes computation
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+ !  USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce      ! lateral diffusion: traceur
+   USE ldfdyn_oce      ! lateral diffusion: dynamics
+   USE phycst          ! physical constants
+   USE zdfmxl_crs      ! mixed layer depth
+   USE eosbn2_crs      ! equation of states
+   USE crslbclnk       ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ldf_slp_crs        ! routine called by step.F90
+   PUBLIC   ldf_slp_grif_crs   ! routine called by step.F90
+   PUBLIC   ldf_slp_init_crs   ! routine called by opa.F90
+
+ !  LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp_crs = .TRUE.     !: slopes flag
+   !                                                                             !! Madec operator
+   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   uslp_crs, wslpi_crs          !: i_slope at U- and W-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   vslp_crs, wslpj_crs          !: j-slope at V- and W-points
+   !                                                                !! Griffies operator
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wslp2                !: wslp**2 from Griffies quarter cells
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi  , triadj     !: isoneutral slopes relative to model-coordinate
+
+   !                                                              !! Madec operator
+   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   omlmask           ! mask of the surface mixed layer at T-pt
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   uslpml, wslpiml   ! i_slope at U- and W-points just below the mixed layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vslpml, wslpjml   ! j_slope at V- and W-points just below the mixed layer
+
+   REAL(wp) ::   repsln = 1.e-25_wp       ! tiny value used as minium of di(rho), dj(rho) and dk(rho)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: ldfslp.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ldf_slp_crs( kt, prd, pn2 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp  ***
+      !!
+      !! ** Purpose :   Compute the slopes of neutral surface (slope of isopycnal
+      !!              surfaces referenced locally) (ln_traldf_iso=T).
+      !!
+      !! ** Method  :   The slope in the i-direction is computed at U- and
+      !!      W-points (uslp, wslpi) and the slope in the j-direction is
+      !!      computed at V- and W-points (vslp, wslpj).
+      !!      They are bounded by 1/100 over the whole ocean, and within the
+      !!      surface layer they are bounded by the distance to the surface
+      !!      ( slope<= depth/l  where l is the length scale of horizontal
+      !!      diffusion (here, aht=2000m2/s ==> l=20km with a typical velocity
+      !!      of 10cm/s)
+      !!        A horizontal shapiro filter is applied to the slopes
+      !!        ln_sco=T, s-coordinate, add to the previously computed slopes
+      !!      the slope of the model level surface.
+      !!        macro-tasked on horizontal slab (jk-loop)  (2, jpk-1)
+      !!      [slopes already set to zero at level 1, and to zero or the ocean
+      !!      bottom slope (ln_sco=T) at level jpk in inildf]
+      !!
+      !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and  j-slopes
+      !!               of now neutral surfaces at u-, w- and v- w-points, resp.
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   prd   ! in situ density
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   pn2   ! Brunt-Vaisala frequency (locally ref.)
+      !!
+      INTEGER  ::   ji , jj , jk    ! dummy loop indices
+      INTEGER  ::   ii0, ii1, iku   ! temporary integer
+      INTEGER  ::   ij0, ij1, ikv   ! temporary integer
+      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw ! local scalars
+      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
+      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
+      REAL(wp) ::   zck, zfk,      zbw             !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwz, zww
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdzr
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp')
+      !
+      CALL wrk_alloc( jpi_crs,jpj_crs,jpk, zwz, zww, zdzr, zgru, zgrv )
+
+      zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
+      z1_16  =  1.0_wp / 16._wp
+      zm1_g  = -1.0_wp / grav
+      zm1_2g = -0.5_wp / grav
+      !
+      zww(:,:,:) = 0._wp
+      zwz(:,:,:) = 0._wp
+      !
+      DO jk = 1, jpk             !==   i- & j-gradient of density   ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zgru(ji,jj,jk) = umask_crs(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) )
+               zgrv(ji,jj,jk) = vmask_crs(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               zgru(ji,jj,mbku_crs(ji,jj)) = gru_crs(ji,jj)
+               zgrv(ji,jj,mbkv_crs(ji,jj)) = grv_crs(ji,jj)
+            END DO
+         END DO
+      ENDIF
+!WRITE(numout,*) ' zgrv (ji,jj,jk-1)' , zgrv (:,:,:)
+!WRITE(numout,*) ' grv_crs (ji,jj,jk-1)'  ,grv_crs (:,:)
+      !
+      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
+      DO jk = 2, jpkm1
+         !                               !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0
+         !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1
+         !                                    ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
+         !                             !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2
+         !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster
+         zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              &
+            &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask_crs(:,:,jk+1) )
+      END DO
+      !
+      !                          !==   Slopes just below the mixed layer   ==!
+      CALL ldf_slp_mxl_crs( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml
+
+
+      ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd )
+      ! ===========================      | vslp = d/dj( prd ) / d/dz( prd )
+      !
+      DO jk = 2, jpkm1                            !* Slopes at u and v points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !                                      ! horizontal and vertical density gradient at u- and v-points
+               zau = zgru(ji,jj,jk) / e1u_crs(ji,jj)
+               zav = zgrv(ji,jj,jk) / e2v_crs(ji,jj)
+               zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) )
+               zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) )
+               !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+               !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+     !IF( umask_crs(ji,jj,jk) .NE. 0._wp .AND. e3u_max_crs(ji,jj,jk)==0._wp )WRITE(narea+3000,*)"bug zbu ",umask_crs(ji,jj,jk),e3u_max_crs(ji,jj,jk) ; CALL flush(narea+3000)
+     !IF( e3u_max_crs(ji,jj,jk)==0._wp )WRITE(narea+3000,*)"bug zbu1 ",ji,jj,jk,umask_crs(ji,jj,jk),e3u_max_crs(ji,jj,jk) ; CALL flush(narea+3000)
+               zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/e3u_max_crs(ji,jj,jk)* ABS( zau )  )
+               zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/e3v_max_crs(ji,jj,jk)* ABS( zav )  )
+                  
+!cc               zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/e3u_crs(ji,jj,jk)* ABS( zau )  )
+!cc               zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/e3v_crs(ji,jj,jk)* ABS( zav )  )
+
+
+               !                                      ! uslp and vslp output in zwz and zww, resp.
+               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
+               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
+               zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                              &
+                  &                   + zfi  * uslpml(ji,jj)                                                     &
+                  &                          * 0.5_wp * ( gdept_crs(ji+1,jj,jk)+gdept_crs(ji,jj,jk) - e3u_max_crs(ji,jj,1) )   &
+                  &                          / MAX( hmlpt_crs(ji,jj), hmlpt_crs(ji+1,jj), 5._wp ) ) * umask_crs(ji,jj,jk)
+               zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                              &
+                  &                   + zfj  * vslpml(ji,jj)                                                     &
+                  &                          * 0.5_wp * ( gdept_crs(ji,jj+1,jk)+ gdept_crs(ji,jj,jk)-e3v_max_crs(ji,jj,1) )   &
+                  &                          / MAX( hmlpt_crs(ji,jj), hmlpt_crs(ji,jj+1), 5. ) ) * vmask_crs(ji,jj,jk)
+!!gm  modif to suppress omlmask.... (as in Griffies case)
+!               !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0.
+!               zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp )
+!               zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp )
+!               zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) )
+!               zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) )
+!               zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk)
+!!gm end modif
+            END DO
+         END DO
+      END DO
+      CALL crs_lbc_lnk( zwz, 'U', -1. )   ;   CALL crs_lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions
+      !
+      !                                            !* horizontal Shapiro filter
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
+            DO ji = 2, jpim1
+               uslp_crs(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
+               vslp_crs(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+         DO jj = 3, jpj-2                               ! other rows
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               uslp_crs(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
+               vslp_crs(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+         !                                        !* decrease along coastal boundaries
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               uslp_crs(ji,jj,jk) = uslp_crs(ji,jj,jk) * ( umask_crs(ji,jj+1,jk) + umask_crs(ji,jj-1,jk  ) ) * 0.5_wp   &
+                  &                            * ( umask_crs(ji,jj  ,jk) + umask_crs(ji,jj  ,jk+1) ) * 0.5_wp
+               vslp_crs(ji,jj,jk) = vslp_crs(ji,jj,jk) * ( vmask_crs(ji+1,jj,jk) + vmask_crs(ji-1,jj,jk  ) ) * 0.5_wp   &
+                  &                            * ( vmask_crs(ji  ,jj,jk) + vmask_crs(ji  ,jj,jk+1) ) * 0.5_wp
+            END DO
+         END DO
+      END DO
+
+
+      ! II.  slopes at w point           | wslpi = mij( d/di( prd ) / d/dz( prd )
+      ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd )
+      !
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !                                  !* Local vertical density gradient evaluated from N^2
+               zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. )
+               !                                  !* Slopes at w point
+               !                                        ! i- & j-gradient of density at w-points
+               zci = MAX(  umask_crs(ji-1,jj,jk  ) + umask_crs(ji,jj,jk  )           &
+                  &      + umask_crs(ji-1,jj,jk-1) + umask_crs(ji,jj,jk-1) , zeps  ) * e1t_crs(ji,jj)
+               zcj = MAX(  vmask_crs(ji,jj-1,jk  ) + vmask_crs(ji,jj,jk-1)           &
+                  &      + vmask_crs(ji,jj-1,jk-1) + vmask_crs(ji,jj,jk  ) , zeps  ) *  e2t_crs(ji,jj)
+               zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           &
+                  &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * tmask_crs (ji,jj,jk)
+               zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           &
+                  &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * tmask_crs (ji,jj,jk)
+
+               !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/e3w_max_crs(ji,jj,jk)* ABS( zai )  )
+               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_max_crs(ji,jj,jk)* ABS( zaj )  )
+               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
+               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0
+               zck = gdepw_crs(ji,jj,jk) / MAX( hmlp_crs(ji,jj), 10._wp )
+               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask_crs(ji,jj,jk)
+               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask_crs(ji,jj,jk)
+!WRITE(numout,*) ' wslpiml(ji,jj)' , wslpiml(ji,jj)
+!WRITE(numout,*) ' zbj' , zbj
+!WRITE(numout,*) ' zeps' , zeps
+!WRITE(numout,*) ' zaj' , zaj
+
+
+!!gm  modif to suppress omlmask....  (as in Griffies operator)
+!               !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0.
+!               zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp )
+!               zck = fsdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. )
+!               zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!!gm end modif
+            END DO
+         END DO
+      END DO
+      CALL crs_lbc_lnk( zwz, 'T', -1. )   ;    CALL crs_lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions
+      !
+      !                                           !* horizontal Shapiro filter
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
+            DO ji = 2, jpim1
+               zcofw = tmask_crs(ji,jj,jk) * z1_16
+               wslpi_crs(ji,jj,jk) = (      zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                    &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                    &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                    &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                    &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw
+
+               wslpj_crs(ji,jj,jk) = (      zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                    &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                    &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                    &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                    &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw
+            END DO
+         END DO
+         DO jj = 3, jpj-2                               ! other rows
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcofw = tmask_crs(ji,jj,jk) * z1_16
+               wslpi_crs(ji,jj,jk) = (      zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                    &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                    &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                    &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                    &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw
+
+               wslpj_crs(ji,jj,jk) = (      zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                    &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                    &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                    &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                    &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw
+            END DO
+         END DO
+         !                                        !* decrease along coastal boundaries
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zck =   ( umask_crs(ji,jj,jk) + umask_crs(ji-1,jj,jk) )   &
+                  &  * ( vmask_crs(ji,jj,jk) + vmask_crs(ji,jj-1,jk) ) * 0.25
+               wslpi_crs(ji,jj,jk) = wslpi_crs(ji,jj,jk) * zck
+               wslpj_crs(ji,jj,jk) = wslpj_crs(ji,jj,jk) * zck
+            END DO
+         END DO
+      END DO
+
+      ! III.  Specific grid points
+      ! ===========================
+ !! cc     !
+ !     IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN     !  ORCA_R4 configuration: horizontal diffusion in specific area
+ !        !                                                    ! Gibraltar Strait
+ !        ij0 =  50   ;   ij1 =  53
+ !        ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        ij0 =  51   ;   ij1 =  53
+ !        ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        !
+ !        !                                                    ! Mediterrannean Sea
+ !        ij0 =  49   ;   ij1 =  56
+ !        ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        ij0 =  50   ;   ij1 =  56
+ !        ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !     ENDIF
+!! cc
+
+      ! IV. Lateral boundary conditions
+      ! ===============================
+      CALL crs_lbc_lnk( uslp_crs , 'U', -1. )      ;      CALL crs_lbc_lnk( vslp_crs , 'V', -1. )
+      CALL crs_lbc_lnk( wslpi_crs, 'W', -1. )      ;      CALL crs_lbc_lnk( wslpj_crs, 'W', -1. )
+!WRITE(numout,*) ' zww' , zww(:,:,:)
+!WRITE(numout,*) ' wslpj_crs' , wslpj_crs(:,:,:)
+  !    IF(ln_ctl) THEN
+  !       CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk)
+  !      CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk)
+  !    ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp')
+      !
+   END SUBROUTINE ldf_slp_crs
+
+
+   SUBROUTINE ldf_slp_grif_crs ( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp_grif  ***
+      !!
+      !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope
+      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_grif=T)
+      !!      at W-points using the Griffies quarter-cells.
+      !!
+      !! ** Method  :   calculates alpha and beta at T-points
+      !!
+      !! ** Action : - triadi_g, triadj_g   T-pts i- and j-slope triads relative to geopot. (used for eiv)
+      !!             - triadi , triadj    T-pts i- and j-slope triads relative to model-coordinate
+      !!             - wslp2              squared slope of neutral surfaces at w-points.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices
+      INTEGER  ::   iku, ikv                    ! local integer
+      REAL(wp) ::   zfacti, zfactj              ! local scalars
+      REAL(wp) ::   znot_thru_surface           ! local scalars
+      REAL(wp) ::   zdit, zdis, zdjt, zdjs, zdkt, zdks, zbu, zbv, zbti, zbtj
+      REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_g_raw, zti_g_lim
+      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim
+      REAL(wp) ::   zdzrho_raw
+      REAL(wp) ::   zbeta0
+      REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalbet
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_grif')
+      !
+      CALL wrk_alloc( jpi,jpj, z1_mlbw )
+      CALL wrk_alloc( jpi,jpj,jpk, zalbet )
+      CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
+      CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
+      !
+      !--------------------------------!
+      !  Some preliminary calculation  !
+      !--------------------------------!
+      !
+      CALL eos_alpbet_crs( tsb_crs, zalbet, zbeta0 )  !==  before local thermal/haline expension ratio at T-points  ==!
+      !
+      DO jl = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==!
+         !
+         ip = jl   ;   jp = jl                ! guaranteed nonzero gradients ( absolute value larger than repsln)
+         DO jk = 1, jpkm1                     ! done each pair of triad
+            DO jj = 1, jpjm1                  ! NB: not masked ==>  a minimum value is set
+               DO ji = 1, fs_jpim1            ! vector opt.
+                  zdit = ( tsb(ji+1,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! i-gradient of T & S at u-point
+                  zdis = ( tsb(ji+1,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point
+                  zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  zdxrho_raw = ( - zalbet(ji+ip,jj   ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj)
+                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj)
+                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX(   repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign
+                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw )
+               END DO
+            END DO
+         END DO
+         !
+         IF( ln_zps.and.l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom
+# if defined key_vectopt_loop
+            DO jj = 1, 1
+               DO ji = 1, jpij-jpi            ! vector opt. (forced unrolling)
+# else
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+# endif
+                  iku  = mbku_crs(ji,jj)          ;   ikv  = mbkv_crs(ji,jj)             ! last ocean level (u- & v-points)
+                  zdit = gtsu_crs(ji,jj,jp_tem)   ;   zdjt = gtsv_crs(ji,jj,jp_tem)      ! i- & j-gradient of Temperature
+                  zdis = gtsu_crs(ji,jj,jp_sal)   ;   zdjs = gtsv_crs(ji,jj,jp_sal)      ! i- & j-gradient of Salinity
+                  zdxrho_raw = ( - zalbet(ji+ip,jj   ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj)
+                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / e2v(ji,jj)
+                  zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign
+                  zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw )
+               END DO
+            END DO
+         ENDIF
+         !
+      END DO
+
+      DO kp = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==!
+         DO jk = 1, jpkm1                     ! done each pair of triad
+            DO jj = 1, jpj                    ! NB: not masked ==>  a minimum value is set
+               DO ji = 1, jpi                 ! vector opt.
+                  IF( jk+kp > 1 ) THEN        ! k-gradient of T & S a jk+kp
+                     zdkt = ( tsb(ji,jj,jk+kp-1,jp_tem) - tsb(ji,jj,jk+kp,jp_tem) )
+                     zdks = ( tsb(ji,jj,jk+kp-1,jp_sal) - tsb(ji,jj,jk+kp,jp_sal) )
+                  ELSE
+                     zdkt = 0._wp                                             ! 1st level gradient set to zero
+                     zdks = 0._wp
+                  ENDIF
+                  zdzrho_raw = ( - zalbet(ji   ,jj   ,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp)
+                  zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )    ! force zdzrho >= repsln
+                 END DO
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 1, jpj                          !==  Reciprocal depth of the w-point below ML base  ==!
+         DO ji = 1, jpi
+            jk = MIN( nmln_crs(ji,jj), mbkt_crs(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth
+            z1_mlbw(ji,jj) = 1._wp / gdepw_crs(ji,jj,jk)
+         END DO
+      END DO
+      !
+      !                                       !==  intialisations to zero  ==!
+      !
+      wslp2  (:,:,:)     = 0._wp              ! wslp2 will be cumulated 3D field set to zero
+      triadi_g(:,:,1,:,:) = 0._wp   ;   triadi_g(:,:,jpk,:,:) = 0._wp   ! set surface and bottom slope to zero
+      triadj_g(:,:,1,:,:) = 0._wp   ;   triadj_g(:,:,jpk,:,:) = 0._wp
+      !!gm _iso set to zero missing
+      triadi  (:,:,1,:,:) = 0._wp   ;   triadj  (:,:,jpk,:,:) = 0._wp   ! set surface and bottom slope to zero
+      triadj  (:,:,1,:,:) = 0._wp   ;   triadj  (:,:,jpk,:,:) = 0._wp
+
+      !-------------------------------------!
+      !  Triads just below the Mixed Layer  !
+      !-------------------------------------!
+      !
+      DO jl = 0, 1                            ! calculate slope of the 4 triads immediately ONE level below mixed-layer base
+         DO kp = 0, 1                         ! with only the slope-max limit   and   MASKED
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  ip = jl   ;   jp = jl
+                  jk = MIN( nmln_crs(ji+ip,jj) , mbkt_crs(ji+ip,jj) ) + 1         ! ML level+1 (MIN in case ML depth is the ocean depth)
+                  ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
+                  zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      &
+                     &      - ( gdept_crs(ji+1,jj,jk-kp) - gdept_crs(ji,jj,jk-kp) ) / e1u_crs(ji,jj)  ) * umask_crs(ji,jj,jk)
+                  jk = MIN( nmln_crs(ji,jj+jp) , mbkt_crs(ji,jj+jp) ) + 1
+                  ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      &
+                     &      - ( gdept_crs(ji,jj+1,jk-kp) - gdept_crs(ji,jj,jk-kp) ) / e2v_crs(ji,jj)  ) * vmask_crs(ji,jj,jk)
+                  zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
+                  ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+               END DO
+            END DO
+         END DO
+      END DO
+
+      !-------------------------------------!
+      !  Triads with surface limits         !
+      !-------------------------------------!
+      !
+      DO kp = 0, 1                            ! k-index of triads
+         DO jl = 0, 1
+            ip = jl   ;   jp = jl             ! i- and j-indices of triads (i-k and j-k planes)
+            DO jk = 1, jpkm1
+               ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface
+               znot_thru_surface = REAL( 1-1/(jk+kp), wp )  !jk+kp=1,=0.; otherwise=1.0
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1         ! vector opt.
+                     !
+                     ! Calculate slope relative to geopotentials used for GM skew fluxes
+                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
+                     ! Limit by slope *relative to geopotentials* by rn_slpmax, and mask by psi-point
+                     ! masked by umask taken at the level of dz(rho)
+                     !
+                     ! raw slopes: unmasked unbounded slopes (relative to geopotential (zti_g) and model surface (zti)
+                     !
+                     zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                   ! unmasked
+                     ztj_raw   = zdyrho(ji   ,jj+jp,jk,1-jp) / zdzrho(ji   ,jj+jp,jk,kp)
+
+                     ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface
+                     zti_coord = znot_thru_surface * ( gdept_crs(ji+1,jj  ,jk) - gdept_crs(ji,jj,jk) ) / e1u_crs(ji,jj)
+                     ztj_coord = znot_thru_surface * ( gdept_crs(ji  ,jj+1,jk) - gdept_crs(ji,jj,jk) ) / e2v_crs(ji,jj)                  ! unmasked
+                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces
+                     ztj_g_raw = ztj_raw - ztj_coord
+                     zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
+                     ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+                     !
+                     ! Below  ML use limited zti_g as is & mask
+                     ! Inside ML replace by linearly reducing sx_mlb towards surface & mask
+                     !
+                     zfacti = REAL( 1 - 1/(1 + (jk+kp-1)/nmln_crs(ji+ip,jj)), wp )  ! k index of uppermost point(s) of triad is jk+kp-1
+                     zfactj = REAL( 1 - 1/(1 + (jk+kp-1)/nmln_crs(ji,jj+jp)), wp )  ! must be .ge. nmln(ji,jj) for zfact=1
+                     !                                                          !                   otherwise  zfact=0
+                     zti_g_lim =          ( zfacti   * zti_g_lim                       &
+                        &      + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp)   &
+                        &                           * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask_crs(ji,jj,jk+kp)
+                     ztj_g_lim =          ( zfactj   * ztj_g_lim                       &
+                        &      + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp)   &
+                        &                           * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask_crs(ji,jj,jk+kp)
+                     !
+                     triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim
+                     triadj_g(ji   ,jj+jp,jk,1-jp,kp) = ztj_g_lim
+                     !
+                     ! Get coefficients of isoneutral diffusion tensor
+                     ! 1. Utilise gradients *relative* to s-coordinate, so add t-point slopes (*subtract* depth gradients)
+                     ! 2. We require that isoneutral diffusion  gives no vertical buoyancy flux
+                     !     i.e. 33 term = (real slope* 31, 13 terms)
+                     ! To do this, retain limited sx**2  in vertical flux, but divide by real slope for 13/31 terms
+                     ! Equivalent to tapering A_iso = sx_limited**2/(real slope)**2
+                     !
+                     zti_lim  = ( zti_g_lim + zti_coord ) * umask_crs(ji,jj,jk+kp)    ! remove coordinate slope => relative to coordinate surfaces
+                     ztj_lim  = ( ztj_g_lim + ztj_coord ) * vmask_crs(ji,jj,jk+kp)
+                     !
+                     IF( ln_triad_iso ) THEN
+                        zti_raw = zti_lim**2 / zti_raw
+                        ztj_raw = ztj_lim**2 / ztj_raw
+                        zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw )
+                        ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw )
+                        zti_lim =           zfacti   * zti_lim                       &
+                        &      + ( 1._wp - zfacti ) * zti_raw
+                        ztj_lim =           zfactj   * ztj_lim                       &
+                        &      + ( 1._wp - zfactj ) * ztj_raw
+                     ENDIF
+                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim
+                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim
+                    !
+                     zbu = e1u(ji    ,jj) * e2u(ji   ,jj) * fse3u(ji   ,jj,jk   )
+                     zbv = e1v(ji    ,jj) * e2v(ji   ,jj) * fse3v(ji   ,jj,jk   )
+                     zbti = e1t(ji+ip,jj) * e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp)
+                     zbtj = e1t(ji,jj+jp) * e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp)
+                     !
+                     !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked
+                     wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim**2      ! masked
+                     wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim**2
+                  END DO
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+      wslp2(:,:,1) = 0._wp                ! force the surface wslp to zero
+
+      CALL crs_lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked
+      !
+      CALL wrk_dealloc( jpi,jpj, z1_mlbw )
+      CALL wrk_dealloc( jpi,jpj,jpk, zalbet )
+      CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
+      CALL wrk_dealloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_grif')
+      !
+   END SUBROUTINE ldf_slp_grif_crs
+
+
+   SUBROUTINE ldf_slp_mxl_crs( prd, pn2, p_gru, p_grv, p_dzr )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_slp_mxl  ***
+      !!
+      !! ** Purpose :   Compute the slopes of iso-neutral surface just below
+      !!              the mixed layer.
+      !!
+      !! ** Method  :   The slope in the i-direction is computed at u- & w-points
+      !!              (uslpml, wslpiml) and the slope in the j-direction is computed
+      !!              at v- and w-points (vslpml, wslpjml) with the same bounds as
+      !!              in ldf_slp.
+      !!
+      !! ** Action  :   uslpml, wslpiml :  i- &  j-slopes of neutral surfaces
+      !!                vslpml, wslpjml    just below the mixed layer
+      !!                omlmask         :  mixed layer mask
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   prd            ! in situ density
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pn2            ! Brunt-Vaisala frequency (locally ref.)
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_gru, p_grv   ! i- & j-gradient of density (u- & v-pts)
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_dzr          ! z-gradient of density      (T-point)
+      !!
+      INTEGER  ::   ji , jj , jk                   ! dummy loop indices
+      INTEGER  ::   iku, ikv, ik, ikm1             ! local integers
+      REAL(wp) ::   zeps, zm1_g, zm1_2g            ! local scalars
+      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
+      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
+      REAL(wp) ::   zck, zfk,      zbw             !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_mxl')
+      !
+      zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
+      zm1_g  = -1.0_wp / grav
+      zm1_2g = -0.5_wp / grav
+      !
+      uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp
+      vslpml (1,:) = 0._wp      ;      vslpml (jpi,:) = 0._wp
+      wslpiml(1,:) = 0._wp      ;      wslpiml(jpi,:) = 0._wp
+      wslpjml(1,:) = 0._wp      ;      wslpjml(jpi,:) = 0._wp
+      !
+      !                                            !==   surface mixed layer mask   !
+      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij                        ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+# endif
+               ik = nmln_crs(ji,jj) - 1
+               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp
+               ELSE                  ;   omlmask(ji,jj,jk) = 0._wp
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+
+      ! Slopes of isopycnal surfaces just before bottom of mixed layer
+      ! --------------------------------------------------------------
+      ! The slope are computed as in the 3D case.
+      ! A key point here is the definition of the mixed layer at u- and v-points.
+      ! It is assumed to be the maximum of the two neighbouring T-point mixed layer depth.
+      ! Otherwise, a n2 value inside the mixed layer can be involved in the computation
+      ! of the slope, resulting in a too steep diagnosed slope and thus a spurious eddy
+      ! induce velocity field near the base of the mixed layer.
+      !-----------------------------------------------------------------------
+      !
+# if defined key_vectopt_loop
+      DO jj = 1, 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            !                        !==   Slope at u- & v-points just below the Mixed Layer   ==!
+            !
+            !                        !- vertical density gradient for u- and v-slopes (from dzr at T-point)
+            iku = MIN(  MAX( 1, nmln_crs(ji,jj) , nmln_crs(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1)
+            ikv = MIN(  MAX( 1, nmln_crs(ji,jj) , nmln_crs(ji,jj+1) ) , jpkm1  )   !
+            zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj  ,iku) )
+            zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji  ,jj+1,ikv) )
+            !                        !- horizontal density gradient at u- & v-points
+            zau = p_gru(ji,jj,iku) / e1u_crs(ji,jj)
+            zav = p_grv(ji,jj,ikv) / e2v_crs(ji,jj)
+            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0
+            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbu = MIN(  zbu , -100._wp* ABS( zau ) , -7.e+3_wp/e3u_max_crs(ji,jj,iku)* ABS( zau )  )
+            zbv = MIN(  zbv , -100._wp* ABS( zav ) , -7.e+3_wp/e3v_max_crs(ji,jj,ikv)* ABS( zav )  )
+            !                        !- Slope at u- & v-points (uslpml, vslpml)
+            uslpml(ji,jj) = zau / ( zbu - zeps ) * umask_crs(ji,jj,iku)
+            vslpml(ji,jj) = zav / ( zbv - zeps ) * vmask_crs(ji,jj,ikv)
+            !
+            !                        !==   i- & j-slopes at w-points just below the Mixed Layer   ==!
+            !
+            ik   = MIN( nmln_crs(ji,jj) + 1, jpk )
+            ikm1 = MAX( 1, ik-1 )
+            !                        !- vertical density gradient for w-slope (from N^2)
+            zbw = zm1_2g * pn2 (ji,jj,ik) * ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. )
+            !                        !- horizontal density i- & j-gradient at w-points
+            zci = MAX(   umask_crs(ji-1,jj,ik  ) + umask_crs(ji,jj,ik  )           &
+               &       + umask_crs(ji-1,jj,ikm1) + umask_crs(ji,jj,ikm1) , zeps  ) * e1t_crs(ji,jj)
+            zcj = MAX(   vmask_crs(ji,jj-1,ik  ) + vmask_crs(ji,jj,ik  )           &
+               &       + vmask_crs(ji,jj-1,ikm1) + vmask_crs(ji,jj,ikm1) , zeps  ) * e2t_crs(ji,jj)
+            zai =    (   p_gru(ji-1,jj,ik  ) + p_gru(ji,jj,ik)           &
+               &       + p_gru(ji-1,jj,ikm1) + p_gru(ji,jj,ikm1  )  ) / zci  * tmask_crs(ji,jj,ik)
+            zaj =    (   p_grv(ji,jj-1,ik  ) + p_grv(ji,jj,ik  )           &
+               &       + p_grv(ji,jj-1,ikm1) + p_grv(ji,jj,ikm1)  ) / zcj  * tmask_crs(ji,jj,ik)
+            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/e3w_max_crs(ji,jj,ik)* ABS( zai )  )
+            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_max_crs(ji,jj,ik)* ABS( zaj )  )
+            !                        !- i- & j-slope at w-points (wslpiml, wslpjml)
+            wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask_crs (ji,jj,ik)
+            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask_crs (ji,jj,ik)
+         END DO
+      END DO
+      !!gm this lbc_lnk should be useless....
+      CALL crs_lbc_lnk( uslpml , 'U', -1. )   ;   CALL crs_lbc_lnk( vslpml , 'V', -1. )   ! lateral boundary cond. (sign change)
+      CALL crs_lbc_lnk( wslpiml, 'W', -1. )   ;   CALL crs_lbc_lnk( wslpjml, 'W', -1. )   ! lateral boundary conditions
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_mxl')
+ !     WRITE(numout,*) ' uslp_crs' , MAXVAL(uslp_crs(:,:,:)) , MINVAL(uslp_crs(:,:,:))
+ !     WRITE(numout,*) ' vslp_crs' , vslp_crs
+ !     WRITE(numout,*) ' uslpml' , uslpml
+ !     WRITE(numout,*) ' vslpml' , vslpml
+ !     WRITE(numout,*) ' wslpiml' , wslpiml
+ !     WRITE(numout,*) ' wslpjml' , wslpjml
+  !    WRITE(numout,*) ' wslpi_crs' , wslpi_crs(:,:,2)
+  !    WRITE(numout,*) ' wslpj_crs_mxl' , wslpj_crs(:,:,:)
+      
+      !
+   END SUBROUTINE ldf_slp_mxl_crs
+
+
+   SUBROUTINE ldf_slp_init_crs
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_slp_init  ***
+      !!
+      !! ** Purpose :   Initialization for the isopycnal slopes computation
+      !!
+      !! ** Method  :   read the nammbf namelist and check the parameter
+      !!      values called by tra_dmp at the first timestep (nit000)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ierr         ! local integer
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_init')
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_slp_init : direction of lateral mixing'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+
+      IF( ln_traldf_grif ) THEN        ! Griffies operator : triad of slopes
+         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr )
+         ALLOCATE( triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1)                      , STAT=ierr )
+         IF( ierr > 0             )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' )
+         !
+         IF( ln_dynldf_iso )   CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' )
+         !
+      ELSE                             ! Madec operator : slopes at u-, v-, and w-points
+         ALLOCATE( uslp_crs(jpi,jpj,jpk) , vslp_crs(jpi,jpj,jpk) , wslpi_crs(jpi,jpj,jpk) , wslpj_crs(jpi,jpj,jpk) ,  &
+            &   omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj)   , vslpml(jpi,jpj)    , wslpiml(jpi,jpj)   , wslpjml(jpi,jpj) , STAT=ierr )
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' )
+
+         ! Direction of lateral diffusion (tracers and/or momentum)
+         ! ------------------------------
+         uslp_crs (:,:,:) = 0._wp   ;   uslpml (:,:) = 0._wp      ! set the slope to zero (even in s-coordinates)
+         vslp_crs (:,:,:) = 0._wp   ;   vslpml (:,:) = 0._wp
+         wslpi_crs(:,:,:) = 0._wp   ;   wslpiml(:,:) = 0._wp
+         wslpj_crs(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp
+
+         !!gm I no longer understand this.....
+         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN
+            IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces'
+
+            ! geopotential diffusion in s-coordinates on tracers and/or momentum
+            ! The slopes of s-surfaces are computed once (no call to ldfslp in step)
+            ! The slopes for momentum diffusion are i- or j- averaged of those on tracers
+
+            ! set the slope of diffusion to the slope of s-surfaces
+            !      ( c a u t i o n : minus sign as fsdep has positive value )
+            !WRITE(narea+3000,*)"ldfslp ",MINVAL(gdept_crs),MAXVAL(gdept_crs)  ; call flush(narea+3000)
+            !WRITE(narea+3000,*)"ldfslp ",MINVAL(vmask_crs),MAXVAL(vmask_crs)  ; call flush(narea+3000)
+            !WRITE(narea+3000,*)"ldfslp ",MINVAL(e2v_crs),MAXVAL(e2v_crs) ; call flush(narea+3000)
+            DO jk = 1, jpk
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !cbr uslp_crs (ji,jj,jk) = -1./e1u_crs(ji,jj) * ( gdept_crs(ji+1,jj,jk) - gdept_crs(ji ,jj ,jk) ) * umask_crs(ji,jj,jk)
+                  !vslp_crs (ji,jj,jk) = -1./e2v_crs(ji,jj) * ( gdept_crs(ji,jj+1,jk) - gdept_crs(ji ,jj ,jk) ) * vmask_crs(ji,jj,jk)
+                  !wslpi_crs(ji,jj,jk) = -1./e1t_crs(ji,jj) * ( gdepw_crs(ji+1,jj,jk) - gdepw_crs(ji-1,jj,jk) ) * tmask_crs(ji,jj,jk) * 0.5
+                  !wslpj_crs(ji,jj,jk) = -1./e2t_crs(ji,jj) * ( gdepw_crs(ji,jj+1,jk) - gdepw_crs(ji,jj-1,jk) ) * tmask_crs(ji,jj,jk) * 0.5
+                  uslp_crs (ji,jj,jk) = -1. * ( gdept_crs(ji+1,jj,jk) - gdept_crs(ji ,jj ,jk) ) * umask_crs(ji,jj,jk)
+                  IF( e1u_crs(ji,jj) .NE. 0._wp ) uslp_crs (ji,jj,jk) = uslp_crs (ji,jj,jk) / e1u_crs(ji,jj)
+                  vslp_crs (ji,jj,jk) = -1. * ( gdept_crs(ji,jj+1,jk) - gdept_crs(ji ,jj ,jk) ) * vmask_crs(ji,jj,jk)
+                  IF( e2v_crs(ji,jj) .NE. 0._wp ) vslp_crs (ji,jj,jk) = vslp_crs (ji,jj,jk) / e2v_crs(ji,jj)
+                  wslpi_crs(ji,jj,jk) = -1. * ( gdepw_crs(ji+1,jj,jk) - gdepw_crs(ji-1,jj,jk) ) * tmask_crs(ji,jj,jk) * 0.5
+                  IF( e1t_crs(ji,jj) .NE. 0._wp ) wslpi_crs(ji,jj,jk) =  wslpi_crs(ji,jj,jk) / e1t_crs(ji,jj)
+                  wslpj_crs(ji,jj,jk) = -1. * ( gdepw_crs(ji,jj+1,jk) - gdepw_crs(ji,jj-1,jk) ) * tmask_crs(ji,jj,jk) * 0.5
+                  IF( e2t_crs(ji,jj) .NE. 0._wp ) wslpj_crs(ji,jj,jk) = wslpj_crs(ji,jj,jk) / e2t_crs(ji,jj)
+                  END DO
+               END DO
+            END DO
+            CALL crs_lbc_lnk( uslp_crs , 'U', -1. )   ;   CALL crs_lbc_lnk( vslp_crs , 'V', -1. )      ! Lateral boundary conditions
+            CALL crs_lbc_lnk( wslpi_crs, 'W', -1. )   ;   CALL crs_lbc_lnk( wslpj_crs, 'W', -1. )
+         ENDIF
+      ENDIF
+  !    WRITE(numout,*) ' wslpi_crs' , wslpi_crs
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_init')
+      !
+   END SUBROUTINE ldf_slp_init_crs
+
+#else
+   !!------------------------------------------------------------------------
+   !!   Dummy module :                 NO Rotation of lateral mixing tensor
+   !!------------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp_crs = .FALSE.    !: slopes flag
+CONTAINS
+   SUBROUTINE ldf_slp_crs( kt, prd, pn2 )   ! Dummy routine
+      INTEGER, INTENT(in) :: kt
+      REAL, DIMENSION(:,:,:), INTENT(in) :: prd, pn2
+      WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1)
+   END SUBROUTINE ldf_slp_crs
+   SUBROUTINE ldf_slp_grif_crs( kt )        ! Dummy routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'ldf_slp_grif: You should not have seen this print! error?', kt
+   END SUBROUTINE ldf_slp_grif_crs
+   SUBROUTINE ldf_slp_init_crs              ! Dummy routine
+   END SUBROUTINE ldf_slp_init_crs
+#endif
+
+   !!======================================================================
+END MODULE ldfslp_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2_crs.F90	(revision 5105)
@@ -0,0 +1,789 @@
+MODULE eosbn2_crs
+   !!==============================================================================
+   !!                       ***  MODULE  eosbn2  ***
+   !! Ocean diagnostic variable : equation of state - in situ and potential density
+   !!                                               - Brunt-Vaisala frequency
+   !!==============================================================================
+   !! History :  OPA  ! 1989-03  (O. Marti)  Original code
+   !!            6.0  ! 1994-07  (G. Madec, M. Imbard)  add bn2
+   !!            6.0  ! 1994-08  (G. Madec)  Add Jackett & McDougall eos
+   !!            7.0  ! 1996-01  (G. Madec)  statement function for e3
+   !!            8.1  ! 1997-07  (G. Madec)  density instead of volumic mass
+   !!             -   ! 1999-02  (G. Madec, N. Grima) semi-implicit pressure gradient
+   !!            8.2  ! 2001-09  (M. Ben Jelloul)  bugfix on linear eos
+   !!   NEMO     1.0  ! 2002-10  (G. Madec)  add eos_init
+   !!             -   ! 2002-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d
+   !!             -   ! 2003-08  (G. Madec)  F90, free form
+   !!            3.0  ! 2006-08  (G. Madec)  add tfreez function
+   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!             -   ! 2010-10  (G. Nurser, G. Madec)  add eos_alpbet used in ldfslp
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   eos            : generic interface of the equation of state
+   !!   eos_insitu     : Compute the in situ density
+   !!   eos_insitu_pot : Compute the insitu and surface referenced potential
+   !!                    volumic mass
+   !!   eos_insitu_2d  : Compute the in situ density for 2d fields
+   !!   eos_bn2        : Compute the Brunt-Vaisala frequency
+   !!   eos_alpbet     : calculates the in situ thermal/haline expansion ratio
+   !!   tfreez         : Compute the surface freezing temperature
+   !!   eos_init       : set eos parameters (namelist)
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE zdfddm          ! vertical physics: double diffusion
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE prtctl          ! Print control
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !                   !! * Interface
+   INTERFACE eos_crs
+      MODULE PROCEDURE eos_insitu_crs, eos_insitu_pot_crs, eos_insitu_2d_crs
+   END INTERFACE
+   INTERFACE bn2_crs
+      MODULE PROCEDURE eos_bn2_crs
+   END INTERFACE
+
+   PUBLIC   eos_crs        ! called by step, istate, tranpc and zpsgrd modules
+   PUBLIC   eos_init_crs   ! called by istate module
+   PUBLIC   bn2_crs        ! called by step module
+   PUBLIC   eos_alpbet_crs ! called by ldfslp module
+   PUBLIC   tfreez_crs     ! called by sbcice_... modules
+
+   !                                          !!* Namelist (nameos) *
+   INTEGER , PUBLIC ::   nn_eos   = 0         !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
+   REAL(wp), PUBLIC ::   rn_alpha = 2.0e-4_wp !: thermal expension coeff. (linear equation of state)
+   REAL(wp), PUBLIC ::   rn_beta  = 7.7e-4_wp !: saline  expension coeff. (linear equation of state)
+
+   REAL(wp), PUBLIC ::   ralpbet_crs              !: alpha / beta ratio
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: eosbn2.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE eos_insitu_crs( pts, prd )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE eos_insitu  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
+      !!       potential temperature and salinity using an equation of state
+      !!       defined through the namelist parameter nn_eos.
+      !!
+      !! ** Method  :   3 cases:
+      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!      nn_eos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = 0.0285 - rn_alpha * t
+      !!      nn_eos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as pts are defined over the whole domain.
+      !!
+      !! ** Action  :   compute prd , the in situ density (no units)
+      !!
+      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                      ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-]
+      !!
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   zt , zs , zh , zsr   ! local scalars
+      REAL(wp) ::   zr1, zr2, zr3, zr4   !   -      -
+      REAL(wp) ::   zrhop, ze, zbw, zb   !   -      -
+      REAL(wp) ::   zd , zc , zaw, za    !   -      -
+      REAL(wp) ::   zb1, za1, zkw, zk0   !   -      -
+      REAL(wp) ::   zrau0r               !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zws
+      !!----------------------------------------------------------------------
+
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zws )
+      !
+      SELECT CASE( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         zrau0r = 1.e0 / rau0
+!CDIR NOVERRCHK
+         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts   (ji,jj,jk,jp_tem)
+                  zs = pts   (ji,jj,jk,jp_sal)
+                  zh = gdept_crs(ji,jj,jk)        ! depth
+                  zsr= zws   (ji,jj,jk)        ! square root salinity
+                  !
+                  ! compute volumic mass pure water at atm pressure
+                  zr1= ( ( ( ( 6.536332e-9_wp  *zt - 1.120083e-6_wp )*zt + 1.001685e-4_wp )*zt   &
+                     &        -9.095290e-3_wp )*zt + 6.793952e-2_wp )*zt +  999.842594_wp
+                  ! seawater volumic mass atm pressure
+                  zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt        &
+                     &                      -4.0899e-3_wp ) *zt+0.824493_wp
+                  zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp
+                  zr4= 4.8314e-4_wp
+                  !
+                  ! potential volumic mass (reference to the surface)
+                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+                  !
+                  ! add the compression terms
+                  ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+                  zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
+                  zb = zbw + ze * zs
+                  !
+                  zd = -2.042967e-2_wp
+                  zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+                  zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp
+                  za = ( zd*zsr + zc ) *zs + zaw
+                  !
+                  zb1=   (-0.1909078_wp*zt+7.390729_wp )        *zt-55.87545_wp
+                  za1= ( ( 2.326469e-3_wp*zt+1.553190_wp)       *zt-65.00517_wp ) *zt+1044.077_wp
+                  zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp
+                  zk0= ( zb1*zsr + za1 )*zs + zkw
+                  !
+                  ! masked in situ density anomaly
+                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                     &             - rau0  ) * zrau0r * tmask_crs(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation function of temperature only  ==!
+         DO jk = 1, jpkm1
+            prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask_crs(:,:,jk)
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation function of temperature and salinity  ==!
+         DO jk = 1, jpkm1
+            prd(:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask_crs(:,:,jk)
+         END DO
+         !
+      END SELECT
+      !
+    !  IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk )
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zws )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos')
+      !
+   END SUBROUTINE eos_insitu_crs
+
+
+   SUBROUTINE eos_insitu_pot_crs( pts, prd, prhop )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_pot  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) and the
+      !!      potential volumic mass (Kg/m3) from potential temperature and
+      !!      salinity fields using an equation of state defined through the
+      !!     namelist parameter nn_eos.
+      !!
+      !! ** Method  :
+      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!              rhop(t,s)  = rho(t,s,0)
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!
+      !!      nn_eos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - rn_alpha * t
+      !!              rhop(t,s)  = rho(t,s)
+      !!
+      !!      nn_eos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0
+      !!                       = rn_beta * s - rn_alpha * tn - 1.
+      !!              rhop(t,s)  = rho(t,s)
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as (tn,sn) or (ta,sa) are defined over the whole domain.
+      !!
+      !! ** Action  : - prd  , the in situ density (no units)
+      !!              - prhop, the potential volumic mass (Kg/m3)
+      !!
+      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
+      !!                Brown and Campana, Mon. Weather Rev., 1978
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius]
+      !                                                                ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! local scalars
+      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zws
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos-p')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zws )
+      !
+      SELECT CASE ( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         zrau0r = 1.e0 / rau0
+!CDIR NOVERRCHK
+         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts   (ji,jj,jk,jp_tem)
+                  zs = pts   (ji,jj,jk,jp_sal)
+                  zh = gdept_crs(ji,jj,jk)        ! depth
+                  zsr= zws   (ji,jj,jk)        ! square root salinity
+                  !
+                  ! compute volumic mass pure water at atm pressure
+                  zr1= ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   &
+                     &                          -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp
+                  ! seawater volumic mass atm pressure
+                  zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt   &
+                     &                                         -4.0899e-3_wp ) *zt+0.824493_wp
+                  zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp
+                  zr4= 4.8314e-4_wp
+                  !
+                  ! potential volumic mass (reference to the surface)
+                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+                  !
+                  ! save potential volumic mass
+                  prhop(ji,jj,jk) = zrhop * tmask_crs(ji,jj,jk)
+                  !
+                  ! add the compression terms
+                  ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+                  zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
+                  zb = zbw + ze * zs
+                  !
+                  zd = -2.042967e-2_wp
+                  zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+                  zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp
+                  za = ( zd*zsr + zc ) *zs + zaw
+                  !
+                  zb1=   (  -0.1909078_wp  *zt+7.390729_wp    ) *zt-55.87545_wp
+                  za1= ( (   2.326469e-3_wp*zt+1.553190_wp    ) *zt-65.00517_wp ) *zt + 1044.077_wp
+                  zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp
+                  zk0= ( zb1*zsr + za1 )*zs + zkw
+                  !
+                  ! masked in situ density anomaly
+                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                     &             - rau0  ) * zrau0r * tmask_crs(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+         DO jk = 1, jpkm1
+            prd  (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask_crs(:,:,jk)
+            prhop(:,:,jk) = ( 1.e0_wp   +            prd (:,:,jk)       ) * rau0 * tmask_crs(:,:,jk)
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+         DO jk = 1, jpkm1
+            prd  (:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask_crs(:,:,jk)
+            prhop(:,:,jk) = ( 1.e0_wp  + prd (:,:,jk) )                                       * rau0 * tmask_crs(:,:,jk)
+         END DO
+         !
+      END SELECT
+      !
+   !   IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk )
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zws )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos-p')
+      !
+   END SUBROUTINE eos_insitu_pot_crs
+
+
+   SUBROUTINE eos_insitu_2d_crs( pts, pdep, prd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_2d  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
+      !!      potential temperature and salinity using an equation of state
+      !!      defined through the namelist parameter nn_eos. * 2D field case
+      !!
+      !! ** Method :
+      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!      nn_eos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = 0.0285 - rn_alpha * t
+      !!      nn_eos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as pts are defined over the whole domain.
+      !!
+      !! ** Action  : - prd , the in situ density (no units)
+      !!
+      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                           ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                  [m]
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density
+      !!
+      INTEGER  ::   ji, jj                    ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars
+      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zmask        !    -         -
+      REAL(wp), POINTER, DIMENSION(:,:) :: zws
+      !!----------------------------------------------------------------------
+      !
+!WRITE(numout,*) ' pts1 ' ,  pts(:,:,1)
+!WRITE(numout,*) ' pts2 ' ,  pts(:,:,2)
+!WRITE(numout,*) ' jpi ' ,  jpi
+!WRITE(numout,*) ' fs_jpim1 ' ,  fs_jpim1
+!WRITE(numout,*) ' dim ' ,  size(pts,1)
+      IF( nn_timing == 1 ) CALL timing_start('eos2d')
+      !
+      CALL wrk_alloc( jpi, jpj, zws )
+      !
+
+      prd(:,:) = 0._wp
+
+      SELECT CASE( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+      !
+!CDIR NOVERRCHK
+         DO jj = 1, jpjm1
+!CDIR NOVERRCHK
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) )
+            END DO
+         END DO
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zmask = tmask_crs(ji,jj,1)          ! land/sea bottom mask = surf. mask
+               zt    = pts  (ji,jj,jp_tem)            ! interpolated T
+               zs    = pts  (ji,jj,jp_sal)            ! interpolated S
+               zsr   = zws  (ji,jj)            ! square root of interpolated S
+               zh    = pdep (ji,jj)            ! depth at the partial step level
+               !
+               ! compute volumic mass pure water at atm pressure
+               zr1 = ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   &
+                  &                        -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp
+               ! seawater volumic mass atm pressure
+               zr2 = ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp )*zt+7.6438e-5_wp ) *zt   &
+                  &                                   -4.0899e-3_wp ) *zt+0.824493_wp
+               zr3 = ( -1.6546e-6_wp*zt+1.0227e-4_wp ) *zt-5.72466e-3_wp
+               zr4 = 4.8314e-4_wp
+               !
+               ! potential volumic mass (reference to the surface)
+               zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+               !
+               ! add the compression terms
+               ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+               zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
+               zb = zbw + ze * zs
+               !
+               zd =    -2.042967e-2_wp
+               zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+               zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt -4.721788_wp
+               za = ( zd*zsr + zc ) *zs + zaw
+               !
+               zb1=     (-0.1909078_wp  *zt+7.390729_wp      ) *zt-55.87545_wp
+               za1=   ( ( 2.326469e-3_wp*zt+1.553190_wp      ) *zt-65.00517_wp ) *zt+1044.077_wp
+               zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp   ) *zt-30.41638_wp ) *zt   &
+                  &                             +2098.925_wp ) *zt+190925.6_wp
+               zk0= ( zb1*zsr + za1 )*zs + zkw
+               !
+               ! masked in situ density anomaly
+               prd(ji,jj) = ( zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 ) / rau0 * zmask
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask_crs(ji,jj,1)
+            END DO
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask_crs(ji,jj,1)
+            END DO
+         END DO
+         !
+      END SELECT
+!WRITE(numout,*) ' prd ' ,  prd(:,:)
+!WRITE(numout,*) ' zws ' ,  zws(:,:)
+!WRITE(numout,*) ' pdep ' ,  pdep(:,:)
+
+
+
+!     IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
+      !
+      CALL wrk_dealloc( jpi, jpj, zws )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos2d')
+      !
+   END SUBROUTINE eos_insitu_2d_crs
+
+
+   SUBROUTINE eos_bn2_crs( pts, pn2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_bn2  ***
+      !!
+      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the time-
+      !!      step of the input arguments
+      !!
+      !! ** Method :
+      !!       * nn_eos = 0  : UNESCO sea water properties
+      !!         The brunt-vaisala frequency is computed using the polynomial
+      !!      polynomial expression of McDougall (1987):
+      !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
+      !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is
+      !!      computed and used in zdfddm module :
+      !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] )
+      !!       * nn_eos = 1  : linear equation of state (temperature only)
+      !!            N^2 = grav * rn_alpha * dk[ t ]/e3w
+      !!       * nn_eos = 2  : linear equation of state (temperature & salinity)
+      !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w
+      !!      The use of potential density to compute N^2 introduces e r r o r
+      !!      in the sign of N^2 at great depths. We recommand the use of
+      !!      nn_eos = 0, except for academical studies.
+      !!        Macro-tasked on horizontal slab (jk-loop)
+      !!      N.B. N^2 is set to zero at the first level (JK=1) in inidtr
+      !!      and is never used at this level.
+      !!
+      !! ** Action  : - pn2 : the brunt-vaisala frequency
+      !!
+      !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                               ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2   ! Brunt-Vaisala frequency    [s-1]
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! local scalars
+#if defined key_zdfddm
+      REAL(wp) ::   zds   ! local scalars
+#endif
+      !!----------------------------------------------------------------------
+
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bn2')
+      !
+      ! pn2 : interior points only (2=< jk =< jpkm1 )
+      ! --------------------------
+      !
+      SELECT CASE( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zgde3w = grav / e3w_max_crs(ji,jj,jk)
+                  zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )         ! potential temperature at w-pt
+                  zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0  ! salinity anomaly (s-35) at w-pt
+                  zh = gdepw_crs(ji,jj,jk)                                                ! depth in meters  at w-point
+                  !
+                  zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &   ! ratio alpha/beta
+                     &                                  - 0.203814e-03_wp ) * zt   &
+                     &                                  + 0.170907e-01_wp ) * zt   &
+                     &   +         0.665157e-01_wp                                 &
+                     &   +     ( - 0.678662e-05_wp * zs                            &
+                     &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   &
+                     &   +   ( ( - 0.302285e-13_wp * zh                            &
+                     &           - 0.251520e-11_wp * zs                            &
+                     &           + 0.512857e-12_wp * zt * zt              ) * zh   &
+                     &           - 0.164759e-06_wp * zs                            &
+                     &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   &
+                     &                                  + 0.380374e-04_wp ) * zh
+                     !
+                  zbeta  = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt      &   ! beta
+                     &                               - 0.301985e-05_wp ) * zt      &
+                     &   +       0.785567e-03_wp                                   &
+                     &   + (     0.515032e-08_wp * zs                              &
+                     &         + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs     &
+                     &   + ( (   0.121551e-17_wp * zh                              &
+                     &         - 0.602281e-15_wp * zs                              &
+                     &         - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh     &
+                     &                                + 0.408195e-10_wp   * zs     &
+                     &     + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt     &
+                     &                                - 0.121555e-07_wp ) * zh
+                     !
+                  !cbr zgde3w: divide by 0
+                  !pn2(ji,jj,jk) = zgde3w * zbeta * tmask_crs(ji,jj,jk)           &   ! N^2
+                  !   &          * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )   &
+                  !   &                     - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) )
+                  pn2(ji,jj,jk) = zbeta * tmask_crs(ji,jj,jk)           &   ! N^2
+                     &          * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )   &
+                     &                     - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) )
+                  IF( e3w_max_crs(ji,jj,jk) .NE. 0._wp ) pn2(ji,jj,jk) = zgde3w * e3w_max_crs(ji,jj,jk)
+
+#if defined key_zdfddm
+                  !                                                         !!bug **** caution a traiter zds=dk[S]= 0 !!!!
+                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s])
+                  IF ( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp
+                  rrau(ji,jj,jk) = zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds
+#endif
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+         DO jk = 2, jpkm1
+            pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / e3w_max_crs(:,:,jk) * tmask_crs(:,:,jk)
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+         DO jk = 2, jpkm1
+            !cbr: bug divide by 0.
+            !pn2(:,:,jk) = grav * (  rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )      &
+            !   &                  - rn_beta  * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) )  )   &
+            !   &               / e3w_max_crs(:,:,jk) * tmask_crs(:,:,jk)
+            pn2(:,:,jk) = grav * (  rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )      &
+               &                  - rn_beta  * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) )  )   &
+               &               * tmask_crs(:,:,jk)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( e3w_max_crs(ji,jj,jk) .NE. 0._wp ) pn2(ji,jj,jk) = pn2(ji,jj,jk) / e3w_max_crs(ji,jj,jk)
+               ENDDO
+            ENDDO
+         END DO
+#if defined key_zdfddm
+         DO jk = 2, jpkm1                                 ! Rrau = (alpha / beta) (dk[t] / dk[s])
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )
+                  IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp
+                  rrau(ji,jj,jk) = ralpbet_crs * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds
+               END DO
+            END DO
+         END DO
+#endif
+      END SELECT
+
+  !    IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk )
+#if defined key_zdfddm
+  !    IF(ln_ctl)   CALL prt_ctl( tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk )
+#endif
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bn2')
+      !
+   END SUBROUTINE eos_bn2_crs
+
+
+   SUBROUTINE eos_alpbet_crs( pts, palpbet, beta0 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_alpbet  ***
+      !!
+      !! ** Purpose :   Calculates the in situ thermal/haline expansion ratio at T-points
+      !!
+      !! ** Method  :   calculates alpha / beta ratio at T-points
+      !!       * nn_eos = 0  : UNESCO sea water properties
+      !!                       The alpha/beta ratio is returned as 3-D array palpbet using the polynomial
+      !!                       polynomial expression of McDougall (1987).
+      !!                       Scalar beta0 is returned = 1.
+      !!       * nn_eos = 1  : linear equation of state (temperature only)
+      !!                       The ratio is undefined, so we return alpha as palpbet
+      !!                       Scalar beta0 is returned = 0.
+      !!       * nn_eos = 2  : linear equation of state (temperature & salinity)
+      !!                       The alpha/beta ratio is returned as ralpbet
+      !!                       Scalar beta0 is returned = 1.
+      !!
+      !! ** Action  : - palpbet : thermal/haline expansion ratio at T-points
+      !!            :   beta0   : 1. or 0.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts       ! pot. temperature & salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palpbet   ! thermal/haline expansion ratio
+      REAL(wp),                              INTENT(  out) ::   beta0     ! set = 1 except with case 1 eos, rho=rho(T)
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos_alpbet')
+      !
+      SELECT CASE ( nn_eos )
+      !
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts(ji,jj,jk,jp_tem)           ! potential temperature
+                  zs = pts(ji,jj,jk,jp_sal) - 35._wp  ! salinity anomaly (s-35)
+                  zh = fsdept(ji,jj,jk)               ! depth in meters
+                  !
+                  palpbet(ji,jj,jk) =                                              &
+                     &     ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &
+                     &                                  - 0.203814e-03_wp ) * zt   &
+                     &                                  + 0.170907e-01_wp ) * zt   &
+                     &   + 0.665157e-01_wp                                         &
+                     &   +     ( - 0.678662e-05_wp * zs                            &
+                     &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   &
+                     &   +   ( ( - 0.302285e-13_wp * zh                            &
+                     &           - 0.251520e-11_wp * zs                            &
+                     &           + 0.512857e-12_wp * zt * zt              ) * zh   &
+                     &           - 0.164759e-06_wp * zs                            &
+                     &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   &
+                     &                                  + 0.380374e-04_wp ) * zh
+               END DO
+            END DO
+         END DO
+         beta0 = 1._wp
+         !
+      CASE ( 1 )              !==  Linear formulation = F( temperature )  ==!
+         palpbet(:,:,:) = rn_alpha
+         beta0 = 0._wp
+         !
+      CASE ( 2 )              !==  Linear formulation = F( temperature , salinity )  ==!
+         palpbet(:,:,:) = ralpbet_crs
+         beta0 = 1._wp
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos_alpbet')
+      !
+   END SUBROUTINE eos_alpbet_crs
+
+
+   FUNCTION tfreez_crs( psal ) RESULT( ptf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   Compute the sea surface freezing temperature [Celcius]
+      !!
+      !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???)
+      !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p
+      !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars
+      !!
+      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu]
+      ! Leave result array automatic rather than making explicitly allocated
+      REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius]
+      !!----------------------------------------------------------------------
+      !
+      ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   &
+         &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:)
+      !
+   END FUNCTION tfreez_crs
+
+
+   SUBROUTINE eos_init_crs
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   initializations for the equation of state
+      !!
+      !! ** Method  :   Read the namelist nameos and control the parameters
+      !!----------------------------------------------------------------------
+      INTEGER ::   ios   ! Local integer output status for namelist read
+      !!
+      NAMELIST/nameos/ nn_eos, rn_alpha, rn_beta
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )            
+      READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist', lwp )
+
+      REWIND( numnam_cfg )    
+      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nameos )
+
+      !
+      IF(lwp) THEN                ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'eos_init : equation of state'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '          Namelist nameos : set eos parameters'
+         WRITE(numout,*) '             flag for eq. of state and N^2  nn_eos   = ', nn_eos
+         WRITE(numout,*) '             thermal exp. coef. (linear)    rn_alpha = ', rn_alpha
+         WRITE(numout,*) '             saline  exp. coef. (linear)    rn_beta  = ', rn_beta
+      ENDIF
+      !
+      SELECT CASE( nn_eos )         ! check option
+      !
+      CASE( 0 )                        !==  Jackett and McDougall (1994) formulation  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and'
+         IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency'
+         !
+      CASE( 1 )                        !==  Linear formulation = F( temperature )  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - rn_alpha * T )'
+         IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   &
+              &                         ' that T and S are used as state variables' )
+         !
+      CASE( 2 )                        !==  Linear formulation = F( temperature , salinity )  ==!
+         ralpbet_crs = rn_alpha / rn_beta
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rn_beta * S - rn_alpha * T )'
+         !
+      CASE DEFAULT                     !==  ERROR in nn_eos  ==!
+         WRITE(ctmp1,*) '          bad flag value for nn_eos = ', nn_eos
+         CALL ctl_stop( ctmp1 )
+         !
+      END SELECT
+      !
+   END SUBROUTINE eos_init_crs
+
+   !!======================================================================
+END MODULE eosbn2_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90	(revision 5105)
@@ -0,0 +1,489 @@
+MODULE traadv_tvd_crs
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_tvd  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+   !! History :  OPA  !  1995-12  (L. Mortier)  Original code
+   !!                 !  2000-01  (H. Loukos)  adapted to ORCA 
+   !!                 !  2000-10  (MA Foujols E.Kestenare)  include file not routine
+   !!                 !  2000-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes
+   !!                 !  2001-07  (E. Durand G. Madec)  adaptation to ORCA config
+   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
+   !!    NEMO    1.0  !  2004-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl
+   !!            2.0  !  2008-04  (S. Cravatte) add the i-, j- & k- trends computation
+   !!             -   !  2009-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_tvd  : update the tracer trend with the horizontal
+   !!                  and vertical advection trends using a TVD scheme
+   !!   nonosc       : compute monotonic tracer fluxes by a nonoscillatory
+   !!                  algorithm 
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce , ONLY : lk_vvl
+   USE trdmod_oce      ! tracers trends
+   USE trdtra          ! tracers trends
+   USE in_out_manager  ! I/O manager
+   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE lib_mpp         ! MPP library
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
+   USE diaptr          ! poleward transport diagnostics
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE crs
+   USE crslbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_tvd_crs    ! routine called by step.F90
+
+   LOGICAL ::   l_trd   ! flag to compute trends
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: traadv_tvd.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_tvd_crs ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                       ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_tvd  ***
+      !! 
+      !! **  Purpose :   Compute the now trend due to total advection of 
+      !!       tracers and add it to the general trend of tracer equations
+      !!
+      !! **  Method  :   TVD scheme, i.e. 2nd order centered scheme with
+      !!       corrected flux (monotonic correction)
+      !!       note: - this advection scheme needs a leap-frog time scheme
+      !!
+      !! ** Action : - update (pta) with the now advective tracer trends
+      !!             - save the trends 
+      !!----------------------------------------------------------------------
+      !cbr ça fait des trucs bizarres USE oce     , ONLY:   zwx => ua        , zwy => va          ! (ua,va) used as workspace
+      !
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices  
+      REAL(wp) ::   z2dtt, zbtr, ztra        ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz,zwx,zwy
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz
+
+      INTEGER  ::   iji, ijj, ijk           ! dummy loop indices  
+      REAL(wp) ::   zmin,zmax
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz , zwx, zwy )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+
+         IF(lwp) WRITE(numout,*)"jpi jpj jpkm1 ",jpi,jpj,jpkm1
+      ENDIF
+      !
+      IF( l_trd )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+         ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0
+      ENDIF
+      !
+      zwi(:,:,:) = 0.e0
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         ! ----------------------------------
+         zwx(:,:,jpk) = 0.e0    ;    zwz(:,:,jpk) = 0.e0
+         zwy(:,:,jpk) = 0.e0    ;    zwi(:,:,jpk) = 0.e0
+
+         ! 2. upstream advection with initial mass fluxes & intermediate update
+         ! --------------------------------------------------------------------
+        !DO jk = 2, jpkm1          ! Interior value
+        !    DO jj = 1, jpj
+        !       DO ji = 1, jpi
+        !          IF( ptb(ji,jj,jk,jn) .NE. ptb(ji,jj,jk,jn) )WRITE(narea+200,*)"ADVtb",ptb(ji,jj,jk,jn) ; call flush(narea+200)
+        !          IF( ptn(ji,jj,jk,jn) .NE. ptn(ji,jj,jk,jn) )WRITE(narea+200,*)"ADVtn",ptb(ji,jj,jk,jn) ; call flush(narea+200)
+        !          IF( pun(ji,jj,jk) .NE. pun(ji,jj,jk) )WRITE(narea+200,*)"ADVun",pun(ji,jj,jk) ; call flush(narea+200)
+        !          IF( pvn(ji,jj,jk) .NE. pvn(ji,jj,jk) )WRITE(narea+200,*)"ADVvn",pvn(ji,jj,jk) ; call flush(narea+200)
+        !          IF( pwn(ji,jj,jk) .NE. pwn(ji,jj,jk) )WRITE(narea+200,*)"ADVwn",pwn(ji,jj,jk) ; call flush(narea+200)
+        !       END DO
+        !    END DO
+        ! END DO
+        ! ji=117 ; jj=211 ; jk=74
+        ! ji=ji-nimpp_crs+1 ; jj=jj-njmpp_crs+1
+        ! IF( ji .GE. 2 .AND. ji .LE. jpi_crs-1 .AND. jj .GE. 2 .AND. jj .LE. jpj_crs-1 )THEN
+        ! WRITE(narea+5000,*)"tvd =======> kt ",kt
+        ! WRITE(narea+5000,*)ptb(ji,jj,jk,jn),ptn(ji,jj,jk,jn)
+        ! WRITE(narea+5000,*)pun(ji-1,jj,jk),pun(ji,jj,jk)
+        ! WRITE(narea+5000,*)pvn(ji,jj-1,jk),pun(ji,jj,jk)
+        ! WRITE(narea+5000,*)pwn(ji,jj,jk),pwn(ji,jj,jk+1)
+        ! ENDIF
+
+         ! upstream tracer flux in the i and j direction
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
+               END DO
+            END DO
+         END DO
+         ! upstream tracer flux in the k direction
+         ! Surface value
+         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface 
+         ENDIF
+         ! Interior value
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) )
+               END DO
+            END DO
+         END DO
+!WRITE(numout,*) 'test_tra', maxval(pta(:,:,:,1)) , kt
+!WRITE(numout,*) 'test_tra', minval(pta(:,:,:,1)) , kt
+         ! total advective trend
+         DO jk = 1, jpkm1
+            z2dtt = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = r1_bt_crs(ji,jj,jk) 
+                  ! total intermediate advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  ! update and guess with monotonic sheme
+                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra
+                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask_crs(ji,jj,jk)
+                  !iji=117 ; ijj=211 ; ijk=74
+                  !iji=iji-nimpp+1 ; ijj=ijj-njmpp+1
+                  !IF( ji==iji .AND. jj==ijj )THEN
+                  !WRITE(narea+5000,*)"test ",jk,zwx(ji,jj,jk) , zwx(ji-1,jj  ,jk  ), & 
+                  !              zwy(ji,jj,jk) , zwy(ji  ,jj-1,jk  ),zwz(ji,jj,jk),zwz(ji  ,jj  ,jk+1)
+                  !ENDIF
+                  !IF( ztra .NE. 0._wp )WRITE(narea+6000,*)"buga ",kt,ji,jj,jk,mbathy_crs(ji,jj), &
+                  !    zwx(ji,jj,jk) , zwx(ji-1,jj  ,jk  ),zwy(ji,jj,jk) , zwy(ji  ,jj-1,jk  ),zwz(ji,jj,jk),zwz(ji  ,jj  ,jk+1)
+               END DO
+            END DO
+         END DO
+         !IF(narea==267)WRITE(narea+5000,*)"1 pta(17,6,74,1) = ",pta(17,6,74,1)
+         !zmin=MINVAL( pta(2:jpi-1,2:jpj-1,2:jpk,1),mask=(tmask(2:jpi-1,2:jpj-1,2:jpk)==1)) ; CALL mpp_min(zmin)
+         !zmax=MAXVAL( pta(2:jpi-1,2:jpj-1,2:jpk,1),mask=(tmask(2:jpi-1,2:jpj-1,2:jpk)==1)) ; CALL mpp_max(zmax)
+         !IF(lwp)WRITE(numout,*)"trcadvtvdcrs a ",kt,zmin,zmax
+
+!WRITE(numout,*) 'test_tra', maxval(pta(:,:,:,jk)) , kt
+!WRITE(numout,*) 'test_tra', minval(pta(:,:,:,jk)) , kt
+         !                             ! Lateral boundary conditions on zwi  (unchanged sign)
+         CALL crs_lbc_lnk( zwi, 'T', 1. )  
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ! store intermediate advective trends
+            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+
+         ! 3. antidiffusive flux : high order minus low order
+         ! --------------------------------------------------
+         ! antidiffusive flux on i and j
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  !iji=117 ; ijj=211 ; ijk=74
+                  !iji=iji-nimpp+1 ; ijj=ijj-njmpp+1
+                  !IF( ji==iji .AND. jj==ijj )THEN
+                  !WRITE(narea+5000,*)"antidiffxy ",jk,pun(ji,jj,jk),ptn(ji,jj,jk,jn),ptn(ji+1,jj,jk,jn),zwx(ji,jj,jk)
+                  !WRITE(narea+5000,*)"antidiffxy ",jk,pvn(ji,jj,jk),ptn(ji,jj,jk,jn),ptn(ji,jj+1,jk,jn),zwy(ji,jj,jk)
+                  !ENDIF
+                  zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
+                  zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
+                  !iji=117 ; ijj=211 ; ijk=74
+                  !iji=iji-nimpp+1 ; ijj=ijj-njmpp+1
+                  !IF( ji==iji .AND. jj==ijj )THEN
+                  !WRITE(narea+5000,*)"antidiffxy ",jk,zwx(ji,jj,jk),zwy(ji,jj,jk) 
+                  !ENDIF
+               END DO
+            END DO
+         END DO
+  !    WRITE(numout,*) 'test6456_trb_sbc', pta(10,10,1,1), kt
+         ! antidiffusive flux on k
+         zwz(:,:,1) = 0.e0         ! Surface value
+         !
+         DO jk = 2, jpkm1          ! Interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk)
+                  !iji=117 ; ijj=211 ; ijk=74
+                  !iji=iji-nimpp+1 ; ijj=ijj-njmpp+1
+                  !IF( ji==iji .AND. jj==ijj )THEN
+                  !WRITE(narea+5000,*)"antidiffz ",jk,zwz(ji,jj,jk)
+                  !ENDIF
+               END DO
+            END DO
+         END DO
+         CALL crs_lbc_lnk( zwx, 'U', -1. )   ;   CALL crs_lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
+         CALL crs_lbc_lnk( zwz, 'W',  1. )
+
+         ! 4. monotonicity algorithm
+         ! -------------------------
+         !DO jk = 2, jpkm1          ! Interior value
+         !   DO jj = 1, jpj
+         !      DO ji = 1, jpi
+         !         IF( ptb(ji,jj,jk,jn) .NE. ptb(ji,jj,jk,jn) )WRITE(narea+200,*)"ADV1",ptb(ji,jj,jk,jn) ; call flush(narea+200)
+         !         IF( zwx(ji,jj,jk) .NE. zwx(ji,jj,jk) )WRITE(narea+200,*)"ADV2",zwx(ji,jj,jk) ; call flush(narea+200)
+         !         IF( zwy(ji,jj,jk) .NE. zwy(ji,jj,jk) )WRITE(narea+200,*)"ADV3",zwy(ji,jj,jk) ; call flush(narea+200)
+         !         IF( zwz(ji,jj,jk) .NE. zwz(ji,jj,jk) )WRITE(narea+200,*)"ADV4",zwz(ji,jj,jk) ; call flush(narea+200)
+         !         IF( zwi(ji,jj,jk) .NE. zwi(ji,jj,jk) )WRITE(narea+200,*)"ADV5",zwi(ji,jj,jk) ; call flush(narea+200)
+         !         IF( tmask_crs(ji,jj,jk) .NE. tmask_crs(ji,jj,jk) )WRITE(narea+200,*)"ADV6",tmask_crs(ji,jj,jk) ; call flush(narea+200)
+         !      END DO
+         !   END DO
+         !END DO
+  
+         CALL nonosc_crs( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
+
+         !IF( narea==267 )THEN
+         !DO jk=1,jpk-1
+         !WRITE(narea+5000,*)"toto",jk,zwx(16,6,jk),zwx(17,6,jk),zwy(17,5,jk),zwy(17,6,jk),zwz(17,6,jk),zwz(17,6,jk+1)
+         !ENDDO
+         !ENDIF
+
+         ! 5. final trend with corrected fluxes
+         ! ------------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  zbtr = r1_bt_crs(ji,jj,jk)
+                  ! total advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  ! add them to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+
+
+                  !IF( narea==267 .AND. ji==17 .AND. jj==6 )THEN 
+                  !WRITE(narea+5000,*)"correc ",jk,ptb(ji,jj,jk,1),pta(ji,jj,jk,1),zwx(ji,jj,jk) , zwx(ji-1,jj  ,jk  ), &
+                  !              zwy(ji,jj,jk) , zwy(ji  ,jj-1,jk  ),zwz(ji,jj,jk),zwz(ji  ,jj  ,jk+1)
+                  !ENDIF
+
+
+                  !IF( ztra .NE. 0._wp )WRITE(narea+6000,*)"bugb ",kt,ji,jj,jk,mbathy_crs(ji,jj), &
+                  !    zwx(ji,jj,jk) , zwx(ji-1,jj  ,jk  ),zwy(ji,jj,jk) , zwy(ji  ,jj-1,jk  ),zwz(ji,jj,jk),zwz(ji  ,jj  ,jk+1)
+               END DO
+            END DO
+         END DO
+         !IF(narea==267)WRITE(narea+5000,*)"2 pta(17,6,74,1) = ",pta(17,6,74,1)
+         !zmin=MINVAL( pta(2:jpi-1,2:jpj-1,2:jpk,1),mask=(tmask(2:jpi-1,2:jpj-1,2:jpk)==1)) ; CALL mpp_min(zmin)
+         !zmax=MAXVAL( pta(2:jpi-1,2:jpj-1,2:jpk,1),mask=(tmask(2:jpi-1,2:jpj-1,2:jpk)==1)) ; CALL mpp_max(zmax)
+         !IF(lwp)WRITE(numout,*)"trcadvtvdcrs b ",kt,zmin,zmax
+
+!WRITE(numout,*) 'test_tra', maxval(pta(:,:,:,jk)) , kt
+!WRITE(numout,*) 'test_tra', minval(pta(:,:,:,jk)) , kt
+!WRITE(numout,*) 'test6456_trb_sbc', pta(10,10,1,1), kt
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
+            
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, ztrdx, pun, ptn(:,:,:,jn) )   
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )  
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:)
+           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:)
+         ENDIF
+         !
+      END DO
+      !
+                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz , zwx, zwy )
+      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd')
+  !    IF(lwp) WRITE(numout,*) 'TEST2', pta
+!WRITE(numout,*) 'test6456_trb_sbc', pta(10,10,1,1), kt
+      !
+   END SUBROUTINE tra_adv_tvd_crs
+
+
+   SUBROUTINE nonosc_crs( pbef, paa, pbb, pcc, paft, p2dt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE nonosc  ***
+      !!     
+      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
+      !!       scheme and the before field by a nonoscillatory algorithm 
+      !!
+      !! **  Method  :   ... ???
+      !!       warning : pbef and paft must be masked, but the boundaries
+      !!       conditions on the fluxes are not necessary zalezak (1979)
+      !!       drange (1995) multi-dimensional forward-in-time and upstream-
+      !!       in-space based differencing for fluid
+      !!----------------------------------------------------------------------
+      !
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ikm1         ! local integer
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars
+      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('nonosc')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      !
+
+      zbig  = 1.e+40_wp
+      zrtrn = 1.e-15_wp
+      zbetup(:,:,jpk) = 0._wp   ;   zbetdo(:,:,jpk) = 0._wp
+
+
+      ! Search local extrema
+      ! --------------------
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+      zbup = MAX( pbef * tmask_crs - zbig * ( 1.e0 - tmask_crs ),   &
+         &        paft * tmask_crs - zbig * ( 1.e0 - tmask_crs )  )
+      zbdo = MIN( pbef * tmask_crs + zbig * ( 1.e0 - tmask_crs ),   &
+         &        paft * tmask_crs + zbig * ( 1.e0 - tmask_crs )  )
+
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         z2dtt = p2dt(jk)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+
+               ! search maximum in neighbourhood
+               zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
+                  &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   &
+                  &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   &
+                  &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  )
+
+               ! search minimum in neighbourhood
+               zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   &
+                  &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   &
+                  &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   &
+                  &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  )
+
+               ! positive part of the flux
+               zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
+
+               ! negative part of the flux
+               zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
+
+               ! up & down beta terms
+               zbt = bt_crs(ji,jj,jk) / z2dtt
+               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
+               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt
+            END DO
+         END DO
+      END DO
+      CALL crs_lbc_lnk( zbetup, 'T', 1. )   ;   CALL crs_lbc_lnk( zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
+
+      ! 3. monotonic flux in the i & j direction (paa & pbb)
+      ! ----------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zau = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+               zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) )
+               !IF( narea==267 .AND. ji==17 .AND. jj==6 )THEN 
+               !   WRITE(narea+5000,*)"nonosc ",jk
+               !   WRITE(narea+5000,*)"paa",zbetdo(ji,jj,jk),zbetup(ji+1,jj,jk),zbetup(ji,jj,jk),zbetdo(ji+1,jj,jk)
+               !   WRITE(narea+5000,*)"paa",zau,zbu,zcu, paa(ji,jj,jk)
+               !ENDIF
+               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1.e0 - zcu) * zbu )
+               !IF( narea==267 .AND. ji==17 .AND. jj==6 )WRITE(narea+5000,*)"paa",paa(ji,jj,jk)
+
+               zav = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+               zbv = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) )
+               !IF( narea==267 .AND. ji==17 .AND. jj==6 )THEN 
+               !   WRITE(narea+5000,*)"pbb",zbetdo(ji,jj,jk),zbetup(ji,jj+1,jk),zbetup(ji,jj,jk),zbetdo(ji,jj+1,jk)
+               !   WRITE(narea+5000,*)"pbb",zav,zbv,zcv, pbb(ji,jj,jk)
+               !ENDIF
+               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1.e0 - zcv) * zbv )
+               !IF( narea==267 .AND. ji==17 .AND. jj==6 )WRITE(narea+5000,*)"pbb",pbb(ji,jj,jk)
+
+      ! monotonic flux in the k direction, i.e. pcc
+      ! -------------------------------------------
+               za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
+               zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
+               zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) )
+               !IF( narea==267 .AND. ji==17 .AND. jj==6 )THEN 
+               !   WRITE(narea+5000,*)"pcc",zbetdo(ji,jj,jk+1),zbetup(ji,jj,jk),zbetup(ji,jj,jk+1),zbetdo(ji,jj,jk)
+               !   WRITE(narea+5000,*)"pcc",za,zb,zc, pcc(ji,jj,jk+1)
+               !ENDIF
+               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1.e0 - zc) * zb )
+               !IF( narea==267 .AND. ji==17 .AND. jj==6 )WRITE(narea+5000,*)"pcc",pcc(ji,jj,jk+1)
+            END DO
+         END DO
+      END DO
+
+         !IF( narea==267 )THEN
+         !DO jk=1,jpk-1
+         !WRITE(narea+5000,*)"nono",jk,paa(16,6,jk),paa(17,6,jk),pbb(17,5,jk),pbb(17,6,jk),pcc(17,6,jk),pcc(17,6,jk+1)
+         !ENDDO
+         !ENDIF
+
+      CALL crs_lbc_lnk( paa, 'U', -1. )   ;   CALL crs_lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
+         !IF( narea==267 )THEN
+         !DO jk=1,jpk-1
+         !WRITE(narea+5000,*)"nono1",jk,paa(16,6,jk),paa(17,6,jk),pbb(17,5,jk),pbb(17,6,jk),pcc(17,6,jk),pcc(17,6,jk+1)
+         !!ENDDO
+         !ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('nonosc')
+      !
+   END SUBROUTINE nonosc_crs
+
+   !!======================================================================
+END MODULE traadv_tvd_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl_crs.F90	(revision 5105)
@@ -0,0 +1,691 @@
+MODULE trabbl_crs
+   !!==============================================================================
+   !!                       ***  MODULE  trabbl  ***
+   !! Ocean physics :  advective and/or diffusive bottom boundary layer scheme
+   !!==============================================================================
+   !! History :  OPA  ! 1996-06  (L. Mortier)  Original code
+   !!            8.0  ! 1997-11  (G. Madec)    Optimization
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  free form + modules
+   !!             -   ! 2004-01  (A. de Miranda, G. Madec, J.M. Molines ) add advective bbl
+   !!            3.3  ! 2009-11  (G. Madec)  merge trabbl and trabbl_adv + style + optimization 
+   !!             -   ! 2010-04  (G. Madec)  Campin & Goosse advective bbl 
+   !!             -   ! 2010-06  (C. Ethe, G. Madec)  merge TRA-TRC
+   !!             -   ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
+   !!----------------------------------------------------------------------
+#if   defined key_trabbl   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trabbl'   or                             bottom boundary layer
+   !!----------------------------------------------------------------------
+   !!   tra_bbl_alloc : allocate trabbl arrays
+   !!   tra_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive)
+   !!   tra_bbl_dif   : generic routine to compute bbl diffusive trend
+   !!   tra_bbl_adv   : generic routine to compute bbl advective trend
+   !!   bbl           : computation of bbl diffu. flux coef. & transport in bottom boundary layer
+   !!   tra_bbl_init  : initialization, namelist read, parameters control
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constant
+   USE eosbn2_crs     ! equation of state
+   USE trdmod_oce     ! trends: ocean variables
+   USE trdtra         ! trends: active tracers
+   USE iom            ! IOM server               
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+   USE crs
+   USE crslbclnk
+   USE crsiom
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_bbl_crs       !  routine called by step.F90
+   PUBLIC   tra_bbl_init_crs  !  routine called by opa.F90
+   PUBLIC   tra_bbl_dif_crs   !  routine called by trcbbl.F90
+   PUBLIC   tra_bbl_adv_crs   !  -          -          -              -
+   PUBLIC   bbl_crs           !  routine called by trcbbl.F90 and dtadyn.F90
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_crs = .TRUE.    !: bottom boundary layer flag
+
+   !                                           !!* Namelist nambbl * 
+   INTEGER , PUBLIC ::   nn_bbl_ldf = 0         !: =1   : diffusive bbl or not (=0)
+   INTEGER , PUBLIC ::   nn_bbl_adv = 0         !: =1/2 : advective bbl or not (=0)
+   !                                            !  =1 : advective bbl using the bottom ocean velocity
+   !                                            !  =2 :     -      -  using utr_bbl proportional to grad(rho)
+   REAL(wp), PUBLIC ::   rn_ahtbbl_crs  = 1.e4_wp   !: along slope bbl diffusive coefficient [m2/s]
+   REAL(wp), PUBLIC ::   rn_ahtbbl  = 1.e3_wp
+   REAL(wp), PUBLIC ::   rn_gambbl  = 10.0_wp   !: lateral coeff. for bottom boundary layer scheme [s]
+
+   LOGICAL , PUBLIC ::   l_bbl                  !: flag to compute bbl diffu. flux coef and transport
+   
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   utr_bbl_crs  , vtr_bbl_crs   ! u- (v-) transport in the bottom boundary layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   ahu_bbl_crs  , ahv_bbl_crs   ! masked diffusive bbl coeff. at u & v-pts
+
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_e1e2t               ! inverse of the cell surface at t-point      [1/m2]
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: trabbl.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION tra_bbl_alloc_crs()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION tra_bbl_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( utr_bbl_crs  (jpi,jpj) , ahu_bbl_crs  (jpi,jpj) , mbku_d  (jpi,jpj) , mgrhu(jpi,jpj) ,     &
+         &      vtr_bbl_crs  (jpi,jpj) , ahv_bbl_crs  (jpi,jpj) , mbkv_d  (jpi,jpj) , mgrhv(jpi,jpj) ,     &
+         &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                          &
+         &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , r1_e1e2t(jpi,jpj)                  , STAT= tra_bbl_alloc_crs )
+         !
+      IF( lk_mpp                )   CALL mpp_sum ( tra_bbl_alloc_crs )
+      IF( tra_bbl_alloc_crs > 0 )   CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.')
+   END FUNCTION tra_bbl_alloc_crs
+
+
+   SUBROUTINE tra_bbl_crs( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bbl  ***
+      !!                   
+      !! ** Purpose :   Compute the before tracer (t & s) trend associated 
+      !!              with the bottom boundary layer and add it to the general
+      !!              trend of tracer equations.
+      !!
+      !! ** Method  :   Depending on namtra_bbl namelist parameters the bbl
+      !!              diffusive and/or advective contribution to the tracer trend
+      !!              is added to the general tracer trend
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
+      !!
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl')
+      !
+      IF( l_trdtra )   THEN                        !* Save ta and sa trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
+         ztrdt(:,:,:) = tsa_crs(:,:,:,jp_tem) 
+         ztrds(:,:,:) = tsa_crs(:,:,:,jp_sal)
+      ENDIF
+
+      IF( l_bbl )  CALL bbl_crs( kt, nit000, 'TRA' )   !* bbl coef. and transport (only if not already done in trcbbl)
+ 
+      IF( nn_bbl_ldf == 1 ) THEN                   !* Diffusive bbl
+         !
+         CALL tra_bbl_dif_crs( tsb_crs, tsa_crs, jpts )
+         IF( ln_ctl )  &
+         CALL prt_ctl( tab3d_1=tsa_crs(:,:,:,jp_tem), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask_crs, & 
+         &             tab3d_2=tsa_crs(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask_crs, clinfo3='tra' )
+         ! lateral boundary conditions ; just need for outputs                          
+         CALL crs_lbc_lnk( ahu_bbl_crs, 'U', 1. )     ;     CALL crs_lbc_lnk( ahv_bbl_crs, 'V', 1. )
+   !      CALL crs_iom_put( "ahu_bbl_crs", ahu_bbl )   ! bbl diffusive flux i-coef     
+   !      CALL crs_iom_put( "ahv_bbl_crs", ahv_bbl )   ! bbl diffusive flux j-coef
+         !
+      END IF
+
+      IF( nn_bbl_adv /= 0 ) THEN                !* Advective bbl
+         !
+         CALL tra_bbl_adv_crs( tsb_crs, tsa_crs, jpts )
+         IF(ln_ctl)   &
+         CALL prt_ctl( tab3d_1=tsa_crs(:,:,:,jp_tem), clinfo1=' bbl_adv  - Ta: ', mask1=tmask_crs,   &
+         &             tab3d_2=tsa_crs(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask_crs, clinfo3='tra' )
+         ! lateral boundary conditions ; just need for outputs                          
+         CALL crs_lbc_lnk( utr_bbl_crs, 'U', 1. )     ;   CALL crs_lbc_lnk( vtr_bbl_crs, 'V', 1. )
+   !      CALL crs_iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport  
+   !      CALL dom_grid_crs            !! cc return at the CRS grid   
+   !      CALL crs_iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport
+   !      CALL dom_grid_crs            !! cc return at the CRS grid
+         !
+      END IF
+
+      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = tsa_crs(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa_crs(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbl, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_bbl, ztrds )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl')
+      !
+   END SUBROUTINE tra_bbl_crs
+
+
+   SUBROUTINE tra_bbl_dif_crs( ptb, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbl_dif  ***
+      !!                   
+      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
+      !!                advection terms. 
+      !!
+      !! ** Method  :   
+      !!        * diffusive bbl (nn_bbl_ldf=1) :
+      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
+      !!      along bottom slope gradient) an additional lateral 2nd order
+      !!      diffusion along the bottom slope is added to the general
+      !!      tracer trend, otherwise the additional trend is set to 0.
+      !!      A typical value of ahbt is 2000 m2/s (equivalent to
+      !!      a downslope velocity of 20 cm/s if the condition for slope
+      !!      convection is satified)
+      !!
+      !! ** Action  :   pta   increased by the bbl diffusive trend
+      !!
+      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
+      !!----------------------------------------------------------------------  
+      !
+      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jn   ! dummy loop indices
+      INTEGER  ::   ik           ! local integers
+      REAL(wp) ::   zbtr         ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) :: zptb
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_bbl_dif')
+      !
+      CALL wrk_alloc( jpi, jpj, zptb )
+      !
+      DO jn = 1, kjpt                                     ! tracer loop
+         !                                                ! ===========
+#  if defined key_vectopt_loop
+         DO jj = 1, 1   ! vector opt. (forced unrolling)
+            DO ji = 1, jpij
+#else
+         DO jj = 1, jpj
+            DO ji = 1, jpi 
+#endif
+               ik = mbkt_crs(ji,jj)                        ! bottom T-level index
+               zptb(ji,jj) = ptb(ji,jj,ik,jn)              ! bottom before T and S
+            END DO
+         END DO
+         !                                                ! Compute the trend
+#  if defined key_vectopt_loop
+         DO jj = 1, 1   ! vector opt. (forced unrolling)
+            DO ji = jpi+1, jpij-jpi-1
+#  else
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+#  endif
+               ik = mbkt_crs(ji,jj)                            ! bottom T-level index
+               zbtr = r1_bt_crs(ji,jj,ik)
+               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         &
+                  &               + (   ahu_bbl_crs(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   &
+                  &                   - ahu_bbl_crs(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   &
+                  &                   + ahv_bbl_crs(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   &
+                  &                   - ahv_bbl_crs(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr
+            END DO
+         END DO
+         !                                                  ! ===========
+      END DO                                                ! end tracer
+      !                                                     ! ===========
+      CALL wrk_dealloc( jpi, jpj, zptb )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_bbl_dif')
+      !
+   END SUBROUTINE tra_bbl_dif_crs
+   
+
+   SUBROUTINE tra_bbl_adv_crs( ptb, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_bbl  ***
+      !!
+      !! ** Purpose :   Compute the before passive tracer trend associated 
+      !!     with the bottom boundary layer and add it to the general trend
+      !!     of tracer equations.
+      !! ** Method  :   advective bbl (nn_bbl_adv = 1 or 2) :
+      !!      nn_bbl_adv = 1   use of the ocean near bottom velocity as bbl velocity
+      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation i.e. 
+      !!                       transport proportional to the along-slope density gradient                   
+      !!
+      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
+      !!----------------------------------------------------------------------  
+      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices
+      INTEGER  ::   iis , iid , ijs , ijd    ! local integers
+      INTEGER  ::   ikus, ikud, ikvs, ikvd   !   -       -
+      REAL(wp) ::   zbtr, ztra               ! local scalars
+      REAL(wp) ::   zu_bbl, zv_bbl           !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_adv')
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========         
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west
+# endif
+               IF( utr_bbl_crs(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection
+                  ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf)
+                  iid  = ji + MAX( 0, mgrhu(ji,jj) )   ;   iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
+                  ikud = mbku_d(ji,jj)                 ;   ikus = mbku_crs(ji,jj)
+                  zu_bbl = ABS( utr_bbl_crs(ji,jj) )
+                  !
+                  !                                               ! up  -slope T-point (shelf bottom point)
+                  zbtr = r1_bt_crs(iis,jj,ikus)
+                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr
+                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra
+                  !                   
+                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column)
+                     zbtr = r1_bt_crs(iid,jj,jk)
+                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr
+                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra
+                  END DO
+                  ! 
+                  zbtr = r1_bt_crs(iid,jj,ikud)
+                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr
+                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra
+               ENDIF
+               !
+               IF( vtr_bbl_crs(ji,jj) /= 0.e0 ) THEN            ! non-zero j-direction bbl advection
+                  ! down-slope j/k-indices (deep)        &   up-slope j/k indices (shelf)
+                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )     ;   ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
+                  ikvd = mbkv_d(ji,jj)                   ;   ikvs = mbkv_crs(ji,jj)
+                  zv_bbl = ABS( vtr_bbl_crs(ji,jj) )
+                  !
+                   
+                  ! up  -slope T-point (shelf bottom point)
+                  zbtr = r1_bt_crs(ji,ijs,ikvs)
+                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr
+                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra
+                  !                   
+                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column)
+                     zbtr = r1_bt_crs(ji,ijd,jk)
+                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr
+                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra
+                  END DO
+                  !                                               ! down-slope T-point (deep bottom point)
+                  zbtr = r1_bt_crs(ji,ijd,ikvd)
+                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr
+                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra
+               ENDIF
+            END DO
+            !
+         END DO
+         !                                                  ! ===========
+      END DO                                                ! end tracer
+      !                                                     ! ===========
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_adv')
+      !
+   END SUBROUTINE tra_bbl_adv_crs
+
+
+   SUBROUTINE bbl_crs( kt, kit000, cdtype )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bbl  ***
+      !!                   
+      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
+      !!                advection terms. 
+      !!
+      !! ** Method  :   
+      !!        * diffusive bbl (nn_bbl_ldf=1) :
+      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
+      !!      along bottom slope gradient) an additional lateral 2nd order
+      !!      diffusion along the bottom slope is added to the general
+      !!      tracer trend, otherwise the additional trend is set to 0.
+      !!      A typical value of ahbt is 2000 m2/s (equivalent to
+      !!      a downslope velocity of 20 cm/s if the condition for slope
+      !!      convection is satified)
+      !!        * advective bbl (nn_bbl_adv=1 or 2) :
+      !!      nn_bbl_adv = 1   use of the ocean velocity as bbl velocity
+      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation
+      !!        i.e. transport proportional to the along-slope density gradient
+      !!
+      !!      NB: the along slope density gradient is evaluated using the
+      !!      local density (i.e. referenced at a common local depth).
+      !!
+      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
+      !!----------------------------------------------------------------------  
+      !
+      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER         , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      !!
+      INTEGER  ::   ji, jj                    ! dummy loop indices
+      INTEGER  ::   ik                        ! local integers
+      INTEGER  ::   iis , iid , ijs , ijd     !   -       -
+      INTEGER  ::   ikus, ikud, ikvs, ikvd    !   -       -
+      REAL(wp) ::   zsign, zsigna, zgbbl      ! local scalars
+      REAL(wp) ::   zgdrho, zt, zs, zh        !   -      -
+      !!
+      REAL(wp) ::   fsalbt, fsbeta, pft, pfs, pfh   ! statement function
+      REAL(wp), POINTER, DIMENSION(:,:) :: zub, zvb, ztb, zsb, zdep
+      !!----------------------- zv_bbl-----------------------------------------------
+      ! ratio alpha/beta = fsalbt : ratio of thermal over saline expension coefficients
+      ! ================            pft :  potential temperature in degrees celcius
+      !                             pfs :  salinity anomaly (s-35) in psu
+      !                             pfh :  depth in meters
+      ! nn_eos = 0  (Jackett and McDougall 1994 formulation)
+      fsalbt( pft, pfs, pfh ) =                                              &   ! alpha/beta
+         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
+                                   - 0.203814e-03 ) * pft                    &
+                                   + 0.170907e-01 ) * pft                    &
+                                   + 0.665157e-01                            &
+         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
+         +  ( ( - 0.302285e-13 * pfh                                         &
+                - 0.251520e-11 * pfs                                         &
+                + 0.512857e-12 * pft * pft          ) * pfh                  &
+                                     - 0.164759e-06   * pfs                  &
+             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
+                                     + 0.380374e-04 ) * pfh
+      fsbeta( pft, pfs, pfh ) =                                              &   ! beta
+         ( ( -0.415613e-09 * pft + 0.555579e-07 ) * pft                      &
+                                 - 0.301985e-05 ) * pft                      &
+                                 + 0.785567e-03                              &
+         + (     0.515032e-08 * pfs                                          &
+               + 0.788212e-08 * pft - 0.356603e-06 ) * pfs                   &
+               +(  (   0.121551e-17 * pfh                                    &
+                     - 0.602281e-15 * pfs                                    &
+                     - 0.175379e-14 * pft + 0.176621e-12 ) * pfh             &
+                                          + 0.408195e-10   * pfs             &
+                 + ( - 0.213127e-11 * pft + 0.192867e-09 ) * pft             &
+                                          - 0.121555e-07 ) * pfh
+      !!----------------------------------------------------------------------
+      
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'bbl')
+      !
+      CALL wrk_alloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 
+      !
+     
+      IF( kt == kit000 )  THEN
+         IF(lwp)  WRITE(numout,*)
+         IF(lwp)  WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype
+         IF(lwp)  WRITE(numout,*) '~~~~~~~~~~'
+      ENDIF
+      
+      !                                        !* bottom temperature, salinity, velocity and depth
+#if defined key_vectopt_loop
+      DO jj = 1, 1   ! vector opt. (forced unrolling)
+         DO ji = 1, jpij
+#else
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+#endif
+            ik = mbkt_crs(ji,jj)                        ! bottom T-level index
+            ztb (ji,jj) = tsb_crs(ji,jj,ik,jp_tem) * tmask_crs(ji,jj,1)      ! bottom before T and S
+            zsb (ji,jj) = tsb_crs(ji,jj,ik,jp_sal) * tmask_crs(ji,jj,1)
+            zdep(ji,jj) = gdept_crs(ji,jj,ik)        ! bottom T-level reference depth !! 
+           
+            zub(ji,jj) = un_crs(ji,jj,mbku_crs(ji,jj))      ! bottom velocity
+            zvb(ji,jj) = vn_crs(ji,jj,mbkv_crs(ji,jj)) 
+         END DO
+      END DO
+      
+      !                                   !-------------------!
+      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   !
+         !                                !-------------------!
+         DO jj = 1, jpjm1                      ! (criteria for non zero flux: grad(rho).grad(h) < 0 )
+            DO ji = 1, jpim1              
+               !                                                ! i-direction 
+               zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )  ! T, S anomalie, and depth
+               zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+               zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+               !                                                         ! masked bbl i-gradient of density
+               zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    &
+                  &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask_crs(ji,jj,1)
+               !                                                     
+               zsign          = SIGN(  0.5, - zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope )
+               ahu_bbl_crs(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)                  ! masked diffusive flux coeff.
+               !
+               !                                                ! j-direction 
+               zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                ! T, S anomalie, and depth
+               zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0
+               zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
+               !                                                         ! masked bbl j-gradient of density
+               zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    &
+                  &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask_crs(ji,jj,1)
+               !                                                    
+               zsign          = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope )
+               ahv_bbl_crs(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj)
+               !
+            END DO
+         END DO
+         !
+      ENDIF
+
+      !                                   !-------------------!
+      IF( nn_bbl_adv /= 0 ) THEN          !   advective bbl   !
+         !                                !-------------------!
+         SELECT CASE ( nn_bbl_adv )             !* bbl transport type
+         !
+         CASE( 1 )                                   != use of upper velocity
+            DO jj = 1, jpjm1                                 ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  !                                               ! i-direction
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )                  ! T, S anomalie, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+                  !                                                           ! masked bbl i-gradient of density
+                  zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    &  
+                     &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask_crs(ji,jj,1)
+                  !                                                         
+                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )    ! sign of i-gradient * i-slope
+                  zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )    ! sign of u * i-slope
+                  !
+                  !                                                           ! bbl velocity
+                  utr_bbl_crs(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u_crs(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj)
+                  !
+                  !                                               ! j-direction
+                  zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                  ! T, S anomalie, and depth
+                  zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
+                  !                                                           ! masked bbl j-gradient of density
+                  zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    &  
+                     &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask_crs(ji,jj,1)
+                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )    ! sign of j-gradient * j-slope
+                  zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )    ! sign of u * i-slope
+                  !
+                  !                                                           ! bbl velocity
+                  vtr_bbl_crs(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v_crs(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj)
+               END DO
+            END DO
+            !
+         CASE( 2 )                                 != bbl velocity = F( delta rho )
+            zgbbl = grav * rn_gambbl
+            DO jj = 1, jpjm1                            ! criteria: rho_up > rho_down
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  !                                         ! i-direction
+                  ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf)
+                  iid  = ji + MAX( 0, mgrhu(ji,jj) )     ;    iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
+                  ikud = mbku_d(ji,jj)                   ;    ikus = mbku_crs(ji,jj)
+                  !
+                  !                                             ! mid-depth density anomalie (up-slope minus down-slope)
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )           ! mid slope depth of T, S, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+                  zgdrho =    fsbeta( zt, zs, zh )                                    &
+                     &   * (  fsalbt( zt, zs, zh ) * ( ztb(iid,jj) - ztb(iis,jj) )    &  
+                     &                             - ( zsb(iid,jj) - zsb(iis,jj) )  ) * umask_crs(ji,jj,1)
+                  zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep
+                  !
+                  !                                             ! bbl transport (down-slope direction)
+                  utr_bbl_crs(ji,jj) = e2u_crs(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) )
+                  !
+                  !                                         ! j-direction
+                  !  down-slope T-point j/k-index (deep)  &   of the up  -slope T-point j/k-index (shelf)
+                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )      ;    ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
+                  ikvd = mbkv_d(ji,jj)                    ;    ikvs = mbkv_crs(ji,jj)
+                  !
+                  !                                             ! mid-depth density anomalie (up-slope minus down-slope)
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji,jj+1) )           ! mid slope depth of T, S, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji,jj+1) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji,jj+1) )
+                  zgdrho =    fsbeta( zt, zs, zh )                                    &
+                     &   * (  fsalbt( zt, zs, zh ) * ( ztb(ji,ijd) - ztb(ji,ijs) )    &  
+                     &                             - ( zsb(ji,ijd) - zsb(ji,ijs) )  ) * vmask_crs(ji,jj,1)
+                  zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep
+                  !
+                  !                                             ! bbl transport (down-slope direction)
+                  vtr_bbl_crs(ji,jj) = e1v_crs(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) )
+               END DO
+            END DO
+         END SELECT
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'bbl')
+      !
+   END SUBROUTINE bbl_crs
+
+
+   SUBROUTINE tra_bbl_init_crs
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbl_init  ***
+      !!
+      !! ** Purpose :   Initialization for the bottom boundary layer scheme.
+      !!
+      !! ** Method  :   Read the nambbl namelist and check the parameters
+      !!              called by nemo_init at the first timestep (kit000)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj               ! dummy loop indices
+      INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integer
+      REAL(wp), POINTER, DIMENSION(:,:) :: zmbk
+      !!
+      NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_init')
+      !
+      CALL wrk_alloc( jpi, jpj, zmbk ) 
+      !
+
+      REWIND ( numnam )              !* Read Namelist nambbl : bottom boundary layer scheme
+      READ   ( numnam, nambbl )
+      !
+      l_bbl = .TRUE.                 !* flag to compute bbl coef and transport
+      !
+      IF(lwp) THEN                   !* Parameter control and print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_bbl_init_crs : bottom boundary layer initialisation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '       Namelist nambbl : set bbl parameters'
+         WRITE(numout,*) '          diffusive bbl (=1)   or not (=0)    nn_bbl_ldf = ', nn_bbl_ldf
+         WRITE(numout,*) '          advective bbl (=1/2) or not (=0)    nn_bbl_adv = ', nn_bbl_adv
+         WRITE(numout,*) '          diffusive bbl coefficient           rn_ahtbbl  = ', rn_ahtbbl, ' m2/s'
+         WRITE(numout,*) '          advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s'
+      ENDIF
+
+      !                              ! allocate trabbl arrays
+      IF( tra_bbl_alloc_crs() /= 0 )   CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' )
+     
+      IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity'
+      IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)'
+
+      IF( nn_eos /= 0 )   CALL ctl_stop ( ' bbl parameterisation requires eos = 0. We stop.' )
+
+
+      ! JMM
+      WHERE (  e1e2w_msk == 0 ) e1e2w_msk = 1
+      ! END JMM
+      !                             !* inverse of surface of T-cells
+      r1_e1e2t(:,:) = 1._wp / e1e2w_msk(:,:,1)
+      
+      !                             !* vertical index of  "deep" bottom u- and v-points
+      DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv)
+         DO ji = 1, jpim1
+            mbku_d(ji,jj) = MAX(  mbkt_crs(ji+1,jj  ) , mbkt_crs(ji,jj)  )   ! >= 1 as mbkt=1 over land
+            mbkv_d(ji,jj) = MAX(  mbkt_crs(ji  ,jj+1) , mbkt_crs(ji,jj)  )
+         END DO
+      END DO
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
+      zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+
+                                        !* sign of grad(H) at u- and v-points
+      mgrhu(jpi,:) = 0.    ;    mgrhu(:,jpj) = 0.   ;    mgrhv(jpi,:) = 0.    ;    mgrhv(:,jpj) = 0.
+      DO jj = 1, jpjm1                
+         DO ji = 1, jpim1
+            mgrhu(ji,jj) = INT(  SIGN( 1.e0, gdept_crs(ji+1,jj,mbkt_crs(ji+1,jj)) - gdept_crs(ji,jj,mbkt_crs(ji,jj)) )  ) !! cc car non vvl
+            mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_crs(ji,jj+1,mbkt_crs(ji,jj+1)) - gdept_crs(ji,jj,mbkt_crs(ji,jj)) )  )
+         END DO
+      END DO
+
+      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point 
+         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0)
+            e3u_bbl_0(ji,jj) = MIN( e3u_crs(ji,jj,mbkt_crs(ji+1,jj  )), e3u_crs(ji,jj,mbkt_crs(ji,jj)) )  
+            e3v_bbl_0(ji,jj) = MIN( e3v_crs(ji,jj,mbkt_crs(ji  ,jj+1)), e3v_crs(ji,jj,mbkt_crs(ji,jj)) )  !! cc car non vvl
+         END DO 
+      END DO
+      CALL crs_lbc_lnk( e3u_bbl_0, 'U', 1. )   ;   CALL crs_lbc_lnk( e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions
+
+      !                             !* masked diffusive flux coefficients 
+      ahu_bbl_0(:,:) = rn_ahtbbl_crs * e2u_crs(:,:) * e3u_bbl_0(:,:) / e1u_crs(:,:)  * umask_crs(:,:,1)
+      ahv_bbl_0(:,:) = rn_ahtbbl_crs * e1v_crs(:,:) * e3v_bbl_0(:,:) / e2v_crs(:,:)  * vmask_crs(:,:,1)
+
+!! cc reflexion for the coarsening
+
+!      IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : regional enhancement of ah_bbl
+         !
+!         SELECT CASE ( jp_cfg )
+!         CASE ( 2 )                          ! ORCA_R2
+!            ij0 = 102   ;   ij1 = 102              ! Gibraltar enhancement of BBL
+!            ii0 = 139   ;   ii1 = 140  
+!            ahu_bbl_0(mi0_crs(ii0):mi1_crs(ii1),mj0_crs(ij0):mj1_crs(ij1)) &
+!          & =  4.e0*ahu_bbl_0(mi0_crs(ii0):mi1_crs(ii1),mj0_crs(ij0):mj1_crs(ij1))
+!            ahv_bbl_0(mi0_crs(ii0):mi1_crs(ii1),mj0_crs(ij0):mj1_crs(ij1)) &
+!          & =  4.e0*ahv_bbl_0(mi0_crs(ii0):mi1_crs(ii1),mj0_crs(ij0):mj1_crs(ij1))
+!            !
+!            ij0 =  88   ;   ij1 =  88              ! Red Sea enhancement of BBL
+!            ii0 = 161   ;   ii1 = 162
+!            ahu_bbl_0(mi0_crs(ii0):mi1_crs(ii1),mj0_crs(ij0):mj1_crs(ij1)) &
+!          & = 10.e0*ahu_bbl_0(mi0_crs(ii0):mi1_crs(ii1),mj0_crs(ij0):mj1_crs(ij1))
+!            ahv_bbl_0(mi0_crs(ii0):mi1_crs(ii1),mj0_crs(ij0):mj1_crs(ij1)) &
+!          & = 10.e0*ahv_bbl_0(mi0_crs(ii0):mi1_crs(ii1),mj0_crs(ij0):mj1_crs(ij1))
+!            !
+!         CASE ( 4 )                          ! ORCA_R4
+!            ij0 =  52   ;   ij1 =  52              ! Gibraltar enhancement of BBL  !!cc 
+!            ii0 =  70   ;   ii1 =  71  
+!            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+!            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+!         END SELECT
+!         !
+!      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zmbk ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init')
+      !
+   END SUBROUTINE tra_bbl_init_crs
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      No bottom boundary layer scheme
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_crs = .FALSE.   !: bbl flag
+CONTAINS
+   SUBROUTINE tra_bbl_init_crs               ! Dummy routine
+   END SUBROUTINE tra_bbl_init_crs
+   SUBROUTINE tra_bbl_crs( kt )              ! Dummy routine
+      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt
+   END SUBROUTINE tra_bbl_crs
+#endif
+
+   !!======================================================================
+END MODULE trabbl_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_crs.F90	(revision 5105)
@@ -0,0 +1,336 @@
+MODULE traldf_iso_crs
+   !!======================================================================
+   !!                   ***  MODULE  traldf_iso  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!======================================================================
+   !! History :  OPA  !  1994-08  (G. Madec, M. Imbard)
+   !!            8.0  !  1997-05  (G. Madec)  split into traldf and trazdf
+   !!            NEMO !  2002-08  (G. Madec)  Free form, F90
+   !!            1.0  !  2005-11  (G. Madec)  merge traldf and trazdf :-)
+   !!            3.3  !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!----------------------------------------------------------------------
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'               slope of the lateral diffusive direction
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_iso  : update the tracer trend with the horizontal 
+   !!                  component of a iso-neutral laplacian operator
+   !!                  and with the vertical part of
+   !!                  the isopycnal or geopotential s-coord. operator 
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE zdf_oce         ! ocean vertical physics
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+ !  USE ldfslp          ! iso-neutral slopes
+   USE ldfslp_crs          ! iso-neutral slopes
+   USE diaptr          ! poleward transport diagnostics
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+#if defined key_diaar5
+   USE phycst          ! physical constants
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+#endif
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_iso_crs   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: traldf_iso.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_ldf_iso_crs( kt, kit000, cdtype, pgu, pgv,              &
+      &                                ptb, pta, kjpt, pahtb0 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_iso  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and 
+      !!      add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The horizontal component of the lateral diffusive trends 
+      !!      is provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      1st part :  masked horizontal derivative of T  ( di[ t ] )
+      !!      ========    with partial cell update if ln_zps=T.
+      !!
+      !!      2nd part :  horizontal fluxes of the lateral mixing operator
+      !!      ========    
+      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
+      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
+      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
+      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
+      !!      Add this trend to the general trend (ta,sa):
+      !!         ta = ta + difft
+      !!
+      !!      3rd part: vertical trends of the lateral mixing operator
+      !!      ========  (excluding the vertical flux proportional to dk[t] )
+      !!      vertical fluxes associated with the rotated lateral mixing:
+      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(tb)) ]
+      !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  }
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
+      !!      Add this trend to the general trend (ta,sa):
+      !!         pta = pta + difft
+      !!
+      !! ** Action :   Update pta arrays with the before rotated diffusion
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zftu => ua       , zftv  => va         ! (ua,va) used as workspace
+      !
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars
+      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
+      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      -
+#if defined key_diaar5
+      REAL(wp)                         ::   zztmp               ! local scalar
+#endif
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zdkt, zdk1t, z2d
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdit, zdjt, ztfw 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso')
+      !
+      CALL wrk_alloc( jpi, jpj,      zdkt, zdk1t, z2d ) 
+      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
+      !
+
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !                                               
+         !!----------------------------------------------------------------------
+         !!   I - masked horizontal derivative 
+         !!----------------------------------------------------------------------
+         !!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient....
+         zdit (1,:,:) = 0.e0     ;     zdit (jpi,:,:) = 0.e0
+         zdjt (1,:,:) = 0.e0     ;     zdjt (jpi,:,:) = 0.e0
+         !!end
+
+         ! Horizontal tracer gradient 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask_crs(ji,jj,jk)
+                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask_crs(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+    !    WRITE(numout,*) ' test1 ', zdit
+!cc commenté pour le test concluant de TMP16 --> pgu mauvais, correction dans
+!zpshde_crs ( probleme de signe lorsque ze3wu negatif, de mem pour pgv)
+         IF( ln_zps ) THEN      ! partial steps correction at the last ocean level 
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,mbku_crs(ji,jj)) = pgu(ji,jj,jn)          
+                  zdjt(ji,jj,mbkv_crs(ji,jj)) = pgv(ji,jj,jn)      
+               END DO
+            END DO
+         ENDIF
+!cc
+     !   WRITE(numout,*) ' test2 ', zdit
+
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+!CDIR PARALLEL DO PRIVATE( zdk1t ) 
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            ! 1. Vertical tracer gradient at level jk and jk+1
+            ! ------------------------------------------------
+            ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask_crs(:,:,jk+1)
+            !
+            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)
+            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask_crs(:,:,jk)
+            ENDIF
+
+            ! 2. Horizontal fluxes
+            ! --------------------   
+            DO jj = 1 , jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+   !               zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2e3u_msk(ji,jj,jk) / e1u_crs(ji,jj)
+  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2e3u_msk(ji,jj,jk) / e1u_crs(ji,jj)
+ !               zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1e3v_msk(ji,jj,jk) / e2v_crs(ji,jj)
+zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1e3v_msk(ji,jj,jk) / e2v_crs(ji,jj)
+
+                  zmsku = 1. / MAX(  tmask_crs(ji+1,jj,jk  ) + tmask_crs(ji,jj,jk+1)   &
+                     &             + tmask_crs(ji+1,jj,jk+1) + tmask_crs(ji,jj,jk  ), 1. )
+                  !
+                  zmskv = 1. / MAX(  tmask_crs(ji,jj+1,jk  ) + tmask_crs(ji,jj,jk+1)   &
+                     &             + tmask_crs(ji,jj+1,jk+1) + tmask_crs(ji,jj,jk  ), 1. )
+                  !
+    !              zcof1 = - fsahtu(ji,jj,jk) * e2e3u_msk(ji,jj,jk) * uslp_crs(ji,jj,jk) * zmsku / MAX( 1._wp , e3u_max_crs(ji,jj,jk)) vue avec Gurvan OK
+                zcof1 = - fsahtu(ji,jj,jk) * e2e3u_msk(ji,jj,jk) * uslp_crs(ji,jj,jk) * zmsku / MAX( 1._wp , e3u_max_crs(ji,jj,jk))
+  !                zcof2 = - fsahtv(ji,jj,jk) * e1e3v_msk(ji,jj,jk) * vslp_crs(ji,jj,jk) * zmskv / MAX( 1._wp , e3v_max_crs(ji,jj,jk))  vue avec Gurvan OK
+                zcof2 = - fsahtv(ji,jj,jk) * e1e3v_msk(ji,jj,jk) * vslp_crs(ji,jj,jk) * zmskv / MAX( 1._wp , e3v_max_crs(ji,jj,jk))
+           !        zcof1 = - fsahtu(ji,jj,jk) * e2u_crs(ji,jj) * uslp(ji,jj,jk) * zmsku
+           !        zcof2 = - fsahtv(ji,jj,jk) * e1v_crs(ji,jj) * vslp(ji,jj,jk) * zmskv  
+                  !
+                  zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk)   &
+                     &              + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
+                     &                         + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask_crs(ji,jj,jk)
+                  zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
+                     &              + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
+                     &                         + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask_crs(ji,jj,jk)                  
+               END DO
+            END DO
+
+            ! II.4 Second derivative (divergence) and add to the general trend
+            ! ----------------------------------------------------------------
+            DO jj = 2 , jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = r1_bt_crs(ji,jj,jk)
+                  ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+
+               END DO
+            END DO
+            !                                          ! ===============
+         END DO                                        !   End of slab  
+         !                                             ! ===============
+         !
+         ! "Poleward" diffusive heat or salt transports (T-S case only)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+            IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) )
+            IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) )
+         ENDIF
+ 
+#if defined key_diaar5
+         IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
+            z2d(:,:) = 0._wp 
+            zztmp = rau0 * rcp 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            z2d(:,:) = zztmp * z2d(:,:)
+            CALL crs_lbc_lnk( z2d, 'U', -1. )
+         !   CALL crs_iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
+            z2d(:,:) = 0._wp 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            z2d(:,:) = zztmp * z2d(:,:)
+            CALL crs_lbc_lnk( z2d, 'V', -1. )
+            ! CALL crs_iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
+         END IF
+#endif
+
+         !!----------------------------------------------------------------------
+         !!   III - vertical trend of T & S (extra diagonal terms only)
+         !!----------------------------------------------------------------------
+         
+         ! Local constant initialization
+         ! -----------------------------
+         ztfw(1,:,:) = 0.e0     ;     ztfw(jpi,:,:) = 0.e0
+         
+         ! Vertical fluxes
+         ! ---------------
+         
+         ! Surface and bottom vertical fluxes set to zero
+         ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0
+         
+         ! interior (2=<jk=<jpk-1)
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zcoef0 = - fsahtw(ji,jj,jk) * tmask_crs(ji,jj,jk)
+                  !
+                  zmsku = 1./MAX(   umask_crs(ji  ,jj,jk-1) + umask_crs(ji-1,jj,jk)      &
+                     &            + umask_crs(ji-1,jj,jk-1) + umask_crs(ji  ,jj,jk), 1.  )
+                  zmskv = 1./MAX(   vmask_crs(ji,jj  ,jk-1) + vmask_crs(ji,jj-1,jk)      &
+                     &            + vmask_crs(ji,jj-1,jk-1) + vmask_crs(ji,jj  ,jk), 1.  )
+                  !
+                  zcoef3 = zcoef0 * e1e2w_crs(ji,jj,jk) * zmsku * wslpi_crs(ji,jj,jk) / e1t_crs(ji,jj)
+                  zcoef4 = zcoef0 * e1e2w_crs(ji,jj,jk) * zmskv * wslpj_crs(ji,jj,jk) / e2t_crs(ji,jj)
+           !       zcoef3 = zcoef0 * e2t_crs(ji,jj) * zmsku * wslpi (ji,jj,jk)
+           !       zcoef4 = zcoef0 * e1t_crs(ji,jj) * zmskv * wslpj (ji,jj,jk)
+                  ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
+                     &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   &
+                     &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      &
+                     &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  )
+               END DO
+            END DO
+         END DO
+         
+         
+         ! I.5 Divergence of vertical fluxes added to the general tracer trend
+         ! -------------------------------------------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = r1_bt_crs(ji,jj,jk)
+                  ztra = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+
+               END DO
+            END DO
+         END DO
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso')
+      !
+   END SUBROUTINE tra_ldf_iso_crs
+
+#else
+   !!----------------------------------------------------------------------
+   !!   default option :   Dummy code   NO rotation of the diffusive tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_ldf_iso_crs( kt, kit000,cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 )      ! Empty routine
+      INTEGER:: kt, kit000
+      CHARACTER(len=3) ::   cdtype
+      REAL, DIMENSION(:,:,:) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
+      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, kit000, cdtype,   &
+         &                       pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0
+   END SUBROUTINE tra_ldf_iso_crs
+#endif
+
+   !!==============================================================================
+END MODULE traldf_iso_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_crs.F90	(revision 5105)
@@ -0,0 +1,164 @@
+MODULE traldf_lap_crs
+   !!==============================================================================
+   !!                       ***  MODULE  traldf_lap  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+   !! History :  OPA  !  87-06  (P. Andrich, D. L Hostis)  Original code
+   !!                 !  91-11  (G. Madec)
+   !!                 !  95-11  (G. Madec)  suppress volumetric scale factors
+   !!                 !  96-01  (G. Madec)  statement function for e3
+   !!            NEMO !  02-06  (G. Madec)  F90: Free form and module
+   !!            1.0  !  04-08  (C. Talandier) New trends organization
+   !!                 !  05-11  (G. Madec)  add zps case
+   !!            3.0  !  10-06  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_lap  : update the tracer trend with the horizontal diffusion
+   !!                 using a iso-level harmonic (laplacien) operator.
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce , ONLY : lk_vvl, ln_zps         ! ocean space and time domain
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE in_out_manager  ! I/O manager
+   USE diaptr          ! poleward transport diagnostics
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE lib_mpp         ! MPP library
+   USE timing          ! Timing
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_lap_crs   ! routine called by step.F90
+
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   e1ur, e2vr   ! scale factor coefficients
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: traldf_lap.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_ldf_lap_crs( kt, kit000, cdtype, pgu, pgv,      &
+      &                                ptb, pta, kjpt ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_lap  ***
+      !!                   
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   Second order diffusive operator evaluated using before
+      !!      fields (forward time scheme). The horizontal diffusive trends of 
+      !!      the tracer is given by:
+      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ]
+      !!                                   + dj-1[ aht e1v*e3v/e2v dj(tb) ] }
+      !!      Add this trend to the general tracer trend pta :
+      !!          pta = pta + difft
+      !!
+      !! ** Action  : - Update pta arrays with the before iso-level 
+      !!                harmonic mixing trend.
+      !!----------------------------------------------------------------------
+      USE oce, ONLY:   ztu => ua , ztv => va  ! (ua,va) used as workspace
+      !
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
+      INTEGER  ::   iku, ikv, ierr       ! local integers
+      REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      CALL timing_start('tra_ldf_lap')
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+         !
+         IF( .NOT. ALLOCATED( e1ur ) ) THEN
+            ! This routine may be called for both active and passive tracers. 
+            ! Allocate and set saved arrays on first call only.
+            ALLOCATE( e1ur(jpi,jpj), e2vr(jpi,jpj), STAT=ierr )
+            IF( lk_mpp    )   CALL mpp_sum( ierr )
+            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'tra_ldf_lap : unable to allocate arrays' )
+            !
+            e1ur(:,:) = 1._wp / e1u_crs(:,:)             !!cc
+            e2vr(:,:) = 1._wp / e2v_crs(:,:)             !!cc
+         ENDIF
+      ENDIF
+
+      !                                                          ! =========== !
+      DO jn = 1, kjpt                                            ! tracer loop !
+         !                                                       ! =========== !    
+         DO jk = 1, jpkm1                                            ! slab loop
+            !                                           
+            ! 1. First derivative (gradient)
+            ! -------------------
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+       !           zabe1 = fsahtu(ji,jj,jk) * umask_crs(ji,jj,jk) * e1ur(ji,jj) * e2e3u_msk(ji,jj,jk)
+       !           zabe2 = fsahtv(ji,jj,jk) * vmask_crs(ji,jj,jk) * e2vr(ji,jj) * e1e3v_msk(ji,jj,jk)
+                   zabe1 = fsahtu(ji,jj,jk) * umask_crs(ji,jj,jk) * e1ur(ji,jj) * e2e3u_msk(ji,jj,jk)
+                   zabe2 = fsahtv(ji,jj,jk) * vmask_crs(ji,jj,jk) * e2vr(ji,jj) * e1e3v_msk(ji,jj,jk)
+                  ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zabe2 * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+            END DO
+
+           IF( ln_zps ) THEN      ! set gradient at partial step level
+              DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     ! last level
+                     iku = mbku_crs(ji,jj)
+                     ikv = mbkv_crs(ji,jj)
+                     IF( iku == jk ) THEN
+                        zabe1 = fsahtu(ji,jj,iku) * umask_crs(ji,jj,iku) * e1ur(ji,jj) * e3u_crs(ji,jj,iku)
+                        ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn)
+                     ENDIF
+                     IF( ikv == jk ) THEN
+                        zabe2 = fsahtv(ji,jj,ikv) * vmask_crs(ji,jj,ikv) * e2vr(ji,jj) * e3v_crs(ji,jj,ikv)
+                        ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn)
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
+         
+         
+            ! 2. Second derivative (divergence) added to the general tracer trends
+            ! ---------------------------------------------------------------------
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = r1_bt_crs(ji,jj,jk) 
+                  ! horizontal diffusive trends added to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
+                     &                                          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
+               END DO
+            END DO
+            !
+         END DO                                             !  End of slab  
+         !
+         ! "Poleward" diffusive heat or salt transports
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+            IF( jn  == jp_tem)   htr_ldf(:) = ptr_vj( ztv(:,:,:) )
+            IF( jn  == jp_sal)   str_ldf(:) = ptr_vj( ztv(:,:,:) )
+         ENDIF
+         !                                                  ! ==================
+      END DO                                                ! end of tracer loop
+      !                                                     ! ==================
+      CALL timing_stop('tra_ldf_lap')
+      !
+   END SUBROUTINE tra_ldf_lap_crs
+
+   !!==============================================================================
+END MODULE traldf_lap_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp_crs.F90	(revision 5105)
@@ -0,0 +1,277 @@
+MODULE trazdf_imp_crs
+   !!======================================================================
+   !!                 ***  MODULE  trazdf_imp  ***
+   !! Ocean  tracers:  vertical component of the tracer mixing trend
+   !!======================================================================
+   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
+   !!            7.0  !  1991-11  (G. Madec)
+   !!                 !  1992-06  (M. Imbard) correction on tracer trend loops
+   !!                 !  1996-01  (G. Madec) statement function for e3
+   !!                 !  1997-05  (G. Madec) vertical component of isopycnal
+   !!                 !  1997-07  (G. Madec) geopotential diffusion in s-coord
+   !!                 !  2000-08  (G. Madec) double diffusive mixing
+   !!   NEMO     1.0  !  2002-08  (G. Madec) F90: Free form and module
+   !!            2.0  !  2006-11  (G. Madec) New step reorganisation
+   !!            3.2  !  2009-03  (G. Madec)  heat and salt content trends
+   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!             -   !  2011-02  (A. Coward, C. Ethe, G. Madec) improvment of surface boundary condition
+   !!----------------------------------------------------------------------
+  
+   !!----------------------------------------------------------------------
+   !!   tra_zdf_imp : Update the tracer trend with the diagonal vertical  
+   !!                 part of the mixing tensor.
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+  ! USE dom_oce, ONLY : lk_vvl        ! ocean space and time domain variables 
+  ! USE dom_oce,         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE trc_oce         ! share passive tracers/ocean variables
+   USE domvvl          ! variable volume
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldftra          ! lateral mixing type
+   USE ldfslp_crs          ! lateral physics: slope of diffusion
+   USE zdfddm          ! ocean vertical physics: double diffusion
+   USE traldf_iso_grif ! active tracers: Griffies operator
+   USE in_out_manager  ! I/O manager
+   USE crslbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_zdf_imp_crs   !  routine called by step.F90
+
+   REAL(wp) ::  r_vvl     ! variable volume indicator, =1 if lk_vvl=T, =0 otherwise 
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: trazdf_imp.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+ 
+   SUBROUTINE tra_zdf_imp_crs( kt, kit000, cdtype, p2dt, ptb, pta, kjpt ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_zdf_imp  ***
+      !!
+      !! ** Purpose :   Compute the after tracer through a implicit computation
+      !!     of the vertical tracer diffusion (including the vertical component 
+      !!     of lateral mixing (only for 2nd order operator, for fourth order 
+      !!     it is already computed and add to the general trend in traldf) 
+      !!
+      !! ** Method  :  The vertical diffusion of the tracer t  is given by:
+      !!                  difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
+      !!      It is computed using a backward time scheme (t=ta).
+      !!      If lk_zdfddm=T, use avs for salinity or for passive tracers
+      !!      Surface and bottom boundary conditions: no diffusive flux on
+      !!      both tracers (bottom, applied through the masked field avt).
+      !!      If iso-neutral mixing, add to avt the contribution due to lateral mixing.
+      !!
+      !! ** Action  : - pta  becomes the after tracer
+      !!---------------------------------------------------------------------
+      USE oce     , ONLY:   zwd => ua       , zws => va         ! (ua,va) used as 3D workspace
+      !
+      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::  zrhs, ze3tb, ze3tn, ze3ta   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt
+      !!---------------------------------------------------------------------
+      !
+!WRITE(numout,*) 'test6456_trb_sbc1', pta(:,:,:,1), kt
+      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwt ) 
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype
+         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ '
+         !
+         IF( lk_vvl ) THEN   ;    r_vvl = 1._wp       ! Variable volume indicator
+         ELSE                ;    r_vvl = 0._wp       
+         ENDIF
+      ENDIF
+      !
+      !                                               ! ============= !
+      DO jn = 1, kjpt                                 !  tracer loop  !
+         !                                            ! ============= !
+         !
+         !  Matrix construction
+         ! --------------------
+         ! Build matrix if temperature or salinity (only in double diffusion case) or first passive tracer
+         !
+         IF(  ( cdtype == 'TRA' .AND. ( jn == jp_tem .OR. ( jn == jp_sal .AND. lk_zdfddm ) ) ) .OR.   &
+            & ( cdtype == 'TRC' .AND. jn == 1 )  )  THEN
+            !
+            ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers
+            IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN   ;   zwt(:,:,2:jpk) = avt  (:,:,2:jpk)
+#if defined key_zdfddm
+            ELSE                                            ;   zwt(:,:,2:jpk) = avs_crs(:,:,2:jpk)
+#endif
+            ENDIF
+            zwt(:,:,1) = 0._wp
+
+            !
+#if defined key_ldfslp
+            ! isoneutral diffusion: add the contribution 
+            IF( ln_traldf_grif    ) THEN     ! Griffies isoneutral diff
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 
+    !                    WRITE(numout,*) 'ah_wslp2', ah_wslp2(ji,jj,jk)      
+                     END DO
+                  END DO
+               END DO
+            ELSE IF( l_traldf_rot ) THEN     ! standard isoneutral diff
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk)                       &
+                           &                          * (  wslpi_crs(ji,jj,jk) * wslpi_crs(ji,jj,jk)   &
+                           &                             + wslpj_crs(ji,jj,jk) * wslpj_crs(ji,jj,jk)  )
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+
+#endif
+!WRITE(numout,*) 'test6456_trb_sbc2', pta(:,:,:,1), kt
+            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked)
+! WRITE(numout,*) 'wslpi_crs', wslpi_crs(:,:,:)
+! WRITE(numout,*) 'wslpj_crs(ji,jj,jk-1)',wslpj_crs(:,:,:)
+! WRITE(numout,*) ' fsahtw',  fsahtw(:,:,:)
+ !WRITE(numout,*) 'ah_wslp2', ah_wslp2(:,:,:) 
+! WRITE(numout,*) 'zwt2(ji,jj,jk-1)', zwt(:,:,:) 
+
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+              !        ze3ta =  ( 1. - r_vvl ) +        r_vvl   * ocean_volume_crs_t(ji,jj,jk)   ! after scale factor at T-point
+             !         ze3tn =         r_vvl   + ( 1. - r_vvl ) * ocean_volume_crs_t(ji,jj,jk)   ! now   scale factor at T-point
+                     ze3ta =  ( 1. - r_vvl ) +        r_vvl   * e3t_crs(ji,jj,jk)   ! after scale factor at T-point
+                     ze3tn =         r_vvl   + ( 1. - r_vvl ) * e3t_crs(ji,jj,jk)   ! now   scale factor at T-point
+                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * e3w_1d(jk  ) )  !cc
+                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * e3w_1d(jk+1) )  !cc
+                     zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk)
+      !               WRITE(numout,*) 'ze3tn', ze3tn
+      !               WRITE(numout,*) 'e3w_0', e3w_0(jk)
+      !               WRITE(numout,*) 'ze3ta', ze3ta
+      !               WRITE(numout,*) 'zwt3(ji,jj,jk-1)', zwt(ji,jj,jk)
+                 END DO
+               END DO
+            END DO
+  ! WRITE(numout,*) 'zwi(ji,jj,jk-1)', zwi(:,:,:)
+  ! WRITE(numout,*) 'zws(ji,jj,jk-1)', zws(:,:,:)
+  ! WRITE(numout,*) 'zwd(ji,jj,jk-1)', zwd(:,:,:) 
+            !
+            !! Matrix inversion from the first level
+            !!----------------------------------------------------------------------
+            !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+            !
+            !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+            !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+            !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+            !        (        ...               )( ...  ) ( ...  )
+            !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+            !
+            !   m is decomposed in the product of an upper and lower triangular matrix.
+            !   The 3 diagonal terms are in 3d arrays: zwd, zws, zwi.
+            !   Suffices i,s and d indicate "inferior" (below diagonal), diagonal
+            !   and "superior" (above diagonal) components of the tridiagonal system.
+            !   The solution will be in the 4d array pta.
+            !   The 3d array zwt is used as a work space array.
+            !   En route to the solution pta is used a to evaluate the rhs and then 
+            !   used as a work space array: its value is modified.
+            !
+            ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
+            ! done once for all passive tracers (so included in the IF instruction)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zwt(ji,jj,1) = zwd(ji,jj,1)
+               END DO
+            END DO
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                    zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
+                  END DO
+               END DO
+            END DO
+            !
+         END IF
+! WRITE(numout,*) 'zwt4(ji,jj,jk-1)', zwt(:,:,:) 
+         !    
+!WRITE(numout,*) 'test6456_trb_sbc4', pta(:,:,:,1), kt     
+         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+           !     ze3tb = ( 1. - r_vvl ) + r_vvl * ocean_volume_crs_t(ji,jj,1)
+           !     ze3tn = ( 1. - r_vvl ) + r_vvl * ocean_volume_crs_t(ji,jj,1)
+               ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,1)
+               ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,1)
+               pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn)
+!WRITE(numout,*) 'test6456_trb_sbc4', pta(:,:,:,1), kt 
+            END DO
+         END DO
+
+!WRITE(numout,*) 'kt', kt 
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+           !        ze3tb = ( 1. - r_vvl ) + r_vvl * ocean_volume_crs_t(ji,jj,jk)
+           !        ze3tn = ( 1. - r_vvl ) + r_vvl * ocean_volume_crs_t(ji,jj,jk)
+                  ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,jk)
+                  ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,jk)
+                  zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn)   ! zrhs=right hand side 
+                  pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn)
+                
+               END DO
+            END DO
+         END DO
+
+!WRITE(numout,*) 'test6456_trb_sbc5', pta(:,:,:,1), kt
+         ! third recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask_crs(ji,jj,jpkm1)
+            END DO
+         END DO
+         DO jk = jpk-2, 1, -1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) )   &
+                     &             / zwt(ji,jj,jk) * tmask_crs(ji,jj,jk)
+                 
+               END DO
+            END DO
+         END DO
+
+         !                                            ! ================= !
+      END DO                                          !  end tracer loop  !
+      !                                               ! ================= !
+      !
+!WRITE(numout,*) 'test6456_trb_sbc6', pta(:,:,:,1), kt
+      CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwt ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_imp_crs')
+      !
+   END SUBROUTINE tra_zdf_imp_crs
+
+   !!==============================================================================
+END MODULE trazdf_imp_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde_crs.F90	(revision 5105)
@@ -0,0 +1,244 @@
+MODULE zpshde_crs
+   !!======================================================================
+   !!                       ***  MODULE zpshde   ***
+   !! z-coordinate + partial step : Horizontal Derivative at ocean bottom level
+   !!======================================================================
+   !! History :  OPA  !  2002-04  (A. Bozec)  Original code
+   !!   NEMO     1.0  !  2002-08  (G. Madec E. Durand)  Optimization and Free form
+   !!             -   !  2004-03  (C. Ethe)  adapted for passive tracers
+   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!======================================================================
+   
+   !!----------------------------------------------------------------------
+   !!   zps_hde      :  Horizontal DErivative of T, S and rd at the last
+   !!                   ocean level (Z-coord. with Partial Steps)
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean: dynamics and tracers variables
+   USE dom_oce         ! domain: ocean variables
+   USE phycst          ! physical constants
+   USE eosbn2_crs          ! ocean equation of state
+   USE in_out_manager  ! I/O manager
+   USE crslbclnk          ! lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+   USE crs
+   
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zps_hde_crs    ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: zpshde.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE zps_hde_crs( kt, kjpt, pta, pgtu, pgtv,   &
+                                 prd, pgru, pgrv    )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE zps_hde  ***
+      !!                    
+      !! ** Purpose :   Compute the horizontal derivative of T, S and rho
+      !!      at u- and v-points with a linear interpolation for z-coordinate
+      !!      with partial steps.
+      !!
+      !! ** Method  :   In z-coord with partial steps, scale factors on last 
+      !!      levels are different for each grid point, so that T, S and rd 
+      !!      points are not at the same depth as in z-coord. To have horizontal
+      !!      gradients again, we interpolate T and S at the good depth : 
+      !!      Linear interpolation of T, S   
+      !!         Computation of di(tb) and dj(tb) by vertical interpolation:
+      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~
+      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~
+      !!         This formulation computes the two cases:
+      !!                 CASE 1                   CASE 2  
+      !!         k-1  ___ ___________   k-1   ___ ___________
+      !!                    Ti  T~                  T~  Ti+1
+      !!                  _____                        _____
+      !!         k        |   |Ti+1     k           Ti |   |
+      !!                  |   |____                ____|   |
+      !!              ___ |   |   |           ___  |   |   |
+      !!                  
+      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
+      !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1)
+      !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  )
+      !!          or
+      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
+      !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i )
+      !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) )
+      !!          Idem for di(s) and dj(s)          
+      !!
+      !!      For rho, we call eos_insitu_2d which will compute rd~(t~,s~) at 
+      !!      the good depth zh from interpolated T and S for the different
+      !!      formulation of the equation of state (eos).
+      !!      Gradient formulation for rho :
+      !!          di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~
+      !!
+      !! ** Action  : - pgtu, pgtv: horizontal gradient of tracer at u- & v-points
+      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 
+      !!----------------------------------------------------------------------
+      !
+      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index
+      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad. of prd at u- & v-pts 
+      !
+      INTEGER  ::   ji, jj, jn      ! Dummy loop indices
+      INTEGER  ::   iku, ikv, ikum1, ikvm1   ! partial step level (ocean bottom level) at u- and v-points
+      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars
+  !cc    REAL(wp), POINTER, DIMENSION(:,:  ) ::  zri, zrj, zhi, zhj
+  !cc    REAL(wp), POINTER, DIMENSION(:,:,:) ::  zti, zte    ! interpolated value of tracer
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) ::  zri, zrj, zhi, zhj
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  zti, zte    ! interpolated value of tracer
+
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde')
+      !
+!!      CALL wrk_alloc( jpi, jpj,       zri, zrj, zhi, zhj ) 
+!!      CALL wrk_alloc( jpi, jpj, kjpt, zti, zte           ) 
+      ALLOCATE( zri(jpi_crs,jpj_crs) , zrj(jpi_crs,jpj_crs), zte(jpi_crs ,jpj_crs ,kjpt), &
+         &      zhi(jpi_crs,jpj_crs) , zhj(jpi_crs,jpj_crs), zti(jpi_crs ,jpj_crs ,kjpt))
+      !
+      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
+         !
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               iku = mbku_crs(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
+               ikv = mbkv_crs(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
+          !     ze3wu = e3w_crs(ji+1,jj  ,iku) - e3w_crs(ji,jj,iku)
+          !     ze3wv = e3w_crs(ji  ,jj+1,ikv) - e3w_crs(ji,jj,ikv)
+               ze3wu = e3w_max_crs(ji+1,jj  ,iku) - e3w_max_crs(ji,jj,iku)
+               ze3wv = e3w_max_crs(ji  ,jj+1,ikv) - e3w_max_crs(ji,jj,ikv)
+               !
+               ! i- direction
+               IF( ze3wu >= 0._wp ) THEN      ! case 1
+                  !cbr zmaxu =  ze3wu / e3w_max_crs(ji+1,jj,iku)  
+                  zmaxu =  ze3wu
+                  IF( e3w_max_crs(ji+1,jj,iku) .NE. 0._wp ) zmaxu = zmaxu / e3w_max_crs(ji+1,jj,iku)
+                 !    zmaxu =  ze3wu / e3w_crs(ji+1,jj,iku)
+                  ! interpolated values of tracers
+                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+                  ! gradient of  tracers
+                  pgtu(ji,jj,jn) = umask_crs(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+               ELSE                           ! case 2
+                  !cbr zmaxu = -ze3wu / e3w_max_crs(ji,jj,iku)
+                  zmaxu =  -ze3wu
+                  IF( e3w_max_crs(ji,jj,iku) .NE. 0._wp ) zmaxu = zmaxu / e3w_max_crs(ji,jj,iku)
+                 !    zmaxu = -ze3wu / e3w_crs(ji,jj,iku)
+                  ! interpolated values of tracers
+                  zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
+                  ! gradient of tracers
+                  pgtu(ji,jj,jn) = umask_crs(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+               ENDIF
+               !
+               ! j- direction
+               IF( ze3wv >= 0._wp ) THEN      ! case 1
+                  !cbr zmaxv =  ze3wv / e3w_max_crs(ji,jj+1,ikv)
+                  zmaxv =  ze3wv
+                  IF( e3w_max_crs(ji,jj+1,ikv) .NE. 0._wp ) zmaxv =  zmaxv / e3w_max_crs(ji,jj+1,ikv)
+               !      zmaxv =  ze3wv / e3w_crs(ji,jj+1,ikv)
+                  ! interpolated values of tracers
+                  zte(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = vmask_crs(ji,jj,1) * ( zte(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+               ELSE                           ! case 2
+                  !cbr zmaxv =  -ze3wv / e3w_max_crs(ji,jj,ikv)
+                  zmaxv =  -ze3wv
+                  IF( e3w_max_crs(ji,jj,ikv) .NE. 0._wp )zmaxv = zmaxv / e3w_max_crs(ji,jj,ikv)
+                !     zmaxv = -ze3wv / e3w_crs(ji,jj,ikv)
+                  ! interpolated values of tracers
+                  zte(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = vmask_crs(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - zte(ji,jj,jn) )
+               ENDIF
+
+# if ! defined key_vectopt_loop
+            END DO
+# endif
+         END DO
+         CALL crs_lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL crs_lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
+         !
+      END DO
+!WRITE(numout,*) ' test24 ', e3w_max_crs
+      ! horizontal derivative of density anomalies (rd)
+      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               iku = mbku_crs(ji,jj)
+               ikv = mbkv_crs(ji,jj)
+   !cc             ze3wu  = e3w_max_crs(ji+1,jj  ,iku) - e3w_max_crs(ji,jj,iku)   !gradiant horizontal pas de max
+               ze3wu  = e3w_crs(ji+1,jj  ,iku) - e3w_crs(ji,jj,iku)
+       !cc        ze3wv  = e3w_max_crs(ji  ,jj+1,ikv) - e3w_max_crs(ji,jj,ikv)
+               ze3wv  = e3w_crs(ji  ,jj+1,ikv) - e3w_crs(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_crs(ji  ,jj,iku)     ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = gdept_crs(ji+1,jj,iku)     ! -     -      case 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_crs(ji,jj  ,ikv)     ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = gdept_crs(ji,jj+1,ikv)     ! -     -      case 2
+               ENDIF
+# if ! defined key_vectopt_loop
+            END DO
+# endif
+         END DO
+         CALL eos_crs( zti, zhi, zri )  
+         CALL eos_crs( zte, zhj, zrj )
+         ! Gradient of density at the last level 
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               iku = mbku_crs(ji,jj)
+               ikv = mbkv_crs(ji,jj)
+      !         ze3wu  = e3w_max_crs(ji+1,jj  ,iku) - e3w_max_crs(ji,jj,iku)         gradient horizontal
+                ze3wu  = e3w_crs(ji+1,jj  ,iku) - e3w_crs(ji,jj,iku)
+      !         ze3wv  = e3w_max_crs(ji  ,jj+1,ikv) - e3w_max_crs(ji,jj,ikv)         gradient horizontal
+                ze3wv  = e3w_crs(ji  ,jj+1,ikv) - e3w_crs(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask_crs(ji,jj,1) * ( zri(ji  ,jj) - prd(ji,jj,iku) )   ! i: 1
+               ELSE                        ;   pgru(ji,jj) = umask_crs(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) )   ! i: 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask_crs(ji,jj,1) * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )   ! j: 1
+               ELSE                        ;   pgrv(ji,jj) = vmask_crs(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )   ! j: 2
+               ENDIF
+# if ! defined key_vectopt_loop
+            END DO
+# endif
+         END DO
+
+
+         CALL crs_lbc_lnk( pgru , 'U', -1. )   ;   CALL crs_lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions
+         !
+      END IF
+      !
+      !!ccCALL wrk_dealloc( jpi, jpj,       zri, zrj, zhi, zhj ) 
+      !!ccCALL wrk_dealloc( jpi, jpj, kjpt, zti, zte           ) 
+      DEALLOCATE( zri , zrj, zte, zhi, zhj, zti)
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde')
+      !
+   END SUBROUTINE zps_hde_crs
+
+   !!======================================================================
+END MODULE zpshde_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl_crs.F90	(revision 5105)
@@ -0,0 +1,134 @@
+MODULE zdfmxl_crs
+   !!======================================================================
+   !!                       ***  MODULE  zdfmxl  ***
+   !! Ocean physics: mixed layer depth 
+   !!======================================================================
+   !! History :  1.0  ! 2003-08  (G. Madec)  original code
+   !!            3.2  ! 2009-07  (S. Masson, G. Madec)  IOM + merge of DO-loop
+   !!----------------------------------------------------------------------
+   !!   zdf_mxl      : Compute the turbocline and mixed layer depths.
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE iom             ! I/O library
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE trc_oce, ONLY : lk_offline ! offline flag
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_mxl_crs       ! called by step.F90
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: mixed layer depth at t-points        [m]
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: zdfmxl.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_mxl_alloc_crs()
+      !!----------------------------------------------------------------------
+      !!               ***  FUNCTION zdf_mxl_alloc  ***
+      !!----------------------------------------------------------------------
+      zdf_mxl_alloc_crs = 0      ! set to zero if no array to be allocated
+      IF( .NOT. ALLOCATED( nmln_crs ) ) THEN
+         ALLOCATE( nmln_crs(jpi_crs,jpj_crs), hmld_crs(jpi_crs,jpj_crs), hmlp_crs(jpi_crs,jpj_crs) & !! declaration in crs.F90
+         &       , hmlpt_crs(jpi_crs,jpj_crs), STAT= zdf_mxl_alloc_crs )
+         !
+         IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc_crs )
+         IF( zdf_mxl_alloc_crs /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.')
+         !
+      ENDIF
+   END FUNCTION zdf_mxl_alloc_crs
+
+
+   SUBROUTINE zdf_mxl_crs( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdfmxl  ***
+      !!                   
+      !! ** Purpose :   Compute the turbocline depth and the mixed layer depth
+      !!              with density criteria.
+      !!
+      !! ** Method  :   The mixed layer depth is the shallowest W depth with 
+      !!      the density of the corresponding T point (just bellow) bellow a
+      !!      given value defined locally as rho(10m) + zrho_c
+      !!               The turbocline depth is the depth at which the vertical
+      !!      eddy diffusivity coefficient (resulting from the vertical physics
+      !!      alone, not the isopycnal part, see trazdf.F) fall below a given
+      !!      value defined locally (avt_c here taken equal to 5 cm/s2)
+      !!
+      !! ** Action  :   nmln, hmld, hmlp, hmlpt
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      INTEGER  ::   iikn, iiki          ! temporary integer within a do loop
+      INTEGER, POINTER, DIMENSION(:,:) ::   imld                ! temporary workspace
+      REAL(wp) ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth
+      REAL(wp) ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_mxl')
+      !
+      CALL wrk_alloc( jpi_crs,jpj_crs, imld )
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         !                             ! allocate zdfmxl arrays
+         IF( zdf_mxl_alloc_crs() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' )
+      ENDIF
+
+      ! w-level of the mixing and mixed layers
+      nmln_crs(:,:) = mbkt_crs(:,:) + 1        ! Initialization to the number of w ocean point
+      imld(:,:)     = mbkt_crs(:,:) + 1
+      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10
+         DO jj = 1, jpj_crs
+            DO ji = 1, jpi_crs
+               IF( rhop_crs(ji,jj,jk) > rhop_crs(ji,jj,nla10) + zrho_c )   nmln_crs(ji,jj) = jk      ! Mixed layer
+        !       IF( avt (ji,jj,jk) < zavt_c                     )   imld(ji,jj) = jk      ! Turbocline 
+            END DO
+         END DO
+      END DO
+      ! depth of the mixing and mixed layers
+      !write(narea+2000,*)"nlb10 ",nlb10,SHAPE(hmlpt_crs),SHAPE(gdepw_crs) ; call flush(narea+2000)
+      DO jj = 1, jpj_crs
+         DO ji = 1, jpi_crs
+           ! iiki = imld(ji,jj)
+            iikn = nmln_crs(ji,jj)
+            ! write(narea+2000,*)ji,jj,iikn,gdept_crs(ji,jj,iikn-1) ; call flush(narea+2000)
+       !     hmld (ji,jj) = gdepw_crs(ji,jj,iiki  ) * tmask_crs(ji,jj,1)    ! Turbocline depth 
+            !IF( iikn .LT. 2 .OR. iikn .GT. jpk )write(narea+2000,*)"iikn ",ji,jj,iikn ; call flush(narea+2000)
+            hmlp_crs (ji,jj) = gdepw_crs(ji,jj,iikn  ) * tmask_crs(ji,jj,1)    ! Mixed layer depth
+            hmlpt_crs(ji,jj) = gdept_crs(ji,jj,iikn-1)                     ! depth of the last T-point inside the mixed layer
+         END DO
+      END DO
+      IF( .NOT.lk_offline ) THEN            ! no need to output in offline mode
+  !       CALL iom_put( "mldr10_1", hmlp )   ! mixed layer depth
+   !      CALL iom_put( "mldkz5"  , hmld )   ! turbocline depth
+      ENDIF
+      
+    !  IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 )
+      !
+      CALL wrk_dealloc( jpi_crs,jpj_crs, imld )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl')
+      !
+   END SUBROUTINE zdf_mxl_crs
+
+   !!======================================================================
+END MODULE zdfmxl_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 5105)
@@ -409,9 +409,21 @@
                             CALL ldf_dyn_init      ! Lateral ocean momentum physics
       IF( lk_ldfslp     )   CALL ldf_slp_init      ! slope of lateral mixing
-
+      !
+      IF( ln_crs .AND. lk_ldfslp ) THEN
+                            CALL dom_grid_crs
+                            CALL ldf_slp_init_crs
+                            CALL dom_grid_glo
+      ENDIF
       !                                     ! Active tracers
                             CALL tra_qsr_init   ! penetrative solar radiation qsr
                             CALL tra_bbc_init   ! bottom heat flux
       IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
+      !
+      IF( ln_crs .AND. lk_trabbl     )  THEN
+                            CALL dom_grid_crs 
+                            CALL tra_bbl_init_crs   ! advective (and/or diffusive) bottom boundary layer scheme
+                            CALL dom_grid_glo
+      ENDIF
+      !
                             CALL tra_dmp_init   ! internal damping trends- tracers
                             CALL tra_adv_init   ! horizontal & vertical advection
@@ -434,5 +446,7 @@
 #if defined key_top
       !                                     ! Passive tracers
+      IF( ln_crs_top )      CALL dom_grid_crs
                             CALL     trc_init
+      IF( ln_crs_top )      CALL dom_grid_glo
 #endif
       !                                     ! Diagnostics
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 5105)
@@ -33,4 +33,5 @@
    USE step_oce         ! time stepping definition modules
    USE iom
+   USE crs
 
    IMPLICIT NONE
@@ -138,4 +139,5 @@
                          CALL zdf_mxl( kstp )         ! mixed layer depth
 
+      IF(ln_crs)         CALL zdf_mxl_crs(kstp)
                                                       ! write TKE or GLS information in the restart file
       IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' )
@@ -224,5 +226,20 @@
       ! Passive Tracer Model
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_crs )   THEN
+                         CALL dom_grid_crs
+                         CALL eos_crs(tsb_crs , rhd_crs, rhop_crs)
+                         CALL bn2_crs(tsb_crs , rb2_crs)
+         IF( ln_zps )    CALL zps_hde_crs( kstp, 2, tsb_crs, gtsu_crs, gtsv_crs, rhd_crs, gru_crs, grv_crs )
+                         CALL zdf_mxl_crs(kstp)
+         IF( lk_ldfslp .AND.  .NOT. ln_traldf_grif )  &
+                         CALL ldf_slp_crs( kstp, rhd_crs, rb2_crs )
+                         CALL dom_grid_glo
+      ENDIF
+
+      IF( ln_crs_top )   CALL dom_grid_crs
+
                          CALL trc_stp( kstp )         ! time-stepping
+
+      IF( ln_crs_top )   CALL dom_grid_glo
 #endif
 
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 5105)
@@ -95,4 +95,8 @@
 
    USE crsfld           ! Standard output on coarse grid   (crs_fld routine)
+   USE zdfmxl_crs
+   USE eosbn2_crs
+   USE zpshde_crs
+   USE ldfslp_crs
 
    USE asminc           ! assimilation increments      (tra_asm_inc routine)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90	(revision 5105)
@@ -13,5 +13,6 @@
    !!----------------------------------------------------------------------
    USE trc         ! passive tracers common variables 
-   USE iom         ! I/O manager
+   USE oce_trc
+   USE crs, ONLY : ln_crs
 
    IMPLICIT NONE
@@ -32,4 +33,5 @@
       INTEGER              :: jn
       !!---------------------------------------------------------------------
+      IF( ln_crs ) CALL iom_swap( "nemo_crs" )
  
       ! write the tracer concentrations in the file
@@ -37,6 +39,12 @@
       DO jn = jp_myt0, jp_myt1
          cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
-         CALL iom_put( cltra, trn(:,:,:,jn) )
+         IF( lk_vvl ) THEN
+            CALL iom_put( cltra, trn(:,:,:,jn) * fse3t_n(:,:,:) )
+         ELSE
+            CALL iom_put( TRIM(cltra), trn(:,:,:,jn) )
+         ENDIF
       END DO
+      !
+      IF( ln_crs ) CALL iom_swap( "nemo" )
       !
    END SUBROUTINE trc_wri_my_trc
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_crs.F90	(revision 5105)
@@ -0,0 +1,228 @@
+MODULE trcadv_crs
+   !!==============================================================================
+   !!                       ***  MODULE  trcadv  ***
+   !! Ocean passive tracers:  advection trend 
+   !!==============================================================================
+   !! History :  2.0  !  05-11  (G. Madec)  Original code
+   !!            3.0  !  10-06  (C. Ethe)   Adapted to passive tracers
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_adv      : compute ocean tracer advection trend
+   !!   trc_adv_ctl  : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   !???USE oce_trc, ONLY: un,vn,wn
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine)
+   USE traadv_tvd_crs  ! TVD      scheme           (tra_adv_tvd    routine)
+   USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine)
+   USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine)
+   USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine)
+   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine)
+   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine)
+   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   USE prtctl_trc      ! Print control
+   USE crs , ONLY : e2e3u_msk , e1e3v_msk , e1e2w_msk,jpi_crs,jpj_crs
+   USE timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_adv_crs          ! routine called by step module
+   PUBLIC   trc_adv_alloc_crs   ! routine called by nemogcm module
+
+   INTEGER ::   nadv   ! choice of the type of advection scheme
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra
+   !                                                    ! except at nitrrc000 (=rdttra) if neuler=0
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcadv.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trc_adv_alloc_crs()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_alloc  ***
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc_crs )
+
+      IF( trc_adv_alloc_crs /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')
+
+   END FUNCTION trc_adv_alloc_crs
+
+
+   SUBROUTINE trc_adv_crs( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv  ***
+      !!
+      !! ** Purpose :   compute the ocean tracer advection trend.
+      !!
+      !! ** Method  : - Update the tracer with the advection term following nadv
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   jk 
+      INTEGER ::   ji,jj
+      CHARACTER (len=22) ::   charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity
+      !!----------------------------------------------------------------------
+      !
+      
+      IF( nn_timing == 1 )  CALL timing_start('trc_adv')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
+      !
+
+      IF( kt == nittrc000 )   CALL trc_adv_ctl_crs          ! initialisation & control of options
+
+#if ! defined key_pisces
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
+      ENDIF
+#else
+      r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping)
+#endif
+
+  !    IF(lwp) WRITE(numout,*) 'TEST', e1e2t
+      !                                                   ! effective transport
+!         IF(lwp) WRITE(numout,*) 'un', maxval(un(:,:,:))
+!         IF(lwp) WRITE(numout,*) 'un', minval(un(:,:,:))
+!         IF(lwp) WRITE(numout,*) 'vn', maxval(vn(:,:,:))
+!         IF(lwp) WRITE(numout,*) 'vn', minval(vn(:,:,:))
+!         IF(lwp) WRITE(numout,*) 'wn', maxval(wn(:,:,:))
+!         IF(lwp) WRITE(numout,*) 'wn', minval(wn(:,:,:))
+      DO jk = 1, jpkm1
+         !                                                ! eulerian transport only
+         zun(:,:,jk) = e2e3u_msk(:,:,jk) * un(:,:,jk)
+         zvn(:,:,jk) = e1e3v_msk(:,:,jk) * vn(:,:,jk)
+         zwn(:,:,jk) = e1e2w_msk(:,:,jk) * wn(:,:,jk)
+         !
+      END DO
+
+         IF(lwp)WRITE(numout,*)"jpi_crs jpj_crs jpk ",jpi_crs,jpj_crs,jpk
+         DO jk=1,jpk
+           DO jj = 1, jpj_crs
+               DO ji = 1, jpi_crs
+                  IF( zwn(ji,jj,jk) .NE. zwn(ji,jj,jk) )WRITE(narea+200,*)"trcadv_zwn",zwn(ji,jj,jk) ; call flush(narea+200)
+               END DO
+            END DO
+         END DO
+
+
+      zwn(:,:,jpk) = 0.e0                                 ! no transport trough the bottom
+
+      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary)
+         &              CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' )
+      !
+      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
+!cbr      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered
+      CASE ( 2 )   ;    CALL tra_adv_tvd_crs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD 
+!cbr      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )   !  MUSCL 
+!cbr      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2 
+!cbr      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS 
+!cbr      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST 
+      !
+      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
+!         CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )          
+!         WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout)
+!                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_tvd_crs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+!         CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )          
+!         WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout)
+!                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+!         CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+!         WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout)
+!                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+!         CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+!         WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout)
+!                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+!         CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+!         WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         !
+      END SELECT
+
+      !                                              ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END IF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_adv')
+      !
+   END SUBROUTINE trc_adv_crs
+
+
+   SUBROUTINE trc_adv_ctl_crs
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_ctl  ***
+      !!                
+      !! ** Purpose : Control the consistency between namelist options for 
+      !!              passive tracer advection schemes and set nadv
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio
+      !!----------------------------------------------------------------------
+
+      ioptio = 0                      ! Parameter control
+      IF( ln_trcadv_cen2   )   ioptio = ioptio + 1
+      IF( ln_trcadv_tvd    )   ioptio = ioptio + 1
+      IF( ln_trcadv_muscl  )   ioptio = ioptio + 1
+      IF( ln_trcadv_muscl2 )   ioptio = ioptio + 1
+      IF( ln_trcadv_ubs    )   ioptio = ioptio + 1
+      IF( ln_trcadv_qck    )   ioptio = ioptio + 1
+      IF( lk_esopa         )   ioptio =          1
+
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' )
+
+      !                              ! Set nadv
+      IF( ln_trcadv_cen2   )   nadv =  1
+      IF( ln_trcadv_tvd    )   nadv =  2
+      IF( ln_trcadv_muscl  )   nadv =  3
+      IF( ln_trcadv_muscl2 )   nadv =  4
+      IF( ln_trcadv_ubs    )   nadv =  5
+      IF( ln_trcadv_qck    )   nadv =  6
+      IF( lk_esopa         )   nadv = -1
+
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used'
+         IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used'
+         IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used'
+         IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used'
+         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used'
+         IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used'
+         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme'
+      ENDIF
+      !
+   END SUBROUTINE trc_adv_ctl_crs
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_adv_crs( kt )
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_adv: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_adv_crs
+#endif
+
+  !!======================================================================
+END MODULE trcadv_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl_crs.F90	(revision 5105)
@@ -0,0 +1,117 @@
+MODULE trcbbl_crs
+  !!======================================================================
+   !!                       ***  MODULE  trcbbl  ***
+   !! Ocean passive tracers physics :  advective and/or diffusive bottom boundary 
+   !!                                  layer scheme
+   !!======================================================================
+   !!==============================================================================
+   !! History :  OPA  !  1996-06  (L. Mortier)  Original code
+   !!            8.0  !  1997-11  (G. Madec)    Optimization
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  free form + modules
+   !!             -   !  2004-01  (A. de Miranda, G. Madec, J.M. Molines ) add advective bbl
+   !!            3.3  !  2009-11  (G. Madec)  merge trabbl and trabbl_adv + style + optimization 
+   !!             -   !  2010-04  (G. Madec)  Campin & Goosse advective bbl 
+   !!             -   !  2010-06  (C. Ethe, G. Madec)  merge TRA-TRC
+   !!----------------------------------------------------------------------
+#if  defined key_top &&  defined key_trabbl 
+   !!----------------------------------------------------------------------
+   !!   'key_trabbl                      diffusive or/and adevective bottom boundary layer
+   !!----------------------------------------------------------------------
+   !!    trc_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive)
+   !!----------------------------------------------------------------------
+   USE oce_trc             ! ocean dynamics and active tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE trabbl_crs              ! 
+   USE prtctl_trc          ! Print control for debbuging
+   USE trdmod_oce
+   USE trdtra
+
+   PUBLIC   trc_bbl_crs       !  routine called by step.F90
+
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcbbl.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+
+   SUBROUTINE trc_bbl_crs( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bbl  ***
+      !!                   
+      !! ** Purpose :   Compute the before tracer (t & s) trend associated 
+      !!     with the bottom boundary layer and add it to the general trend
+      !!     of tracer equations.
+      !!
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
+      !!----------------------------------------------------------------------
+      !
+!      WRITE(numout,*) '          nn_bbl_ldf_test     = ' , nn_bbl_ldf
+      
+      IF( nn_timing == 1 )  CALL timing_start('trc_bbl')
+      !
+      IF( .NOT. lk_offline .AND. nn_dttrc == 1 ) THEN
+         CALL bbl_crs( kt, nittrc000, 'TRC' )      ! Online coupling with dynamics  : Computation of bbl coef and bbl transport
+         l_bbl_crs = .FALSE.                       ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files
+      ENDIF
+
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+
+      !* Diffusive bbl :
+      IF( nn_bbl_ldf == 1 ) THEN
+  
+         CALL tra_bbl_dif_crs( trb, tra, jptra )  
+         IF( ln_ctl )   THEN
+            WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_trc_info(charout)
+            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         ENDIF
+         !
+      END IF
+
+      !* Advective bbl : bbl upstream advective trends added to the tracer trends
+      IF( nn_bbl_adv /= 0 ) THEN
+         !
+         CALL tra_bbl_adv_crs( trb, tra, jptra )  
+         IF( ln_ctl )   THEN
+            WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_trc_info(charout)
+            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         ENDIF
+         !
+      END IF
+
+      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+        DO jn = 1, jptra
+           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
+           CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) )
+        END DO
+        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends
+      ENDIF
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('trc_bbl')
+      !
+   END SUBROUTINE trc_bbl_crs
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      No bottom boundary layer scheme
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_bbl_crs( kt )              ! Empty routine
+      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bbl_crs
+#endif
+
+   !!======================================================================
+END MODULE trcbbl_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_crs.F90	(revision 5105)
@@ -0,0 +1,277 @@
+MODULE trcldf_crs
+   !!======================================================================
+   !!                       ***  MODULE  trcldf  ***
+   !! Ocean Passive tracers : lateral diffusive trends
+   !!=====================================================================
+   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
+   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   trc_ldf     : update the tracer trend with the lateral diffusion
+   !!       ldf_ctl : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   USE ldfslp          ! ???
+   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine)
+   USE traldf_bilap    ! lateral mixing            (tra_ldf_bilap routine)
+   USE traldf_iso_crs      ! lateral mixing            (tra_ldf_iso routine)
+   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
+   USE traldf_lap_crs      ! lateral mixing            (tra_ldf_lap routine)
+   USE trdmod_oce
+   USE trdtra
+   USE prtctl_trc      ! Print control
+   !USE crs
+   USE trc_oce, ONLY : lk_offline  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ldf_crs    ! called by step.F90
+   !                                                 !!: ** lateral mixing namelist (nam_trcldf) **
+   REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient
+   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals)
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcldf.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_ldf_crs( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf  ***
+      !!
+      !! ** Purpose :   compute the lateral ocean tracer physics.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!
+      INTEGER            :: jn
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_ldf')
+      !
+      IF( kt == nittrc000 )   CALL ldf_ctl          ! initialisation & control of options
+
+      rldf = rldf_rat
+
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd )
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+
+!      WRITE(numout,*) 'nldf', nldf
+      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( 0 )   ;   CALL tra_ldf_lap_crs   ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level laplacian
+      CASE ( 1 )                                                                                            ! rotated laplacian
+                       IF( ln_traldf_grif ) THEN
+                          CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
+                       ELSE
+                          CALL tra_ldf_iso_crs     ( kt, nittrc000, 'TRC', gtru ,gtrv , trb, tra, jptra, rn_ahtb_0 )
+                       ENDIF
+      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level bilaplacian
+      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian
+         !
+      CASE ( -1 )                                     ! esopa: test all possibility with control print
+         CALL tra_ldf_lap_crs   ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )
+         WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         IF( ln_traldf_grif ) THEN
+            CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
+         ELSE
+            CALL tra_ldf_iso_crs     ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
+         ENDIF
+         WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )
+         WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )
+         WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END SELECT
+      !
+      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+        DO jn = 1, jptra
+           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
+           CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) )
+        END DO
+        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd )
+      ENDIF
+      !                                          ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('ldf ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_ldf')
+      !
+   END SUBROUTINE trc_ldf_crs
+
+
+   SUBROUTINE ldf_ctl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_ctl  ***
+      !!
+      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
+      !!
+      !! ** Method  :   set nldf from the namtra_ldf logicals
+      !!      nldf == -2   No lateral diffusion
+      !!      nldf == -1   ESOPA test: ALL operators are used
+      !!      nldf ==  0   laplacian operator
+      !!      nldf ==  1   Rotated laplacian operator
+      !!      nldf ==  2   bilaplacian operator
+      !!      nldf ==  3   Rotated bilaplacian
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ierr         ! temporary integers
+      !!----------------------------------------------------------------------
+
+      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN
+       !  IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN  !! cc
+       !     rldf_rat = 1.0_wp
+       !  ELSE
+       !     CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' )
+       !  END IF
+          rldf_rat = 1.0_wp !!cc
+      ELSE
+         rldf_rat = rn_ahtrc_0 / rn_aht_0
+      END IF
+      !  Define the lateral mixing oparator for tracers
+      ! ===============================================
+
+      !                               ! control the input
+      ioptio = 0
+      IF( ln_trcldf_lap   )   ioptio = ioptio + 1
+      IF( ln_trcldf_bilap )   ioptio = ioptio + 1
+      IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' )
+      IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion
+      ioptio = 0
+      IF( ln_trcldf_level )   ioptio = ioptio + 1
+      IF( ln_trcldf_hor   )   ioptio = ioptio + 1
+      IF( ln_trcldf_iso   )   ioptio = ioptio + 1
+      IF( ioptio /= 1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
+
+      ! defined the type of lateral diffusion from ln_trcldf_... logicals
+      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
+      ierr = 0
+      IF( ln_trcldf_lap ) THEN       ! laplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed
+            IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 1      ! horizontal (   rotation)
+            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ln_trcldf_bilap ) THEN      ! bilaplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed
+            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 3      ! horizontal (   rotation)
+            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' )
+      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' )
+      IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso )   &
+           CALL ctl_stop( '          eddy induced velocity on tracers',   &
+           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' )
+      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
+         IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' )
+#if defined key_offline
+         l_traldf_rot = .TRUE.                 ! needed for trazdf_imp
+#endif
+      ENDIF
+
+      IF( lk_esopa ) THEN
+         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options'
+         nldf = -1
+      ENDIF
+
+      IF( .NOT. ln_trcldf_diff ) THEN
+         IF(lwp) WRITE(numout,*) '          No lateral diffusion on passive tracers'
+         nldf = -2
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion'
+         IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used'
+         IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator'
+         IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator'
+         IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator'
+         IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian'
+      ENDIF
+
+      IF( ln_trcldf_bilap ) THEN
+         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion'
+         IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' )
+      ELSE
+         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)'
+         IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' )
+      ENDIF
+
+      ! ratio between active and passive tracers diffusive coef.
+      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN
+       !  IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN   !!cc
+       !     rldf_rat = 1.0_wp
+       !  ELSE
+       !     CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' )
+       !  END IF
+          rldf_rat = 1.0_wp   !!cc
+      ELSE
+         rldf_rat = rn_ahtrc_0 / rn_aht_0
+      END IF
+      IF( rldf_rat < 0 ) THEN
+         IF( .NOT.lk_offline ) THEN 
+            CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' )
+         ELSE
+            CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' )
+         ENDIF 
+      ENDIF
+      !
+   END SUBROUTINE ldf_ctl
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ldf_crs( kt )
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_ldf: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_ldf_crs
+#endif
+   !!======================================================================
+END MODULE trcldf_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc_crs.F90	(revision 5105)
@@ -0,0 +1,131 @@
+MODULE trcsbc_crs
+   !!==============================================================================
+   !!                       ***  MODULE  trcsbc  ***
+   !! Ocean passive tracers:  surface boundary condition
+   !!======================================================================
+   !! History :  8.2  !  1998-10  (G. Madec, G. Roullet, M. Imbard)  Original code
+   !!            8.2  !  2001-02  (D. Ludicone)  sea ice and free surface
+   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            9.0  !  2004-03  (C. Ethe)  adapted for passive tracers
+   !!                 !  2006-08  (C. Deltel) Diagnose ML trends for passive tracers
+   !!==============================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_sbc      : update the tracer trend at ocean surface
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers variables
+   USE trc             ! ocean  passive tracers variables
+   USE prtctl_trc      ! Print control for debbuging
+   USE trdmod_oce
+   USE trdtra
+!cbr   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sbc_crs   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcsbc.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sbc_crs ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_sbc  ***
+      !!                   
+      !! ** Purpose :   Compute the tracer surface boundary condition trend of
+      !!      (concentration/dilution effect) and add it to the general 
+      !!       trend of tracer equations.
+      !!
+      !! ** Method :
+      !!      * concentration/dilution effect:
+      !!            The surface freshwater flux modify the ocean volume
+      !!         and thus the concentration of a tracer as :
+      !!            tra = tra + emp * trn / e3t   for k=1
+      !!         where emp, the surface freshwater budget (evaporation minus
+      !!         precipitation minus runoff) given in kg/m2/s is divided
+      !!         by 1035 kg/m3 (density of ocean water) to obtain m/s.
+      !!
+      !! ** Action  : - Update the 1st level of tra with the trend associated
+      !!                with the tracer surface boundary condition 
+      !!
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jn           ! dummy loop indices
+      REAL(wp) ::   zsrau, zse3t   ! temporary scalars
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsfx
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sbc')
+      !
+      ! Allocate temporary workspace
+                      CALL wrk_alloc( jpi, jpj,      zsfx  )
+      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+     IF( .NOT. lk_offline .AND. lk_vvl ) THEN  ! online coupling with vvl
+         zsfx(:,:) = 0._wp
+      ELSE                                      ! online coupling free surface or offline with free surface
+         zsfx(:,:) = emp(:,:)
+      ENDIF
+
+      ! 0. initialization
+      zsrau = 1. / rau0
+      DO jn = 1, jptra
+         !
+         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
+         !                                             ! add the trend to the general tracer trend
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zse3t = 1. / fse3t(ji,jj,1)
+               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t
+            END DO
+         END DO
+         
+         IF( l_trdtrc ) THEN
+            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
+            CALL trd_tra( kt, 'TRC', jn, jptra_trd_nsr, ztrtrd )
+         END IF
+         !                                                       ! ===========
+      END DO                                                     ! tracer loop
+      !                                                          ! ===========
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      ENDIF
+                      CALL wrk_dealloc( jpi, jpj,      zsfx  )
+      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sbc')
+      !
+   END SUBROUTINE trc_sbc_crs
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      NO passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sbc_crs (kt)              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sbc_crs
+#endif
+   
+   !!======================================================================
+END MODULE trcsbc_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 5105)
@@ -17,14 +17,23 @@
    USE trcnam_trp      ! passive tracers transport namelist variables
    USE trabbl          ! bottom boundary layer               (trc_bbl routine)
+   USE trabbl_crs      ! bottom boundary layer               (trc_bbl routine)
    USE trcbbl          ! bottom boundary layer               (trc_bbl routine)
+   USE trcbbl_crs      ! bottom boundary layer               (trc_bbl routine)
    USE zdfkpp          ! KPP non-local tracer fluxes         (trc_kpp routine)
    USE trcdmp          ! internal damping                    (trc_dmp routine)
    USE trcldf          ! lateral mixing                      (trc_ldf routine)
+   USE trcldf_crs      ! lateral mixing                      (trc_ldf routine)
    USE trcadv          ! advection                           (trc_adv routine)
+   USE trcadv_crs      ! advection                           (trc_adv routine)
    USE trczdf          ! vertical diffusion                  (trc_zdf routine)
+   USE trczdf_crs      ! vertical diffusion                  (trc_zdf routine
    USE trcnxt          ! time-stepping                       (trc_nxt routine)
    USE trcrad          ! positivity                          (trc_rad routine)
    USE trcsbc          ! surface boundary condition          (trc_sbc routine)
+   USE trcsbc_crs      ! surface boundary condition          (trc_sbc routine)
    USE zpshde          ! partial step: hor. derivative       (zps_hde routine)
+   USE zpshde_crs      ! partial step: hor. derivative       (zps_hde routine)
+   USE dom_oce , ONLY : ln_crs
+   USe crs, ONLY : jpi_crs,jpj_crs,wn_crs !cbr
 
 #if defined key_agrif
@@ -58,4 +67,6 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index
+      REAL(wp) :: zmin,zmax
+      INTEGER :: ji,jj,jk
       !! ---------------------------------------------------------------------
       !
@@ -64,10 +75,25 @@
       IF( .NOT. lk_c1d ) THEN
          !
-                                CALL trc_sbc( kstp )            ! surface boundary condition
-         IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme
+!         CALL test(kstp,1)
+!         IF( ln_crs ) THEN ;    CALL trc_sbc_crs( kstp )
+!         ELSE              ;    CALL trc_sbc( kstp )
+!         ENDIF
+!         CALL test(kstp,2)
+         IF( ln_crs ) THEN ;    CALL trc_bbl_crs( kstp )
+         ELSE              ;    CALL trc_bbl( kstp )
+         ENDIF
          IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends
+!         CALL test(kstp,3)
+
+         IF( ln_crs ) THEN ;    CALL trc_adv_crs( kstp )
+         ELSE              ;    CALL trc_adv( kstp )
+         ENDIF
+!         CALL test(kstp,4)
+
          IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only
-                                CALL trc_adv( kstp )            ! horizontal & vertical advection 
-                                CALL trc_ldf( kstp )            ! lateral mixing
+         IF( ln_crs ) THEN ;    CALL trc_ldf_crs( kstp )
+         ELSE              ;    CALL trc_ldf( kstp )
+         ENDIF
+!         CALL test(kstp,5)
          IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
             &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
@@ -75,6 +101,10 @@
          IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge
 #endif
-                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
+         IF( ln_crs ) THEN ;    CALL trc_zdf_crs( kstp )
+         ELSE              ;    CALL trc_zdf( kstp )
+         ENDIF
+!         CALL test(kstp,6)
                                 CALL trc_nxt( kstp )            ! tracer fields at next time step     
+!         CALL test(kstp,7)
          IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations
 
@@ -82,5 +112,10 @@
       IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )   ! Update tracer at AGRIF zoom boundaries : children only
 #endif
-         IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )  ! Partial steps: now horizontal gradient of passive
+         IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, gtru, gtrv )  ! Partial steps: now horizontal gradient of passive
+         IF( ln_zps    )THEN
+         IF( ln_crs ) THEN ;    CALL zps_hde_crs( kstp, jptra, trn, gtru, gtrv )
+         ELSE              ;    CALL zps_hde( kstp, jptra, trn, gtru, gtrv )
+         ENDIF
+         ENDIF
                                                                 ! tracers at the bottom ocean level
          !
@@ -98,5 +133,35 @@
       !
    END SUBROUTINE trc_trp
+   SUBROUTINE test(kt,i)
+   INTEGER,INTENT(IN) :: kt,i
+   REAL(wp)::zmin,zmax
+   INTEGER :: ji,jj,jk
+   zmin=MINVAL( trb(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin)
+   zmax=MAXVAL( trb(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax)
+   IF(lwp)WRITE(numout,*)"trctrp b ",kt,i,zmin,zmax   
+   zmin=MINVAL( trn(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin)
+   zmax=MAXVAL( trn(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax)
+   IF(lwp)WRITE(numout,*)"trctrp n ",kt,i,zmin,zmax   
+   zmin=MINVAL( tra(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin)
+   zmax=MAXVAL( tra(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax)
+   IF(lwp)WRITE(numout,*)"trctrp a ",kt,i,zmin,zmax   
+   zmin=MINVAL( trn(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_min(zmin)
+   zmax=MAXVAL( trn(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_max(zmax)
+   IF(lwp)WRITE(numout,*)"trctrp n ",kt,i,zmin,zmax   
+   zmin=MINVAL( tra(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_min(zmin)
+   zmax=MAXVAL( tra(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_max(zmax)
+   IF(lwp)WRITE(numout,*)"trctrp a ",kt,i,zmin,zmax   
 
+   IF(narea==267)WRITE(narea+5000,*)"tra(17,5,74,1) = ",kt,i,tra(17,5,74,1)
+
+   DO ji=1,jpi
+   DO jj=1,jpj
+   DO jk=1,jpk
+      IF( tra(ji,jj,jk,1) .NE.  tra(ji,jj,jk,1) )WRITE(narea+200,*)"BUG7 ",ji,jj,jk, tra(ji,jj,jk,1); CALL FLUSH(narea+200)
+   ENDDO
+   ENDDO
+   ENDDO
+   
+   END SUBROUTINE test
 #else
    !!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_crs.F90	(revision 5105)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_crs.F90	(revision 5105)
@@ -0,0 +1,182 @@
+MODULE trczdf_crs
+   !!==============================================================================
+   !!                 ***  MODULE  trczdf  ***
+   !! Ocean Passive tracers : vertical diffusive trends 
+   !!=====================================================================
+   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
+   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_ldf     : update the tracer trend with the lateral diffusion
+   !!       ldf_ctl : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine)
+   USE trazdf_imp_crs      ! vertical diffusion: implicit (tra_zdf_imp     routine)
+   USE trdmod_oce
+   USE trdtra
+   USE prtctl_trc      ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_zdf_crs          ! called by step.F90 
+   PUBLIC   trc_zdf_alloc_crs    ! called by nemogcm.F90 
+
+   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used
+      !                                ! defined from ln_zdf...  namlist logicals)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  r2dt   ! vertical profile time-step, = 2 rdttra
+      !                                                 ! except at nittrc000 (=rdttra) if neuler=0
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trczdf.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   INTEGER FUNCTION trc_zdf_alloc_crs()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_zdf_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( r2dt(jpk) , STAT=trc_zdf_alloc_crs )
+      !
+      IF( trc_zdf_alloc_crs /= 0 )   CALL ctl_warn('trc_zdf_alloc_crs : failed to allocate array.')
+      !
+   END FUNCTION trc_zdf_alloc_crs
+
+
+   SUBROUTINE trc_zdf_crs( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_zdf  ***
+      !!
+      !! ** Purpose :   compute the vertical ocean tracer physics.
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
+      !
+      INTEGER               ::  jk, jn
+      CHARACTER (len=22)    :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd   ! 4D workspace
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_zdf')
+      !
+      IF( kt == nittrc000 )   CALL zdf_ctl          ! initialisation & control of options
+
+#if ! defined key_pisces
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
+      ENDIF
+#else
+      r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping)
+#endif
+
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd )
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+!      WRITE(numout,*) 'nzdf', nzdf
+      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( -1 )                                       ! esopa: test all possibility with control print
+         CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) 
+         WRITE(charout, FMT="('zdf1 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_zdf_imp_crs( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra ) 
+         WRITE(charout, FMT="('zdf2 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme 
+      CASE ( 1 ) ;  CALL tra_zdf_imp_crs( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme          
+
+      END SELECT
+
+      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn)
+            END DO
+            CALL trd_tra( kt, 'TRC', jn, jptra_trd_zdf, ztrtrd(:,:,:,jn) )
+         END DO
+         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd )
+      ENDIF
+      !                                          ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('zdf ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END IF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_zdf')
+      !
+   END SUBROUTINE trc_zdf_crs
+
+
+   SUBROUTINE zdf_ctl
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE zdf_ctl  ***
+      !!
+      !! ** Purpose :   Choose the vertical mixing scheme
+      !!
+      !! ** Method  :   Set nzdf from ln_zdfexp
+      !!      nzdf = 0   explicit (time-splitting) scheme (ln_trczdf_exp=T)
+      !!           = 1   implicit (euler backward) scheme (ln_trczdf_exp=F)
+      !!      NB: The implicit scheme is required when using : 
+      !!             - rotated lateral mixing operator
+      !!             - TKE, GLS or KPP vertical mixing scheme
+      !!----------------------------------------------------------------------
+
+      !  Define the vertical tracer physics scheme
+      ! ==========================================
+
+      ! Choice from ln_zdfexp already read in namelist in zdfini module
+      IF( ln_trczdf_exp ) THEN           ! use explicit scheme
+         nzdf = 0
+      ELSE                               ! use implicit scheme
+         nzdf = 1
+      ENDIF
+
+      ! Force implicit schemes
+      IF( ln_trcldf_iso                               )   nzdf = 1      ! iso-neutral lateral physics
+      IF( ln_trcldf_hor .AND. ln_sco                  )   nzdf = 1      ! horizontal lateral physics in s-coordinate
+#if defined key_zdftke || defined key_zdfgls || defined key_zdfkpp
+                                                          nzdf = 1      ! TKE, GLS or KPP physics       
+#endif
+      IF( ln_trczdf_exp .AND. nzdf == 1 )   THEN
+         CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS or KPP vertical scheme ', &
+            &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' )
+      ENDIF
+
+      ! Test: esopa
+      IF( lk_esopa )    nzdf = -1                      ! All schemes used
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
+         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
+         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
+      ENDIF
+
+   END SUBROUTINE zdf_ctl
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_zdf_crs( kt )
+      INTEGER, INTENT(in) :: kt  
+      WRITE(*,*) 'trc_zdf: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_zdf_crs
+#endif
+   !!==============================================================================
+END MODULE trczdf_crs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 5105)
@@ -8,4 +8,181 @@
    !!----------------------------------------------------------------------
 #if defined key_top
+
+#if defined key_crs
+
+  !* Domain size *
+   USE par_oce , ONLY :   jpi      =>   jpi        !: first  dimension of grid --> i 
+   USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j  
+   USE par_oce , ONLY :   jpk      =>   jpk        !: number of levels  
+   USE par_oce , ONLY :   jpim1    =>   jpim1      !: jpi - 1
+   USE par_oce , ONLY :   jpjm1    =>   jpjm1      !: jpj - 1 
+   USE par_oce , ONLY :   jpkm1    =>   jpkm1      !: jpk - 1  
+   USE par_oce , ONLY :   jpij     =>   jpij       !: jpi x jpj
+   USE par_oce , ONLY :   lk_esopa =>   lk_esopa   !: flag to activate the all option
+   USE par_oce , ONLY :   jp_tem   =>   jp_tem     !: indice for temperature
+   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity
+
+   !* IO manager *
+   USE in_out_manager
+
+   !* Memory Allocation *
+   USE wrk_nemo
+
+   !* Timing *
+   USE timing, ONLY : timing_start , timing_stop
+
+   !* MPP library                         
+   USE lib_mpp
+
+   !* Fortran utilities                         
+   USE lib_fortran
+
+   !* Lateral boundary conditions                         
+   USE lbclnk
+
+   !* physical constants *
+   USE phycst
+
+   !* 1D configuration
+   USE c1d
+
+   !* model domain *
+   USE dom_oce , ONLY : narea => narea
+   USE dom_oce , ONLY : nproc => nproc
+   USE dom_oce , ONLY : nimpp => nimpp
+   USE dom_oce , ONLY : njmpp => njmpp
+   USE dom_oce , ONLY : nreci => nreci
+   USE dom_oce , ONLY : nrecj => nrecj
+   USE dom_oce , ONLY : nlci  => nlci
+   USE dom_oce , ONLY : nldi  => nldi
+   USE dom_oce , ONLY : nlei  => nlei
+   USE dom_oce , ONLY : nlcj  => nlcj
+   USE dom_oce , ONLY : nldj  => nldj
+   USE dom_oce , ONLY : nlej  => nlej
+   USE dom_oce , ONLY : nlcit  => nlcit
+   USE dom_oce , ONLY : nldit  => nldit
+   USE dom_oce , ONLY : nleit  => nleit
+   USE dom_oce , ONLY : nlcjt  => nlcjt
+   USE dom_oce , ONLY : nldjt  => nldjt
+   USE dom_oce , ONLY : nlejt  => nlejt
+   USE dom_oce , ONLY : nimppt => nimppt
+   USE dom_oce , ONLY : njmppt => njmppt
+   USE dom_oce , ONLY : ibonit => ibonit
+   USE dom_oce , ONLY : ibonjt => ibonjt
+   USE dom_oce , ONLY : lk_vvl => lk_vvl
+   USE dom_oce , ONLY : rdt => rdt
+   USE dom_oce , ONLY : ln_zco => ln_zco
+   USE dom_oce , ONLY : ln_zps => ln_zps
+   USE dom_oce , ONLY : ln_sco => ln_sco
+   USE dom_oce , ONLY : neuler => neuler
+
+   USE crs,  ONLY : mi0 => mi0 
+   USE crs,  ONLY : mi1 => mi1 
+   USE crs,  ONLY : mj0 => mj0 
+   USE crs,  ONLY : mj1 => mj1 
+
+   USE dom_oce , ONLY :  lzoom => lzoom 
+   !USE dom_oce , ONLY :  => 
+
+   !* horizontal mesh *
+   USE crs , ONLY :   glamt      =>   glamt_crs      !: longitude of t-point (degre)  
+   USE crs , ONLY :   glamu      =>   glamu_crs      !: longitude of t-point (degre)  
+   USE crs , ONLY :   glamv      =>   glamv_crs      !: longitude of t-point (degre)  
+   USE crs , ONLY :   glamf      =>   glamf_crs      !: longitude of t-point (degre)  
+   USE crs , ONLY :   gphit      =>   gphit_crs      !: latitude  of t-point (degre)   
+   USE crs , ONLY :   gphiu      =>   gphiu_crs      !: latitude  of t-point (degre)   
+   USE crs , ONLY :   gphiv      =>   gphiv_crs      !: latitude  of t-point (degre)   
+   USE crs , ONLY :   gphif      =>   gphif_crs      !: latitude  of t-point (degre)   
+   USE crs , ONLY :   e1t        =>   e1t_crs        !: horizontal scale factors at t-point (m)  
+   USE crs , ONLY :   e2t        =>   e2t_crs        !: horizontal scale factors at t-point (m)   
+   USE crs , ONLY :   e1e2t      =>   e1e2t_crs      !: cell surface at t-point (m2)
+   USE crs , ONLY :   e1u        =>   e1u_crs        !: horizontal scale factors at u-point (m)
+   USE crs , ONLY :   e2u        =>   e2u_crs        !: horizontal scale factors at u-point (m)
+   USE crs , ONLY :   e1v        =>   e1v_crs        !: horizontal scale factors at v-point (m)
+   USE crs , ONLY :   e2v        =>   e2v_crs        !: horizontal scale factors at v-point (m)  
+   USE crs , ONLY :   e3t        =>  e3t_crs         !: vertical scale factors at t-
+   USE crs , ONLY :   e3t_0      =>  e3t_crs         !: vertical scale factors at t-
+   USE crs , ONLY :   fse3t      =>  e3t_crs
+   USE crs , ONLY :   fse3t_b      =>  e3t_crs
+   USE crs , ONLY :   fse3t_a      =>  e3t_crs
+   USE crs , ONLY :   fse3w      =>  e3w_crs
+   USE crs , ONLY :   e3u        =>  e3u_crs         !: vertical scale factors at u-
+   USE crs , ONLY :   e3u_0      =>  e3u_crs         !: vertical scale factors at u-
+   USE crs , ONLY :   e3v        =>  e3v_crs         !: vertical scale factors v-
+   USE crs , ONLY :   e3v_0      =>  e3v_crs         !: vertical scale factors v-
+   USE crs , ONLY :   e3w        =>  e3w_crs         !: w-points (m)
+   USE crs , ONLY :   e3w_0      =>  e3w_crs         !: w-points (m)
+   USE crs , ONLY :   e3f        =>  e3f_crs         !: f-points (m)
+   USE crs , ONLY :   ff         =>  ff_crs         !: f-points (m)
+
+   USE crs , ONLY :   gdept_0    =>  gdept_crs       !: depth of t-points (m)
+   USE dom_oce , ONLY :   gdept_1d   =>  gdept_1d      !: depth of t-points (m)
+#if defined key_zco
+   USE crs , ONLY :   gdept      =>  gdept_crs       !: depth of t-points (m)
+   USE crs , ONLY :   gdepw      =>  gdepw_crs       !: depth of t-points (m)
+#endif
+  !* masks, bathymetry *
+   USE crs , ONLY :   mbkt       =>   mbkt_crs       !: vertical index of the bottom last T- ocean level
+   USE crs , ONLY :   mbku       =>   mbku_crs       !: vertical index of the bottom last U- ocean level
+   USE crs , ONLY :   mbkv       =>   mbkv_crs       !: vertical index of the bottom last V- ocean level
+   USE crs , ONLY :   tmask_i    =>   tmask_i_crs    !: Interior mask at t-points
+   USE crs , ONLY :   tmask      =>   tmask_crs      !: land/ocean mask at t-points
+   USE crs , ONLY :   umask      =>   umask_crs      !: land/ocean mask at u-points   
+   USE crs , ONLY :   vmask      =>   vmask_crs      !: land/ocean mask at v-points 
+   USE crs , ONLY :   fmask      =>   fmask_crs      !: land/ocean mask at f-points 
+
+ !* ocean fields: here now and after fields *
+!cbr?   USE crs , ONLY :   ua      =>    ua_crs      !: i-horizontal velocity (m s-1) 
+!cbr?   USE crs , ONLY :   va      =>    va_crs      !: j-horizontal velocity (m s-1)
+   USE crs , ONLY :   un      =>    un_crs      !: i-horizontal velocity (m s-1) 
+   USE crs , ONLY :   vn      =>    vn_crs      !: j-horizontal velocity (m s-1)
+   USE crs , ONLY :   wn      =>    wn_crs      !: vertical velocity (m s-1)  
+   USE crs , ONLY :   tsn     =>    tsn_crs     !: 4D array contaning ( tn, sn )
+   USE oce , ONLY :   tsb     =>    tsb     !: 4D array contaning ( tb, sb )
+   USE oce , ONLY :   tsa     =>    tsa     !: 4D array contaning ( ta, sa )
+   USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3) 
+   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units)
+   USE crs , ONLY :   hdivn   =>    hdivn_crs   !: horizontal divergence (1/s)
+   USE crs , ONLY :   hdivb   =>    hdivb_crs   !: horizontal divergence (1/s)
+   USE crs , ONLY :   sshb    =>    sshb_crs    !: sea surface height at t-point [m]   
+   USE crs , ONLY :   sshn    =>    sshn_crs    !: sea surface height at t-point [m]   
+   USE crs , ONLY :   ssha    =>    ssha_crs    !: sea surface height at t-point [m]   
+
+   !* surface fluxes *
+   USE crs , ONLY :   utau       =>    utau_crs       !: i-surface stress component
+   USE crs , ONLY :   vtau       =>    vtau_crs       !: j-surface stress component
+   USE crs , ONLY :   wndm       =>    wndm_crs       !: 10m wind speed 
+   USE crs , ONLY :   qsr        =>    qsr_crs        !: penetrative solar radiation (w m-2)  
+   USE crs , ONLY :   emp        =>    emp_crs        !: freshwater budget: volume flux               [Kg/m2/s]
+   USE crs , ONLY :   emp_b      =>    emp_b_crs      !: freshwater budget: volume flux               [Kg/m2/s]
+   USE crs , ONLY :   sfx        =>    sfx_crs        !: freshwater budget: concentration/dillution   [Kg/m2/s]
+   USE crs , ONLY :   fmmflx     =>    fmmflx_crs     !: freshwater budget: volume flux               [Kg/m2/s]
+   USE crs , ONLY :   rnf        =>    rnf_crs        !: river runoff   [Kg/m2/s]
+   USE crs , ONLY :   fr_i       =>    fr_i_crs       !: ice fraction (between 0 to 1)
+
+   USE crs , ONLY :   avt        =>   avt_crs         !: vert. diffusivity coef. at w-point for temp  
+#if defined key_zdfddm
+   USE crs , ONLY :   avs        =>   avs_crs         !: salinity vertical diffusivity coeff. at w-point
+#endif
+
+!cbr   USE trc_oce
+   USE trc_oce, ONLY : lk_offline
+   USE trc_oce, ONLY : nn_dttrc
+
+   USE crs , ONLY :   nmln        =>   nmln_crs        !: number of level in the mixed layer
+   USE crs , ONLY :   hmld        =>   hmld_crs        !: mixing layer depth (turbocline)
+   USE crs , ONLY :   hmlp        =>   hmlp_crs        !: mixed layer depth  (rho=rho0+zdcrit) (m)
+   USE crs , ONLY :   hmlpt       =>   hmlpt_crs       !: mixed layer depth at t-points (m)
+
+  !* direction of lateral diffusion *
+#if   defined key_ldfslp
+   USE ldfslp_crs , ONLY :   uslp       =>   uslp_crs         !: i-direction slope at u-, w-points
+   USE ldfslp_crs , ONLY :   vslp       =>   vslp_crs         !: j-direction slope at v-, w-points
+   USE ldfslp_crs , ONLY :   wslpi      =>   wslpi_crs        !: i-direction slope at u-, w-points
+   USE ldfslp_crs , ONLY :   wslpj      =>   wslpj_crs        !: j-direction slope at v-, w-points
+#endif
+
+#else
+
    !!----------------------------------------------------------------------
    !!   'key_top'                                                TOP models
@@ -24,4 +201,78 @@
    USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity
 
+  !* model domain *
+   USE dom_oce , ONLY : narea => narea
+   USE dom_oce , ONLY : nproc => nproc
+   USE dom_oce , ONLY : nimpp => nimpp
+   USE dom_oce , ONLY : njmpp => njmpp
+   USE dom_oce , ONLY : nreci => nreci
+   USE dom_oce , ONLY : nrecj => nrecj
+   USE dom_oce , ONLY : nlci  => nlci
+   USE dom_oce , ONLY : nldi  => nldi
+   USE dom_oce , ONLY : nlei  => nlei
+   USE dom_oce , ONLY : nlcj  => nlcj
+   USE dom_oce , ONLY : nldj  => nldj
+   USE dom_oce , ONLY : nlej  => nlej
+   USE dom_oce , ONLY : nlcit  => nlcit
+   USE dom_oce , ONLY : nldit  => nldit
+   USE dom_oce , ONLY : nleit  => nleit
+   USE dom_oce , ONLY : nlcjt  => nlcjt
+   USE dom_oce , ONLY : nldjt  => nldjt
+   USE dom_oce , ONLY : nlejt  => nlejt
+   USE dom_oce , ONLY : nimppt => nimppt
+   USE dom_oce , ONLY : njmppt => njmppt
+   USE dom_oce , ONLY : ibonit => ibonit
+   USE dom_oce , ONLY : ibonjt => ibonjt
+   USE dom_oce , ONLY : lk_vvl => lk_vvl
+   USE dom_oce , ONLY : rdt => rdt
+   USE dom_oce , ONLY : ln_zco => ln_zco
+   USE dom_oce , ONLY : ln_zps => ln_zps
+   USE dom_oce , ONLY : ln_sco => ln_sco
+   USE dom_oce , ONLY : neuler => neuler
+
+   USE dom_oce,  ONLY : mi0 => mi0
+   USE dom_oce,  ONLY : mi1 => mi1
+   USE dom_oce,  ONLY : mj0 => mj0
+   USE dom_oce,  ONLY : mj1 => mj1
+
+   USE dom_oce , ONLY :   glamt      =>   glamt      !: longitude of t-point (degre)  
+   USE dom_oce , ONLY :   glamu      =>   glamu      !: longitude of t-point (degre)  
+   USE dom_oce , ONLY :   glamv      =>   glamv      !: longitude of t-point (degre)  
+   USE dom_oce , ONLY :   glamf      =>   glamf      !: longitude of t-point (degre)  
+   USE dom_oce , ONLY :   gphit      =>   gphit      !: latitude  of t-point (degre)   
+   USE dom_oce , ONLY :   gphiu      =>   gphiu      !: latitude  of t-point (degre)   
+   USE dom_oce , ONLY :   gphiv      =>   gphiv      !: latitude  of t-point (degre)   
+   USE dom_oce , ONLY :   gphif      =>   gphif     !: latitude  of t-point (degre)   
+   USE dom_oce , ONLY :   e1t        =>   e1t        !: horizontal scale factors at t-point (m)  
+   USE dom_oce , ONLY :   e2t        =>   e2t        !: horizontal scale factors at t-point (m)   
+   USE dom_oce , ONLY :   e1e2t      =>   e1e2t      !: cell surface at t-point (m2)
+   USE dom_oce , ONLY :   e1u        =>   e1u        !: horizontal scale factors at u-point (m)
+   USE dom_oce , ONLY :   e2u        =>   e2u        !: horizontal scale factors at u-point (m)
+   USE dom_oce , ONLY :   e1v        =>   e1v        !: horizontal scale factors at v-point (m)
+   USE dom_oce , ONLY :   e2v        =>   e2v        !: horizontal scale factors at v-point (m)  
+   USE dom_oce , ONLY :   e3t        =>  e3t_0         !: vertical scale factors at t-
+   USE dom_oce , ONLY :   e3t_0      =>  e3t_0         !: vertical scale factors at t-
+   USE dom_oce , ONLY :   fse3t      =>  e3t_0
+   USE dom_oce , ONLY :   fse3t_b      =>  e3t_0
+   USE dom_oce , ONLY :   fse3t_a      =>  e3t_0
+   USE dom_oce , ONLY :   fse3w      =>  e3w_0
+   USE dom_oce , ONLY :   e3u        =>  e3u_0         !: vertical scale factors at u-
+   USE dom_oce , ONLY :   e3u_0      =>  e3u_0         !: vertical scale factors at u-
+   USE dom_oce , ONLY :   e3v        =>  e3v_0         !: vertical scale factors v-
+   USE dom_oce , ONLY :   e3v_0      =>  e3v_0         !: vertical scale factors v-
+   USE dom_oce , ONLY :   e3w        =>  e3w_0         !: w-points (m)
+   USE dom_oce , ONLY :   e3w_0      =>  e3w_0         !: w-points (m)
+   USE dom_oce , ONLY :   e3f        =>  e3f_0         !: f-points (m)
+   USE dom_oce , ONLY :   ff         =>  ff         !: f-points (m)
+   USE dom_oce , ONLY :   gdept_0    =>  gdept_0         !: f-points (m)
+   USE dom_oce , ONLY :   gdept_1d   => gdept_1d          !: f-points (m)
+   USE dom_oce , ONLY :   tmask      => tmask          !: f-points (m)
+   USE dom_oce , ONLY :   umask      => umask          !: f-points (m)
+   USE dom_oce , ONLY :   vmask      => vmask          !: f-points (m)
+   USE dom_oce , ONLY :   tmask_i      => tmask_i          !: f-points (m)
+   USE dom_oce , ONLY :   mbkt      => mbkt          !: f-points (m)
+   USE dom_oce , ONLY :   mbku      => mbku          !: f-points (m)
+   USE dom_oce , ONLY :   mbkv      => mbkv          !: f-points (m)
+
    !* IO manager *
    USE in_out_manager    
@@ -49,5 +300,6 @@
 
    !* model domain *
-   USE dom_oce 
+   !cbr USE dom_oce , ONLY : e3w_0
+   USE dom_oce , ONLY :  lzoom => lzoom 
 
    USE domvvl, ONLY : un_td, vn_td          !: thickness diffusion transport
@@ -66,7 +318,4 @@
    USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3) 
    USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units)
-#if defined key_offline
-   USE oce , ONLY :   rab_n   =>    rab_n   !: local thermal/haline expension ratio at T-points
-#endif
    USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s)
    USE oce , ONLY :   rotn    =>    rotn    !: relative vorticity    [s-1]
@@ -135,4 +384,5 @@
 # endif
 
+#endif
 #else
    !!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdia.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdia.F90	(revision 5105)
@@ -20,6 +20,5 @@
    !! trcdib_wr   : outputs of biological fields
    !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain variables 
-   USE oce_trc
+   USE trc_oce, ONLY : lk_offline ! offline flag
    USE trc
    USE par_trc
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 5105)
@@ -19,5 +19,4 @@
    USE oce_trc       !  shared variables between ocean and passive tracers
    USE trc           !  passive tracers common variables
-   USE iom           !  I/O manager
    USE lib_mpp       !  MPP library
    USE fldread       !  read input fields
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcini.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 5105)
@@ -25,10 +25,12 @@
    USE trcini_my_trc   ! MY_TRC   initialisation
    USE trcdta          ! initialisation from files
-   USE daymod          ! calendar manager
-   USE zpshde          ! partial step: hor. derivative   (zps_hde routine)
+   USE zpshde,ONLY: zps_hde    ! partial step: hor. derivative   (zps_hde routine)
+   USE zpshde_crs      ! partial step: hor. derivative   (zps_hde routine)
    USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
    USE trcsub          ! variables to substep passive tracers
    USE lib_mpp         ! distribued memory computing library
-   USE sbc_oce
+   USE sbc_oce, ONLY : ltrcdm2dc
+   USE crs    , ONLY : ln_crs
+   USE dom_oce, ONLY : nn_cla
  
    IMPLICIT NONE
@@ -143,7 +145,11 @@
  
       tra(:,:,:,:) = 0._wp
-      IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive
-        &    CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )       ! tracers at the bottom ocean level
-
+      IF( ln_zps .AND. .NOT. lk_c1d )THEN              ! Partial steps: before horizontal gradient of passive
+         IF( ln_crs )  THEN
+            CALL zps_hde_crs( nit000, jptra, trn, gtru, gtrv )
+         ELSE
+            CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )! tracers at the bottom ocean level
+         ENDIF
+      ENDIF
       !
       IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers
@@ -188,7 +194,9 @@
       !!----------------------------------------------------------------------
       USE trcadv        , ONLY:   trc_adv_alloc          ! TOP-related alloc routines...
+      USE trcadv_crs    , ONLY:   trc_adv_alloc_crs      ! TOP-related alloc routines..
       USE trc           , ONLY:   trc_alloc
       USE trcnxt        , ONLY:   trc_nxt_alloc
       USE trczdf        , ONLY:   trc_zdf_alloc
+      USE trczdf_crs    , ONLY:   trc_zdf_alloc_crs
       USE trdtrc_oce    , ONLY:   trd_trc_oce_alloc
 #if defined key_trdmxl_trc 
@@ -200,7 +208,9 @@
       !
       ierr =        trc_adv_alloc()          ! Start of TOP-related alloc routines...
+      ierr = ierr + trc_adv_alloc_crs()
       ierr = ierr + trc_alloc    ()
       ierr = ierr + trc_nxt_alloc()
       ierr = ierr + trc_zdf_alloc()
+      ierr = ierr + trc_zdf_alloc_crs()
       ierr = ierr + trd_trc_oce_alloc()
 #if defined key_trdmxl_trc 
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 5105)
@@ -23,9 +23,12 @@
    !!   trc_rst_wri    : write restart file
    !!----------------------------------------------------------------------
-   USE oce_trc
+   USE oce_trc ! ,ONLY: jprstlib
    USE trc
    USE trcnam_trp
-   USE iom
-   USE daymod
+   USE iom_def , ONLY : jprstlib , jprstdimg , jpnf90 , jpdom_autoglo 
+   USE iom , ONLY : iom_open , iom_get , iom_varid , iom_rstput , iom_close
+   USE dom_oce, ONLY: ndastp ,adatrj  , rdttra
+   USE daymod , ONLY : day_init
+
    IMPLICIT NONE
    PRIVATE
@@ -137,5 +140,5 @@
           CALL trc_rst_stat            ! statistics
           CALL iom_close( numrtw )     ! close the restart file (only at last time step)
-#if ! defined key_trdmxl_trc
+#if ! defined key_trdmld_trc
           lrst_trc = .FALSE.
 #endif
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 5105)
@@ -11,5 +11,5 @@
    !!----------------------------------------------------------------------
    USE oce_trc          ! ocean dynamics and active tracers variables
-   USE sbc_oce
+   USE sbc_oce , ONLY : ltrcdm2dc,qsr_mean
    USE trc
    USE trctrp           ! passive tracers transport
@@ -17,11 +17,12 @@
    USE prtctl_trc       ! Print control for debbuging
    USE trcdia
-   USE trcwri
+   USE trcwri , ONLY : trc_wri
    USE trcrst
    USE trdtrc_oce
    USE trdmxl_trc
-   USE iom
+   USE iom, ONLY : lk_iomput , iom_close
    USE in_out_manager
    USE trcsub
+   USE dom_oce, ONLY : nday, nmonth, nyear
 
    IMPLICIT NONE
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 5104)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 5105)
@@ -13,17 +13,17 @@
    USE trc
    USE prtctl_trc       ! Print control for debbuging
-   USE iom
-   USE in_out_manager
+   USE iom, ONLY : jpnf90
+   USE in_out_manager, ONLY : jprstlib
    USE lbclnk
-#if defined key_zdftke
-   USE zdftke          ! twice TKE (en)
-#endif
+!#if defined key_zdftke
+!   USE zdftke          ! twice TKE (en)
+!#endif
 #if defined key_zdfgls
    USE zdfgls, ONLY: en
 #endif
-   USE trabbl
-   USE zdf_oce
-   USE domvvl
-   USE divcur          ! hor. divergence and curl      (div & cur routines)
+!   USE trabbl
+!   USE zdf_oce
+!   USE domvvl
+   USE divcur, ONLY : div_cur           ! hor. divergence and curl      (div & cur routines)
    USE sbcrnf, ONLY: h_rnf, nk_rnf   ! River runoff 
    USE bdy_oce
@@ -160,7 +160,11 @@
          wndm_temp  (:,:)        = wndm  (:,:)
          !                                    !  Variables reset in trc_sub_ssh
+#if ! defined key_crs
          rotn_temp  (:,:,:)      = rotn  (:,:,:)
+# endif
          hdivn_temp (:,:,:)      = hdivn (:,:,:)
+#if ! defined key_crs
          rotb_temp  (:,:,:)      = rotb  (:,:,:)
+# endif
          hdivb_temp (:,:,:)      = hdivb (:,:,:)
          !
@@ -396,7 +400,9 @@
       !
       hdivn (:,:,:)   =  hdivn_temp (:,:,:)
+      hdivb (:,:,:)   =  hdivb_temp (:,:,:)
+#if ! defined key_crs
       rotn  (:,:,:)   =  rotn_temp  (:,:,:)
-      hdivb (:,:,:)   =  hdivb_temp (:,:,:)
       rotb  (:,:,:)   =  rotb_temp  (:,:,:)
+#endif
       !                                      
 
