Index: branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
===================================================================
--- branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 8873)
+++ branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 8882)
@@ -140,5 +140,5 @@
       ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsn_crs
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs, rke_crs
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs
       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivn_crs    
       REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshn_crs    
@@ -151,8 +151,6 @@
 
       ! Vertical diffusion
-      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp  
-# if defined key_zdfddm
-      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity vertical diffusivity coeff. [m2/s] at w-point
-# endif
+      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: temperature vertical diffusivity coeff. [m2/s] at w-point
+      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity    vertical diffusivity coeff. [m2/s] at w-point
 
       ! Mixing and Mixed Layer Depth
@@ -230,7 +228,6 @@
 
 
-      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( 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) , STAT=ierr(11))
 
      ALLOCATE( sshn_crs(jpi_crs,jpj_crs), emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), &
@@ -239,21 +236,17 @@
          &     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),    &
-# if defined key_zdfddm
-         &      avs_crs(jpi_crs,jpj_crs,jpk),    &
-# endif
-         &      STAT=ierr(13) )
+     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),   &
+         &                                        avs_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(13) )
 
       ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , &
          &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) )
          
-      ALLOCATE( nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij), &
-       &  nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   &
-                njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij), &
-       &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) )
-
-         
+      ALLOCATE( nimppt_crs (jpnij) , nlcit_crs (jpnij) , nldit_crs (jpnij) , nleit_crs (jpnij),   &
+         &      nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   &
+                njmppt_crs (jpnij) , nlcjt_crs (jpnij) , nldjt_crs (jpnij) , nlejt_crs (jpnij),   &
+         &      njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) )
+   
       crs_dom_alloc = MAXVAL(ierr)
-
+      !
    END FUNCTION crs_dom_alloc
 
Index: branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
===================================================================
--- branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 8873)
+++ branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 8882)
@@ -25,5 +25,4 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE timing          ! preformance summary
-   USE wrk_nemo        ! working array
 
    IMPLICIT NONE
@@ -58,18 +57,12 @@
       INTEGER  ::   ji, jj, jk        ! dummy loop indices
       REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars
-      !
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zt, zt_crs
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zs, zs_crs  
+      REAL(wp) ::   zztmp             !   -      -
+      !
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zt  , zs  , z3d
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) ::   zt_crs, zs_crs  
       !!----------------------------------------------------------------------
       ! 
       IF( nn_timing == 1 )   CALL timing_start('crs_fld')
-
-      !  Initialize arrays
-      CALL wrk_alloc( jpi,jpj,jpk,   ze3t, ze3w )
-      CALL wrk_alloc( jpi,jpj,jpk,   ze3u, ze3v )
-      CALL wrk_alloc( jpi,jpj,jpk,   zt  , zs   )
-      !
-      CALL wrk_alloc( jpi_crs,jpj_crs,jpk,   zt_crs, zs_crs )
 
       ! Depth work arrrays
@@ -84,7 +77,6 @@
          vn_crs   (:,:,:  ) = 0._wp    ! v-velocity
          wn_crs   (:,:,:  ) = 0._wp    ! w
-         avt_crs  (:,:,:  ) = 0._wp    ! avt
+         avs_crs  (:,:,:  ) = 0._wp    ! avt
          hdivn_crs(:,:,:  ) = 0._wp    ! hdiv
-         rke_crs  (:,:,:  ) = 0._wp    ! rke
          sshn_crs (:,:    ) = 0._wp    ! ssh
          utau_crs (:,:    ) = 0._wp    ! taux
@@ -158,9 +150,23 @@
       CALL iom_put( "voces" , zs_crs )   ! vS
 
-     
-      !  Kinetic energy
-      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
-      CALL iom_put( "eken", rke_crs )
-
+      IF( iom_use( "eken") ) THEN     !      kinetic energy
+         z3d(:,:,jk) = 0._wp 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zztmp  = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                  z3d(ji,jj,jk) = 0.25_wp * zztmp * (                                    &
+                     &            un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)   &
+                     &          + un(ji  ,jj,jk)**2 * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk)   &
+                     &          + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)   &
+                     &          + vn(ji,jj  ,jk)**2 * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk)   )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( z3d, 'T', 1. )
+         !
+         CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
+         CALL iom_put( "eken", zt_crs )
+      ENDIF
       !  Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 ) 
       DO jk = 1, jpkm1
@@ -175,7 +181,7 @@
                    hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 
                ENDIF
-            ENDDO
-         ENDDO
-      ENDDO
+            END DO
+         END DO
+      END DO
       CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 )
       !
@@ -196,16 +202,19 @@
       !  free memory
 
-      !  avt, avs
-!!gm BUG   TOP always uses avs !!!
+      !  avs
       SELECT CASE ( nn_crs_kz )
          CASE ( 0 )
             CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
+            CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
          CASE ( 1 )
             CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
+            CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
          CASE ( 2 )
             CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
+            CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
       END SELECT
       !
-      CALL iom_put( "avt", avt_crs )   !  Kz
+      CALL iom_put( "avt", avt_crs )   !  Kz on T
+      CALL iom_put( "avs", avs_crs )   !  Kz on S
       
       !  sbc fields  
@@ -231,9 +240,4 @@
       CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output 
 
-      !  free memory
-      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t, ze3w )
-      CALL wrk_dealloc( jpi,jpj,jpk,   ze3u, ze3v )
-      CALL wrk_dealloc( jpi,jpj,jpk,   zt  , zs   )
-      CALL wrk_dealloc( jpi_crs,jpj_crs,jpk,   zt_crs, zs_crs )
       !
       CALL iom_swap( "nemo" )     ! return back on high-resolution grid
Index: branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
===================================================================
--- branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 8873)
+++ branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 8882)
@@ -15,5 +15,5 @@
    
    INTERFACE crs_lbc_lnk
-      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_3d_gather, crs_lbc_lnk_2d
+      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_2d
    END INTERFACE
    
@@ -49,12 +49,12 @@
       ll_grid_crs = ( jpi == jpi_crs )
       !
-      IF( PRESENT(pval) ) THEN  ;  zval = pval
-      ELSE                      ;  zval = 0._wp
+      IF( PRESENT(pval) ) THEN   ;   zval = pval
+      ELSE                       ;   zval = 0._wp
       ENDIF
       !
       IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
       !
-      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  )
-      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  )
+      IF( PRESENT( cd_mpp ) ) THEN   ;   CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  )
+      ELSE                           ;   CALL lbc_lnk( pt3d1, cd_type1, psgn        , pval=zval  )
       ENDIF
       !
@@ -62,33 +62,4 @@
       !
    END SUBROUTINE crs_lbc_lnk_3d
-   
-   
-   SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
-      !!---------------------------------------------------------------------
-      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions for coarsened grid
-      !!
-      !! ** Method  :   Swap domain indices from full to coarse domain
-      !!                before arguments are passed directly to lbc_lnk.
-      !!                Upon exiting, switch back to full domain indices.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1, cd_type2 ! grid type
-      REAL(wp)                                , INTENT(in   ) ::   psgn               ! control of the sign
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1   , pt3d2    ! 3D array on which the lbc is applied
-      !
-      LOGICAL ::   ll_grid_crs
-      !!----------------------------------------------------------------------
-      !
-      ll_grid_crs = ( jpi == jpi_crs )
-      !
-      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
-      !
-      CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  )
-      !
-      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
-      !
-   END SUBROUTINE crs_lbc_lnk_3d_gather
-
    
    
@@ -115,12 +86,12 @@
       ll_grid_crs = ( jpi == jpi_crs )
       !
-      IF( PRESENT(pval) ) THEN  ;  zval = pval
-      ELSE                      ;  zval = 0._wp
+      IF( PRESENT(pval) ) THEN   ;   zval = pval
+      ELSE                       ;   zval = 0._wp
       ENDIF
       !
       IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
       !
-      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  )
-      ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  )
+      IF( PRESENT( cd_mpp ) ) THEN   ;   CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  )
+      ELSE                           ;   CALL lbc_lnk( pt2d, cd_type, psgn        , pval=zval  )
       ENDIF
       !
