Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90	(revision 5901)
@@ -24,5 +24,7 @@
    !                                                   !!* namicerun read in iceini  *
    CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in     !: suffix of ice restart name (input)
+   CHARACTER(len=256)    , PUBLIC ::   cn_icerst_indir  !: ice restart in directory
    CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out    !: suffix of ice restart name (output)
+   CHARACTER(len=256)    , PUBLIC ::   cn_icerst_outdir !: ice restart out directory
    LOGICAL               , PUBLIC ::   ln_limdyn        !: flag for ice dynamics (T) or not (F)
    LOGICAL               , PUBLIC ::   ln_limdmp        !: Ice damping
@@ -35,5 +37,5 @@
    INTEGER , PUBLIC ::   nbiter      !: number of sub-time steps for relaxation
    INTEGER , PUBLIC ::   nbitdr      !: maximum number of iterations for relaxation
-   INTEGER , PUBLIC ::   nevp        !: number of EVP subcycling iterations
+   INTEGER , PUBLIC ::   nn_nevp     !: number of EVP subcycling iterations
    INTEGER , PUBLIC ::   telast      !: timescale for EVP elastic waves
    REAL(wp), PUBLIC ::   epsd        !: tolerance parameter for dynamic
@@ -47,15 +49,17 @@
    REAL(wp), PUBLIC ::   c_rhg       !: second bulk-rhelogy parameter
    REAL(wp), PUBLIC ::   etamn       !: minimun value for viscosity
-   REAL(wp), PUBLIC ::   creepl      !: creep limit
-   REAL(wp), PUBLIC ::   ecc         !: eccentricity of the elliptical yield curve
+   REAL(wp), PUBLIC ::   rn_creepl   !: creep limit
+   REAL(wp), PUBLIC ::   rn_ecc      !: eccentricity of the elliptical yield curve
    REAL(wp), PUBLIC ::   ahi0        !: sea-ice hor. eddy diffusivity coeff. (m2/s)
    REAL(wp), PUBLIC ::   alphaevp    !: coefficient for the solution of EVP int. stresses
-   REAL(wp), PUBLIC ::   hminrhg = 0.001_wp    !: clem : ice volume (a*h in m) below which ice velocity is set to ocean velocity
-
-   REAL(wp), PUBLIC ::   usecc2                !:  = 1.0 / ( ecc * ecc )
+
+   REAL(wp), PUBLIC ::   usecc2                !:  = 1.0 / ( rn_ecc * rn_ecc )
    REAL(wp), PUBLIC ::   rhoco                 !: = rau0 * cw
    REAL(wp), PUBLIC ::   sangvg, cangvg        !: sin and cos of the turning angle for ocean stress
    REAL(wp), PUBLIC ::   pstarh                !: pstar / 2.0
 
+   !                                !!** switch for presence of ice or not 
+   REAL(wp), PUBLIC ::   rswitch
+
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv   !: hor. diffusivity coeff. at ocean U- and V-points (m2/s)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pahu , pahv   !: ice hor. eddy diffusivity coef. at ocean U- and V-points
@@ -63,7 +67,4 @@
 
    !!* Ice Rheology
-
-   LOGICAL , PUBLIC::  ltrcdm2dc_ice = .FALSE.              !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux
-
 # if defined key_lim2_vp
    !                                                      !!* VP rheology *
@@ -111,5 +112,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qdtcn         !: energy from the ice to the ocean point (at a factor 2)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   thcm          !: part of the solar energy used in the lead heat budget
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric_daymean!: Solar flux transmitted trough the ice, for day mean of qsr ( PISCES, with dirunal cycle )
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric_mean   !: Solar flux transmitted trough the ice, for day mean of qsr ( PISCES, with dirunal cycle )
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric        !: Solar flux transmitted trough the ice
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ffltbif       !: linked with the max heat contained in brine pockets (?)
@@ -171,6 +172,4 @@
          &     tbif  (jpi,jpj,jplayersp1)                           , STAT=ierr(5))
 
-      IF( ltrcdm2dc_ice ) ALLOCATE(fstric_daymean(jpi,jpj), STAT=ierr(6) )
-
       !* moment used in the advection scheme
       ALLOCATE(sxice (jpi,jpj) , syice (jpi,jpj) , sxxice(jpi,jpj) ,     &
@@ -199,5 +198,4 @@
    !!   Default option         Empty module        NO LIM 2.0 sea-ice model
    !!----------------------------------------------------------------------
-   LOGICAL , PUBLIC::  ltrcdm2dc_ice = .FALSE.              !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux
 #endif
    !!-----------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90	(revision 5901)
@@ -40,5 +40,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -60,9 +60,4 @@
       ENDIF
       !                                
-      ! When Diurnal cycle, core bulk and LIM2  are activated, 
-      ! a daily mean qsr is computed for tracer/biogeochemistery model                                 !
-      IF( ltrcdm2dc )THEN  ; ltrcdm2dc_ice = .TRUE.
-      ELSE                 ; ltrcdm2dc_ice = .FALSE.
-      ENDIF
       !                                ! Allocate the ice arrays
       ierr =        ice_alloc_2    ()       ! ice variables
@@ -123,5 +118,6 @@
       !! ** input   :   Namelist namicerun
       !!-------------------------------------------------------------------
-      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, ln_limdmp, acrit, hsndif, hicdif
+      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, &
+                          ln_limdyn, ln_limdmp, acrit, hsndif, hicdif
       INTEGER  ::   ios                 ! Local integer output status for namelist read
       !!-------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90	(revision 5901)
@@ -71,8 +71,6 @@
          CALL fld_read( kt, nn_fsbc, sf_icedmp )
          !
-!CDIR COLLAPSE
          hicif(:,:) = MAX( 0._wp,                     &        ! h >= 0         avoid spurious out of physical range
             &         hicif(:,:) - rdt_ice * resto_ice(:,:,1) * ( hicif(:,:) - sf_icedmp(jp_hicif)%fnow(:,:,1) )  ) 
-!CDIR COLLAPSE
          frld (:,:) = MAX( 0._wp, MIN( 1._wp,         &        ! 0<= frld<=1    values which blow the run up
             &         frld (:,:) - rdt_ice * resto_ice(:,:,1) * ( frld (:,:) - sf_icedmp(jp_frld )%fnow(:,:,1) )  )  )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90	(revision 5901)
@@ -227,6 +227,6 @@
       NAMELIST/namicedyn/ epsd, alpha,     &
          &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   &
-         &                c_rhg, etamn, creepl, ecc, ahi0,                  &
-         &                nevp, telast, alphaevp, hminrhg
+         &                c_rhg, etamn, rn_creepl, rn_ecc, ahi0,                  &
+         &                nn_nevp, telast, alphaevp
       !!-------------------------------------------------------------------
                     
@@ -256,11 +256,10 @@
          WRITE(numout,*) '       second bulk-rhelogy parameter                    c_rhg  = ', c_rhg
          WRITE(numout,*) '       minimun value for viscosity                      etamn  = ', etamn
-         WRITE(numout,*) '       creep limit                                      creepl = ', creepl
-         WRITE(numout,*) '       eccentricity of the elliptical yield curve       ecc    = ', ecc
+         WRITE(numout,*) '       creep limit                                      rn_creepl = ', rn_creepl
+         WRITE(numout,*) '       eccentricity of the elliptical yield curve       rn_ecc = ', rn_ecc
          WRITE(numout,*) '       horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0
-         WRITE(numout,*) '       number of iterations for subcycling nevp   = ', nevp
+         WRITE(numout,*) '       number of iterations for subcycling              nn_nevp= ', nn_nevp
          WRITE(numout,*) '       timescale for elastic waves telast = ', telast
          WRITE(numout,*) '       coefficient for the solution of int. stresses alphaevp = ', alphaevp
-         WRITE(numout,*) '       min ice thickness for rheology calculations     hminrhg = ', hminrhg
       ENDIF
       !
@@ -272,5 +271,5 @@
 
       !  Initialization
-      usecc2 = 1.0 / ( ecc * ecc )
+      usecc2 = 1.0 / ( rn_ecc * rn_ecc )
       rhoco  = rau0 * cw
       angvg  = angvg * rad      ! convert angvg from degree to radian
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 5901)
@@ -69,5 +69,6 @@
       IF( .NOT. ln_limini ) THEN  
          
-         tfu(:,:) = eos_fzp( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius]
+         CALL eos_fzp( tsn(:,:,1,jp_sal), tfu(:,:) )       ! freezing/melting point of sea water [Celcius]
+         tfu(:,:) = tfu(:,:) *  tmask(:,:,1)
 
          DO jj = 1, jpj
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90	(revision 5901)
@@ -160,7 +160,5 @@
       !-------------------------------------------------------------------
 
-!CDIR NOVERRCHK
       DO jj = k_j1 , k_jpj-1
-!CDIR NOVERRCHK
          DO ji = 1 , jpi
             ! only the sinus changes its sign with the hemisphere
@@ -245,7 +243,5 @@
          ! Computation of free drift field for free slip boundary conditions.
 
-!CDIR NOVERRCHK
          DO jj = k_j1, k_jpj-1
-!CDIR NOVERRCHK
             DO ji = 1, fs_jpim1
                !- Rate of strain tensor.
@@ -266,5 +262,5 @@
 
                !  Creep limit depends on the size of the grid.
-               zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ),  creepl)
+               zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ),  rn_creepl)
 
                !-  Computation of viscosities.
@@ -401,7 +397,5 @@
 iflag:   DO jter = 1 , nbitdr                                   !    Relaxation    !
             !                                                   ! ================ !
-!CDIR NOVERRCHK
             DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
                DO ji = 2, fs_jpim1   ! NO vector opt.
                   !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90	(revision 5901)
@@ -50,4 +50,5 @@
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
+      CHARACTER(len=150)  ::   clpath   ! full path to ice output restart file
       !!----------------------------------------------------------------------
       !
@@ -58,24 +59,30 @@
       ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1
       IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN
-         ! beware of the format used to write kt (default is i8.8, that should be large enough...)
-         IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
-         ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
+         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
+            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
+            ENDIF
+            ! create the file
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
+            clpath = TRIM(cn_icerst_outdir) 
+            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/' 
+            IF(lwp) THEN
+               WRITE(numout,*)
+               SELECT CASE ( jprstlib )
+               CASE ( jprstdimg )
+                  WRITE(numout,*) '             open ice restart binary file: ',TRIM(clpath)//clname
+               CASE DEFAULT
+                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
+               END SELECT
+               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
+                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
+               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
+               ENDIF
+            ENDIF
+
+            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )
+            lrst_ice = .TRUE.
          ENDIF
-         ! create the file
-         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
-         IF(lwp) THEN
-            WRITE(numout,*)
-            SELECT CASE ( jprstlib )
-            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname
-            CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname
-            END SELECT
-            IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
-               WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
-            ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
-            ENDIF
-         ENDIF
-
-         CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib )
-         lrst_ice = .TRUE.
       ENDIF
       !
@@ -188,9 +195,9 @@
         ! eventually read netcdf file (monobloc)  for restarting on different number of processors
         ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90
-        INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok )
+        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok )
         IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
       ENDIF
 
-      CALL iom_open ( cn_icerst_in, numrir, kiolib = jlibalt )
+      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in), numrir, kiolib = jlibalt )
 
       CALL iom_get( numrir, 'kt_ice' , ziter )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90	(revision 5901)
@@ -46,5 +46,4 @@
    PUBLIC   lim_sbc_flx_2      ! called by sbc_ice_lim_2
    PUBLIC   lim_sbc_tau_2      ! called by sbc_ice_lim_2
-   PUBLIC   lim_bio_meanqsr_2  ! called by sbc_ice_lim_2
 
    REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice 
@@ -97,5 +96,5 @@
       !!              - fr_i    : ice fraction
       !!              - tn_ice  : sea-ice surface temperature
-      !!              - alb_ice : sea-ice albedo (lk_cpl=T)
+      !!              - alb_ice : sea-ice albedo (ln_cpl=T)
       !!
       !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
@@ -179,5 +178,5 @@
 
             !   computation the solar flux at ocean surface
-            IF( lk_cpl ) THEN
+            IF( ln_cpl ) THEN
                zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) )
             ELSE
@@ -203,5 +202,5 @@
             ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area)
             !                                                  ! coupled mode: 
-            IF( lk_cpl ) THEN
+            IF( ln_cpl ) THEN
                zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area)
                   &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice
@@ -253,5 +252,5 @@
       !-----------------------------------------------!
 
-      IF( lk_cpl) THEN
+      IF( ln_cpl) THEN
          tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature       
          ht_i(:,:,1) = hicif(:,:)
@@ -320,7 +319,6 @@
          !
          IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==! (i.e. surface module time-step)
-!CDIR NOVERRCHK
+            !
             DO jj = 1, jpj                               !* modulus of ice-ocean relative velocity at I-point
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   zu_i  = u_ice(ji,jj) - u_oce(ji,jj)                   ! ice-ocean relative velocity at I-point
@@ -329,7 +327,5 @@
                END DO
             END DO
-!CDIR NOVERRCHK
             DO jj = 1, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
-!CDIR NOVERRCHK
                DO ji = 1, jpim1   ! NO vector opt.
                   !                                               ! modulus of U_ice-U_oce at T-point
@@ -384,7 +380,6 @@
          !
          IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==! (i.e. surface module time-step)
-!CDIR NOVERRCHK
+            !
             DO jj = 2, jpjm1                          !* modulus of the ice-ocean velocity at T-point
-!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1
                   zu_t  = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   ! 2*(U_ice-U_oce) at T-point
@@ -430,18 +425,4 @@
    END SUBROUTINE lim_sbc_tau_2
 
-   SUBROUTINE lim_bio_meanqsr_2
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE lim_bio_meanqsr
-      !!
-      !! ** Purpose :   provide daily qsr_mean for PISCES when 
-      !!                analytic diurnal cycle is applied in physic
-      !!
-      !! ** Method  :   add part under ice
-      !!
-      !!---------------------------------------------------------------------
-
-      qsr_mean(:,:) =  pfrld(:,:) * qsr_mean(:,:) + ( 1. - pfrld(:,:) ) * fstric_daymean(:,:)
-
-   END SUBROUTINE lim_bio_meanqsr_2
 
    SUBROUTINE lim_sbc_init_2
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90	(revision 5901)
@@ -114,5 +114,5 @@
       CALL wrk_alloc( jpi, jpj, jpk, zmsk )
 
-      IF( kt == nit000 )   CALL lim_thd_init_2  ! Initialization (first time-step only)
+      IF( kt == nit000 )   CALL lim_thd_init_2   ! Initialization (first time-step only)
    
       !-------------------------------------------!
@@ -137,5 +137,4 @@
       rdq_ice(:,:) = 0.e0   ! heat content associated with rdm_ice
       zmsk (:,:,:) = 0.e0
-      IF( ltrcdm2dc_ice  ) fstric_daymean (:,:) = 0.e0   ! part of solar radiation absorbing inside the ice
 
       ! set to zero snow thickness smaller than epsi04
@@ -197,7 +196,5 @@
       !--------------------------------------------------------------------------
 
-      !CDIR NOVERRCHK
       DO jj = 1, jpj
-         !CDIR NOVERRCHK
          DO ji = 1, jpi
             zthsnice       = hsnif(ji,jj) + hicif(ji,jj)
@@ -217,5 +214,5 @@
                         
             !  partial computation of the lead energy budget (qldif)
-            IF( lk_cpl ) THEN 
+            IF( ln_cpl ) THEN 
                qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                                  &
                   &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) )   &
@@ -285,11 +282,9 @@
          CALL tab_2d_1d_2( nbpb, tbif_1d    (1:nbpb , 3 ), tbif(:,:,3)    , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, qsr_ice_1d (1:nbpb)     , qsr_ice(:,:,1) , jpi, jpj, npb(1:nbpb) )
-         IF( ltrcdm2dc_ice ) &
-         & CALL tab_2d_1d_2( nbpb, qsr_ice_mean_1d (1:nbpb), qsr_ice_mean(:,:,1), jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, fr1_i0_1d  (1:nbpb)     , fr1_i0         , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, fr2_i0_1d  (1:nbpb)     , fr2_i0         , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb,  qns_ice_1d(1:nbpb)     ,  qns_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, dqns_ice_1d(1:nbpb)     , dqns_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
-         IF( .NOT. lk_cpl ) THEN 
+         IF( .NOT. ln_cpl ) THEN 
             CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb)     ,  qla_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
             CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb)     , dqla_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
@@ -336,9 +331,5 @@
          CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb)  , jpi, jpj )
          CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb)  , jpi, jpj )
-         IF( ltrcdm2dc_ice )THEN
-            CALL tab_1d_2d_2( nbpb, fstric_daymean     , npb, fstbif_daymean_1d (1:nbpb)  , jpi, jpj )
-            CALL tab_1d_2d_2( nbpb, qsr_ice_mean(:,:,1), npb,    qsr_ice_mean_1d(1:nbpb)  , jpi, jpj )
-         ENDIF
-         IF( .NOT. lk_cpl )   CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb)             , jpi, jpj )
+         IF( .NOT. ln_cpl )   CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj )
          !
       ENDIF
@@ -441,5 +432,5 @@
       IF( iom_use('qsr_ai_cea' ) )   CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) )   ! Solar flux over the ice     [W/m2]
       IF( iom_use('qns_ai_cea' ) )   CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) )   ! Non-solar flux over the ice [W/m2]
-      IF( iom_use('qla_ai_cea' ) .AND. .NOT. lk_cpl ) &
+      IF( iom_use('qla_ai_cea' ) .AND. .NOT. ln_cpl ) &
          &                           CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) )   ! Latent flux over the ice [W/m2]
       !
@@ -564,5 +555,5 @@
       IF(lwm) WRITE ( numoni, namicethd )
 
-      IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )
+      IF( ln_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )
       !
       IF(lwp) THEN                          ! control print
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90	(revision 5901)
@@ -134,5 +134,4 @@
       !---------------------------------------------------------------------
       
-!CDIR NOVERRCHK
       DO ji = kideb , kiut
          iicefr       = 1 - MAX( 0, INT( SIGN( 1.5 * zone , zfrl_old(ji) - 1.0 + epsi13 ) ) )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90	(revision 5901)
@@ -18,5 +18,5 @@
    USE ice_2
    USE limistate_2
-   USE sbc_oce, ONLY : lk_cpl
+   USE sbc_oce, ONLY : ln_cpl
    USE in_out_manager
    USE lib_mpp          ! MPP library
@@ -273,16 +273,4 @@
        END DO
 
-       IF( ltrcdm2dc_ice )THEN
-
-          DO ji = kideb , kiut
-             zihsn  = MAX( zzero , SIGN (zone , -h_snow_1d(ji) ) )
-             zihic  = MAX( zzero , 1.0 - ( h_ice_1d(ji) / zhsu ) )
-             zi0(ji)  = zihsn * ( fr1_i0_1d(ji) + zihic * fr2_i0_1d(ji) )
-             zexp     = MIN( zone , EXP( -1.5 * ( h_ice_1d(ji) - zhsu ) ) )
-             fstbif_daymean_1d(ji) = zi0(ji) * qsr_ice_mean_1d(ji) * zexp
-          END DO
-
-       ENDIF
-
        !--------------------------------------------------------------------------------
        !  4. Computation of the surface temperature : determined by considering the 
@@ -337,5 +325,5 @@
        !----------------------------------------------------------------------  
                      
-       IF ( .NOT. lk_cpl ) THEN   ! duplicate the loop for performances issues
+       IF ( .NOT. ln_cpl ) THEN   ! duplicate the loop for performances issues
           DO ji = kideb, kiut
              sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90	(revision 5901)
@@ -55,8 +55,6 @@
       fstbif_1d   ,     &  !:    "                  "      fstric
       fltbif_1d   ,     &  !:    "                  "      ffltbif
-      fstbif_daymean_1d, & !:    "                  " fstric_daymean
       fscbq_1d    ,     &  !:    "                  "      fscmcbq
       qsr_ice_1d  ,     &  !:    "                  "      qsr_ice
-      qsr_ice_mean_1d , &  !:    "                  "      qsr_ice_mean
       fr1_i0_1d   ,     &  !:    "                  "      fr1_i0
       fr2_i0_1d   ,     &  !:    "                  "      fr2_i0
@@ -122,6 +120,4 @@
          &      tbif_1d(jpij, jplayersp1), Stat=ierr(4))
          !
-      IF( ltrcdm2dc_ice )ALLOCATE(fstbif_daymean_1d(jpij),qsr_ice_mean_1d(jpij),Stat=ierr(5))
-         !
       thd_ice_alloc_2 = MAXVAL(ierr)
       IF( thd_ice_alloc_2 /= 0 )   CALL ctl_warn('thd_ice_alloc_2: failed to allocate arrays')
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90	(revision 5901)
@@ -5,7 +5,6 @@
    !!======================================================================
    !! History :  3.0  ! 2003-08  (M. Vancoppenolle)  LIM-3 original code
-   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
+   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation
    !!----------------------------------------------------------------------
-   USE par_ice        ! LIM-3 parameter
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
@@ -21,11 +20,5 @@
    INTEGER, PUBLIC ::   njeq , njeqm1        !: j-index of the equator if it is inside the domain
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcor       !: coriolis coefficient
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   covrai     !: sine of geographic latitude
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   area       !: surface of grid cell 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tms, tmi   !: temperature mask, mask for stress
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmu, tmv   !: mask at u and v velocity points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmf        !: mask at f-point
-
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   fcor   !: coriolis coefficient
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   wght   !: weight of the 4 neighbours to compute averages
 
@@ -44,10 +37,5 @@
       !!-------------------------------------------------------------------
       !
-      ALLOCATE( fcor(jpi,jpj)                   ,      &
-         &      covrai(jpi,jpj) , area(jpi,jpj) ,      &
-         &      tms   (jpi,jpj) , tmi (jpi,jpj) ,      &
-         &      tmu   (jpi,jpj) , tmv (jpi,jpj) ,      &
-         &      tmf   (jpi,jpj) ,                      &
-         &      wght(jpi,jpj,2,2)               , STAT = dom_ice_alloc )
+      ALLOCATE( fcor(jpi,jpj), wght(jpi,jpj,2,2), STAT = dom_ice_alloc )
       !
       IF( dom_ice_alloc /= 0 )   CALL ctl_warn( 'dom_ice_alloc: failed to allocate arrays.' )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 5901)
@@ -11,5 +11,4 @@
    !!   'key_lim3'                                      LIM-3 sea-ice model
    !!----------------------------------------------------------------------
-   USE par_ice        ! LIM sea-ice parameters
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
@@ -18,5 +17,5 @@
    PRIVATE
 
-   PUBLIC    ice_alloc  !  Called in iceini.F90
+   PUBLIC    ice_alloc  !  Called in sbc_lim_init
 
    !!======================================================================
@@ -110,7 +109,7 @@
    !! smv_i       |      -      |    Sea ice salt content         | ppt.m |
    !! oa_i        !      -      !    Sea ice areal age content    | day   |
-   !! e_i         !      -      !    Ice enthalpy                 | 10^9 J| 
+   !! e_i         !      -      !    Ice enthalpy                 | J/m2  | 
    !!      -      ! q_i_1d      !    Ice enthalpy per unit vol.   | J/m3  | 
-   !! e_s         !      -      !    Snow enthalpy                | 10^9 J| 
+   !! e_s         !      -      !    Snow enthalpy                | J/m2  | 
    !!      -      ! q_s_1d      !    Snow enthalpy per unit vol.  | J/m3  | 
    !!                                                                     |
@@ -148,6 +147,6 @@
    !! tm_i        |      -      |    Mean sea ice temperature     | K     |
    !! ot_i        !      -      !    Sea ice areal age content    | day   |
-   !! et_i        !      -      !    Total ice enthalpy           | 10^9 J| 
-   !! et_s        !      -      !    Total snow enthalpy          | 10^9 J| 
+   !! et_i        !      -      !    Total ice enthalpy           | J/m2  | 
+   !! et_s        !      -      !    Total snow enthalpy          | J/m2  | 
    !! bv_i        !      -      !    Mean relative brine volume   | ???   | 
    !!=====================================================================
@@ -165,67 +164,68 @@
    REAL(wp), PUBLIC ::   r1_rdtice        !: = 1. / rdt_ice
 
-   !                                     !!** ice-dynamic namelist (namicedyn) **
-   INTEGER , PUBLIC ::   nevp             !: number of iterations for subcycling
-   REAL(wp), PUBLIC ::   epsd             !: tolerance parameter for dynamic
-   REAL(wp), PUBLIC ::   om               !: relaxation constant
-   REAL(wp), PUBLIC ::   cw               !: drag coefficient for oceanic stress
-   REAL(wp), PUBLIC ::   pstar            !: determines ice strength (N/M), Hibler JPO79
-   REAL(wp), PUBLIC ::   c_rhg            !: determines changes in ice strength
-   REAL(wp), PUBLIC ::   creepl           !: creep limit : has to be under 1.0e-9
-   REAL(wp), PUBLIC ::   ecc              !: eccentricity of the elliptical yield curve
-   REAL(wp), PUBLIC ::   ahi0             !: sea-ice hor. eddy diffusivity coeff. (m2/s)
-   REAL(wp), PUBLIC ::   telast           !: timescale for elastic waves (s)
-   REAL(wp), PUBLIC ::   relast           !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 
-   REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses 
-   REAL(wp), PUBLIC ::   hminrhg          !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity
+   !                                     !!** ice-thickness distribution namelist (namiceitd) **
+   INTEGER , PUBLIC ::   nn_catbnd        !: categories distribution following: tanh function (1), or h^(-alpha) function (2)
+   REAL(wp), PUBLIC ::   rn_himean        !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only)
+
+   !                                     !!** ice-dynamics namelist (namicedyn) **
+   LOGICAL , PUBLIC ::   ln_icestr_bvf    !: use brine volume to diminish ice strength
+   INTEGER , PUBLIC ::   nn_icestr        !: ice strength parameterization (0=Hibler79 1=Rothrock75)
+   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling
+   INTEGER , PUBLIC ::   nn_ahi0          !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation)
+   REAL(wp), PUBLIC ::   rn_pe_rdg        !: ridging work divided by pot. energy change in ridging, nn_icestr = 1
+   REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress
+   REAL(wp), PUBLIC ::   rn_pstar         !: determines ice strength (N/M), Hibler JPO79
+   REAL(wp), PUBLIC ::   rn_crhg          !: determines changes in ice strength
+   REAL(wp), PUBLIC ::   rn_creepl        !: creep limit : has to be under 1.0e-9
+   REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve
+   REAL(wp), PUBLIC ::   rn_ahi0_ref      !: sea-ice hor. eddy diffusivity coeff. (m2/s)
+   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 
 
    !                                     !!** ice-salinity namelist (namicesal) **
-   REAL(wp), PUBLIC ::   s_i_max          !: maximum ice salinity [PSU]
-   REAL(wp), PUBLIC ::   s_i_min          !: minimum ice salinity [PSU]
-   REAL(wp), PUBLIC ::   s_i_0            !: 1st sal. value for the computation of sal .prof. [PSU]
-   REAL(wp), PUBLIC ::   s_i_1            !: 2nd sal. value for the computation of sal .prof. [PSU]
-   REAL(wp), PUBLIC ::   sal_G            !: restoring salinity for gravity drainage [PSU]
-   REAL(wp), PUBLIC ::   sal_F            !: restoring salinity for flushing [PSU]
-   REAL(wp), PUBLIC ::   time_G           !: restoring time constant for gravity drainage (= 20 days) [s]
-   REAL(wp), PUBLIC ::   time_F           !: restoring time constant for gravity drainage (= 10 days) [s]
-   REAL(wp), PUBLIC ::   bulk_sal         !: bulk salinity (ppt) in case of constant salinity
+   REAL(wp), PUBLIC ::   rn_simax         !: maximum ice salinity [PSU]
+   REAL(wp), PUBLIC ::   rn_simin         !: minimum ice salinity [PSU]
+   REAL(wp), PUBLIC ::   rn_sal_gd        !: restoring salinity for gravity drainage [PSU]
+   REAL(wp), PUBLIC ::   rn_sal_fl        !: restoring salinity for flushing [PSU]
+   REAL(wp), PUBLIC ::   rn_time_gd       !: restoring time constant for gravity drainage (= 20 days) [s]
+   REAL(wp), PUBLIC ::   rn_time_fl       !: restoring time constant for gravity drainage (= 10 days) [s]
+   REAL(wp), PUBLIC ::   rn_icesal        !: bulk salinity (ppt) in case of constant salinity
 
    !                                     !!** ice-salinity namelist (namicesal) **
-   INTEGER , PUBLIC ::   num_sal             !: salinity configuration used in the model
+   INTEGER , PUBLIC ::   nn_icesal           !: salinity configuration used in the model
    !                                         ! 1 - constant salinity in both space and time
    !                                         ! 2 - prognostic salinity (s(z,t))
    !                                         ! 3 - salinity profile, constant in time
-   INTEGER , PUBLIC ::   thcon_i_swi         !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007)
+   INTEGER , PUBLIC ::   nn_ice_thcon        !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007)
+   INTEGER , PUBLIC ::   nn_monocat          !: virtual ITD mono-category parameterizations (1) or not (0)
+   LOGICAL , PUBLIC ::   ln_it_qnsice        !: iterate surface flux with changing surface temperature or not (F)
 
    !                                     !!** ice-mechanical redistribution namelist (namiceitdme)
-   REAL(wp), PUBLIC ::   Cs               !: fraction of shearing energy contributing to ridging            
-   REAL(wp), PUBLIC ::   Cf               !: ratio of ridging work to PE loss
-   REAL(wp), PUBLIC ::   fsnowrdg         !: fractional snow loss to the ocean during ridging
-   REAL(wp), PUBLIC ::   fsnowrft         !: fractional snow loss to the ocean during ridging
-   REAL(wp), PUBLIC ::   Gstar            !: fractional area of young ice contributing to ridging
-   REAL(wp), PUBLIC ::   astar            !: equivalent of G* for an exponential participation function
-   REAL(wp), PUBLIC ::   Hstar            !: thickness that determines the maximal thickness of ridged ice
-   REAL(wp), PUBLIC ::   hparmeter        !: threshold thickness (m) for rafting / ridging 
-   REAL(wp), PUBLIC ::   Craft            !: coefficient for smoothness of the hyperbolic tangent in rafting
-   REAL(wp), PUBLIC ::   ridge_por        !: initial porosity of ridges (0.3 regular value)
-   REAL(wp), PUBLIC ::   betas            !: coef. for partitioning of snowfall between leads and sea ice
-   REAL(wp), PUBLIC ::   kappa_i          !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]
-   REAL(wp), PUBLIC ::   nconv_i_thd      !: maximal number of iterations for heat diffusion
-   REAL(wp), PUBLIC ::   maxer_i_thd      !: maximal tolerated error (C) for heat diffusion
+   REAL(wp), PUBLIC ::   rn_cs            !: fraction of shearing energy contributing to ridging            
+   REAL(wp), PUBLIC ::   rn_fsnowrdg      !: fractional snow loss to the ocean during ridging
+   REAL(wp), PUBLIC ::   rn_fsnowrft      !: fractional snow loss to the ocean during ridging
+   REAL(wp), PUBLIC ::   rn_gstar         !: fractional area of young ice contributing to ridging
+   REAL(wp), PUBLIC ::   rn_astar         !: equivalent of G* for an exponential participation function
+   REAL(wp), PUBLIC ::   rn_hstar         !: thickness that determines the maximal thickness of ridged ice
+   REAL(wp), PUBLIC ::   rn_hraft         !: threshold thickness (m) for rafting / ridging 
+   REAL(wp), PUBLIC ::   rn_craft         !: coefficient for smoothness of the hyperbolic tangent in rafting
+   REAL(wp), PUBLIC ::   rn_por_rdg       !: initial porosity of ridges (0.3 regular value)
+   REAL(wp), PUBLIC ::   rn_betas         !: coef. for partitioning of snowfall between leads and sea ice
+   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]
+   REAL(wp), PUBLIC ::   nn_conv_dif      !: maximal number of iterations for heat diffusion
+   REAL(wp), PUBLIC ::   rn_terr_dif      !: maximal tolerated error (C) for heat diffusion
 
    !                                     !!** ice-mechanical redistribution namelist (namiceitdme)
-   INTEGER , PUBLIC ::   ridge_scheme_swi !: scheme used for ice ridging
-   INTEGER , PUBLIC ::   raft_swi         !: rafting of ice or not                        
-   INTEGER , PUBLIC ::   partfun_swi      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007)
-   INTEGER , PUBLIC ::   brinstren_swi    !: use brine volume to diminish ice strength
-
-   REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( ecc * ecc )
-   REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cw
-
+   LOGICAL , PUBLIC ::   ln_rafting      !: rafting of ice or not                        
+   INTEGER , PUBLIC ::   nn_partfun      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007)
+
+   REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( rn_ecc * rn_ecc )
+   REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cio
+   REAL(wp), PUBLIC ::   r1_nlay_i        !: 1 / nlay_i
+   REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s 
+   !
    !                                     !!** switch for presence of ice or not 
    REAL(wp), PUBLIC ::   rswitch
-
+   !
    !                                     !!** define some parameters 
-   REAL(wp), PUBLIC, PARAMETER ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy
    REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number 
    REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number 
@@ -266,4 +266,8 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice [kg/m2]
 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total) [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_thd     !: ice concentration tendency (thermodynamics) [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_dyn     !: ice concentration tendency (dynamics) [s-1]
+
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s]
@@ -282,4 +286,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations 
@@ -296,7 +301,4 @@
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice
-
-   ! temporary arrays for dummy version of the code
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, q_s
 
    !!--------------------------------------------------------------------------
@@ -333,5 +335,5 @@
       
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i        !: ice temperatures          [K]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i        !: ice thermal contents [Giga J]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i        !: ice thermal contents    [J/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i        !: ice salinities          [PSU]
 
@@ -356,57 +358,47 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity
-      
-
-   !!--------------------------------------------------------------------------
-   !! * Increment of global variables
-   !!--------------------------------------------------------------------------
+            
+   !!--------------------------------------------------------------------------
+   !! * Ice thickness distribution variables
+   !!--------------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories 
+
+   !!--------------------------------------------------------------------------
+   !! * Ice Run
+   !!--------------------------------------------------------------------------
+   !                                                  !!: ** Namelist namicerun read in sbc_lim_init **
+   INTEGER          , PUBLIC ::   jpl             !: number of ice  categories 
+   INTEGER          , PUBLIC ::   nlay_i          !: number of ice  layers 
+   INTEGER          , PUBLIC ::   nlay_s          !: number of snow layers 
+   CHARACTER(len=32), PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input)
+   CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory
+   CHARACTER(len=32), PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output)
+   CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory
+   LOGICAL          , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F)
+   LOGICAL          , PUBLIC ::   ln_icectl       !: flag for sea-ice points output (T) or not (F)
+   REAL(wp)         , PUBLIC ::   rn_amax         !: maximum ice concentration
+   INTEGER          , PUBLIC ::   iiceprt         !: debug i-point
+   INTEGER          , PUBLIC ::   jiceprt         !: debug j-point
+   !
+   !!--------------------------------------------------------------------------
+   !! * Ice diagnostics
+   !!--------------------------------------------------------------------------
+   ! Increment of global variables
    ! thd refers to changes induced by thermodynamics
    ! trp   ''         ''     ''       advection (transport of ice)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_a_i_thd  , d_a_i_trp                 !: icefractions                  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_s_thd  , d_v_s_trp                 !: snow volume
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_i_thd  , d_v_i_trp                 !: ice  volume
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_smv_i_thd, d_smv_i_trp               !:     
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_fl  , d_sm_i_gd                 !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_se  , d_sm_i_si  , d_sm_i_la    !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_oa_i_thd , d_oa_i_trp                !:
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_s_thd  , d_e_s_trp     !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_i_thd  , d_e_i_trp     !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   d_u_ice_dyn, d_v_ice_dyn   !: ice velocity 
-      
-   !!--------------------------------------------------------------------------
-   !! * Ice thickness distribution variables
-   !!--------------------------------------------------------------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories 
-
-   !!--------------------------------------------------------------------------
-   !! * Ice Run
-   !!--------------------------------------------------------------------------
-   !                                                  !!: ** Namelist namicerun read in iceini **
-   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input)
-   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output)
-   LOGICAL               , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F)
-   LOGICAL               , PUBLIC ::   ln_nicep        !: flag for sea-ice points output (T) or not (F)
-   REAL(wp)              , PUBLIC ::   cai             !: atmospheric drag over sea ice
-   REAL(wp)              , PUBLIC ::   cao             !: atmospheric drag over ocean
-   REAL(wp)              , PUBLIC ::   amax            !: maximum ice concentration
+   LOGICAL , PUBLIC                                        ::   ln_limdiahsb  !: flag for ice diag (T) or not (F)
+   LOGICAL , PUBLIC                                        ::   ln_limdiaout  !: flag for ice diag (T) or not (F)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vi   !: transport of ice volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vs   !: transport of snw volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_ei   !: transport of ice enthalpy (W/m2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_es   !: transport of snw enthalpy (W/m2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_smv  !: transport of salt content
    !
-   !!--------------------------------------------------------------------------
-   !! * Ice diagnostics
-   !!--------------------------------------------------------------------------
-   !! Check if everything down here is necessary
-   LOGICAL , PUBLIC                                      ::   ln_limdiahsb  !: flag for ice diag (T) or not (F)
-   LOGICAL , PUBLIC                                      ::   ln_limdiaout  !: flag for ice diag (T) or not (F)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd     !: thermodynamic growth rates 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   !: transport of ice volume
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vs   !: transport of snw volume
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_ei   !: transport of ice enthalpy (W/m2)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_es   !: transport of snw enthalpy (W/m2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_heat     !: snw/ice heat content variation   [W/m2] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_smvi     !: ice salt content variation   [] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vice     !: ice volume variation   [m/s] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vsnw     !: snw volume variation   [m/s] 
    !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_heat_dhc !: snw/ice heat content variation   [W/m2] 
-   !
-   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point
-
    !!----------------------------------------------------------------------
    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
@@ -422,5 +414,5 @@
       INTEGER :: ice_alloc
       !
-      INTEGER :: ierr(19), ii
+      INTEGER :: ierr(17), ii
       !!-----------------------------------------------------------------
 
@@ -439,15 +431,17 @@
 
       ii = ii + 1
-      ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,      &
-         &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,      &
-         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,    &
+      ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,                        &
+         &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,                        &
+         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,                        &
          &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     &
-         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,  qlead  (jpi,jpj) ,     &
-         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl) ,      &
-         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,      &
-         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,   &
-         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), &
-         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,  &
-         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , &
+         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,     &
+         &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) ,                        &
+         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead  (jpi,jpj) ,                     &
+         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,                        &
+         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,    &
+         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,     & 
+         &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) ,                                   &
+         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,                           &
+         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) ,    &
          &      hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,  STAT=ierr(ii) )
 
@@ -464,8 +458,7 @@
          &      bv_i (jpi,jpj) , smt_i(jpi,jpj)                                   , STAT=ierr(ii) )
       ii = ii + 1
-      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) ,                            &
-         &      e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) )
-      ii = ii + 1
-      ALLOCATE( t_i(jpi,jpj,nlay_i+1,jpl) , e_i(jpi,jpj,nlay_i+1,jpl) , s_i(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) )
+      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , s_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) )
 
       ! * Moments for advection
@@ -483,24 +476,12 @@
          &      STAT=ierr(ii) )
       ii = ii + 1
-      ALLOCATE( sxe (jpi,jpj,nlay_i+1,jpl) , sye (jpi,jpj,nlay_i+1,jpl) , sxxe(jpi,jpj,nlay_i+1,jpl) ,     &
-         &      syye(jpi,jpj,nlay_i+1,jpl) , sxye(jpi,jpj,nlay_i+1,jpl)                           , STAT=ierr(ii) )
+      ALLOCATE( sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe(jpi,jpj,nlay_i,jpl) ,     &
+         &      syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl)                            , STAT=ierr(ii) )
 
       ! * Old values of global variables
       ii = ii + 1
       ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     &
-         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) ,     &
-         &      oa_i_b (jpi,jpj,jpl)                                                        ,     &
-         &      u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)                                   , STAT=ierr(ii) )
-
-      ! * Increment of global variables
-      ii = ii + 1
-      ALLOCATE( d_a_i_thd(jpi,jpj,jpl) , d_a_i_trp (jpi,jpj,jpl) , d_v_s_thd  (jpi,jpj,jpl) , d_v_s_trp  (jpi,jpj,jpl) ,   &
-         &      d_v_i_thd(jpi,jpj,jpl) , d_v_i_trp (jpi,jpj,jpl) , d_smv_i_thd(jpi,jpj,jpl) , d_smv_i_trp(jpi,jpj,jpl) ,   &     
-         &      d_sm_i_fl(jpi,jpj,jpl) , d_sm_i_gd (jpi,jpj,jpl) , d_sm_i_se  (jpi,jpj,jpl) , d_sm_i_si  (jpi,jpj,jpl) ,   &
-         &      d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) ,   &
-         &     STAT=ierr(ii) )
-      ii = ii + 1
-      ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,nlay_i,jpl) , d_u_ice_dyn(jpi,jpj) ,     &
-         &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,nlay_i,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) )
+         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) ,     &
+         &      oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)          , STAT=ierr(ii) )
       
       ! * Ice thickness distribution variables
@@ -510,7 +491,7 @@
       ! * Ice diagnostics
       ii = ii + 1
-      ALLOCATE( dv_dt_thd(jpi,jpj,jpl),    &
-         &      diag_trp_vi(jpi,jpj), diag_trp_vs  (jpi,jpj), diag_trp_ei(jpi,jpj),   & 
-         &      diag_trp_es(jpi,jpj), diag_heat_dhc(jpi,jpj),  STAT=ierr(ii) )
+      ALLOCATE( diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj),   & 
+         &      diag_trp_es(jpi,jpj), diag_trp_smv(jpi,jpj), diag_heat  (jpi,jpj),   &
+         &      diag_smvi  (jpi,jpj), diag_vice   (jpi,jpj), diag_vsnw  (jpi,jpj), STAT=ierr(ii) )
 
       ice_alloc = MAXVAL( ierr(:) )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90	(revision 5891)
+++ 	(revision )
@@ -1,225 +1,0 @@
-MODULE iceini
-   !!======================================================================
-   !!                       ***  MODULE iceini   ***
-   !!   Sea-ice model : LIM Sea ice model Initialization
-   !!======================================================================
-   !! History :  3.0  ! 2008-03  (M. Vancoppenolle) LIM-3 original code
-   !!            3.3  ! 2010-12  (G. Madec) add call to lim_thd_init and lim_thd_sal_init
-   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                     LIM sea-ice model
-   !!----------------------------------------------------------------------
-   !!   ice_init      : sea-ice model initialization
-   !!----------------------------------------------------------------------
-   USE phycst         ! physical constants
-   USE dom_oce        ! ocean domain
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE sbc_ice        ! Surface boundary condition: ice   fields
-   USE ice            ! LIM variables
-   USE par_ice        ! LIM parameters
-   USE dom_ice        ! LIM domain
-   USE thd_ice        ! LIM thermodynamical variables
-   USE limitd_me      ! LIM ice thickness distribution
-   USE limmsh         ! LIM mesh
-   USE limistate      ! LIM initial state
-   USE limrst         ! LIM restart
-   USE limthd         ! LIM ice thermodynamics
-   USE limthd_sal     ! LIM ice thermodynamics: salinity
-   USE limvar         ! LIM variables
-   USE limsbc         ! LIM surface boundary condition
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   ice_init   ! called by sbcice_lim.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE ice_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ice_init  ***
-      !!
-      !! ** purpose :   Allocate all the dynamic arrays of the LIM-3 modules
-      !!----------------------------------------------------------------------
-      INTEGER :: ierr
-      !!----------------------------------------------------------------------
-
-      !                                ! Allocate the ice arrays
-      ierr =        ice_alloc        ()      ! ice variables
-      ierr = ierr + dom_ice_alloc    ()      ! domain
-      ierr = ierr + sbc_ice_alloc    ()      ! surface forcing
-      ierr = ierr + thd_ice_alloc    ()      ! thermodynamics
-      ierr = ierr + lim_itd_me_alloc ()      ! ice thickness distribution - mechanics
-      !
-      IF( lk_mpp    )   CALL mpp_sum( ierr )
-      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays')
-      !
-      !                                ! adequation jpk versus ice/snow layers/categories
-      IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk )   &
-         &      CALL ctl_stop( 'STOP',                     &
-         &     'ice_init: the 3rd dimension of workspace arrays is too small.',   &
-         &     'use more ocean levels or less ice/snow layers/categories.' )
-
-                                       ! Open the reference and configuration namelist files and namelist output file 
-      CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
-      CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-      IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 )
-      !
-      CALL ice_run                     ! set some ice run parameters
-      !
-      CALL lim_thd_init                ! set ice thermodynics parameters
-      !
-      CALL lim_thd_sal_init            ! set ice salinity parameters
-      !
-      rdt_ice   = nn_fsbc * rdttra(1)  ! sea-ice timestep
-      r1_rdtice = 1._wp / rdt_ice      ! sea-ice timestep inverse
-      !
-      CALL lim_msh                     ! ice mesh initialization
-      !
-      CALL lim_itd_ini                 ! ice thickness distribution initialization
-      !
-      CALL lim_itd_me_init             ! ice thickness distribution initialization
-      !                                ! Initial sea-ice state
-      IF( .NOT. ln_rstart ) THEN              ! start from rest
-         numit = 0
-         numit = nit000 - 1
-         CALL lim_istate                        ! start from rest: sea-ice deduced from sst
-         CALL lim_var_agg(1)                    ! aggregate category variables in bulk variables
-         CALL lim_var_glo2eqv                   ! convert global variables in equivalent variables
-      ELSE                                   ! start from a restart file
-         CALL lim_rst_read                      ! read the restart file
-         numit = nit000 - 1
-         CALL lim_var_agg(1)                    ! aggregate ice variables
-         CALL lim_var_glo2eqv                   ! convert global var in equivalent variables
-      ENDIF
-      !
-      hi_max(jpl) = 99._wp  ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl)
-      !
-      CALL lim_sbc_init                 ! ice surface boundary condition   
-      !
-      fr_i(:,:) = at_i(:,:)             ! initialisation of sea-ice fraction
-      tn_ice(:,:,:) = t_su(:,:,:)       ! initialisation of surface temp for coupled simu
-      !
-      nstart = numit  + nn_fsbc      
-      nitrun = nitend - nit000 + 1 
-      nlast  = numit  + nitrun 
-      !
-      IF( nstock == 0  )   nstock = nlast + 1
-      !
-   END SUBROUTINE ice_init
-
-
-   SUBROUTINE ice_run
-      !!-------------------------------------------------------------------
-      !!                  ***  ROUTINE ice_run ***
-      !!                 
-      !! ** Purpose :   Definition some run parameter for ice model
-      !!
-      !! ** Method  :   Read the namicerun namelist and check the parameter 
-      !!              values called at the first timestep (nit000)
-      !!
-      !! ** input   :   Namelist namicerun
-      !!-------------------------------------------------------------------
-      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, amax, cai, cao, ln_nicep, ln_limdiahsb, ln_limdiaout
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      !!-------------------------------------------------------------------
-      !                    
-      REWIND( numnam_ice_ref )              ! Namelist namicerun in reference namelist : Parameters for ice
-      READ  ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )
-
-      REWIND( numnam_ice_cfg )              ! Namelist namicerun in configuration namelist : Parameters for ice
-      READ  ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namicerun )
-      !
-      !IF( lk_mpp .AND. ln_nicep ) THEN
-      !   ln_nicep = .FALSE.
-      !   CALL ctl_warn( 'ice_run : specific control print for LIM3 desactivated with MPI' )
-      !ENDIF
-      !
-      IF(lwp) THEN                        ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
-         WRITE(numout,*) ' ~~~~~~'
-         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn
-         WRITE(numout,*) '   maximum ice concentration                               = ', amax 
-         WRITE(numout,*) '   atmospheric drag over sea ice                           = ', cai
-         WRITE(numout,*) '   atmospheric drag over ocean                             = ', cao
-         WRITE(numout,*) '   Several ice points in the ice or not in ocean.output    = ', ln_nicep
-         WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb
-         WRITE(numout,*) '   Output   heat/salt budget or not          ln_limdiaout  = ', ln_limdiaout
-      ENDIF
-      !
-   END SUBROUTINE ice_run
-
-
-   SUBROUTINE lim_itd_ini
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_ini ***
-      !!
-      !! ** Purpose :   Initializes the ice thickness distribution
-      !! ** Method  :   ...
-      !!    Note    : hi_max(jpl) is here set up to a value close to 7 m for
-      !!              limistate (only) and is changed to 99 m in ice_init
-      !!------------------------------------------------------------------
-      INTEGER  ::   jl                   ! dummy loop index
-      REAL(wp) ::   zc1, zc2, zc3, zx1   ! local scalars
-      !!------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'lim_itd_ini : Initialization of ice thickness distribution '
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-
-      !------------------------------------------------------------------------------!
-      ! 1) Ice thickness distribution parameters initialization    
-      !------------------------------------------------------------------------------!
-      IF(lwp) THEN  
-         WRITE(numout,*) ' Number of ice categories jpl = ', jpl
-      ENDIF
-
-      !- Thickness categories boundaries 
-      !----------------------------------
-      hi_max(:) = 0._wp
-
-      zc1 =  3._wp / REAL( jpl, wp )
-      zc2 = 10._wp * zc1
-      zc3 =  3._wp
-
-      DO jl = 1, jpl
-         zx1 = REAL( jl-1, wp ) / REAL( jpl, wp )
-         hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) )
-      END DO
-
-      IF(lwp) WRITE(numout,*) ' Thickness category boundaries '
-      IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl)
-
-      !
-      DO jl = 1, jpl
-         hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp
-      END DO
-      !
-      !
-   END SUBROUTINE lim_itd_ini
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :        Empty module           NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE ice_init        ! Empty routine
-   END SUBROUTINE ice_init
-#endif
-
-   !!======================================================================
-END MODULE iceini
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90	(revision 5901)
@@ -63,5 +63,5 @@
       !! 
       INTEGER  ::   ji, jj                               ! dummy loop indices
-      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! local scalars
+      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! local scalars
       REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      -
       REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      -
@@ -85,17 +85,17 @@
             zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      &
                &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  )
-            zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask
+            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
 
             ps0 (ji,jj) = zslpmax  
-            psx (ji,jj) = zs1new      * zin0
-            psxx(ji,jj) = zs2new      * zin0
-            psy (ji,jj) = psy (ji,jj) * zin0
-            psyy(ji,jj) = psyy(ji,jj) * zin0
-            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0
+            psx (ji,jj) = zs1new      * rswitch
+            psxx(ji,jj) = zs2new      * rswitch
+            psy (ji,jj) = psy (ji,jj) * rswitch
+            psyy(ji,jj) = psyy(ji,jj) * rswitch
+            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch
          END DO
       END DO
 
       !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
-      psm (:,:)  = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
+      psm (:,:)  = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
 
       !  Calculate fluxes and moments between boxes i<-->i+1              
@@ -207,8 +207,8 @@
 
       !-- Lateral boundary conditions
-      CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. )
-      CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes
-      CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. )
-      CALL lbc_lnk( psxy, 'T',  1. )
+      CALL lbc_lnk_multi( psm , 'T',  1., ps0 , 'T',  1.   &
+         &              , psx , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes
+         &              , psxx, 'T',  1., psyy, 'T',  1.   &
+         &              , psxy, 'T',  1. )
 
       IF(ln_ctl) THEN
@@ -248,5 +248,5 @@
       !!
       INTEGER  ::   ji, jj                               ! dummy loop indices
-      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! temporary scalars
+      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! temporary scalars
       REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         -
       REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         -
@@ -270,17 +270,17 @@
             zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   &
                &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  )
-            zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask
+            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
             !
             ps0 (ji,jj) = zslpmax  
-            psx (ji,jj) = psx (ji,jj) * zin0
-            psxx(ji,jj) = psxx(ji,jj) * zin0
-            psy (ji,jj) = zs1new * zin0
-            psyy(ji,jj) = zs2new * zin0
-            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0
+            psx (ji,jj) = psx (ji,jj) * rswitch
+            psxx(ji,jj) = psxx(ji,jj) * rswitch
+            psy (ji,jj) = zs1new * rswitch
+            psyy(ji,jj) = zs2new * rswitch
+            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch
          END DO
       END DO
 
       !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
-      psm(:,:)  = MAX(  pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  )
+      psm(:,:)  = MAX(  pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  )
 
       !  Calculate fluxes and moments between boxes j<-->j+1              
@@ -393,8 +393,8 @@
 
       !-- Lateral boundary conditions
-      CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. )
-      CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes
-      CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. )
-      CALL lbc_lnk( psxy, 'T',  1. )
+      CALL lbc_lnk_multi( psm , 'T',  1.,  ps0 , 'T',  1.   &
+         &              , psx , 'T', -1.,  psy , 'T', -1.   &   ! caution gradient ==> the sign changes
+         &              , psxx, 'T',  1.,  psyy, 'T',  1.   &
+         &              , psxy, 'T',  1. )
 
       IF(ln_ctl) THEN
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limcat_1D.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limcat_1D.F90	(revision 5891)
+++ 	(revision )
@@ -1,215 +1,0 @@
-MODULE limcat_1D
-   !!======================================================================
-   !!                     ***  MODULE  limcat_1D  ***
-   !!  Used for LIM3 to convert cell averages of ice thickness, snow thickness
-   !!  and ice cover into a prescribed distribution over the cell. 
-   !!  (Example of application: BDY forcings when input are cell averaged)  
-   !!======================================================================
-   !! History :   -   ! Original code from M. Vancoppenolle (?)
-   !!                 ! 2011-12 (C. Rousset) rewritten for clarity
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3' :                                    LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_cat_1D      :  main subroutine
-   !!----------------------------------------------------------------------
-   !! Modules used
-   USE phycst
-   USE oce             ! dynamics and tracers variables
-   USE dom_oce
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE par_ice         ! ice parameters
-   USE ice             ! ice variables
-   USE eosbn2          ! equation of state
-   USE in_out_manager
-   USE dom_ice
-   USE ice
-   USE lbclnk
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! Accessibility
-   PUBLIC lim_cat_1D      
-
-CONTAINS
-
-   SUBROUTINE lim_cat_1D(zhti,zhts,zai,zht_i,zht_s,za_i)
-      !! Local variables
-      INTEGER  :: ji, jk, jl             ! dummy loop indices
-      INTEGER  :: ijpij, i_fill, jl0, ztest_1, ztest_2, ztest_3, ztest_4, ztests  
-      REAL(wp) :: zarg, zV, zconv
-      REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zai    ! input ice/snow variables
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zht_i, zht_s, za_i ! output ice/snow variables
-      REAL(wp) :: epsi06 = 1.0e-6
-      REAL(wp) :: zc1, zc2, zc3, zx1, zdh   ! local scalars
-      REAL(wp), DIMENSION(0:jpl)   ::   zhi_max         !:Boundary of ice thickness categories in thickness space
- 
-      IF( nn_timing == 1 )  CALL timing_start('limcat_1D')
-      !--------------------------------------------------------------------
-      ! initialisation of variables
-      !--------------------------------------------------------------------
-      ijpij = SIZE(zhti,1)
-      zht_i(1:ijpij,1:jpl) = 0._wp
-      zht_s(1:ijpij,1:jpl) = 0._wp
-      za_i (1:ijpij,1:jpl) = 0._wp
-
-      !------------------------------------------------------------------------------------
-      ! Distribute ice concentration and thickness into the categories
-      !------------------------------------------------------------------------------------
-      ! Method: we first try to fill the jpl ice categories bounded by thicknesses
-      !         hmax(0:jpl) with a gaussian distribution, and check whether the distribution
-      !         fulfills volume and area conservation, positivity and ice categories bounds.
-      !         In other words, if ice input is too thin, the last category (jpl)
-      !         cannot be filled, so we try to fill jpl-1 categories...
-      !         And so forth iteratively until the number of categories filled
-      !         fulfills ice volume concervation between input and output (ztests=4) 
-      !--------------------------------------------------------------------------------------
-
-      !- Thickness categories boundaries
-      !    hi_max is calculated in iceini.F90 but since limcat_1D.F90 routine 
-      !    is called before (in bdydta.F90), one must recalculate it.   
-      !    Note clem: there may be a way of doing things cleaner
-      !----------------------------------
-      zhi_max(:) = 0._wp
-      zc1 =  3._wp / REAL( jpl , wp ) ; zc2 = 10._wp * zc1 ; zc3 =  3._wp
-      DO jl = 1, jpl
-         zx1 = REAL( jl-1 , wp ) / REAL( jpl , wp )
-         zhi_max(jl) = zhi_max(jl-1) + zc1 + zc2 * ( 1._wp + TANH( zc3 * ( zx1 - 1._wp ) ) )
-      END DO
- 
-      ! ----------------------------------------
-      ! distribution over the jpl ice categories
-      ! ----------------------------------------
-      DO ji = 1, ijpij
-         
-         IF( zhti(ji) > 0._wp ) THEN
-
-         ! initialisation of tests
-         ztest_1 = 0
-         ztest_2 = 0
-         ztest_3 = 0
-         ztest_4 = 0
-         ztests  = 0
-         
-         i_fill = jpl + 1                                    !====================================
-         DO WHILE ( ( ztests /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories  
-            ! iteration                                      !====================================
-            i_fill = i_fill - 1
-            
-            ! initialisation of ice variables for each try
-            zht_i(ji,1:jpl) = 0._wp
-            za_i (ji,1:jpl) = 0._wp
-            
-            ! *** case very thin ice: fill only category 1
-            IF ( i_fill == 1 ) THEN
-               zht_i(ji,1) = zhti(ji)
-               za_i (ji,1) = zai (ji)
-               ! *** case ice is thicker: fill categories >1
-            ELSE
-
-               ! Fill ice thicknesses except the last one (i_fill) by (hmax-hmin)/2 
-               DO jl = 1, i_fill - 1
-                  zht_i(ji,jl) = ( zhi_max(jl) + zhi_max(jl-1) ) * 0.5_wp
-               END DO
-               
-               ! find which category (jl0) the input ice thickness falls into
-               jl0 = i_fill
-               DO jl = 1, i_fill
-                  IF ( ( zhti(ji) >= zhi_max(jl-1) ) .AND. ( zhti(ji) < zhi_max(jl) ) ) THEN
-                     jl0 = jl
-		     CYCLE
-                  ENDIF
-               END DO
-               
-               ! Concentrations in the (i_fill-1) categories 
-               za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl))
-               DO jl = 1, i_fill - 1
-                  IF ( jl == jl0 ) CYCLE
-                  zarg           = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp )
-                  za_i(ji,jl) =   za_i (ji,jl0) * EXP(-zarg**2)
-               END DO
-               
-               ! Concentration in the last (i_fill) category
-               za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) )
-               
-               ! Ice thickness in the last (i_fill) category
-               zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) )
-               zht_i(ji,i_fill) = ( zhti(ji)*zai(ji) -  zV ) / za_i(ji,i_fill) 
-               
-            ENDIF ! case ice is thick or thin
-            
-            !---------------------
-            ! Compatibility tests
-            !--------------------- 
-            ! Test 1: area conservation
-            zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) )
-            IF ( zconv < epsi06 ) ztest_1 = 1
-            
-            ! Test 2: volume conservation
-            zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) )
-            IF ( zconv < epsi06 ) ztest_2 = 1
-            
-            ! Test 3: thickness of the last category is in-bounds ?
-            IF ( zht_i(ji,i_fill) >= zhi_max(i_fill-1) ) ztest_3 = 1
-            
-            ! Test 4: positivity of ice concentrations
-            ztest_4 = 1
-            DO jl = 1, i_fill
-               IF ( za_i(ji,jl) < 0._wp ) ztest_4 = 0
-            END DO
-            
-            ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4
-                                                           !============================
-         END DO                                            ! end iteration on categories
-                                                           !============================
-         ! Check if tests have passed (i.e. volume conservation...)
-         !IF ( ztests /= 4 ) THEN
-         !   WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '
-         !   WRITE(numout,*) ' !! ALERT categories distribution !!'
-         !   WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '
-         !   WRITE(numout,*) ' *** ztests is not equal to 4 '
-         !   WRITE(numout,*) ' *** ztest (1:4) = ', ztest_1, ztest_2, ztest_3, ztest_4
-         !   WRITE(numout,*) 'i_fill=',i_fill
-         !   WRITE(numout,*) 'zai(ji)=',zai(ji)
-         !   WRITE(numout,*) 'za_i(ji,jpl)=',za_i(ji,:)
-         !ENDIF
-         
-         ENDIF ! if zhti > 0
-
-      END DO ! i loop
-
-      ! ------------------------------------------------
-      ! Adding Snow in each category where za_i is not 0
-      ! ------------------------------------------------ 
-      DO jl = 1, jpl
-         DO ji = 1, ijpij
-            IF( za_i(ji,jl) > 0._wp ) THEN
-               zht_s(ji,jl) = zht_i(ji,jl) * ( zhts(ji) / zhti(ji) )
-               ! In case snow load is in excess that would lead to transformation from snow to ice
-               ! Then, transfer the snow excess into the ice (different from limthd_dh)
-               zdh = MAX( 0._wp, ( rhosn * zht_s(ji,jl) + ( rhoic - rau0 ) * zht_i(ji,jl) ) * r1_rau0 ) 
-               ! recompute ht_i, ht_s avoiding out of bounds values
-               zht_i(ji,jl) = MIN( zhi_max(jl), zht_i(ji,jl) + zdh )
-               zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic / rhosn )
-            ENDIF
-         ENDDO
-      ENDDO
-
-      IF( nn_timing == 1 )  CALL timing_stop('limcat_1D')
-     
-    END SUBROUTINE lim_cat_1D
-    
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :         Empty module          NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_cat_1D          ! Empty routine
-   END SUBROUTINE lim_cat_1D
-#endif
-
-   !!======================================================================
-END MODULE limcat_1D
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 5901)
@@ -6,6 +6,7 @@
    !! History :   -   ! Original code from William H. Lipscomb, LANL
    !!            3.0  ! 2004-06  (M. Vancoppenolle)   Energy Conservation 
-   !!            4.0  ! 2011-02  (G. Madec)  add mpp considerations
+   !!            3.5  ! 2011-02  (G. Madec)  add mpp considerations
    !!             -   ! 2014-05  (C. Rousset) add lim_cons_hsm
+   !!             -   ! 2015-03  (C. Rousset) add lim_cons_final
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -16,5 +17,4 @@
    !!----------------------------------------------------------------------
    USE phycst         ! physical constants
-   USE par_ice        ! LIM-3 parameter
    USE ice            ! LIM-3 variables
    USE dom_ice        ! LIM-3 domain
@@ -23,4 +23,5 @@
    USE lib_mpp        ! MPP library
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE sbc_oce , ONLY : sfx  ! Surface boundary condition: ocean fields
 
    IMPLICIT NONE
@@ -31,4 +32,5 @@
    PUBLIC   lim_cons_check
    PUBLIC   lim_cons_hsm
+   PUBLIC   lim_cons_final
 
    !!----------------------------------------------------------------------
@@ -73,8 +75,8 @@
       !! ** Method  : Arithmetics
       !!---------------------------------------------------------------------
-      INTEGER                                  , INTENT(in   ) ::   ksum   !: number of categories
-      INTEGER                                  , INTENT(in   ) ::   klay   !: number of vertical layers
-      REAL(wp), DIMENSION(jpi,jpj,nlay_i+1,jpl), INTENT(in   ) ::   pin   !: input field
-      REAL(wp), DIMENSION(jpi,jpj)             , INTENT(  out) ::   pout   !: output field
+      INTEGER                                , INTENT(in   ) ::   ksum   !: number of categories
+      INTEGER                                , INTENT(in   ) ::   klay   !: number of vertical layers
+      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl), INTENT(in   ) ::   pin    !: input field
+      REAL(wp), DIMENSION(jpi,jpj)           , INTENT(  out) ::   pout   !: output field
       !
       INTEGER ::   jk, jl   ! dummy loop indices
@@ -156,61 +158,106 @@
 
    SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b )
-      !!-------------------------------------------------------------------
-      !!               ***  ROUTINE lim_cons_hsm ***
-      !!
-      !! ** Purpose : Test the conservation of heat, salt and mass for each routine
-      !!
-      !! ** Method  :
-      !!---------------------------------------------------------------------
-      INTEGER         , INTENT(in)    :: icount      ! determine wether this is the beggining of the routine (0) or the end (1)
-      CHARACTER(len=*), INTENT(in)    :: cd_routine  ! name of the routine
+      !!--------------------------------------------------------------------------------------------------------
+      !!                                        ***  ROUTINE lim_cons_hsm ***
+      !!
+      !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine
+      !!                     + test if ice concentration and volume are > 0
+      !!
+      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiahsb=true
+      !!              It prints in ocean.output if there is a violation of conservation at each time-step
+      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine violations are set to
+      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years.
+      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
+      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
+      !!--------------------------------------------------------------------------------------------------------
+      INTEGER         , INTENT(in)    :: icount        ! determine wether this is the beggining of the routine (0) or the end (1)
+      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine
       REAL(wp)        , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
       REAL(wp)                        :: zvi,   zsmv,   zei,   zfs,   zfw,   zft
       REAL(wp)                        :: zvmin, zamin, zamax 
+      REAL(wp)                        :: zvtrp, zetrp
+      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill
+      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt
 
       IF( icount == 0 ) THEN
 
-         zvi_b  = glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) )
-         zsmv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )
-         zei_b  = glob_sum( SUM(   e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) )
-         zfw_b  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  &
-            &                   wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    &
-            &             ) * area(:,:) * tms(:,:) )
-         zfs_b  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
-            &                   sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &
-            &                 ) * area(:,:) * tms(:,:) )
-         zft_b  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
-            &                 - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
-            &                  ) * area(:,:) / unit_fac * tms(:,:) )
+         ! salt flux
+         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
+            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &
+            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv )
+
+         ! water flux
+         zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  &
+            &                  wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    &
+            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv )
+
+         ! heat flux
+         zft_b  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
+            &                - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
+            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv )
+
+         zvi_b  = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t * tmask(:,:,1) * zconv )
+
+         zsmv_b = glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e1e2t * tmask(:,:,1) * zconv )
+
+         zei_b  = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  &
+            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    &
+                            ) * e1e2t * tmask(:,:,1) * zconv )
 
       ELSEIF( icount == 1 ) THEN
 
-         zfs  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
-            &                 sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
-            &                ) * area(:,:) * tms(:,:) ) - zfs_b
-         zfw  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  &
-            &                 wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    &
-            &                ) * area(:,:) * tms(:,:) ) - zfw_b
-         zft  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
-            &               - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
-            &                ) * area(:,:) / unit_fac * tms(:,:) ) - zft_b
+         ! salt flux
+         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
+            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
+            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b
+
+         ! water flux
+         zfw  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  &
+            &                wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    &
+            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfw_b
+
+         ! heat flux
+         zft  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
+            &              - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
+            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zft_b
  
-         zvi  = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zvi_b ) * r1_rdtice - zfw 
-         zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zsmv_b ) * r1_rdtice + ( zfs / rhoic )
-         zei  =   glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zei_b * r1_rdtice + zft
-
-         zvmin = glob_min(v_i)
-         zamax = glob_max(SUM(a_i,dim=3))
-         zamin = glob_min(a_i)
-       
+         ! outputs
+         zvi  = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 )  &
+            &                    * e1e2t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday
+
+         zsmv = ( ( glob_sum( SUM( smv_i * rhoic            , dim=3 )  &
+            &                    * e1e2t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday
+
+         zei  =   glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  &
+            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    &
+            &                ) * e1e2t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft
+
+         ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative
+         zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1e2t * tmask(:,:,1) * zconv ) * rday 
+         zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e1e2t * tmask(:,:,1) * zconv )
+
+         zvmin = glob_min( v_i )
+         zamax = glob_max( SUM( a_i, dim=3 ) )
+         zamin = glob_min( a_i )
+
+         ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 
+         zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2
+         zv_sill = zarea * 2.5e-5
+         zs_sill = zarea * 25.e-5
+         zh_sill = zarea * 10.e-5
+
          IF(lwp) THEN
-            IF ( ABS( zvi    ) >  1.e-4 ) WRITE(numout,*) 'violation volume [kg/day]     (',cd_routine,') = ',(zvi * rday)
-            IF ( ABS( zsmv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday)
-            IF ( ABS( zei    ) >  1.    ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (',cd_routine,') = ',(zei)
-            IF ( zvmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',(zvmin)
-            IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > amax+1.e-10 ) THEN
-                                          WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax
+            IF ( ABS( zvi  ) > zv_sill ) WRITE(numout,*) 'violation volume [Mt/day]     (',cd_routine,') = ',zvi
+            IF ( ABS( zsmv ) > zs_sill ) WRITE(numout,*) 'violation saline [psu*Mt/day] (',cd_routine,') = ',zsmv
+            IF ( ABS( zei  ) > zh_sill ) WRITE(numout,*) 'violation enthalpy [GW]       (',cd_routine,') = ',zei
+            IF ( ABS(zvtrp ) > zv_sill .AND. cd_routine == 'limtrp' ) THEN
+                                         WRITE(numout,*) 'violation vtrp [Mt/day]       (',cd_routine,') = ',zvtrp
+                                         WRITE(numout,*) 'violation etrp [GW]           (',cd_routine,') = ',zetrp
             ENDIF
-            IF ( zamin <  0.            ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin
+            IF (     zvmin   < -epsi10 ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',zvmin
+            IF (     zamax   > rn_amax+epsi10 .AND. cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN
+                                         WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax
+            ENDIF
+            IF (      zamin  < -epsi10 ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin
          ENDIF
 
@@ -218,4 +265,43 @@
 
    END SUBROUTINE lim_cons_hsm
+
+   SUBROUTINE lim_cons_final( cd_routine )
+      !!---------------------------------------------------------------------------------------------------------
+      !!                                   ***  ROUTINE lim_cons_final ***
+      !!
+      !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step
+      !!
+      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiahsb=true
+      !!              It prints in ocean.output if there is a violation of conservation at each time-step
+      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine the violation are set to
+      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years.
+      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
+      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
+      !!--------------------------------------------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine
+      REAL(wp)                        :: zhfx, zsfx, zvfx
+      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill
+      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt
+
+#if ! defined key_bdy
+      ! heat flux
+      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e1e2t * tmask(:,:,1) * zconv ) 
+      ! salt flux
+      zsfx  = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv ) * rday
+      ! water flux
+      zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t * tmask(:,:,1) * zconv ) * rday
+
+      ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 
+      zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2
+      zv_sill = zarea * 2.5e-5
+      zs_sill = zarea * 25.e-5
+      zh_sill = zarea * 10.e-5
+
+      IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx    [Mt/day]       (',cd_routine,')  = ',(zvfx)
+      IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx    [psu*Mt/day]   (',cd_routine,')  = ',(zsfx)
+      IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx    [GW]           (',cd_routine,')  = ',(zhfx)
+#endif
+
+   END SUBROUTINE lim_cons_final
 
 #else
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90	(revision 5901)
@@ -0,0 +1,458 @@
+MODULE limctl
+   !!======================================================================
+   !!                     ***  MODULE  limctl  ***
+   !!   LIM-3 : control and printing
+   !!======================================================================
+   !! History :  3.5  !  2015-01  (M. Vancoppenolle) Original code
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!    lim_ctl   : control prints in case of crash
+   !!    lim_prt   : ice control print at a given grid point
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ice             ! LIM-3: ice variables
+   USE thd_ice         ! LIM-3: thermodynamical variables
+   USE dom_ice         ! LIM-3: ice domain
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice   fields
+
+   USE phycst          ! Define parameters for the routines
+
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE lib_fortran     ! 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_ctl
+   PUBLIC   lim_prt
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id: limctl.F90 5043 2015-01-28 16:44:18Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_ctl( kt )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_ctl *** 
+      !!                 
+      !! ** Purpose :   Alerts in case of model crash
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER  ::   ji, jj, jk,  jl   ! dummy loop indices
+      INTEGER  ::   inb_altests       ! number of alert tests (max 20)
+      INTEGER  ::   ialert_id         ! number of the current alert
+      REAL(wp) ::   ztmelts           ! ice layer melting point
+      CHARACTER (len=30), DIMENSION(20)      ::   cl_alname   ! name of alert
+      INTEGER           , DIMENSION(20)      ::   inb_alp     ! number of alerts positive
+      !!-------------------------------------------------------------------
+
+      inb_altests = 10
+      inb_alp(:)  =  0
+
+      ! Alert if incompatible volume and concentration
+      ialert_id = 2 ! reference number of this alert
+      cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN
+                  !WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration '
+                  !WRITE(numout,*) ' at_i     ', at_i(ji,jj)
+                  !WRITE(numout,*) ' Point - category', ji, jj, jl
+                  !WRITE(numout,*) ' a_i *** a_i_b   ', a_i      (ji,jj,jl), a_i_b  (ji,jj,jl)
+                  !WRITE(numout,*) ' v_i *** v_i_b   ', v_i      (ji,jj,jl), v_i_b  (ji,jj,jl)
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Alerte if very thick ice
+      ialert_id = 3 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert
+      jl = jpl 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   ht_i(ji,jj,jl)  >  50._wp   ) THEN
+               !CALL lim_prt( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' )
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if very fast ice
+      ialert_id = 4 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5  .AND.  &
+               &  at_i(ji,jj) > 0._wp   ) THEN
+               !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' )
+               !WRITE(numout,*) ' ice strength             : ', strength(ji,jj)
+               !WRITE(numout,*) ' oceanic stress utau      : ', utau(ji,jj) 
+               !WRITE(numout,*) ' oceanic stress vtau      : ', vtau(ji,jj)
+               !WRITE(numout,*) ' sea-ice stress utau_ice  : ', utau_ice(ji,jj) 
+               !WRITE(numout,*) ' sea-ice stress vtau_ice  : ', vtau_ice(ji,jj)
+               !WRITE(numout,*) ' oceanic speed u          : ', u_oce(ji,jj)
+               !WRITE(numout,*) ' oceanic speed v          : ', v_oce(ji,jj)
+               !WRITE(numout,*) ' sst                      : ', sst_m(ji,jj)
+               !WRITE(numout,*) ' sss                      : ', sss_m(ji,jj)
+               !WRITE(numout,*) 
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if there is ice on continents
+      ialert_id = 6 ! reference number of this alert
+      cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   tmask(ji,jj,1) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN 
+               !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' )
+               !WRITE(numout,*) ' masks s, u, v        : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1) 
+               !WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
+               !WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
+               !WRITE(numout,*) ' at_i(ji,jj)          : ', at_i(ji,jj)
+               !WRITE(numout,*) ' v_ice(ji,jj)         : ', v_ice(ji,jj)
+               !WRITE(numout,*) ' v_ice(ji,jj-1)       : ', v_ice(ji,jj-1)
+               !WRITE(numout,*) ' u_ice(ji-1,jj)       : ', u_ice(ji-1,jj)
+               !WRITE(numout,*) ' u_ice(ji,jj)         : ', v_ice(ji,jj)
+               !
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+!
+!     ! Alert if very fresh ice
+      ialert_id = 7 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( sm_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+!                 CALL lim_prt(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' )
+!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
+!                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
+!                 WRITE(numout,*) 
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+!
+
+!     ! Alert if too old ice
+      ialert_id = 9 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. &
+                      ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
+                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN
+                  !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ')
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+ 
+      ! Alert on salt flux
+      ialert_id = 5 ! reference number of this alert
+      cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth
+               !CALL lim_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' )
+               !DO jl = 1, jpl
+                  !WRITE(numout,*) ' Category no: ', jl
+                  !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' a_i_b      : ', a_i_b  (ji,jj,jl)   
+                  !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' v_i_b      : ', v_i_b  (ji,jj,jl)   
+                  !WRITE(numout,*) ' '
+               !END DO
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if qns very big
+      ialert_id = 8 ! reference number of this alert
+      cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN
+               !
+               !WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux'
+               !WRITE(numout,*) ' ji, jj    : ', ji, jj
+               !WRITE(numout,*) ' qns       : ', qns(ji,jj)
+               !WRITE(numout,*) ' sst       : ', sst_m(ji,jj)
+               !WRITE(numout,*) ' sss       : ', sss_m(ji,jj)
+               !
+               !CALL lim_prt( kt, ji, jj, 2, '   ')
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               !
+            ENDIF
+         END DO
+      END DO
+      !+++++
+ 
+      ! Alert if very warm ice
+      ialert_id = 10 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert
+      inb_alp(ialert_id) = 0
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztmelts    =  -tmut * s_i(ji,jj,jk,jl) + rt0
+                  IF( t_i(ji,jj,jk,jl) >= ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   &
+                     &                             .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN
+                     !WRITE(numout,*) ' ALERTE 10 :   Very warm ice'
+                     !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl
+                     !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl)
+                     !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl)
+                     !WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl)
+                     !WRITE(numout,*) ' ztmelts : ', ztmelts
+                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! sum of the alerts on all processors
+      IF( lk_mpp ) THEN
+         DO ialert_id = 1, inb_altests
+            CALL mpp_sum(inb_alp(ialert_id))
+         END DO
+      ENDIF
+
+      ! print alerts
+      IF( lwp ) THEN
+         ialert_id = 1                                 ! reference number of this alert
+         cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert
+         WRITE(numout,*) ' time step ',kt
+         WRITE(numout,*) ' All alerts at the end of ice model '
+         DO ialert_id = 1, inb_altests
+            WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! '
+         END DO
+      ENDIF
+     !
+   END SUBROUTINE lim_ctl
+ 
+   
+   SUBROUTINE lim_prt( kt, ki, kj, kn, cd1 )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_prt *** 
+      !!                 
+      !! ** Purpose :   Writes global ice state on the (i,j) point 
+      !!                in ocean.ouput 
+      !!                3 possibilities exist 
+      !!                n = 1/-1 -> simple ice state (plus Mechanical Check if -1)
+      !!                n = 2    -> exhaustive state
+      !!                n = 3    -> ice/ocean salt fluxes
+      !!
+      !! ** input   :   point coordinates (i,j) 
+      !!                n : number of the option
+      !!-------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt            ! ocean time step
+      INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices
+      CHARACTER(len=*), INTENT(in) ::   cd1           !
+      !!
+      INTEGER :: jl, ji, jj
+      !!-------------------------------------------------------------------
+
+      DO ji = mi0(ki), mi1(ki)
+         DO jj = mj0(kj), mj1(kj)
+
+            WRITE(numout,*) ' time step ',kt,' ',cd1             ! print title
+
+            !----------------
+            !  Simple state
+            !----------------
+            
+            IF ( kn == 1 .OR. kn == -1 ) THEN
+               WRITE(numout,*) ' lim_prt - Point : ',ji,jj
+               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' Simple state '
+               WRITE(numout,*) ' masks s,u,v   : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1)
+               WRITE(numout,*) ' lat - long    : ', gphit(ji,jj), glamt(ji,jj)
+               WRITE(numout,*) ' Time step     : ', numit
+               WRITE(numout,*) ' - Ice drift   '
+               WRITE(numout,*) '   ~~~~~~~~~~~ '
+               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
+               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
+               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
+               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
+               WRITE(numout,*) ' strength      : ', strength(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Cell values '
+               WRITE(numout,*) '   ~~~~~~~~~~~ '
+               WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj)
+               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
+               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
+               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
+               DO jl = 1, jpl
+                  WRITE(numout,*) ' - Category (', jl,')'
+                  WRITE(numout,*) ' a_i           : ', a_i(ji,jj,jl)
+                  WRITE(numout,*) ' ht_i          : ', ht_i(ji,jj,jl)
+                  WRITE(numout,*) ' ht_s          : ', ht_s(ji,jj,jl)
+                  WRITE(numout,*) ' v_i           : ', v_i(ji,jj,jl)
+                  WRITE(numout,*) ' v_s           : ', v_s(ji,jj,jl)
+                  WRITE(numout,*) ' e_s           : ', e_s(ji,jj,1,jl)
+                  WRITE(numout,*) ' e_i           : ', e_i(ji,jj,1:nlay_i,jl)
+                  WRITE(numout,*) ' t_su          : ', t_su(ji,jj,jl)
+                  WRITE(numout,*) ' t_snow        : ', t_s(ji,jj,1,jl)
+                  WRITE(numout,*) ' t_i           : ', t_i(ji,jj,1:nlay_i,jl)
+                  WRITE(numout,*) ' sm_i          : ', sm_i(ji,jj,jl)
+                  WRITE(numout,*) ' smv_i         : ', smv_i(ji,jj,jl)
+                  WRITE(numout,*)
+               END DO
+            ENDIF
+            IF( kn == -1 ) THEN
+               WRITE(numout,*) ' Mechanical Check ************** '
+               WRITE(numout,*) ' Check what means ice divergence '
+               WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj)
+               WRITE(numout,*) ' Total lead fraction     ', ato_i(ji,jj)
+               WRITE(numout,*) ' Sum of both             ', ato_i(ji,jj) + at_i(ji,jj)
+               WRITE(numout,*) ' Sum of both minus 1     ', ato_i(ji,jj) + at_i(ji,jj) - 1.00
+            ENDIF
+            
+
+            !--------------------
+            !  Exhaustive state
+            !--------------------
+            
+            IF ( kn .EQ. 2 ) THEN
+               WRITE(numout,*) ' lim_prt - Point : ',ji,jj
+               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' Exhaustive state '
+               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
+               WRITE(numout,*) ' Time step ', numit
+               WRITE(numout,*) 
+               WRITE(numout,*) ' - Cell values '
+               WRITE(numout,*) '   ~~~~~~~~~~~ '
+               WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj)
+               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
+               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
+               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
+               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
+               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
+               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
+               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
+               WRITE(numout,*) ' strength      : ', strength(ji,jj)
+               WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)  
+               WRITE(numout,*)
+               
+               DO jl = 1, jpl
+                  WRITE(numout,*) ' - Category (',jl,')'
+                  WRITE(numout,*) '   ~~~~~~~~         ' 
+                  WRITE(numout,*) ' ht_i       : ', ht_i(ji,jj,jl)             , ' ht_s       : ', ht_s(ji,jj,jl)
+                  WRITE(numout,*) ' t_i        : ', t_i(ji,jj,1:nlay_i,jl)
+                  WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)             , ' t_s        : ', t_s(ji,jj,1,jl)
+                  WRITE(numout,*) ' sm_i       : ', sm_i(ji,jj,jl)             , ' o_i        : ', o_i(ji,jj,jl)
+                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)  
+                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)            , ' ei1        : ', e_i_b(ji,jj,1,jl) 
+                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)            , ' ei2_b      : ', e_i_b(ji,jj,2,jl)  
+                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl) 
+                  WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)            , ' smv_i_b    : ', smv_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl)
+               END DO !jl
+               
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Heat / FW fluxes '
+               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' - Heat fluxes in and out the ice ***'
+               WRITE(numout,*) ' qsr_ini       : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) )
+               WRITE(numout,*) ' qns_ini       : ', pfrld(ji,jj) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) )
+               WRITE(numout,*)
+               WRITE(numout,*) 
+               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)  
+               WRITE(numout,*) ' sss        : ', sss_m(ji,jj)  
+               WRITE(numout,*) 
+               WRITE(numout,*) ' - Stresses '
+               WRITE(numout,*) '   ~~~~~~~~ '
+               WRITE(numout,*) ' utau_ice   : ', utau_ice(ji,jj) 
+               WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ji,jj)
+               WRITE(numout,*) ' utau       : ', utau    (ji,jj) 
+               WRITE(numout,*) ' vtau       : ', vtau    (ji,jj)
+               WRITE(numout,*) ' oc. vel. u : ', u_oce   (ji,jj)
+               WRITE(numout,*) ' oc. vel. v : ', v_oce   (ji,jj)
+            ENDIF
+            
+            !---------------------
+            ! Salt / heat fluxes
+            !---------------------
+            
+            IF ( kn .EQ. 3 ) THEN
+               WRITE(numout,*) ' lim_prt - Point : ',ji,jj
+               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' - Salt / Heat Fluxes '
+               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
+               WRITE(numout,*) ' Time step ', numit
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
+               WRITE(numout,*) ' qsr       : ', qsr(ji,jj)
+               WRITE(numout,*) ' qns       : ', qns(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj)
+               WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj)
+               WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj)
+               WRITE(numout,*) ' dhc          : ', diag_heat(ji,jj)              
+               WRITE(numout,*)
+               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj)
+               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj)
+               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj)
+               WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj) 
+               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Salt fluxes at bottom interface ***'
+               WRITE(numout,*) ' emp       : ', emp    (ji,jj)
+               WRITE(numout,*) ' sfx       : ', sfx    (ji,jj)
+               WRITE(numout,*) ' sfx_res   : ', sfx_res(ji,jj)
+               WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj)
+               WRITE(numout,*) ' sfx_dyn   : ', sfx_dyn(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Momentum fluxes '
+               WRITE(numout,*) ' utau      : ', utau(ji,jj) 
+               WRITE(numout,*) ' vtau      : ', vtau(ji,jj)
+            ENDIF 
+            WRITE(numout,*) ' '
+            !
+         END DO
+      END DO
+      !
+   END SUBROUTINE lim_prt
+
+#else
+   !!--------------------------------------------------------------------------
+   !!   Default option         Empty Module               No LIM3 sea-ice model
+   !!--------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_ctl     ! Empty routine
+   END SUBROUTINE lim_ctl
+   SUBROUTINE lim_prt     ! Empty routine
+   END SUBROUTINE lim_prt
+#endif
+   !!======================================================================
+END MODULE limctl
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90	(revision 5901)
@@ -14,5 +14,4 @@
    !!----------------------------------------------------------------------
    USE ice             ! LIM-3: sea-ice variable
-   USE par_ice         ! LIM-3: ice parameters
    USE dom_ice         ! LIM-3: sea-ice domain
    USE dom_oce         ! ocean domain
@@ -32,6 +31,4 @@
 
    PUBLIC   lim_diahsb        ! routine called by ice_step.F90
-   !!PUBLIC   lim_diahsb_init   ! routine called by ice_init.F90
-   !!PUBLIC   lim_diahsb_rst   ! routine called by ice_init.F90
 
    real(wp) ::   frc_sal, frc_vol   ! global forcing trends
@@ -43,5 +40,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.4 , NEMO Consortium (2012)
-   !! $Id: limdiahsb.F90 3294 2012-10-18 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -74,71 +71,72 @@
 
       ! 1/area
-      z1_area = 1._wp / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 )
-
-      rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) )
+      z1_area = 1._wp / MAX( glob_sum( e1e2t(:,:) * tmask(:,:,1) ), epsi06 )
+
+      rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e1e2t(:,:) * tmask(:,:,1) ) - epsi06 ) )
       ! ----------------------- !
       ! 1 -  Content variations !
       ! ----------------------- !
-      zbg_ivo = glob_sum( vt_i(:,:) * area(:,:) * tms(:,:) ) ! volume ice 
-      zbg_svo = glob_sum( vt_s(:,:) * area(:,:) * tms(:,:) ) ! volume snow
-      zbg_are = glob_sum( at_i(:,:) * area(:,:) * tms(:,:) ) ! area
-      zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )       ! mean salt content
-      zbg_tem = glob_sum( ( tm_i(:,:) - rtt ) * vt_i(:,:) * area(:,:) * tms(:,:) )  ! mean temp content
-
-      !zbg_ihc = glob_sum( et_i(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content
-      !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content
+      zbg_ivo = glob_sum( vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume ice 
+      zbg_svo = glob_sum( vt_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume snow
+      zbg_are = glob_sum( at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! area
+      zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1e2t(:,:) * tmask(:,:,1) )       ! mean salt content
+      zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) )  ! mean temp content
+
+      !zbg_ihc = glob_sum( et_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content
+      !zbg_shc = glob_sum( et_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content
 
       ! Volume
       ztmp = rswitch * z1_area * r1_rau0 * rday
-      zbg_vfx     = ztmp * glob_sum(     emp(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) )
+      zbg_vfx     = ztmp * glob_sum(     emp(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) )
 
       ! Salt
-      zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) )
-
-      zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) )
+      zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+
+      zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) )
 
       ! Heat budget
-      zbg_ihc      = glob_sum( et_i(:,:) * 1.e-20 ) ! ice heat content  [1.e-20 J]
-      zbg_shc      = glob_sum( et_s(:,:) * 1.e-20 ) ! snow heat content [1.e-20 J]
-      zbg_hfx_dhc  = glob_sum( diag_heat_dhc(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-
-      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_res  = glob_sum( hfx_res(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_out  = glob_sum( hfx_out(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * area(:,:) * tms(:,:) ) ! [in W]
+      zbg_ihc      = glob_sum( et_i(:,:) * e1e2t(:,:) ) * 1.e-20  ! ice heat content  [1.e20 J]
+      zbg_shc      = glob_sum( et_s(:,:) * e1e2t(:,:) ) * 1.e-20  ! snow heat content [1.e20 J]
+      zbg_hfx_dhc  = glob_sum( diag_heat(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+
+      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_res  = glob_sum( hfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_out  = glob_sum( hfx_out(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
     
       ! --------------------------------------------- !
       ! 2 - Trends due to forcing and ice growth/melt !
       ! --------------------------------------------- !
-      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes
-      z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes
+      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes
+      z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! salt fluxes
       z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + &
-                          &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + wfx_sub(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes
+                          &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + &
+                          &     wfx_sub(:,:) ) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes
       !
       frc_vol  = frc_vol  + z_frc_vol  * rdt_ice
@@ -247,11 +245,4 @@
          WRITE(numout,*) '~~~~~~~~~~~~'
       ENDIF
-
-      ! ---------------------------------- !
-      ! 2 - initial conservation variables !
-      ! ---------------------------------- !
-      !frc_vol = 0._wp                                          ! volume       trend due to forcing
-      !frc_sal = 0._wp                                          ! salt content   -    -   -    -         
-      !bg_grme = 0._wp                                          ! ice growth + melt volume trend
       !
       CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 5901)
@@ -6,5 +6,5 @@
    !! history :  1.0  ! 2002-08  (C. Ethe, G. Madec)  original VP code 
    !!            3.0  ! 2007-03  (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle)  LIM3: EVP-Cgrid
-   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
+   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -20,5 +20,4 @@
    USE sbc_ice          ! Surface boundary condition: ice   fields
    USE ice              ! LIM-3 variables
-   USE par_ice          ! LIM-3 parameters
    USE dom_ice          ! LIM-3 domain
    USE limrhg           ! LIM-3 rheology
@@ -31,4 +30,5 @@
    USE timing          ! Timing
    USE limcons        ! conservation tests
+   USE limvar
 
    IMPLICIT NONE
@@ -76,4 +76,6 @@
       CALL wrk_alloc( jpj, zswitch, zmsk )
 
+      CALL lim_var_agg(1)             ! aggregate ice categories
+
       IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only)
 
@@ -83,6 +85,6 @@
          IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
-         u_ice_b(:,:) = u_ice(:,:) * tmu(:,:)
-         v_ice_b(:,:) = v_ice(:,:) * tmv(:,:)
+         u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1)
+         v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1)
 
          ! Rheology (ice dynamics)
@@ -101,5 +103,5 @@
             DO jj = 1, jpj
                zswitch(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line
-               zmsk(jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line
+               zmsk   (jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line
             END DO
 
@@ -157,9 +159,9 @@
          zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
          ! frictional velocity at T-point
-         zcoef = 0.5_wp * cw
+         zcoef = 0.5_wp * rn_cio
          DO jj = 2, jpjm1 
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ust2s(ji,jj) = zcoef * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   &
-                  &                    + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1)   ) * tms(ji,jj)
+                  &                    + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tmask(ji,jj,1)
             END DO
          END DO
@@ -170,9 +172,9 @@
       ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean
          !
-         zcoef = SQRT( 0.5_wp ) / rau0
+         zcoef = SQRT( 0.5_wp ) * r1_rau0
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ust2s(ji,jj) = zcoef * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   &
-                  &                        + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1)   ) * tms(ji,jj)
+                  &                        + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) * tmask(ji,jj,1)
             END DO
          END DO
@@ -189,5 +191,5 @@
          CALL prt_ctl(tab2d_1=delta_i   , clinfo1=' lim_dyn  : delta_i   :')
          CALL prt_ctl(tab2d_1=strength  , clinfo1=' lim_dyn  : strength  :')
-         CALL prt_ctl(tab2d_1=area      , clinfo1=' lim_dyn  : cell area :')
+         CALL prt_ctl(tab2d_1=e1e2t     , clinfo1=' lim_dyn  : cell area :')
          CALL prt_ctl(tab2d_1=at_i      , clinfo1=' lim_dyn  : at_i      :')
          CALL prt_ctl(tab2d_1=vt_i      , clinfo1=' lim_dyn  : vt_i      :')
@@ -241,7 +243,8 @@
       !!-------------------------------------------------------------------
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicedyn/ epsd, om, cw, pstar,   &
-         &                c_rhg, creepl, ecc, ahi0,     &
-         &                nevp, relast, alphaevp, hminrhg
+      NAMELIST/namicedyn/ nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio,  rn_creepl, rn_ecc, &
+         &                nn_nevp, rn_relast, nn_ahi0, rn_ahi0_ref
+      INTEGER  ::   ji, jj
+      REAL(wp) ::   za00, zd_max
       !!-------------------------------------------------------------------
 
@@ -259,28 +262,64 @@
          WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics '
          WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '   tolerance parameter                              epsd   = ', epsd
-         WRITE(numout,*) '   relaxation constant                              om     = ', om
-         WRITE(numout,*) '   drag coefficient for oceanic stress              cw     = ', cw
-         WRITE(numout,*) '   first bulk-rheology parameter                    pstar  = ', pstar
-         WRITE(numout,*) '   second bulk-rhelogy parameter                    c_rhg  = ', c_rhg
-         WRITE(numout,*) '   creep limit                                      creepl = ', creepl
-         WRITE(numout,*) '   eccentricity of the elliptical yield curve       ecc    = ', ecc
-         WRITE(numout,*) '   horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0
-         WRITE(numout,*) '   number of iterations for subcycling              nevp   = ', nevp
-         WRITE(numout,*) '   ratio of elastic timescale over ice time step    relast = ', relast
-         WRITE(numout,*) '   coefficient for the solution of int. stresses  alphaevp = ', alphaevp
-         WRITE(numout,*) '   min ice thickness for rheology calculations     hminrhg = ', hminrhg
+         WRITE(numout,*)'    ice strength parameterization (0=Hibler 1=Rothrock)  nn_icestr     = ', nn_icestr 
+         WRITE(numout,*)'    Including brine volume in ice strength comp.         ln_icestr_bvf = ', ln_icestr_bvf
+         WRITE(numout,*)'   Ratio of ridging work to PotEner change in ridging    rn_pe_rdg     = ', rn_pe_rdg 
+         WRITE(numout,*) '   drag coefficient for oceanic stress                  rn_cio        = ', rn_cio
+         WRITE(numout,*) '   first bulk-rheology parameter                        rn_pstar      = ', rn_pstar
+         WRITE(numout,*) '   second bulk-rhelogy parameter                        rn_crhg       = ', rn_crhg
+         WRITE(numout,*) '   creep limit                                          rn_creepl     = ', rn_creepl
+         WRITE(numout,*) '   eccentricity of the elliptical yield curve           rn_ecc        = ', rn_ecc
+         WRITE(numout,*) '   number of iterations for subcycling                  nn_nevp       = ', nn_nevp
+         WRITE(numout,*) '   ratio of elastic timescale over ice time step        rn_relast     = ', rn_relast
+         WRITE(numout,*) '   horizontal diffusivity calculation                   nn_ahi0       = ', nn_ahi0
+         WRITE(numout,*) '   horizontal diffusivity coeff. (orca2 grid)           rn_ahi0_ref   = ', rn_ahi0_ref
       ENDIF
       !
-      usecc2 = 1._wp / ( ecc * ecc )
-      rhoco  = rau0  * cw
-
-      ! elastic damping
-      telast = relast * rdt_ice
-
-      !  Diffusion coefficients.
-      ahiu(:,:) = ahi0 * umask(:,:,1)
-      ahiv(:,:) = ahi0 * vmask(:,:,1)
-      !
+      usecc2 = 1._wp / ( rn_ecc * rn_ecc )
+      rhoco  = rau0  * rn_cio
+      !
+      !  Diffusion coefficients
+      SELECT CASE( nn_ahi0 )
+
+      CASE( 0 )
+         ahiu(:,:) = rn_ahi0_ref
+         ahiv(:,:) = rn_ahi0_ref
+
+         IF(lwp) WRITE(numout,*) ''
+         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim constant = rn_ahi0_ref'
+
+      CASE( 1 ) 
+
+         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
+         IF( lk_mpp )   CALL mpp_max( zd_max )          ! max over the global domain
+         
+         ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp   ! 1.e05 = 100km = max grid space at 60° latitude in orca2
+                                                        !                    (60° = min latitude for ice cover)  
+         ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp
+
+         IF(lwp) WRITE(numout,*) ''
+         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')'
+         IF(lwp) WRITE(numout,*) '   value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp 
+         
+      CASE( 2 ) 
+
+         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
+         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
+         
+         za00 = rn_ahi0_ref * 1.e-05_wp          ! 1.e05 = 100km = max grid space at 60° latitude in orca2
+                                                 !                    (60° = min latitude for ice cover)  
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1)
+               ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1)
+            END DO
+         END DO
+         !
+         IF(lwp) WRITE(numout,*) ''
+         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to e1'
+         IF(lwp) WRITE(numout,*) '   maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max
+         
+      END SELECT
+
    END SUBROUTINE lim_dyn_init
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 5901)
@@ -13,4 +13,5 @@
    !!----------------------------------------------------------------------
    !!   lim_hdf       : diffusion trend on sea-ice variable
+   !!   lim_hdf_init  : initialisation of diffusion trend on sea-ice variable
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean domain
@@ -26,8 +27,9 @@
    PRIVATE
 
-   PUBLIC   lim_hdf     ! called by lim_tra
-
-   LOGICAL  ::   linit = .TRUE.              ! initialization flag (set to flase after the 1st call)
-   REAL(wp) ::   epsi04 = 1.e-04              ! constant
+   PUBLIC   lim_hdf         ! called by lim_trp
+   PUBLIC   lim_hdf_init    ! called by sbc_lim_init
+
+   LOGICAL  ::   linit = .TRUE.                             ! initialization flag (set to flase after the 1st call)
+   INTEGER  ::   nn_convfrq                                 !:  convergence check frequency of the Crant-Nicholson scheme
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   efact   ! metric coefficient
 
@@ -54,9 +56,12 @@
       REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   ptab    ! Field on which the diffusion is applied
       !
-      INTEGER  ::  ji, jj                   ! dummy loop indices
-      INTEGER  ::  its, iter, ierr          ! local integers
-      REAL(wp) ::   zalfa, zrlxint, zconv   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zrlx, zflu, zflv, zdiv0, zdiv, ztab0
-      CHARACTER(lc) ::   charout   ! local character
+      INTEGER                           ::  ji, jj                    ! dummy loop indices
+      INTEGER                           ::  iter, ierr           ! local integers
+      REAL(wp)                          ::  zrlxint, zconv     ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zrlx, zflu, zflv, zdiv0, zdiv, ztab0
+      CHARACTER(lc)                     ::  charout                   ! local character
+      REAL(wp), PARAMETER               ::  zrelax = 0.5_wp           ! relaxation constant for iterative procedure
+      REAL(wp), PARAMETER               ::  zalfa  = 0.5_wp           ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit
+      INTEGER , PARAMETER               ::  its    = 100              ! Maximum number of iteration
       !!-------------------------------------------------------------------
       
@@ -71,5 +76,5 @@
          DO jj = 2, jpjm1  
             DO ji = fs_2 , fs_jpim1   ! vector opt.
-               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) / ( e1t(ji,jj) * e2t(ji,jj) )
+               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e1e2t(ji,jj)
             END DO
          END DO
@@ -77,6 +82,4 @@
       ENDIF
       !                             ! Time integration parameters
-      zalfa = 0.5_wp                      ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit
-      its   = 100                         ! Maximum number of iteration
       !
       ztab0(:, : ) = ptab(:,:)      ! Arrays initialization
@@ -91,5 +94,5 @@
       iter  = 0
       !
-      DO WHILE( zconv > ( 2._wp * epsi04 ) .AND. iter <= its )   ! Sub-time step loop
+      DO WHILE( zconv > ( 2._wp * 1.e-04 ) .AND. iter <= its )   ! Sub-time step loop
          !
          iter = iter + 1                                 ! incrementation of the sub-time step number
@@ -97,6 +100,6 @@
          DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction
             DO ji = 1 , fs_jpim1   ! vector opt.
-               zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
-               zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) / e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
+               zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
+               zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
             END DO
          END DO
@@ -104,6 +107,5 @@
          DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes
             DO ji = fs_2 , fs_jpim1   ! vector opt. 
-               zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   &
-                  &            + zflv(ji,jj) - zflv(ji  ,jj-1)  ) / ( e1t (ji,jj) * e2t (ji,jj) )
+               zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj)
             END DO
          END DO
@@ -115,18 +117,20 @@
                zrlxint = (   ztab0(ji,jj)    &
                   &       +  rdt_ice * (           zalfa   * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) )   &
-                  &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj) )  )                             & 
-                  &    / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) )
-               zrlx(ji,jj) = ptab(ji,jj) + om * ( zrlxint - ptab(ji,jj) )
+                  &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj) )                               & 
+                  &      ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) )
+               zrlx(ji,jj) = ptab(ji,jj) + zrelax * ( zrlxint - ptab(ji,jj) )
             END DO
          END DO
          CALL lbc_lnk( zrlx, 'T', 1. )                   ! lateral boundary condition
          !
-         zconv = 0._wp                                   ! convergence test
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) )  )
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_max( zconv )            ! max over the global domain
+         IF ( MOD( iter, nn_convfrq ) == 0 )  THEN    ! convergence test every nn_convfrq iterations (perf. optimization)
+            zconv = 0._wp
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) )  )
+               END DO
+            END DO
+            IF( lk_mpp )   CALL mpp_max( zconv )      ! max over the global domain
+         ENDIF
          !
          ptab(:,:) = zrlx(:,:)
@@ -138,6 +142,6 @@
       DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction
          DO ji = 1 , fs_jpim1   ! vector opt.
-            zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
-            zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) / e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
+            zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
+            zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
          END DO
       END DO
@@ -145,6 +149,5 @@
       DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes
          DO ji = fs_2 , fs_jpim1   ! vector opt. 
-            zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   &
-                 &            + zflv(ji,jj) - zflv(ji  ,jj-1)  ) / ( e1t (ji,jj) * e2t (ji,jj) )
+            zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj)
             ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) )
          END DO
@@ -164,11 +167,45 @@
    END SUBROUTINE lim_hdf
 
+   
+   SUBROUTINE lim_hdf_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_hdf_init  ***
+      !!
+      !! ** Purpose : Initialisation of horizontal diffusion of sea-ice 
+      !!
+      !! ** Method  : Read the namicehdf namelist
+      !!
+      !! ** input   : Namelist namicehdf
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namicehdf/ nn_convfrq
+      !!-------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_hdf : Ice horizontal diffusion'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namicehdf in reference namelist : Ice horizontal diffusion
+      READ  ( numnam_ice_ref, namicehdf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicehdf in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicehdf in configuration namelist : Ice horizontal diffusion
+      READ  ( numnam_ice_cfg, namicehdf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicehdf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicehdf )
+      !
+      IF(lwp) THEN                          ! control print
+         WRITE(numout,*)
+         WRITE(numout,*)'   Namelist of ice parameters for ice horizontal diffusion computation '
+         WRITE(numout,*)'      convergence check frequency of the Crant-Nicholson scheme   nn_convfrq   = ', nn_convfrq
+      ENDIF
+      !
+   END SUBROUTINE lim_hdf_init
 #else
    !!----------------------------------------------------------------------
    !!   Default option          Dummy module           NO LIM sea-ice model
    !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_hdf         ! Empty routine
-   END SUBROUTINE lim_hdf
 #endif
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 5901)
@@ -22,5 +22,4 @@
    USE eosbn2           ! equation of state
    USE ice              ! sea-ice variables
-   USE par_ice          ! ice parameters
    USE par_oce          ! ocean parameters
    USE dom_ice          ! sea-ice domain
@@ -36,17 +35,17 @@
 
    !                          !!** init namelist (namiceini) **
-   REAL(wp) ::   thres_sst   ! threshold water temperature for initial sea ice
-   REAL(wp) ::   hts_ini_n   ! initial snow thickness in the north
-   REAL(wp) ::   hts_ini_s   ! initial snow thickness in the south
-   REAL(wp) ::   hti_ini_n   ! initial ice thickness in the north
-   REAL(wp) ::   hti_ini_s   ! initial ice thickness in the south
-   REAL(wp) ::   ati_ini_n   ! initial leads area in the north
-   REAL(wp) ::   ati_ini_s   ! initial leads area in the south
-   REAL(wp) ::   smi_ini_n   ! initial salinity 
-   REAL(wp) ::   smi_ini_s   ! initial salinity
-   REAL(wp) ::   tmi_ini_n   ! initial temperature
-   REAL(wp) ::   tmi_ini_s   ! initial temperature
-
-   LOGICAL  ::  ln_limini    ! initialization or not
+   REAL(wp) ::   rn_thres_sst   ! threshold water temperature for initial sea ice
+   REAL(wp) ::   rn_hts_ini_n   ! initial snow thickness in the north
+   REAL(wp) ::   rn_hts_ini_s   ! initial snow thickness in the south
+   REAL(wp) ::   rn_hti_ini_n   ! initial ice thickness in the north
+   REAL(wp) ::   rn_hti_ini_s   ! initial ice thickness in the south
+   REAL(wp) ::   rn_ati_ini_n   ! initial leads area in the north
+   REAL(wp) ::   rn_ati_ini_s   ! initial leads area in the south
+   REAL(wp) ::   rn_smi_ini_n   ! initial salinity 
+   REAL(wp) ::   rn_smi_ini_s   ! initial salinity
+   REAL(wp) ::   rn_tmi_ini_n   ! initial temperature
+   REAL(wp) ::   rn_tmi_ini_s   ! initial temperature
+
+   LOGICAL  ::  ln_iceini    ! initialization or not
    !!----------------------------------------------------------------------
    !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008)
@@ -87,5 +86,5 @@
       !! * Local variables
       INTEGER    :: ji, jj, jk, jl             ! dummy loop indices
-      REAL(wp)   :: epsi20, ztmelts, zdh
+      REAL(wp)   :: ztmelts, zdh
       INTEGER    :: i_hemis, i_fill, jl0  
       REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv
@@ -101,6 +100,4 @@
       CALL wrk_alloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
 
-      epsi20   = 1.e-20_wp
-
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization '
@@ -115,12 +112,13 @@
       ! surface temperature
       DO jl = 1, jpl ! loop over categories
-         t_su  (:,:,jl) = rtt * tms(:,:)
-         tn_ice(:,:,jl) = rtt * tms(:,:)
+         t_su  (:,:,jl) = rt0 * tmask(:,:,1)
+         tn_ice(:,:,jl) = rt0 * tmask(:,:,1)
       END DO
 
       ! basal temperature (considered at freezing point)
-      t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:) 
-
-      IF( ln_limini ) THEN
+      CALL eos_fzp( sss_m(:,:), t_bo(:,:) )
+      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 
+
+      IF( ln_iceini ) THEN
 
       !--------------------------------------------------------------------
@@ -130,8 +128,8 @@
       DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest
          DO ji = 1, jpi
-            IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN 
-               zswitch(ji,jj) = 0._wp * tms(ji,jj)    ! no ice
+            IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN 
+               zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice
             ELSE                                                                                   
-               zswitch(ji,jj) = 1._wp * tms(ji,jj)    !    ice
+               zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice
             ENDIF
          END DO
@@ -158,9 +156,9 @@
       !-----------------------------
       ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
-      zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) = hti_ini_s  ! ice thickness
-      zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) = hts_ini_s  ! snow depth
-      zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) = ati_ini_s  ! ice concentration
-      zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) = smi_ini_s  ! bulk ice salinity
-      ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) = tmi_ini_s  ! temperature (ice and snow)
+      zht_i_ini(1) = rn_hti_ini_n ; zht_i_ini(2) = rn_hti_ini_s  ! ice thickness
+      zht_s_ini(1) = rn_hts_ini_n ; zht_s_ini(2) = rn_hts_ini_s  ! snow depth
+      zat_i_ini(1) = rn_ati_ini_n ; zat_i_ini(2) = rn_ati_ini_s  ! ice concentration
+      zsm_i_ini(1) = rn_smi_ini_n ; zsm_i_ini(2) = rn_smi_ini_s  ! bulk ice salinity
+      ztm_i_ini(1) = rn_tmi_ini_n ; ztm_i_ini(2) = rn_tmi_ini_s  ! temperature (ice and snow)
 
       zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume
@@ -197,11 +195,11 @@
                !--- Ice thicknesses in the i_fill - 1 first categories
                DO jl = 1, i_fill - 1
-                  zh_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) )
+                  zh_i_ini(jl,i_hemis) = hi_mean(jl)
                END DO
                
                !--- jl0: most likely index where cc will be maximum
                DO jl = 1, jpl
-                  IF ( ( zht_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. &
-                     ( zht_i_ini(i_hemis) .LE. hi_max(jl)   ) ) THEN
+                  IF ( ( zht_i_ini(i_hemis) >  hi_max(jl-1) ) .AND. &
+                     & ( zht_i_ini(i_hemis) <= hi_max(jl)   ) ) THEN
                      jl0 = jl
                   ENDIF
@@ -267,5 +265,5 @@
 
             ! Test 3: thickness of the last category is in-bounds ?
-            IF ( zh_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN
+            IF ( zh_i_ini(i_fill, i_hemis) > hi_max(i_fill-1) ) THEN
                ztest_3 = 1
             ELSE
@@ -317,9 +315,9 @@
             DO ji = 1, jpi
                a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration
-               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))  ! ice thickness
+               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))   ! ice thickness
                ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth
-               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity
-               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age
-               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt ! surf temp
+               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj))     ! salinity
+               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                        ! age (1 day)
+               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp
 
                ! This case below should not be used if (ht_s/ht_i) is ok in namelist
@@ -329,5 +327,5 @@
                ! recompute ht_i, ht_s avoiding out of bounds values
                ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh )
-               ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic / rhosn )
+               ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn )
 
                ! ice volume, salt content, age content
@@ -336,7 +334,7 @@
                smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
                oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content
-            END DO ! ji
-         END DO ! jj
-      END DO ! jl
+            END DO
+         END DO
+      END DO
 
       ! Snow temperature and heat content
@@ -345,15 +343,14 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt
+                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0
                    ! Snow energy of melting
-                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus )
-                   ! Change dimensions
-                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac
-                   ! Multiply by volume, so that heat content in Joules
-                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s
-               END DO ! ji
-            END DO ! jj
-         END DO ! jl
-      END DO ! jk
+                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
+
+                   ! Mutliply by volume, and divide by number of layers to get heat content in J/m2
+                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
+               END DO
+            END DO
+         END DO
+      END DO
 
       ! Ice salinity, temperature and heat content
@@ -362,27 +359,24 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 
-                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min
-                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K
+                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 
+                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin
+                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K
 
                    ! heat content per unit volume
                    e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
-                      +   lfus    * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) &
-                      -   rcp     * ( ztmelts - rtt ) )
-
-                   ! Correct dimensions to avoid big values
-                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 
-
-                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J
-                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i
-               END DO ! ji
-            END DO ! jj
-         END DO ! jl
-      END DO ! jk
+                      +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
+                      -   rcp     * ( ztmelts - rt0 ) )
+
+                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
+                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
+               END DO
+            END DO
+         END DO
+      END DO
 
       tn_ice (:,:,:) = t_su (:,:,:)
 
       ELSE 
-         ! if ln_limini=false
+         ! if ln_iceini=false
          a_i  (:,:,:) = 0._wp
          v_i  (:,:,:) = 0._wp
@@ -400,12 +394,12 @@
          DO jl = 1, jpl
             DO jk = 1, nlay_i
-               t_i(:,:,jk,jl) = rtt * tms(:,:)
+               t_i(:,:,jk,jl) = rt0 * tmask(:,:,1)
             END DO
             DO jk = 1, nlay_s
-               t_s(:,:,jk,jl) = rtt * tms(:,:)
+               t_s(:,:,jk,jl) = rt0 * tmask(:,:,1)
             END DO
          END DO
       
-      ENDIF ! ln_limini
+      ENDIF ! ln_iceini
       
       at_i (:,:) = 0.0_wp
@@ -481,6 +475,6 @@
       !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization
       !!-----------------------------------------------------------------------------
-      NAMELIST/namiceini/ ln_limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n, hti_ini_s,  &
-         &                                      ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n, tmi_ini_s
+      NAMELIST/namiceini/ ln_iceini, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, rn_hti_ini_n, rn_hti_ini_s,  &
+         &                                      rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s
       INTEGER :: ios                 ! Local integer output status for namelist read
       !!-----------------------------------------------------------------------------
@@ -502,16 +496,16 @@
          WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation '
          WRITE(numout,*) '~~~~~~~~~~~~~~~'
-         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini   = ', ln_limini
-         WRITE(numout,*) '   threshold water temp. for initial sea-ice    thres_sst  = ', thres_sst
-         WRITE(numout,*) '   initial snow thickness in the north          hts_ini_n  = ', hts_ini_n
-         WRITE(numout,*) '   initial snow thickness in the south          hts_ini_s  = ', hts_ini_s 
-         WRITE(numout,*) '   initial ice thickness  in the north          hti_ini_n  = ', hti_ini_n
-         WRITE(numout,*) '   initial ice thickness  in the south          hti_ini_s  = ', hti_ini_s
-         WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_n  = ', ati_ini_n
-         WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_s  = ', ati_ini_s
-         WRITE(numout,*) '   initial  ice salinity  in the north          smi_ini_n  = ', smi_ini_n
-         WRITE(numout,*) '   initial  ice salinity  in the south          smi_ini_s  = ', smi_ini_s
-         WRITE(numout,*) '   initial  ice/snw temp  in the north          tmi_ini_n  = ', tmi_ini_n
-         WRITE(numout,*) '   initial  ice/snw temp  in the south          tmi_ini_s  = ', tmi_ini_s
+         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_iceini     = ', ln_iceini
+         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst
+         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n
+         WRITE(numout,*) '   initial snow thickness in the south          rn_hts_ini_s  = ', rn_hts_ini_s 
+         WRITE(numout,*) '   initial ice thickness  in the north          rn_hti_ini_n  = ', rn_hti_ini_n
+         WRITE(numout,*) '   initial ice thickness  in the south          rn_hti_ini_s  = ', rn_hti_ini_s
+         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_n  = ', rn_ati_ini_n
+         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_s  = ', rn_ati_ini_s
+         WRITE(numout,*) '   initial  ice salinity  in the north          rn_smi_ini_n  = ', rn_smi_ini_n
+         WRITE(numout,*) '   initial  ice salinity  in the south          rn_smi_ini_s  = ', rn_smi_ini_s
+         WRITE(numout,*) '   initial  ice/snw temp  in the north          rn_tmi_ini_n  = ', rn_tmi_ini_n
+         WRITE(numout,*) '   initial  ice/snw temp  in the south          rn_tmi_ini_s  = ', rn_tmi_ini_s
       ENDIF
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 5901)
@@ -18,14 +18,12 @@
    USE thd_ice          ! LIM thermodynamics
    USE ice              ! LIM variables
-   USE par_ice          ! LIM parameters
    USE dom_ice          ! LIM domain
-   USE limthd_lac       ! LIM
    USE limvar           ! LIM
-   USE in_out_manager   ! I/O manager
    USE lbclnk           ! lateral boundary condition - MPP exchanges
    USE lib_mpp          ! MPP library
    USE wrk_nemo         ! work arrays
    USE prtctl           ! Print control
-  ! Check budget (Rousset)
+
+   USE in_out_manager   ! I/O manager
    USE iom              ! I/O manager
    USE lib_fortran      ! glob_sum
@@ -40,6 +38,5 @@
    PUBLIC   lim_itd_me_icestrength
    PUBLIC   lim_itd_me_init
-   PUBLIC   lim_itd_me_zapsmall
-   PUBLIC   lim_itd_me_alloc        ! called by iceini.F90
+   PUBLIC   lim_itd_me_alloc        ! called by sbc_lim_init 
 
    !-----------------------------------------------------------------------
@@ -125,18 +122,19 @@
       !!  and Elizabeth C. Hunke, LANL are gratefully acknowledged
       !!--------------------------------------------------------------------!
-      INTEGER ::   ji, jj, jk, jl   ! dummy loop index
-      INTEGER ::   niter, nitermax = 20   ! local integer 
-      LOGICAL  ::   asum_error            ! flag for asum .ne. 1
+      INTEGER  ::   ji, jj, jk, jl        ! dummy loop index
+      INTEGER  ::   niter                 ! local integer 
       INTEGER  ::   iterate_ridging       ! if true, repeat the ridging
-      REAL(wp) ::   w1, tmpfac            ! local scalar
+      REAL(wp) ::   za, zfac              ! local scalar
       CHARACTER (len = 15) ::   fieldid
-      REAL(wp), POINTER, DIMENSION(:,:) ::   closing_net     ! net rate at which area is removed    (1/s)
-                                                             ! (ridging ice area - area of new ridges) / dt
-      REAL(wp), POINTER, DIMENSION(:,:) ::   divu_adv        ! divu as implied by transport scheme  (1/s)
-      REAL(wp), POINTER, DIMENSION(:,:) ::   opning          ! rate of opening due to divergence/shear
-      REAL(wp), POINTER, DIMENSION(:,:) ::   closing_gross   ! rate at which area removed, not counting area of new ridges
-      REAL(wp), POINTER, DIMENSION(:,:) ::   msnow_mlt       ! mass of snow added to ocean (kg m-2)
-      REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2)
-      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final  !  ice volume summed over categories
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_net     ! net rate at which area is removed    (1/s)
+                                                               ! (ridging ice area - area of new ridges) / dt
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   divu_adv        ! divu as implied by transport scheme  (1/s)
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   opning          ! rate of opening due to divergence/shear
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_gross   ! rate at which area removed, not counting area of new ridges
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   msnow_mlt       ! mass of snow added to ocean (kg m-2)
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2)
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_i_init, vt_i_final  !  ice volume summed over categories
+      !
+      INTEGER, PARAMETER ::   nitermax = 20    
       !
       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
@@ -144,5 +142,5 @@
       IF( nn_timing == 1 )  CALL timing_start('limitd_me')
 
-      CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final )
+      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final )
 
       IF(ln_ctl) THEN
@@ -156,8 +154,11 @@
       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
+      CALL lim_var_zapsmall
+      CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting
+
       !-----------------------------------------------------------------------------!
       ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons
       !-----------------------------------------------------------------------------!
-      Cp = 0.5 * grav * (rau0-rhoic) * rhoic / rau0                ! proport const for PE
+      Cp = 0.5 * grav * (rau0-rhoic) * rhoic * r1_rau0             ! proport const for PE
       !
       CALL lim_itd_me_ridgeprep                                    ! prepare ridging
@@ -193,5 +194,5 @@
             !  (thick, newly ridged ice).
 
-            closing_net(ji,jj) = Cs * 0.5 * ( Delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp )
+            closing_net(ji,jj) = rn_cs * 0.5 * ( delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp )
 
             ! 2.2 divu_adv
@@ -237,15 +238,13 @@
                ! Reduce the closing rate if more than 100% of the open water 
                ! would be removed.  Reduce the opening rate proportionately.
-               IF ( ato_i(ji,jj) .GT. epsi10 .AND. athorn(ji,jj,0) .GT. 0.0 ) THEN
-                  w1 = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice
-                  IF ( w1 .GT. ato_i(ji,jj)) THEN
-                     tmpfac = ato_i(ji,jj) / w1
-                     closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac
-                     opning(ji,jj) = opning(ji,jj) * tmpfac
-                  ENDIF !w1
-               ENDIF !at0i and athorn
-
-            END DO ! ji
-         END DO ! jj
+               za   = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice
+               IF( za > epsi20 ) THEN
+                  zfac = MIN( 1._wp, ato_i(ji,jj) / za )
+                  closing_gross(ji,jj) = closing_gross(ji,jj) * zfac
+                  opning       (ji,jj) = opning       (ji,jj) * zfac
+               ENDIF
+
+            END DO
+         END DO
 
          ! correction to closing rate / opening if excessive ice removal
@@ -253,19 +252,16 @@
          ! Reduce the closing rate if more than 100% of any ice category 
          ! would be removed.  Reduce the opening rate proportionately.
-
          DO jl = 1, jpl
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  IF ( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp )THEN
-                     w1 = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice
-                     IF ( w1  >  a_i(ji,jj,jl) ) THEN
-                        tmpfac = a_i(ji,jj,jl) / w1
-                        closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac
-                        opning       (ji,jj) = opning       (ji,jj) * tmpfac
-                     ENDIF
+                  za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice
+                  IF( za  >  epsi20 ) THEN
+                     zfac = MIN( 1._wp, a_i(ji,jj,jl) / za )
+                     closing_gross(ji,jj) = closing_gross(ji,jj) * zfac
+                     opning       (ji,jj) = opning       (ji,jj) * zfac
                   ENDIF
-               END DO !ji
-            END DO ! jj
-         END DO !jl
+               END DO
+            END DO
+         END DO
 
          ! 3.3 Redistribute area, volume, and energy.
@@ -276,6 +272,9 @@
          ! 3.4 Compute total area of ice plus open water after ridging.
          !-----------------------------------------------------------------------------!
-
-         CALL lim_itd_me_asumr
+         ! This is in general not equal to one because of divergence during transport
+         asum(:,:) = ato_i(:,:)
+         DO jl = 1, jpl
+            asum(:,:) = asum(:,:) + a_i(:,:,jl)
+         END DO
 
          ! 3.5 Do we keep on iterating ???
@@ -288,5 +287,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF (ABS(asum(ji,jj) - kamax ) .LT. epsi10) THEN
+               IF (ABS(asum(ji,jj) - kamax ) < epsi10) THEN
                   closing_net(ji,jj) = 0._wp
                   opning     (ji,jj) = 0._wp
@@ -324,11 +323,6 @@
       ! Convert ridging rate diagnostics to correct units.
       ! Update fresh water and heat fluxes due to snow melt.
-
-      asum_error = .false. 
-
       DO jj = 1, jpj
          DO ji = 1, jpi
-
-            IF(ABS(asum(ji,jj) - kamax) > epsi10 ) asum_error = .true.
 
             dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice
@@ -341,5 +335,5 @@
             !-----------------------------------------------------------------------------!
             wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean
-            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * unit_fac / area(ji,jj) * r1_rdtice  ! heat sink for ocean (<0, W.m-2)
+            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice     ! heat sink for ocean (<0, W.m-2)
 
          END DO
@@ -347,20 +341,21 @@
 
       ! Check if there is a ridging error
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ABS( asum(ji,jj) - kamax)  >  epsi10 ) THEN   ! there is a bug
-               WRITE(numout,*) ' '
-               WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj)
-               WRITE(numout,*) ' limitd_me '
-               WRITE(numout,*) ' POINT : ', ji, jj
-               WRITE(numout,*) ' jpl, a_i, athorn '
-               WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0)
-               DO jl = 1, jpl
-                  WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl)
-               END DO
-            ENDIF  ! asum
-
-         END DO !ji
-      END DO !jj
+      IF( lwp ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( ABS( asum(ji,jj) - kamax)  >  epsi10 ) THEN   ! there is a bug
+                  WRITE(numout,*) ' '
+                  WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj)
+                  WRITE(numout,*) ' limitd_me '
+                  WRITE(numout,*) ' POINT : ', ji, jj
+                  WRITE(numout,*) ' jpl, a_i, athorn '
+                  WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0)
+                  DO jl = 1, jpl
+                     WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl)
+                  END DO
+               ENDIF
+            END DO
+         END DO
+      END IF
 
       ! Conservation check
@@ -371,16 +366,16 @@
       ENDIF
 
+      CALL lim_var_agg( 1 ) 
+
       !-----------------------------------------------------------------------------!
-      ! 6) Updating state variables and trend terms (done in limupdate)
+      ! control prints
       !-----------------------------------------------------------------------------!
-      CALL lim_var_glo2eqv
-      CALL lim_itd_me_zapsmall
-
-
-      IF(ln_ctl) THEN     ! Control print
+      IF(ln_ctl) THEN 
+         CALL lim_var_glo2eqv
+
          CALL prt_ctl_info(' ')
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_me  : cell area :')
+         CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_me  : cell area :')
          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me  : at_i      :')
          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me  : vt_i      :')
@@ -436,9 +431,8 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kstrngth    ! = 1 for Rothrock formulation, 0 for Hibler (1979)
-
-      INTEGER ::   ji,jj, jl   ! dummy loop indices
-      INTEGER ::   ksmooth     ! smoothing the resistance to deformation
-      INTEGER ::   numts_rm    ! number of time steps for the P smoothing
-      REAL(wp) ::   hi, zw1, zp, zdummy, zzc, z1_3   ! local scalars
+      INTEGER             ::   ji,jj, jl   ! dummy loop indices
+      INTEGER             ::   ksmooth     ! smoothing the resistance to deformation
+      INTEGER             ::   numts_rm    ! number of time steps for the P smoothing
+      REAL(wp)            ::   zhi, zp, z1_3  ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:) ::   zworka   ! temporary array used here
       !!----------------------------------------------------------------------
@@ -466,30 +460,29 @@
                   !
                   IF( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp ) THEN
-                     hi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+                     zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
                      !----------------------------
                      ! PE loss from deforming ice
                      !----------------------------
-                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * hi * hi
+                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * zhi * zhi
 
                      !--------------------------
                      ! PE gain from rafting ice
                      !--------------------------
-                     strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * hi * hi
+                     strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * zhi * zhi
 
                      !----------------------------
                      ! PE gain from ridging ice
                      !----------------------------
-                     strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl)/krdg(ji,jj,jl)     &
-                        * z1_3 * (hrmax(ji,jj,jl)**3 - hrmin(ji,jj,jl)**3) / ( hrmax(ji,jj,jl)-hrmin(ji,jj,jl) )   
-!!gm Optimization:  (a**3-b**3)/(a-b) = a*a+ab+b*b   ==> less costly operations even if a**3 is replaced by a*a*a...                    
-                  ENDIF            ! aicen > epsi10
+                     strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl) / krdg(ji,jj,jl)     &
+                        * z1_3 * ( hrmax(ji,jj,jl)**2 + hrmin(ji,jj,jl)**2 +  hrmax(ji,jj,jl) * hrmin(ji,jj,jl) )  
+                        !!(a**3-b**3)/(a-b) = a*a+ab+b*b                      
+                  ENDIF
                   !
-               END DO ! ji
-            END DO !jj
-         END DO !jl
-
-         zzc = Cf * Cp     ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and Cf accounts for frictional dissipation
-         strength(:,:) = zzc * strength(:,:) / aksum(:,:)
-
+               END DO
+            END DO
+         END DO
+   
+         strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:)
+                         ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation
          ksmooth = 1
 
@@ -499,5 +492,5 @@
       ELSE                      ! kstrngth ne 1:  Hibler (1979) form
          !
-         strength(:,:) = Pstar * vt_i(:,:) * EXP( - C_rhg * ( 1._wp - at_i(:,:) )  )
+         strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) )  )
          !
          ksmooth = 1
@@ -511,16 +504,11 @@
       ! CAN BE REMOVED
       !
-      IF ( brinstren_swi == 1 ) THEN
+      IF( ln_icestr_bvf ) THEN
 
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF ( bv_i(ji,jj) .GT. 0.0 ) THEN
-                  zdummy = MIN ( bv_i(ji,jj), 0.10 ) * MIN( bv_i(ji,jj), 0.10 )
-               ELSE
-                  zdummy = 0.0
-               ENDIF
                strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bv_i(ji,jj),0.0)))
-            END DO              ! j
-         END DO                 ! i
+            END DO
+         END DO
 
       ENDIF
@@ -538,16 +526,11 @@
          CALL lbc_lnk( strength, 'T', 1. )
 
-         DO jj = 2, jpj - 1
-            DO ji = 2, jpi - 1
-               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN ! ice is
-                  ! present
-                  zworka(ji,jj) = 4.0 * strength(ji,jj)              &
-                     &          + strength(ji-1,jj) * tms(ji-1,jj) &  
-                     &          + strength(ji+1,jj) * tms(ji+1,jj) &  
-                     &          + strength(ji,jj-1) * tms(ji,jj-1) &  
-                     &          + strength(ji,jj+1) * tms(ji,jj+1)    
-
-                  zw1 = 4.0 + tms(ji-1,jj) + tms(ji+1,jj) + tms(ji,jj-1) + tms(ji,jj+1)
-                  zworka(ji,jj) = zworka(ji,jj) / zw1
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN 
+                  zworka(ji,jj) = ( 4.0 * strength(ji,jj)              &
+                     &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &  
+                     &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) &
+                     &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )
                ELSE
                   zworka(ji,jj) = 0._wp
@@ -556,6 +539,6 @@
          END DO
 
-         DO jj = 2, jpj - 1
-            DO ji = 2, jpi - 1
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
                strength(ji,jj) = zworka(ji,jj)
             END DO
@@ -563,5 +546,5 @@
          CALL lbc_lnk( strength, 'T', 1. )
 
-      ENDIF ! ksmooth
+      ENDIF
 
       !--------------------
@@ -580,8 +563,8 @@
          DO jj = 1, jpj - 1
             DO ji = 1, jpi - 1
-               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN       ! ice is present
+               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN 
                   numts_rm = 1 ! number of time steps for the running mean
-                  IF ( strp1(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1
-                  IF ( strp2(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1
+                  IF ( strp1(ji,jj) > 0.0 ) numts_rm = numts_rm + 1
+                  IF ( strp2(ji,jj) > 0.0 ) numts_rm = numts_rm + 1
                   zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm
                   strp2(ji,jj) = strp1(ji,jj)
@@ -612,5 +595,5 @@
       !!---------------------------------------------------------------------!
       INTEGER ::   ji,jj, jl    ! dummy loop indices
-      REAL(wp) ::   Gstari, astari, hi, hrmean, zdummy   ! local scalar
+      REAL(wp) ::   Gstari, astari, zhi, hrmean, zdummy   ! local scalar
       REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka    ! temporary array used here
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n
@@ -620,6 +603,6 @@
       CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
 
-      Gstari     = 1.0/Gstar    
-      astari     = 1.0/astar    
+      Gstari     = 1.0/rn_gstar    
+      astari     = 1.0/rn_astar    
       aksum(:,:)    = 0.0
       athorn(:,:,:) = 0.0
@@ -632,5 +615,5 @@
 
       !     ! Zero out categories with very small areas
-      CALL lim_itd_me_zapsmall
+      CALL lim_var_zapsmall
 
       !------------------------------------------------------------------------------!
@@ -639,7 +622,9 @@
 
       ! Compute total area of ice plus open water.
-      CALL lim_itd_me_asumr
-      ! This is in general not equal to one 
-      ! because of divergence during transport
+      ! This is in general not equal to one because of divergence during transport
+      asum(:,:) = ato_i(:,:)
+      DO jl = 1, jpl
+         asum(:,:) = asum(:,:) + a_i(:,:,jl)
+      END DO
 
       ! Compute cumulative thickness distribution function
@@ -649,22 +634,9 @@
 
       Gsum(:,:,-1) = 0._wp
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ato_i(ji,jj) > epsi10 ) THEN   ;   Gsum(ji,jj,0) = ato_i(ji,jj)
-            ELSE                               ;   Gsum(ji,jj,0) = 0._wp
-            ENDIF
-         END DO
-      END DO
+      Gsum(:,:,0 ) = ato_i(:,:)
 
       ! for each value of h, you have to add ice concentration then
       DO jl = 1, jpl
-         DO jj = 1, jpj 
-            DO ji = 1, jpi
-               IF( a_i(ji,jj,jl) .GT. epsi10 ) THEN   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl)
-               ELSE                                   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1)
-               ENDIF
-            END DO
-         END DO
+         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl)
       END DO
 
@@ -687,51 +659,50 @@
       !-----------------------------------------------------------------
 
-      IF( partfun_swi == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975)
+      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975)
          DO jl = 0, jpl    
             DO jj = 1, jpj 
                DO ji = 1, jpi
-                  IF( Gsum(ji,jj,jl) < Gstar) THEN
-                     athorn(ji,jj,jl) = Gstari * (Gsum(ji,jj,jl)-Gsum(ji,jj,jl-1)) * &
-                        (2.0 - (Gsum(ji,jj,jl-1)+Gsum(ji,jj,jl))*Gstari)
-                  ELSEIF (Gsum(ji,jj,jl-1) < Gstar) THEN
-                     athorn(ji,jj,jl) = Gstari * (Gstar-Gsum(ji,jj,jl-1)) *  &
-                        (2.0 - (Gsum(ji,jj,jl-1)+Gstar)*Gstari)
+                  IF( Gsum(ji,jj,jl) < rn_gstar) THEN
+                     athorn(ji,jj,jl) = Gstari * ( Gsum(ji,jj,jl) - Gsum(ji,jj,jl-1) ) * &
+                        &                        ( 2.0 - (Gsum(ji,jj,jl-1) + Gsum(ji,jj,jl) ) * Gstari )
+                  ELSEIF (Gsum(ji,jj,jl-1) < rn_gstar) THEN
+                     athorn(ji,jj,jl) = Gstari * ( rn_gstar - Gsum(ji,jj,jl-1) ) *  &
+                        &                        ( 2.0 - ( Gsum(ji,jj,jl-1) + rn_gstar ) * Gstari )
                   ELSE
                      athorn(ji,jj,jl) = 0.0
                   ENDIF
-               END DO ! ji
-            END DO ! jj
-         END DO ! jl 
+               END DO
+            END DO
+         END DO
 
       ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007)
          !                        
          zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array
-
          DO jl = -1, jpl
             Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy
-         END DO !jl
+         END DO
          DO jl = 0, jpl
              athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl)
          END DO
          !
-      ENDIF ! partfun_swi
-
-      IF( raft_swi == 1 ) THEN      ! Ridging and rafting ice participation functions
+      ENDIF
+
+      IF( ln_rafting ) THEN      ! Ridging and rafting ice participation functions
          !
          DO jl = 1, jpl
             DO jj = 1, jpj 
                DO ji = 1, jpi
-                  IF ( athorn(ji,jj,jl) .GT. 0._wp ) THEN
+                  IF ( athorn(ji,jj,jl) > 0._wp ) THEN
 !!gm  TANH( -X ) = - TANH( X )  so can be computed only 1 time....
-                     aridge(ji,jj,jl) = ( TANH (  Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
-                     araft (ji,jj,jl) = ( TANH ( -Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
+                     aridge(ji,jj,jl) = ( TANH (  rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
+                     araft (ji,jj,jl) = ( TANH ( -rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
                      IF ( araft(ji,jj,jl) < epsi06 )   araft(ji,jj,jl)  = 0._wp
                      aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0 )
-                  ENDIF ! athorn
-               END DO ! ji
-            END DO ! jj
-         END DO ! jl
-
-      ELSE  ! raft_swi = 0
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ELSE
          !
          DO jl = 1, jpl
@@ -741,11 +712,11 @@
       ENDIF
 
-      IF ( raft_swi == 1 ) THEN
-
-         IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi10 ) THEN
+      IF( ln_rafting ) THEN
+
+         IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) > epsi10 .AND. lwp ) THEN
             DO jl = 1, jpl
                DO jj = 1, jpj
                   DO ji = 1, jpi
-                     IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT. epsi10 ) THEN
+                     IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) > epsi10 ) THEN
                         WRITE(numout,*) ' ALERTE 96 : wrong participation function ... '
                         WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl
@@ -793,11 +764,11 @@
             DO ji = 1, jpi
 
-               IF (a_i(ji,jj,jl) .GT. epsi10 .AND. athorn(ji,jj,jl) .GT. 0.0 ) THEN
-                  hi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
-                  hrmean          = MAX(SQRT(Hstar*hi), hi*krdgmin)
-                  hrmin(ji,jj,jl) = MIN(2.0*hi, 0.5*(hrmean + hi))
+               IF (a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0.0 ) THEN
+                  zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+                  hrmean          = MAX(SQRT(rn_hstar*zhi), zhi*krdgmin)
+                  hrmin(ji,jj,jl) = MIN(2.0*zhi, 0.5*(hrmean + zhi))
                   hrmax(ji,jj,jl) = 2.0*hrmean - hrmin(ji,jj,jl)
-                  hraft(ji,jj,jl) = kraft*hi
-                  krdg(ji,jj,jl)  = hrmean / hi
+                  hraft(ji,jj,jl) = kraft*zhi
+                  krdg(ji,jj,jl)  = hrmean / zhi
                ELSE
                   hraft(ji,jj,jl) = 0.0
@@ -807,7 +778,7 @@
                ENDIF
 
-            END DO ! ji
-         END DO ! jj
-      END DO ! jl
+            END DO
+         END DO
+      END DO
 
       ! Normalization factor : aksum, ensures mass conservation
@@ -841,12 +812,8 @@
       LOGICAL, PARAMETER ::   l_conservation_check = .true.  ! if true, check conservation (useful for debugging)
       !
-      LOGICAL ::   neg_ato_i      ! flag for ato_i(i,j) < -puny
-      LOGICAL ::   large_afrac    ! flag for afrac > 1
-      LOGICAL ::   large_afrft    ! flag for afrac > 1
       INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices
       INTEGER ::   ij                ! horizontal index, combines i and j loops
       INTEGER ::   icells            ! number of cells with aicen > puny
-      REAL(wp) ::   hL, hR, farea, zdummy, zdummy0, ztmelts    ! left and right limits of integration
-      REAL(wp) ::   zsstK            ! SST in Kelvin
+      REAL(wp) ::   hL, hR, farea, ztmelts    ! left and right limits of integration
 
       INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices
@@ -864,5 +831,4 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges
       REAL(wp), POINTER, DIMENSION(:,:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! areal age content of ridged & rifging ice
       REAL(wp), POINTER, DIMENSION(:,:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2
 
@@ -873,4 +839,5 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   srdg2   ! sal*volume of new ridges
       REAL(wp), POINTER, DIMENSION(:,:) ::   smsw    ! sal*volume of water trapped into ridges
+      REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! ice age of ice ridged
 
       REAL(wp), POINTER, DIMENSION(:,:) ::   afrft            ! fraction of category area rafted
@@ -878,5 +845,5 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   virft , vsrft    ! ice & snow volume of rafting ice
       REAL(wp), POINTER, DIMENSION(:,:) ::   esrft , smrft    ! snow energy & salinity of rafting ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   oirft1, oirft2   ! areal age content of rafted ice & rafting ice
+      REAL(wp), POINTER, DIMENSION(:,:) ::   oirft1, oirft2   ! ice age of ice rafted
 
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   eirft      ! ice energy of rafting ice
@@ -886,12 +853,12 @@
       !!----------------------------------------------------------------------
 
-      CALL wrk_alloc( (jpi+1)*(jpj+1),      indxi, indxj )
-      CALL wrk_alloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final )
-      CALL wrk_alloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 )
-      CALL wrk_alloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw )
-      CALL wrk_alloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
-      CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
-      CALL wrk_alloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw )
-      CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, eicen_init )
+      CALL wrk_alloc( (jpi+1)*(jpj+1),       indxi, indxj )
+      CALL wrk_alloc( jpi, jpj,              vice_init, vice_final, eice_init, eice_final )
+      CALL wrk_alloc( jpi, jpj,              afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
+      CALL wrk_alloc( jpi, jpj,              vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 )
+      CALL wrk_alloc( jpi, jpj,              afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
+      CALL wrk_alloc( jpi, jpj, jpl,         aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
+      CALL wrk_alloc( jpi, jpj, nlay_i,      eirft, erdg1, erdg2, ersw )
+      CALL wrk_alloc( jpi, jpj, nlay_i, jpl, eicen_init )
 
       ! Conservation check
@@ -901,6 +868,6 @@
          CALL lim_column_sum        (jpl,    v_i,       vice_init )
          CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_init )
-         DO ji = mi0(jiindx), mi1(jiindx)
-            DO jj = mj0(jjindx), mj1(jjindx)
+         DO ji = mi0(iiceprt), mi1(iiceprt)
+            DO jj = mj0(jiceprt), mj1(jiceprt)
                WRITE(numout,*) ' vice_init  : ', vice_init(ji,jj)
                WRITE(numout,*) ' eice_init  : ', eice_init(ji,jj)
@@ -912,52 +879,26 @@
       ! 1) Compute change in open water area due to closing and opening.
       !-------------------------------------------------------------------------------
-
-      neg_ato_i = .false.
-
       DO jj = 1, jpj
          DO ji = 1, jpi
             ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice        &
                &                        + opning(ji,jj)                          * rdt_ice
-            IF( ato_i(ji,jj) < -epsi10 ) THEN
-               neg_ato_i = .TRUE.
-            ELSEIF( ato_i(ji,jj) < 0._wp ) THEN    ! roundoff error
+            IF    ( ato_i(ji,jj) < -epsi10 ) THEN    ! there is a bug
+               IF(lwp)   WRITE(numout,*) 'Ridging error: ato_i < 0 -- ato_i : ',ato_i(ji,jj)
+            ELSEIF( ato_i(ji,jj) < 0._wp   ) THEN    ! roundoff error
                ato_i(ji,jj) = 0._wp
             ENDIF
-         END DO !jj
-      END DO !ji
-
-      ! if negative open water area alert it
-      IF( neg_ato_i ) THEN       ! there is a bug
-         DO jj = 1, jpj 
-            DO ji = 1, jpi
-               IF( ato_i(ji,jj) < -epsi10 ) THEN 
-                  WRITE(numout,*) ''  
-                  WRITE(numout,*) 'Ridging error: ato_i < 0'
-                  WRITE(numout,*) 'ato_i : ', ato_i(ji,jj)
-               ENDIF               ! ato_i < -epsi10
-            END DO
-         END DO
-      ENDIF
+         END DO
+      END DO
 
       !-----------------------------------------------------------------
       ! 2) Save initial state variables
       !-----------------------------------------------------------------
-
-      DO jl = 1, jpl
-         aicen_init(:,:,jl) = a_i(:,:,jl)
-         vicen_init(:,:,jl) = v_i(:,:,jl)
-         vsnwn_init(:,:,jl) = v_s(:,:,jl)
-         !
-         smv_i_init(:,:,jl) = smv_i(:,:,jl)
-         oa_i_init (:,:,jl) = oa_i (:,:,jl)
-      END DO !jl
-
-      esnwn_init(:,:,:) = e_s(:,:,1,:)
-
-      DO jl = 1, jpl  
-         DO jk = 1, nlay_i
-            eicen_init(:,:,jk,jl) = e_i(:,:,jk,jl)
-         END DO
-      END DO
+      aicen_init(:,:,:)   = a_i  (:,:,:)
+      vicen_init(:,:,:)   = v_i  (:,:,:)
+      vsnwn_init(:,:,:)   = v_s  (:,:,:)
+      smv_i_init(:,:,:)   = smv_i(:,:,:)
+      esnwn_init(:,:,:)   = e_s  (:,:,1,:)
+      eicen_init(:,:,:,:) = e_i  (:,:,:,:)
+      oa_i_init (:,:,:)   = oa_i (:,:,:)
 
       !
@@ -982,12 +923,8 @@
                   indxi(icells) = ji
                   indxj(icells) = jj
-               ENDIF ! test on a_icen_init 
-            END DO ! ji
-         END DO ! jj
-
-         large_afrac = .false.
-         large_afrft = .false.
-
-!CDIR NODEP
+               ENDIF
+            END DO
+         END DO
+
          DO ij = 1, icells
             ji = indxi(ij)
@@ -1003,9 +940,4 @@
             arft2(ji,jj) = arft1(ji,jj) / kraft
 
-            oirdg1(ji,jj)= aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice
-            oirft1(ji,jj)= araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice
-            oirdg2(ji,jj)= oirdg1(ji,jj) / krdg(ji,jj,jl1)
-            oirft2(ji,jj)= oirft1(ji,jj) / kraft
-
             !---------------------------------------------------------------
             ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1 
@@ -1015,12 +947,13 @@
             afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting
 
-            IF (afrac(ji,jj) > kamax + epsi10) THEN  !riging
-               large_afrac = .true.
-            ELSEIF (afrac(ji,jj) > kamax) THEN  ! roundoff error
+            IF( afrac(ji,jj) > kamax + epsi10 ) THEN  ! there is a bug
+               IF(lwp)   WRITE(numout,*) ' ardg > a_i -- ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1)
+            ELSEIF( afrac(ji,jj) > kamax ) THEN       ! roundoff error
                afrac(ji,jj) = kamax
             ENDIF
-            IF (afrft(ji,jj) > kamax + epsi10) THEN !rafting
-               large_afrft = .true.
-            ELSEIF (afrft(ji,jj) > kamax) THEN  ! roundoff error
+
+            IF( afrft(ji,jj) > kamax + epsi10 ) THEN ! there is a bug
+               IF(lwp)   WRITE(numout,*) ' arft > a_i -- arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1) 
+            ELSEIF( afrft(ji,jj) > kamax) THEN       ! roundoff error
                afrft(ji,jj) = kamax
             ENDIF
@@ -1031,39 +964,42 @@
             !--------------------------------------------------------------------------
             vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj)
-            vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por )
-            vsw  (ji,jj) = vrdg1(ji,jj) * ridge_por
-
-            vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj)
-            esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj)
-            srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj)
-            srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless
+            vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + rn_por_rdg )
+            vsw  (ji,jj) = vrdg1(ji,jj) * rn_por_rdg
+
+            vsrdg (ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj)
+            esrdg (ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj)
+            srdg1 (ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj)
+            oirdg1(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj)
+            oirdg2(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) / krdg(ji,jj,jl1) 
 
             ! rafting volumes, heat contents ...
-            virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj)
-            vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj)
-            esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj)
-            smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 
+            virft (ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj)
+            vsrft (ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj)
+            esrft (ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj)
+            smrft (ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 
+            oirft1(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) 
+            oirft2(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) / kraft 
 
             ! substract everything
-            a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1(ji,jj)  - arft1(ji,jj)
-            v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1(ji,jj)  - virft(ji,jj)
-            v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg(ji,jj)  - vsrft(ji,jj)
-            e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg(ji,jj)  - esrft(ji,jj)
+            a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1 (ji,jj) - arft1 (ji,jj)
+            v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1 (ji,jj) - virft (ji,jj)
+            v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg (ji,jj) - vsrft (ji,jj)
+            e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg (ji,jj) - esrft (ji,jj)
+            smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1 (ji,jj) - smrft (ji,jj)
             oa_i(ji,jj,jl1)  = oa_i(ji,jj,jl1)  - oirdg1(ji,jj) - oirft1(ji,jj)
-            smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1(ji,jj)  - smrft(ji,jj)
 
             !-----------------------------------------------------------------
             ! 3.5) Compute properties of new ridges
             !-----------------------------------------------------------------
-            !-------------
+            !---------
             ! Salinity
-            !-------------
+            !---------
             smsw(ji,jj)  = vsw(ji,jj) * sss_m(ji,jj)                      ! salt content of seawater frozen in voids !! MV HC2014
             srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge
 
-            !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity
+            !srdg2(ji,jj) = MIN( rn_simax * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity
             
             sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice
-            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! gurvan: increase in ice volume du to seawater frozen in voids             
+            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! increase in ice volume du to seawater frozen in voids             
 
             !------------------------------------            
@@ -1091,10 +1027,10 @@
             !           ij looping 1-icells
 
-            msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-fsnowrdg)   &   ! rafting included
-               &                                + rhosn*vsrft(ji,jj)*(1.0-fsnowrft)
-
-            ! in 1e-9 Joules (same as e_s)
-            esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included
-               &                                - esrft(ji,jj)*(1.0-fsnowrft)          
+            msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-rn_fsnowrdg)   &   ! rafting included
+               &                                + rhosn*vsrft(ji,jj)*(1.0-rn_fsnowrft)
+
+            ! in J/m2 (same as e_s)
+            esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-rn_fsnowrdg)         &   !rafting included
+               &                                - esrft(ji,jj)*(1.0-rn_fsnowrft)          
 
             !-----------------------------------------------------------------
@@ -1109,5 +1045,5 @@
             dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1)
 
-         END DO                 ! ij
+         END DO
 
          !--------------------------------------------------------------------
@@ -1116,5 +1052,4 @@
          !--------------------------------------------------------------------
          DO jk = 1, nlay_i
-!CDIR NODEP
             DO ij = 1, icells
                ji = indxi(ij)
@@ -1128,57 +1063,23 @@
                ! enthalpy of the trapped seawater (J/m2, >0)
                ! clem: if sst>0, then ersw <0 (is that possible?)
-               zsstK  = sst_m(ji,jj) + rt0
-               ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i )
+               ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * sst_m(ji,jj) * r1_nlay_i
 
                ! heat flux to the ocean
                hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux 
 
-               ! Correct dimensions to avoid big values
-               ersw(ji,jj,jk)   = ersw(ji,jj,jk) / unit_fac
-
-               ! Mutliply by ice volume, and divide by number of layers to get heat content in 1.e9 J
-               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 
-               !! MV HC 2014
-               ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj)
-
+               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean
                erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk)
 
-            END DO ! ij
-         END DO !jk
+            END DO
+         END DO
 
 
          IF( con_i ) THEN
             DO jk = 1, nlay_i
-!CDIR NODEP
                DO ij = 1, icells
                   ji = indxi(ij)
                   jj = indxj(ij)
                   eice_init(ji,jj) = eice_init(ji,jj) + erdg2(ji,jj,jk) - erdg1(ji,jj,jk)
-               END DO ! ij
-            END DO !jk
-         ENDIF
-
-         IF( large_afrac ) THEN   ! there is a bug
-!CDIR NODEP
-            DO ij = 1, icells
-               ji = indxi(ij)
-               jj = indxj(ij)
-               IF( afrac(ji,jj) > kamax + epsi10 ) THEN 
-                  WRITE(numout,*) ''
-                  WRITE(numout,*) ' ardg > a_i'
-                  WRITE(numout,*) ' ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1)
-               ENDIF
-            END DO
-         ENDIF
-         IF( large_afrft ) THEN  ! there is a bug
-!CDIR NODEP
-            DO ij = 1, icells
-               ji = indxi(ij)
-               jj = indxj(ij)
-               IF( afrft(ji,jj) > kamax + epsi10 ) THEN 
-                  WRITE(numout,*) ''
-                  WRITE(numout,*) ' arft > a_i'
-                  WRITE(numout,*) ' arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1)
-               ENDIF
+               END DO
             END DO
          ENDIF
@@ -1190,5 +1091,4 @@
          DO jl2  = 1, jpl 
             ! over categories to which ridged ice is transferred
-!CDIR NODEP
             DO ij = 1, icells
                ji = indxi(ij)
@@ -1199,6 +1099,5 @@
                ! Transfer area, volume, and energy accordingly.
 
-               IF( hrmin(ji,jj,jl1) >= hi_max(jl2)  .OR.        &
-                   hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN
+               IF( hrmin(ji,jj,jl1) >= hi_max(jl2) .OR. hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN
                   hL = 0._wp
                   hR = 0._wp
@@ -1214,18 +1113,17 @@
                a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ardg2 (ji,jj) * farea
                v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + vrdg2 (ji,jj) * fvol(ji,jj)
-               v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * fsnowrdg
-               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * fsnowrdg
+               v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg
+               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg
                smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + srdg2 (ji,jj) * fvol(ji,jj)
                oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirdg2(ji,jj) * farea
 
-            END DO ! ij
+            END DO
 
             ! Transfer ice energy to category jl2 by ridging
             DO jk = 1, nlay_i
-!CDIR NODEP
                DO ij = 1, icells
                   ji = indxi(ij)
                   jj = indxj(ij)
-                  e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj)*erdg2(ji,jj,jk)
+                  e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj) * erdg2(ji,jj,jk)
                END DO
             END DO
@@ -1235,5 +1133,4 @@
          DO jl2 = 1, jpl 
 
-!CDIR NODEP
             DO ij = 1, icells
                ji = indxi(ij)
@@ -1242,30 +1139,27 @@
                ! thickness category jl2, transfer area, volume, and energy accordingly.
                !
-               IF( hraft(ji,jj,jl1) <= hi_max(jl2)  .AND.        &
-                   hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN
+               IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN
                   a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + arft2 (ji,jj)
                   v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + virft (ji,jj)
-                  v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrft (ji,jj) * fsnowrft
-                  e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrft (ji,jj) * fsnowrft
+                  v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrft (ji,jj) * rn_fsnowrft
+                  e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft
                   smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + smrft (ji,jj)    
-                  oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj)    
-               ENDIF ! hraft
+                  oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj)
+               ENDIF
                !
-            END DO ! ij
+            END DO
 
             ! Transfer rafted ice energy to category jl2 
             DO jk = 1, nlay_i
-!CDIR NODEP
                DO ij = 1, icells
                   ji = indxi(ij)
                   jj = indxj(ij)
-                  IF(  hraft(ji,jj,jl1)  <=  hi_max(jl2)   .AND.        &
-                       hraft(ji,jj,jl1)  >   hi_max(jl2-1)  ) THEN
+                  IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) > hi_max(jl2-1)  ) THEN
                      e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk)
                   ENDIF
-               END DO           ! ij
-            END DO !jk
-
-         END DO ! jl2
+               END DO
+            END DO
+
+         END DO
 
       END DO ! jl1 (deforming categories)
@@ -1281,6 +1175,6 @@
          CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid) 
 
-         DO ji = mi0(jiindx), mi1(jiindx)
-            DO jj = mj0(jjindx), mj1(jjindx)
+         DO ji = mi0(iiceprt), mi1(iiceprt)
+            DO jj = mj0(jiceprt), mj1(jiceprt)
                WRITE(numout,*) ' vice_init  : ', vice_init (ji,jj)
                WRITE(numout,*) ' vice_final : ', vice_final(ji,jj)
@@ -1291,37 +1185,14 @@
       ENDIF
       !
-      CALL wrk_dealloc( (jpi+1)*(jpj+1),      indxi, indxj )
-      CALL wrk_dealloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final )
-      CALL wrk_dealloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 )
-      CALL wrk_dealloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw )
-      CALL wrk_dealloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
-      CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
-      CALL wrk_dealloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw )
-      CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, eicen_init )
+      CALL wrk_dealloc( (jpi+1)*(jpj+1),        indxi, indxj )
+      CALL wrk_dealloc( jpi, jpj,               vice_init, vice_final, eice_init, eice_final )
+      CALL wrk_dealloc( jpi, jpj,               afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
+      CALL wrk_dealloc( jpi, jpj,               vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 )
+      CALL wrk_dealloc( jpi, jpj,               afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
+      CALL wrk_dealloc( jpi, jpj, jpl,          aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
+      CALL wrk_dealloc( jpi, jpj, nlay_i,       eirft, erdg1, erdg2, ersw )
+      CALL wrk_dealloc( jpi, jpj, nlay_i, jpl,  eicen_init )
       !
    END SUBROUTINE lim_itd_me_ridgeshift
-
-
-   SUBROUTINE lim_itd_me_asumr
-      !!-----------------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_me_asumr ***
-      !!
-      !! ** Purpose :   finds total fractional area
-      !!
-      !! ** Method  :   Find the total area of ice plus open water in each grid cell.
-      !!              This is similar to the aggregate_area subroutine except that the
-      !!              total area can be greater than 1, so the open water area is 
-      !!              included in the sum instead of being computed as a residual. 
-      !!-----------------------------------------------------------------------------
-      INTEGER ::   jl   ! dummy loop index
-      !!-----------------------------------------------------------------------------
-      !
-      asum(:,:) = ato_i(:,:)                    ! open water
-      DO jl = 1, jpl                            ! ice categories
-         asum(:,:) = asum(:,:) + a_i(:,:,jl)
-      END DO
-      !
-   END SUBROUTINE lim_itd_me_asumr
-
 
    SUBROUTINE lim_itd_me_init
@@ -1339,7 +1210,7 @@
       !!-------------------------------------------------------------------
       INTEGER :: ios                 ! Local integer output status for namelist read
-      NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,              & 
-        &                   Gstar, astar, Hstar, raft_swi, hparmeter, Craft, ridge_por, &
-        &                   partfun_swi, brinstren_swi
+      NAMELIST/namiceitdme/ rn_cs, rn_fsnowrdg, rn_fsnowrft,              & 
+        &                   rn_gstar, rn_astar, rn_hstar, ln_rafting, rn_hraft, rn_craft, rn_por_rdg, &
+        &                   nn_partfun
       !!-------------------------------------------------------------------
       !
@@ -1357,130 +1228,18 @@
          WRITE(numout,*)' lim_itd_me_init : ice parameters for mechanical ice redistribution '
          WRITE(numout,*)' ~~~~~~~~~~~~~~~'
-         WRITE(numout,*)'   Switch choosing the ice redistribution scheme           ridge_scheme_swi', ridge_scheme_swi 
-         WRITE(numout,*)'   Fraction of shear energy contributing to ridging        Cs              ', Cs 
-         WRITE(numout,*)'   Ratio of ridging work to PotEner change in ridging      Cf              ', Cf 
-         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        fsnowrdg        ', fsnowrdg 
-         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        fsnowrft        ', fsnowrft 
-         WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  Gstar           ', Gstar
-         WRITE(numout,*)'   Equivalent to G* for an exponential part function       astar           ', astar
-         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     Hstar           ', Hstar
-         WRITE(numout,*)'   Rafting of ice sheets or not                            raft_swi        ', raft_swi
-         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       hparmeter       ', hparmeter
-         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  Craft           ', Craft  
-         WRITE(numout,*)'   Initial porosity of ridges                              ridge_por       ', ridge_por
-         WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    partfun_swi     ', partfun_swi
-         WRITE(numout,*)'   Switch for including brine volume in ice strength comp. brinstren_swi   ', brinstren_swi
+         WRITE(numout,*)'   Fraction of shear energy contributing to ridging        rn_cs       = ', rn_cs 
+         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrdg = ', rn_fsnowrdg 
+         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrft = ', rn_fsnowrft 
+         WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  rn_gstar    = ', rn_gstar
+         WRITE(numout,*)'   Equivalent to G* for an exponential part function       rn_astar    = ', rn_astar
+         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     rn_hstar    = ', rn_hstar
+         WRITE(numout,*)'   Rafting of ice sheets or not                            ln_rafting  = ', ln_rafting
+         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       rn_hraft    = ', rn_hraft
+         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  rn_craft    = ', rn_craft  
+         WRITE(numout,*)'   Initial porosity of ridges                              rn_por_rdg  = ', rn_por_rdg
+         WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    nn_partfun  = ', nn_partfun
       ENDIF
       !
    END SUBROUTINE lim_itd_me_init
-
-
-   SUBROUTINE lim_itd_me_zapsmall
-      !!-------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_itd_me_zapsmall ***
-      !!
-      !! ** Purpose :   Remove too small sea ice areas and correct salt fluxes
-      !!
-      !! history :
-      !! author: William H. Lipscomb, LANL
-      !! Nov 2003:  Modified by Julie Schramm to conserve volume and energy
-      !! Sept 2004: Modified by William Lipscomb; replaced normalize_state with
-      !!            additions to local freshwater, salt, and heat fluxes
-      !!  9.0, LIM3.0 - 02-2006 (M. Vancoppenolle) original code
-      !!-------------------------------------------------------------------
-      INTEGER ::   ji, jj, jl, jk   ! dummy loop indices
-      INTEGER ::   icells           ! number of cells with ice to zap
-
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask   ! 2D workspace
-      REAL(wp)                          ::   zmask_glo, zsal, zvi, zvs, zei, zes
-!!gm      REAL(wp) ::   xtmp      ! temporary variable
-      !!-------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi, jpj, zmask )
-
-      ! to be sure that at_i is the sum of a_i(jl)
-      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
-
-      DO jl = 1, jpl
-         !-----------------------------------------------------------------
-         ! Count categories to be zapped.
-         !-----------------------------------------------------------------
-         icells = 0
-         zmask(:,:)  = 0._wp
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( a_i(ji,jj,jl) <= epsi10 .OR. v_i(ji,jj,jl) <= epsi10 .OR. at_i(ji,jj) <= epsi10 ) THEN
-                  zmask(ji,jj) = 1._wp
-               ENDIF
-            END DO
-         END DO
-         !zmask_glo = glob_sum(zmask)
-         !IF( ln_nicep .AND. lwp ) WRITE(numout,*) zmask_glo, ' cells of ice zapped in the ocean '
-
-         !-----------------------------------------------------------------
-         ! Zap ice energy and use ocean heat to melt ice
-         !-----------------------------------------------------------------
-
-         DO jk = 1, nlay_i
-            DO jj = 1 , jpj
-               DO ji = 1 , jpi
-                  zei  = e_i(ji,jj,jk,jl)
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) )
-                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) + rtt * zmask(ji,jj)
-                  ! update exchanges with ocean
-                  hfx_res(ji,jj)   = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
-               END DO
-            END DO
-         END DO
-
-         DO jj = 1 , jpj
-            DO ji = 1 , jpi
-               
-               zsal = smv_i(ji,jj,jl)
-               zvi  = v_i(ji,jj,jl)
-               zvs  = v_s(ji,jj,jl)
-               zes  = e_s(ji,jj,1,jl)
-               !-----------------------------------------------------------------
-               ! Zap snow energy and use ocean heat to melt snow
-               !-----------------------------------------------------------------
-               !           xtmp = esnon(i,j,n) / dt ! < 0
-               !           fhnet(i,j)      = fhnet(i,j)      + xtmp
-               !           fhnet_hist(i,j) = fhnet_hist(i,j) + xtmp
-               ! xtmp is greater than 0
-               ! fluxes are positive to the ocean
-               ! here the flux has to be negative for the ocean
-               t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) )
-
-               !-----------------------------------------------------------------
-               ! zap ice and snow volume, add water and salt to ocean
-               !-----------------------------------------------------------------
-               ato_i(ji,jj)    = a_i  (ji,jj,jl) *           zmask(ji,jj)   + ato_i(ji,jj)
-               a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
-               v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
-               v_s  (ji,jj,jl) = v_s  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
-               t_su (ji,jj,jl) = t_su (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj)
-               oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
-               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
-               e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) )
-               ! additional condition
-               IF( v_s(ji,jj,jl) <= epsi10 ) THEN
-                  v_s(ji,jj,jl)   = 0._wp
-                  e_s(ji,jj,1,jl) = 0._wp
-               ENDIF
-               ! update exchanges with ocean
-               sfx_res(ji,jj)  = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
-               wfx_res(ji,jj)  = wfx_res(ji,jj) - ( v_i(ji,jj,jl)   - zvi  ) * rhoic * r1_rdtice
-               wfx_snw(ji,jj)  = wfx_snw(ji,jj) - ( v_s(ji,jj,jl)   - zvs  ) * rhosn * r1_rdtice
-               hfx_res(ji,jj)  = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
-            END DO
-         END DO
-      END DO ! jl 
-
-      ! to be sure that at_i is the sum of a_i(jl)
-      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
-      !
-      CALL wrk_dealloc( jpi, jpj, zmask )
-      !
-   END SUBROUTINE lim_itd_me_zapsmall
 
 #else
@@ -1493,10 +1252,6 @@
    SUBROUTINE lim_itd_me_icestrength
    END SUBROUTINE lim_itd_me_icestrength
-   SUBROUTINE lim_itd_me_sort
-   END SUBROUTINE lim_itd_me_sort
    SUBROUTINE lim_itd_me_init
    END SUBROUTINE lim_itd_me_init
-   SUBROUTINE lim_itd_me_zapsmall
-   END SUBROUTINE lim_itd_me_zapsmall
 #endif
    !!======================================================================
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90	(revision 5901)
@@ -13,5 +13,4 @@
    !!   'key_lim3' :                                   LIM3 sea-ice model
    !!----------------------------------------------------------------------
-   !!   lim_itd_th       : thermodynamics of ice thickness distribution
    !!   lim_itd_th_rem   :
    !!   lim_itd_th_reb   :
@@ -25,8 +24,5 @@
    USE thd_ice          ! LIM-3 thermodynamic variables
    USE ice              ! LIM-3 variables
-   USE par_ice          ! LIM-3 parameters
-   USE limthd_lac       ! LIM-3 lateral accretion
    USE limvar           ! LIM-3 variables
-   USE limcons          ! LIM-3 conservation
    USE prtctl           ! Print control
    USE in_out_manager   ! I/O manager
@@ -34,15 +30,11 @@
    USE wrk_nemo         ! work arrays
    USE lib_fortran      ! to use key_nosignedzero
-   USE timing          ! Timing
-   USE limcons        ! conservation tests
+   USE limcons          ! conservation tests
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_itd_th         ! called by ice_stp
    PUBLIC   lim_itd_th_rem
    PUBLIC   lim_itd_th_reb
-   PUBLIC   lim_itd_fitline
-   PUBLIC   lim_itd_shiftice
 
    !!----------------------------------------------------------------------
@@ -53,84 +45,4 @@
 CONTAINS
 
-   SUBROUTINE lim_itd_th( kt )
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_th ***
-      !!
-      !! ** Purpose :   computes the thermodynamics of ice thickness distribution
-      !!
-      !! ** Method  :
-      !!------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! time step index
-      !
-      INTEGER ::   ji, jj, jk, jl   ! dummy loop index         
-      !
-      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
-      !!------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('limitd_th')
-
-      ! conservation test
-      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'lim_itd_th  : Thermodynamics of the ice thickness distribution'
-         WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-
-      !------------------------------------------------------------------------------|
-      !  1) Transport of ice between thickness categories.                           |
-      !------------------------------------------------------------------------------|
-      ! Given thermodynamic growth rates, transport ice between
-      ! thickness categories.
-      IF( jpl > 1 )   CALL lim_itd_th_rem( 1, jpl, kt )
-      !
-      CALL lim_var_glo2eqv    ! only for info
-      CALL lim_var_agg(1)
-
-      !------------------------------------------------------------------------------|
-      !  3) Add frazil ice growing in leads.
-      !------------------------------------------------------------------------------|
-      CALL lim_thd_lac
-      CALL lim_var_glo2eqv    ! only for info
-     
-      IF(ln_ctl) THEN   ! Control print
-         CALL prt_ctl_info(' ')
-         CALL prt_ctl_info(' - Cell values : ')
-         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_th  : cell area :')
-         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :')
-         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :')
-         CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th  : vt_s      :')
-         DO jl = 1, jpl
-            CALL prt_ctl_info(' ')
-            CALL prt_ctl_info(' - Category : ', ivar1=jl)
-            CALL prt_ctl_info('   ~~~~~~~~~~')
-            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : a_i      : ')
-            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_i     : ')
-            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_s     : ')
-            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_i      : ')
-            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_s      : ')
-            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : e_s      : ')
-            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_itd_th  : t_su     : ')
-            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : t_snow   : ')
-            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ')
-            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ')
-            DO jk = 1, nlay_i
-               CALL prt_ctl_info(' ')
-               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
-               CALL prt_ctl_info('   ~~~~~~~')
-               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : t_i      : ')
-               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : e_i      : ')
-            END DO
-         END DO
-      ENDIF
-      !
-      ! conservation test
-      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-      !
-     IF( nn_timing == 1 )  CALL timing_stop('limitd_th')
-   END SUBROUTINE lim_itd_th
-   !
-
    SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt )
       !!------------------------------------------------------------------
@@ -153,5 +65,5 @@
       REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars
       REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      -
-      REAL(wp) ::   zx3,             zareamin          !   -      -
+      REAL(wp) ::   zx3        
       CHARACTER (len = 15) :: fieldid
 
@@ -179,14 +91,12 @@
       !!------------------------------------------------------------------
 
-      CALL wrk_alloc( jpi,jpj, zremap_flag )    ! integer
-      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )   ! integer
+      CALL wrk_alloc( jpi,jpj, zremap_flag )
+      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )
       CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )
       CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )   
       CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
       CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )   
-      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
+      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
       CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final )
-
-      zareamin = epsi10   !minimum area in thickness categories tolerated by the conceptors of the model
 
       !!----------------------------------------------------------------------------------------------
@@ -216,9 +126,9 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               rswitch             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) )     !0 if no ice and 1 if yes
+               rswitch           = MAX( 0.0, SIGN( 1.0, a_i(ji,jj,jl) - epsi10 ) )     !0 if no ice and 1 if yes
                ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch
-               rswitch             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i_b(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes
+               rswitch           = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) )
                zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch
-               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) 
+               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) ! clem: useless IF statement? 
             END DO
          END DO
@@ -239,5 +149,5 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            IF ( at_i(ji,jj) .gt. zareamin ) THEN
+            IF ( at_i(ji,jj) > epsi10 ) THEN
                nbrem         = nbrem + 1
                nind_i(nbrem) = ji
@@ -247,6 +157,6 @@
                zremap_flag(ji,jj) = 0
             ENDIF
-         END DO !ji
-      END DO !jj
+         END DO
+      END DO
 
       !-----------------------------------------------------------------------------------------------
@@ -254,7 +164,4 @@
       !-----------------------------------------------------------------------------------------------
       !- 4.1 Compute category boundaries
-      ! Tricky trick see limitd_me.F90
-      ! will be soon removed, CT
-      ! hi_max(kubnd) = 99.
       zhbnew(:,:,:) = 0._wp
 
@@ -265,11 +172,11 @@
             !
             zhbnew(ii,ij,jl) = hi_max(jl)
-            IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN
+            IF    ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN
                !interpolate between adjacent category growth rates
                zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) )
                zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) )
-            ELSEIF ( a_i_b(ii,ij,jl) > epsi10) THEN
+            ELSEIF( a_i_b(ii,ij,jl) > epsi10) THEN
                zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl)
-            ELSEIF ( a_i_b(ii,ij,jl+1) > epsi10) THEN
+            ELSEIF( a_i_b(ii,ij,jl+1) > epsi10) THEN
                zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1)
             ENDIF
@@ -280,16 +187,23 @@
             ii = nind_i(ji)
             ij = nind_j(ji)
-            IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN
+
+            ! clem: we do not want ht_i to be too close to either HR or HL otherwise a division by nearly 0 is possible 
+            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
+            IF    ( a_i(ii,ij,jl  ) > epsi10 .AND. ht_i(ii,ij,jl  ) > ( zhbnew(ii,ij,jl) - epsi10 ) ) THEN
                zremap_flag(ii,ij) = 0
-            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN
+            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) < ( zhbnew(ii,ij,jl) + epsi10 ) ) THEN
                zremap_flag(ii,ij) = 0
             ENDIF
 
             !- 4.3 Check that each zhbnew does not exceed maximal values hi_max  
+            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
             IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0
-            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
-         END DO
-
-      END DO !jl
+            ! clem bug: why is not the following instead?
+            !!IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
+            !!IF( zhbnew(ii,ij,jl) > hi_max(jl  ) ) zremap_flag(ii,ij) = 0
+ 
+         END DO
+
+      END DO
 
       !-----------------------------------------------------------------------------------------------
@@ -312,21 +226,24 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zhb0(ji,jj) = hi_max(0) ! 0eme
-            zhb1(ji,jj) = hi_max(1) ! 1er
-
-            zhbnew(ji,jj,klbnd-1) = 0._wp
+            zhb0(ji,jj) = hi_max(0)
+            zhb1(ji,jj) = hi_max(1)
 
             IF( a_i(ji,jj,kubnd) > epsi10 ) THEN
-               zhbnew(ji,jj,kubnd) = 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1)
+               zhbnew(ji,jj,kubnd) = MAX( hi_max(kubnd-1), 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1) )
             ELSE
-               zhbnew(ji,jj,kubnd) = hi_max(kubnd)  
-               !!? clem bug: since hi_max(jpl)=99, this limit is very high 
-               !!? but I think it is erased in fitline subroutine 
-            ENDIF
-
-            IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1)
-
-         END DO !jj
-      END DO !jj
+!clem bug               zhbnew(ji,jj,kubnd) = hi_max(kubnd)  
+               zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) ! not used anyway
+            ENDIF
+
+            ! clem: we do not want ht_i_b to be too close to either HR or HL otherwise a division by nearly 0 is possible 
+            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
+            IF    ( zht_i_b(ji,jj,klbnd) < ( zhb0(ji,jj) + epsi10 ) )  THEN
+               zremap_flag(ji,jj) = 0
+            ELSEIF( zht_i_b(ji,jj,klbnd) > ( zhb1(ji,jj) - epsi10 ) )  THEN
+               zremap_flag(ji,jj) = 0
+            ENDIF
+
+         END DO
+      END DO
 
       !-----------------------------------------------------------------------------------------------
@@ -334,6 +251,5 @@
       !-----------------------------------------------------------------------------------------------
       !- 7.1 g(h) for category 1 at start of time step
-      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd),         &
-         &                  g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   &
+      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   &
          &                  hR(:,:,klbnd), zremap_flag )
 
@@ -343,48 +259,39 @@
          ij = nind_j(ji) 
 
-         !ji
-         IF (a_i(ii,ij,klbnd) .gt. epsi10) THEN
+         IF( a_i(ii,ij,klbnd) > epsi10 ) THEN
+
             zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category
-            ! ji, a_i > epsi10
-            IF (zdh0 .lt. 0.0) THEN !remove area from category 1
-               ! ji, a_i > epsi10; zdh0 < 0
-               zdh0 = MIN(-zdh0,hi_max(klbnd))
-
+
+            IF( zdh0 < 0.0 ) THEN      !remove area from category 1
+               zdh0 = MIN( -zdh0, hi_max(klbnd) )
                !Integrate g(1) from 0 to dh0 to estimate area melted
-               zetamax = MIN(zdh0,hR(ii,ij,klbnd)) - hL(ii,ij,klbnd)
-               IF (zetamax.gt.0.0) THEN
-                  zx1  = zetamax
-                  zx2  = 0.5 * zetamax*zetamax 
-                  zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 !ice area removed
-                  ! Constrain new thickness <= ht_i
-                  zdamax = a_i(ii,ij,klbnd) * & 
-                     (1.0 - ht_i(ii,ij,klbnd)/zht_i_b(ii,ij,klbnd)) ! zdamax > 0
-                  !ice area lost due to melting of thin ice
-                  zda0   = MIN(zda0, zdamax)
-
+               zetamax = MIN( zdh0, hR(ii,ij,klbnd) ) - hL(ii,ij,klbnd)
+
+               IF( zetamax > 0.0 ) THEN
+                  zx1    = zetamax
+                  zx2    = 0.5 * zetamax * zetamax 
+                  zda0   = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1                        ! ice area removed
+                  zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! Constrain new thickness <= ht_i                
+                  zda0   = MIN( zda0, zdamax )                                                  ! ice area lost due to melting 
+                                                                                                !     of thin ice (zdamax > 0)
                   ! Remove area, conserving volume
-                  ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) & 
-                     * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 )
+                  ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 )
                   a_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) - zda0
-                  v_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd)*ht_i(ii,ij,klbnd) ! clem-useless ?
-               ENDIF     ! zetamax > 0
-               ! ji, a_i > epsi10
-
-            ELSE ! if ice accretion
-               ! ji, a_i > epsi10; zdh0 > 0
-               zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd)) 
-               ! zhbnew was 0, and is shifted to the right to account for thin ice
-               ! growth in openwater (F0 = f1)
-            ENDIF ! zdh0 
-
-            ! a_i > epsi10
-         ENDIF ! a_i > epsi10
-
-      END DO ! ji
+                  v_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) * ht_i(ii,ij,klbnd) ! clem-useless ?
+               ENDIF
+
+            ELSE ! if ice accretion zdh0 > 0
+               ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1)
+               zhbnew(ii,ij,klbnd-1) = MIN( zdh0, hi_max(klbnd) ) 
+            ENDIF
+
+         ENDIF
+
+      END DO
 
       !- 7.3 g(h) for each thickness category  
       DO jl = klbnd, kubnd
-         CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), &
-            g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag)
+         CALL lim_itd_fitline( jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl),  &
+            &                  g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag )
       END DO
 
@@ -406,36 +313,34 @@
             ij = nind_j(ji)
 
-            IF (zhbnew(ii,ij,jl) .gt. hi_max(jl)) THEN ! transfer from jl to jl+1
-
+            IF (zhbnew(ii,ij,jl) > hi_max(jl)) THEN ! transfer from jl to jl+1
                ! left and right integration limits in eta space
-               zvetamin(ji) = MAX(hi_max(jl), hL(ii,ij,jl)) - hL(ii,ij,jl)
-               zvetamax(ji) = MIN(zhbnew(ii,ij,jl), hR(ii,ij,jl)) - hL(ii,ij,jl)
+               zvetamin(ji) = MAX( hi_max(jl), hL(ii,ij,jl) ) - hL(ii,ij,jl)
+               zvetamax(ji) = MIN( zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl)
                zdonor(ii,ij,jl) = jl
 
-            ELSE  ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl
-
+            ELSE                                    ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl
                ! left and right integration limits in eta space
                zvetamin(ji) = 0.0
-               zvetamax(ji) = MIN(hi_max(jl), hR(ii,ij,jl+1)) - hL(ii,ij,jl+1)
+               zvetamax(ji) = MIN( hi_max(jl), hR(ii,ij,jl+1) ) - hL(ii,ij,jl+1)
                zdonor(ii,ij,jl) = jl + 1
 
-            ENDIF  ! zhbnew(jl) > hi_max(jl)
-
-            zetamax = MAX(zvetamax(ji), zvetamin(ji)) ! no transfer if etamax < etamin
+            ENDIF
+
+            zetamax = MAX( zvetamax(ji), zvetamin(ji) ) ! no transfer if etamax < etamin
             zetamin = zvetamin(ji)
 
             zx1  = zetamax - zetamin
-            zwk1 = zetamin*zetamin
-            zwk2 = zetamax*zetamax
-            zx2  = 0.5 * (zwk2 - zwk1)
+            zwk1 = zetamin * zetamin
+            zwk2 = zetamax * zetamax
+            zx2  = 0.5 * ( zwk2 - zwk1 )
             zwk1 = zwk1 * zetamin
             zwk2 = zwk2 * zetamax
-            zx3  = 1.0/3.0 * (zwk2 - zwk1)
+            zx3  = 1.0 / 3.0 * ( zwk2 - zwk1 )
             nd   = zdonor(ii,ij,jl)
             zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1
             zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd)
 
-         END DO ! ji
-      END DO ! jl klbnd -> kubnd - 1
+         END DO
+      END DO
 
       !!----------------------------------------------------------------------------------------------
@@ -451,9 +356,9 @@
          ii = nind_i(ji)
          ij = nind_j(ji)
-         IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim ) THEN
-            a_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim 
-            ht_i(ii,ij,1) = hiclim
+         IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < rn_himin ) THEN
+            a_i (ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / rn_himin 
+            ht_i(ii,ij,1) = rn_himin
          ENDIF
-      END DO !ji
+      END DO
 
       !!----------------------------------------------------------------------------------------------
@@ -479,11 +384,11 @@
       ENDIF
 
-      CALL wrk_dealloc( jpi,jpj, zremap_flag )    ! integer
-      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )   ! integer
+      CALL wrk_dealloc( jpi,jpj, zremap_flag )
+      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )
       CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )
       CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )   
       CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
       CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )   
-      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
+      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
       CALL wrk_dealloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final )
 
@@ -491,6 +396,5 @@
 
 
-   SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice,   &
-      &                        g0, g1, hL, hR, zremap_flag )
+   SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, g0, g1, hL, hR, zremap_flag )
       !!------------------------------------------------------------------
       !!                ***  ROUTINE lim_itd_fitline ***
@@ -511,5 +415,5 @@
       INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) ::   zremap_flag  !
       !
-      INTEGER ::   ji,jj           ! horizontal indices
+      INTEGER  ::   ji,jj        ! horizontal indices
       REAL(wp) ::   zh13         ! HbL + 1/3 * (HbR - HbL)
       REAL(wp) ::   zh23         ! HbL + 2/3 * (HbR - HbL)
@@ -518,20 +422,17 @@
       !!------------------------------------------------------------------
       !
-      !
       DO jj = 1, jpj
          DO ji = 1, jpi
             !
             IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > epsi10   &
-               &                        .AND. hice(ji,jj)        > 0._wp     ) THEN
+               &                        .AND. hice(ji,jj)        > 0._wp )  THEN
 
                ! Initialize hL and hR
-
                hL(ji,jj) = HbL(ji,jj)
                hR(ji,jj) = HbR(ji,jj)
 
                ! Change hL or hR if hice falls outside central third of range
-
-               zh13 = 1.0/3.0 * (2.0*hL(ji,jj) + hR(ji,jj))
-               zh23 = 1.0/3.0 * (hL(ji,jj) + 2.0*hR(ji,jj))
+               zh13 = 1.0 / 3.0 * ( 2.0 * hL(ji,jj) + hR(ji,jj) )
+               zh23 = 1.0 / 3.0 * ( hL(ji,jj) + 2.0 * hR(ji,jj) )
 
                IF    ( hice(ji,jj) < zh13 ) THEN   ;   hR(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hL(ji,jj)
@@ -540,17 +441,16 @@
 
                ! Compute coefficients of g(eta) = g0 + g1*eta
-
                zdhr = 1._wp / (hR(ji,jj) - hL(ji,jj))
                zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr
                zwk2 = ( hice(ji,jj) - hL(ji,jj) ) * zdhr
-               g0(ji,jj) = zwk1 * ( 2._wp/3._wp - zwk2 )
-               g1(ji,jj) = 2._wp * zdhr * zwk1 * (zwk2 - 0.5)
+               g0(ji,jj) = zwk1 * ( 2._wp / 3._wp - zwk2 )
+               g1(ji,jj) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5 )
                !
-            ELSE                   ! remap_flag = .false. or a_i < epsi10 
+            ELSE  ! remap_flag = .false. or a_i < epsi10 
                hL(ji,jj) = 0._wp
                hR(ji,jj) = 0._wp
                g0(ji,jj) = 0._wp
                g1(ji,jj) = 0._wp
-            ENDIF                  ! a_i > epsi10
+            ENDIF
             !
          END DO
@@ -576,5 +476,5 @@
 
       INTEGER ::   ji, jj, jl, jl2, jl1, jk   ! dummy loop indices
-      INTEGER ::   ii, ij          ! indices when changing from 2D-1D is done
+      INTEGER ::   ii, ij                     ! indices when changing from 2D-1D is done
 
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaTsfn
@@ -589,15 +489,10 @@
       INTEGER, POINTER, DIMENSION(:) ::   nind_i, nind_j   ! compressed indices for i/j directions
 
-      INTEGER ::   nbrem             ! number of cells with ice to transfer
-
-      LOGICAL ::   zdaice_negative         ! true if daice < -puny
-      LOGICAL ::   zdvice_negative         ! true if dvice < -puny
-      LOGICAL ::   zdaice_greater_aicen    ! true if daice > aicen
-      LOGICAL ::   zdvice_greater_vicen    ! true if dvice > vicen
+      INTEGER  ::   nbrem             ! number of cells with ice to transfer
       !!------------------------------------------------------------------
 
       CALL wrk_alloc( jpi,jpj,jpl, zaTsfn )
       CALL wrk_alloc( jpi,jpj, zworka )
-      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer
+      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )
 
       !----------------------------------------------------------------------------------------------
@@ -606,91 +501,9 @@
 
       DO jl = klbnd, kubnd
-         zaTsfn(:,:,jl) = a_i(:,:,jl)*t_su(:,:,jl)
-      END DO
-
-      !----------------------------------------------------------------------------------------------
-      ! 2) Check for daice or dvice out of range, allowing for roundoff error
-      !----------------------------------------------------------------------------------------------
-      ! Note: zdaice < 0 or zdvice < 0 usually happens when category jl
-      ! has a small area, with h(n) very close to a boundary.  Then
-      ! the coefficients of g(h) are large, and the computed daice and
-      ! dvice can be in error. If this happens, it is best to transfer
-      ! either the entire category or nothing at all, depending on which
-      ! side of the boundary hice(n) lies.
-      !-----------------------------------------------------------------
-      DO jl = klbnd, kubnd-1
-
-         zdaice_negative = .false.
-         zdvice_negative = .false.
-         zdaice_greater_aicen = .false.
-         zdvice_greater_vicen = .false.
-
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
-               IF (zdonor(ji,jj,jl) .GT. 0) THEN
-                  jl1 = zdonor(ji,jj,jl)
-
-                  IF (zdaice(ji,jj,jl) .LT. 0.0) THEN
-                     IF (zdaice(ji,jj,jl) .GT. -epsi10) THEN
-                        IF ( ( jl1.EQ.jl   .AND. ht_i(ji,jj,jl1) .GT. hi_max(jl) )           &
-                           .OR.                                      &
-                           ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) )           &  
-                           ) THEN                                                             
-                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1)  ! shift entire category
-                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1)
-                        ELSE
-                           zdaice(ji,jj,jl) = 0.0 ! shift no ice
-                           zdvice(ji,jj,jl) = 0.0
-                        ENDIF
-                     ELSE
-                        zdaice_negative = .true.
-                     ENDIF
-                  ENDIF
-
-                  IF (zdvice(ji,jj,jl) .LT. 0.0) THEN
-                     IF (zdvice(ji,jj,jl) .GT. -epsi10 ) THEN
-                        IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1).GT.hi_max(jl) )     &
-                           .OR.                                     &
-                           ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) ) &
-                           ) THEN
-                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category
-                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
-                        ELSE
-                           zdaice(ji,jj,jl) = 0.0    ! shift no ice
-                           zdvice(ji,jj,jl) = 0.0
-                        ENDIF
-                     ELSE
-                        zdvice_negative = .true.
-                     ENDIF
-                  ENDIF
-
-                  ! If daice is close to aicen, set daice = aicen.
-                  IF (zdaice(ji,jj,jl) .GT. a_i(ji,jj,jl1) - epsi10 ) THEN
-                     IF (zdaice(ji,jj,jl) .LT. a_i(ji,jj,jl1)+epsi10) THEN
-                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1)
-                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
-                     ELSE
-                        zdaice_greater_aicen = .true.
-                     ENDIF
-                  ENDIF
-
-                  IF (zdvice(ji,jj,jl) .GT. v_i(ji,jj,jl1)-epsi10) THEN
-                     IF (zdvice(ji,jj,jl) .LT. v_i(ji,jj,jl1)+epsi10) THEN
-                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1)
-                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
-                     ELSE
-                        zdvice_greater_vicen = .true.
-                     ENDIF
-                  ENDIF
-
-               ENDIF               ! donor > 0
-            END DO                   ! i
-         END DO                 ! j
-
-      END DO !jl
+         zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl)
+      END DO
 
       !-------------------------------------------------------------------------------
-      ! 3) Transfer volume and energy between categories
+      ! 2) Transfer volume and energy between categories
       !-------------------------------------------------------------------------------
 
@@ -699,9 +512,9 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF (zdaice(ji,jj,jl) .GT. 0.0 ) THEN ! daice(n) can be < puny
+               IF (zdaice(ji,jj,jl) > 0.0 ) THEN ! daice(n) can be < puny
                   nbrem = nbrem + 1
                   nind_i(nbrem) = ji
                   nind_j(nbrem) = jj
-               ENDIF ! tmask
+               ENDIF
             END DO
          END DO
@@ -712,8 +525,8 @@
 
             jl1 = zdonor(ii,ij,jl)
-            rswitch             = MAX( 0.0 , SIGN( 1.0 , v_i(ii,ij,jl1) - epsi10 ) )
-            zworka(ii,ij)   = zdvice(ii,ij,jl) / MAX(v_i(ii,ij,jl1),epsi10) * rswitch
+            rswitch       = MAX( 0._wp , SIGN( 1._wp , v_i(ii,ij,jl1) - epsi10 ) )
+            zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi10 ) * rswitch
             IF( jl1 == jl) THEN   ;   jl2 = jl1+1
-            ELSE                    ;   jl2 = jl 
+            ELSE                  ;   jl2 = jl 
             ENDIF
 
@@ -721,5 +534,4 @@
             ! Ice areas
             !--------------
-
             a_i(ii,ij,jl1) = a_i(ii,ij,jl1) - zdaice(ii,ij,jl)
             a_i(ii,ij,jl2) = a_i(ii,ij,jl2) + zdaice(ii,ij,jl)
@@ -728,5 +540,4 @@
             ! Ice volumes
             !--------------
-
             v_i(ii,ij,jl1) = v_i(ii,ij,jl1) - zdvice(ii,ij,jl) 
             v_i(ii,ij,jl2) = v_i(ii,ij,jl2) + zdvice(ii,ij,jl)
@@ -735,5 +546,4 @@
             ! Snow volumes
             !--------------
-
             zdvsnow        = v_s(ii,ij,jl1) * zworka(ii,ij)
             v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow
@@ -743,5 +553,4 @@
             ! Snow heat content  
             !--------------------
-
             zdesnow            = e_s(ii,ij,1,jl1) * zworka(ii,ij)
             e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow
@@ -751,5 +560,4 @@
             ! Ice age 
             !--------------
-
             zdo_aice           = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl)
             oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice
@@ -759,5 +567,4 @@
             ! Ice salinity
             !--------------
-
             zdsm_vice          = smv_i(ii,ij,jl1) * zworka(ii,ij)
             smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice
@@ -767,10 +574,9 @@
             ! Surface temperature
             !---------------------
-
             zdaTsf             = t_su(ii,ij,jl1) * zdaice(ii,ij,jl)
             zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf
             zaTsfn(ii,ij,jl2)  = zaTsfn(ii,ij,jl2) + zdaTsf 
 
-         END DO                 ! ji
+         END DO
 
          !------------------
@@ -779,5 +585,4 @@
 
          DO jk = 1, nlay_i
-!CDIR NODEP
             DO ji = 1, nbrem
                ii = nind_i(ji)
@@ -785,5 +590,5 @@
 
                jl1 = zdonor(ii,ij,jl)
-               IF (jl1 .EQ. jl) THEN
+               IF (jl1 == jl) THEN
                   jl2 = jl+1
                ELSE             ! n1 = n+1
@@ -794,6 +599,6 @@
                e_i(ii,ij,jk,jl1) =  e_i(ii,ij,jk,jl1) - zdeice
                e_i(ii,ij,jk,jl2) =  e_i(ii,ij,jk,jl2) + zdeice 
-            END DO              ! ji
-         END DO                 ! jk
+            END DO
+         END DO
 
       END DO                   ! boundaries, 1 to ncat-1
@@ -809,16 +614,15 @@
                   ht_i(ji,jj,jl)  =  v_i   (ji,jj,jl) / a_i(ji,jj,jl) 
                   t_su(ji,jj,jl)  =  zaTsfn(ji,jj,jl) / a_i(ji,jj,jl) 
-                  rswitch         =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes
                ELSE
                   ht_i(ji,jj,jl)  = 0._wp
-                  t_su(ji,jj,jl)  = rtt
+                  t_su(ji,jj,jl)  = rt0
                ENDIF
-            END DO                 ! ji
-         END DO                 ! jj
-      END DO                    ! jl
+            END DO
+         END DO
+      END DO
       !
       CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn )
       CALL wrk_dealloc( jpi,jpj, zworka )
-      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer
+      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )
       !
    END SUBROUTINE lim_itd_shiftice
@@ -846,5 +650,4 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   ! snow volume summed over categories
       !!------------------------------------------------------------------
-      !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate
       
       CALL wrk_alloc( jpi,jpj,jpl, zdonor )   ! interger
@@ -864,9 +667,6 @@
          DO jj = 1, jpj
             DO ji = 1, jpi 
-               IF( a_i(ji,jj,jl) > epsi10 ) THEN 
-                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
-               ELSE
-                  ht_i(ji,jj,jl) = 0._wp
-               ENDIF
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
+               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
             END DO
          END DO
@@ -874,19 +674,5 @@
 
       !------------------------------------------------------------------------------
-      ! 2) Make sure thickness of cat klbnd is at least hi_max(klbnd)
-      !------------------------------------------------------------------------------
-      DO jj = 1, jpj 
-         DO ji = 1, jpi 
-            IF( a_i(ji,jj,klbnd) > epsi10 ) THEN
-               IF( ht_i(ji,jj,klbnd) <= hi_max(0) .AND. hi_max(0) > 0._wp ) THEN
-                  a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max(0) 
-                  ht_i(ji,jj,klbnd) = hi_max(0)
-               ENDIF
-            ENDIF
-         END DO
-      END DO
-
-      !------------------------------------------------------------------------------
-      ! 3) If a category thickness is not in bounds, shift the
+      ! 2) If a category thickness is not in bounds, shift the
       ! entire area, volume, and energy to the neighboring category
       !------------------------------------------------------------------------------
@@ -917,15 +703,13 @@
                   zdonor(ji,jj,jl)  = jl 
                   ! begin TECLIM change
-                  !zdaice(ji,jj,jl)  = a_i(ji,jj,jl)
-                  !zdvice(ji,jj,jl)  = v_i(ji,jj,jl)
                   !zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * 0.5_wp
                   !zdvice(ji,jj,jl)  = v_i(ji,jj,jl)-zdaice(ji,jj,jl)*(hi_max(jl)+hi_max(jl-1)) * 0.5_wp
                   ! end TECLIM change 
                   ! clem: how much of a_i you send in cat sup is somewhat arbitrary
-                  zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * ( ht_i(ji,jj,jl) - hi_max(jl) + epsi10 ) / ht_i(ji,jj,jl)  
-                  zdvice(ji,jj,jl)  = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi10 )
+                  zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * ( ht_i(ji,jj,jl) - hi_max(jl) + epsi20 ) / ht_i(ji,jj,jl)  
+                  zdvice(ji,jj,jl)  = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi20 )
                ENDIF
-            END DO                 ! ji
-         END DO                 ! jj
+            END DO
+         END DO
          IF(lk_mpp)   CALL mpp_max( zshiftflag )
 
@@ -938,5 +722,5 @@
          ENDIF
          !
-      END DO                    ! jl
+      END DO
 
       !----------------------------
@@ -951,5 +735,4 @@
          zshiftflag = 0
 
-!clem-change
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -961,6 +744,6 @@
                   zdvice(ji,jj,jl) = v_i(ji,jj,jl+1)
                ENDIF
-            END DO                 ! ji
-         END DO                 ! jj
+            END DO
+         END DO
 
          IF(lk_mpp)   CALL mpp_max( zshiftflag )
@@ -973,21 +756,9 @@
             zdvice(:,:,jl) = 0._wp
          ENDIF
-!clem-change
-
-!         ! clem-change begin: why not doing that?
-!         DO jj = 1, jpj
-!            DO ji = 1, jpi
-!               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN
-!                  ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10
-!                  a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1) 
-!               ENDIF
-!            END DO                 ! ji
-!         END DO                 ! jj
-         ! clem-change end
-
-      END DO                    ! jl
+
+      END DO
 
       !------------------------------------------------------------------------------
-      ! 4) Conservation check
+      ! 3) Conservation check
       !------------------------------------------------------------------------------
 
@@ -1002,5 +773,5 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi,jpj,jpl, zdonor )   ! interger
+      CALL wrk_dealloc( jpi,jpj,jpl, zdonor )
       CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice )
       CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final )
@@ -1013,8 +784,4 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE lim_itd_th           ! Empty routines
-   END SUBROUTINE lim_itd_th
-   SUBROUTINE lim_itd_th_ini
-   END SUBROUTINE lim_itd_th_ini
    SUBROUTINE lim_itd_th_rem
    END SUBROUTINE lim_itd_th_rem
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90	(revision 5901)
@@ -23,5 +23,5 @@
    PRIVATE
 
-   PUBLIC   lim_msh   ! routine called by ice_ini.F90
+   PUBLIC   lim_msh   ! routine called by sbcice_lim.F90
 
    !!----------------------------------------------------------------------
@@ -41,5 +41,4 @@
       !!              - Definition of some constants linked with the grid
       !!              - Definition of the metric coef. for the sea/ice
-      !!              - Initialization of the ice masks (tmsk, umsk)
       !! 
       !! Reference  : Deleersnijder et al. Ocean Modelling 100, 7-10 
@@ -103,17 +102,4 @@
 !!gm end
 
-      !                           !==  ice masks  ==!
-      tms(:,:) = tmask(:,:,1)             ! ice T-point  : use surface tmask
-      tmu(:,:) = umask(:,:,1)             ! ice U-point  : use surface umask  (C-grid EVP)
-      tmv(:,:) = vmask(:,:,1)             ! ice V-point  : use surface vmask  (C-grid EVP)
-      DO jj = 1, jpjm1                    ! ice F-point  : recompute fmask (due to nn_shlat)
-         DO ji = 1 , jpim1   ! NO vector opt.
-            tmf(ji,jj) =  tms(ji,jj) * tms(ji+1,jj) * tms(ji,jj+1) * tms(ji+1,jj+1)
-         END DO
-      END DO
-      CALL lbc_lnk( tmf(:,:), 'F', 1. )           ! lateral boundary conditions
-
-      !                           !==  unmasked and masked area of T-grid cell
-      area(:,:) = e1t(:,:) * e2t(:,:)
       !
    END SUBROUTINE lim_msh
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 5901)
@@ -102,5 +102,5 @@
       !!                 and charge ellipse.
       !!                 The user should make sure that the parameters
-      !!                 nevp, telast and creepl maintain stress state
+      !!                 nn_nevp, elastic time scale and rn_creepl maintain stress state
       !!                 on the charge ellipse for plastic flow
       !!                 e.g. in the Canadian Archipelago
@@ -108,5 +108,4 @@
       !! References : Hunke and Dukowicz, JPO97
       !!              Bouillon et al., Ocean Modelling 2009
-      !!              Vancoppenolle et al., Ocean Modelling 2008
       !!-------------------------------------------------------------------
       INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation
@@ -117,18 +116,17 @@
       CHARACTER (len=50) ::   charout
       REAL(wp) ::   zt11, zt12, zt21, zt22, ztagnx, ztagny, delta                         !
-      REAL(wp) ::   za, zstms, zmask   ! local scalars
-      REAL(wp) ::   zc1, zc2, zc3             ! ice mass
-
-      REAL(wp) ::   dtevp              ! time step for subcycling
-      REAL(wp) ::   dtotel, ecc2, ecci ! square of yield ellipse eccenticity
-      REAL(wp) ::   z0, zr, zcca, zccb ! temporary scalars
-      REAL(wp) ::   zu_ice2, zv_ice1   !
-      REAL(wp) ::   zddc, zdtc         ! delta on corners and on centre
-      REAL(wp) ::   zdst               ! shear at the center of the grid point
-      REAL(wp) ::   zdsshx, zdsshy     ! term for the gradient of ocean surface
-      REAL(wp) ::   sigma1, sigma2     ! internal ice stress
+      REAL(wp) ::   za, zstms          ! local scalars
+      REAL(wp) ::   zc1, zc2, zc3      ! ice mass
+
+      REAL(wp) ::   dtevp , z1_dtevp              ! time step for subcycling
+      REAL(wp) ::   dtotel, z1_dtotel, ecc2, ecci ! square of yield ellipse eccenticity
+      REAL(wp) ::   z0, zr, zcca, zccb            ! temporary scalars
+      REAL(wp) ::   zu_ice2, zv_ice1              !
+      REAL(wp) ::   zddc, zdtc                    ! delta on corners and on centre
+      REAL(wp) ::   zdst                          ! shear at the center of the grid point
+      REAL(wp) ::   zdsshx, zdsshy                ! term for the gradient of ocean surface
+      REAL(wp) ::   sigma1, sigma2                ! internal ice stress
 
       REAL(wp) ::   zresm         ! Maximal error on ice velocity
-      REAL(wp) ::   zdummy        ! dummy argument
       REAL(wp) ::   zintb, zintn  ! dummy argument
 
@@ -139,8 +137,9 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   zcorl1, zcorl2   ! coriolis parameter on U/V points
       REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct , za2ct    ! temporary arrays
-      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce1, v_oce1   ! ocean u/v component on U points                           
-      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2, v_oce2   ! ocean u/v component on V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   v_oce1           ! ocean u/v component on U points                           
+      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2           ! ocean u/v component on V points
       REAL(wp), POINTER, DIMENSION(:,:) ::   u_ice2, v_ice1   ! ice u/v component on V/U point
       REAL(wp), POINTER, DIMENSION(:,:) ::   zf1   , zf2      ! arrays for internal stresses
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask            ! mask ocean grid points
       
       REAL(wp), POINTER, DIMENSION(:,:) ::   zdt              ! tension at centre of grid cells
@@ -152,8 +151,11 @@
                                                               !   ocean surface (ssh_m) if ice is not embedded
                                                               !   ice top surface if ice is embedded   
+
+      REAL(wp), PARAMETER               ::   zepsi = 1.0e-20_wp ! tolerance parameter
+      REAL(wp), PARAMETER               ::   zvmin = 1.0e-03_wp ! ice volume below which ice velocity equals ocean velocity
       !!-------------------------------------------------------------------
 
       CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
-      CALL wrk_alloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1                )
+      CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               )
       CALL wrk_alloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  )
       CALL wrk_alloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
@@ -161,14 +163,14 @@
 #if  defined key_lim2 && ! defined key_lim2_vp
 # if defined key_agrif
-     USE ice_2, vt_s => hsnm
-     USE ice_2, vt_i => hicm
+      USE ice_2, vt_s => hsnm
+      USE ice_2, vt_i => hicm
 # else
-     vt_s => hsnm
-     vt_i => hicm
+      vt_s => hsnm
+      vt_i => hicm
 # endif
-     at_i(:,:) = 1. - frld(:,:)
+      at_i(:,:) = 1. - frld(:,:)
 #endif
 #if defined key_agrif && defined key_lim2 
-    CALL agrif_rhg_lim2_load      ! First interpolation of coarse values
+      CALL agrif_rhg_lim2_load      ! First interpolation of coarse values
 #endif
       !
@@ -186,19 +188,17 @@
 
 #if defined key_lim3
-      CALL lim_itd_me_icestrength( ridge_scheme_swi )      ! LIM-3: Ice strength on T-points
-#endif
-
-!CDIR NOVERRCHK
+      CALL lim_itd_me_icestrength( nn_icestr )      ! LIM-3: Ice strength on T-points
+#endif
+
       DO jj = k_j1 , k_jpj       ! Ice mass and temp variables
-!CDIR NOVERRCHK
          DO ji = 1 , jpi
 #if defined key_lim3
-            zpresh(ji,jj) = tms(ji,jj) *  strength(ji,jj)
+            zpresh(ji,jj) = tmask(ji,jj,1) *  strength(ji,jj)
 #endif
 #if defined key_lim2
-            zpresh(ji,jj) = tms(ji,jj) *  pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) )
-#endif
-            ! tmi = 1 where there is ice or on land
-            tmi(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - epsd ) ) ) * tms(ji,jj)
+            zpresh(ji,jj) = tmask(ji,jj,1) *  pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) )
+#endif
+            ! zmask = 1 where there is ice or on land
+            zmask(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - zepsi ) ) ) * tmask(ji,jj,1)
          END DO
       END DO
@@ -206,20 +206,13 @@
       ! Ice strength on grid cell corners (zpreshc)
       ! needed for calculation of shear stress 
-!CDIR NOVERRCHK
       DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
          DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1)
-            zstms          =  tms(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + &
-               &              tms(ji,jj+1)   * wght(ji+1,jj+1,1,2) + &
-               &              tms(ji+1,jj)   * wght(ji+1,jj+1,2,1) + &
-               &              tms(ji,jj)     * wght(ji+1,jj+1,1,1)
-            zpreshc(ji,jj) = (  zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + &
-               &                zpresh(ji,jj+1)   * wght(ji+1,jj+1,1,2) + &
-               &                zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + & 
-               &                zpresh(ji,jj)     * wght(ji+1,jj+1,1,1)   &
-               &             ) / MAX( zstms, epsd )
+            zstms          =  tmask(ji+1,jj+1,1) * wght(ji+1,jj+1,2,2) + tmask(ji,jj+1,1) * wght(ji+1,jj+1,1,2) +   &
+               &              tmask(ji+1,jj,1)   * wght(ji+1,jj+1,2,1) + tmask(ji,jj,1)   * wght(ji+1,jj+1,1,1)
+            zpreshc(ji,jj) = ( zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + zpresh(ji,jj+1) * wght(ji+1,jj+1,1,2) +   &
+               &               zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + zpresh(ji,jj)   * wght(ji+1,jj+1,1,1)     &
+               &             ) / MAX( zstms, zepsi )
          END DO
       END DO
-
       CALL lbc_lnk( zpreshc(:,:), 'F', 1. )
       !
@@ -236,21 +229,19 @@
       !  zcorl2: Coriolis parameter on V-points                            
       !  (ztagnx,ztagny): wind stress on U/V points                       
-      !  u_oce1: ocean u component on u points                           
       !  v_oce1: ocean v component on u points                          
       !  u_oce2: ocean u component on v points                         
-      !  v_oce2: ocean v component on v points                        
 
       IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
-          !                                            
-          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
-          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
+         !                                            
+         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
+         !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
          zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp     
-          !
-          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
-          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
+         !
+         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
+         !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
          zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
-          !
+         !
          zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0
-          !
+         !
       ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
          zpice(:,:) = ssh_m(:,:)
@@ -260,36 +251,33 @@
          DO ji = fs_2, fs_jpim1
 
-            zc1 = tms(ji  ,jj  ) * ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) )
-            zc2 = tms(ji+1,jj  ) * ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) )
-            zc3 = tms(ji  ,jj+1) * ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) )
-
-            zt11 = tms(ji  ,jj) * e1t(ji  ,jj)
-            zt12 = tms(ji+1,jj) * e1t(ji+1,jj)
-            zt21 = tms(ji,jj  ) * e2t(ji,jj  )
-            zt22 = tms(ji,jj+1) * e2t(ji,jj+1)
+            zc1 = tmask(ji  ,jj  ,1) * ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) )
+            zc2 = tmask(ji+1,jj  ,1) * ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) )
+            zc3 = tmask(ji  ,jj+1,1) * ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) )
+
+            zt11 = tmask(ji  ,jj,1) * e1t(ji  ,jj)
+            zt12 = tmask(ji+1,jj,1) * e1t(ji+1,jj)
+            zt21 = tmask(ji,jj  ,1) * e2t(ji,jj  )
+            zt22 = tmask(ji,jj+1,1) * e2t(ji,jj+1)
 
             ! Leads area.
-            zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + epsd )
-            zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + epsd )
+            zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + zepsi )
+            zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + zepsi )
 
             ! Mass, coriolis coeff. and currents
-            zmass1(ji,jj) = ( zt12*zc1 + zt11*zc2 ) / (zt11+zt12+epsd)
-            zmass2(ji,jj) = ( zt22*zc1 + zt21*zc3 ) / (zt21+zt22+epsd)
-            zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj)*fcor(ji,jj) + e1t(ji,jj)*fcor(ji+1,jj) )   &
-               &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + epsd )
-            zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1)*fcor(ji,jj) + e2t(ji,jj)*fcor(ji,jj+1) )   &
-               &                          / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd )
+            zmass1(ji,jj) = ( zt12 * zc1 + zt11 * zc2 ) / ( zt11 + zt12 + zepsi )
+            zmass2(ji,jj) = ( zt22 * zc1 + zt21 * zc3 ) / ( zt21 + zt22 + zepsi )
+            zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) * fcor(ji,jj) + e1t(ji,jj) * fcor(ji+1,jj) )   &
+               &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + zepsi )
+            zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * fcor(ji,jj) + e2t(ji,jj) * fcor(ji,jj+1) )   &
+               &                          / ( e2t(ji,jj+1) + e2t(ji,jj) + zepsi )
             !
-            u_oce1(ji,jj)  = u_oce(ji,jj)
-            v_oce2(ji,jj)  = v_oce(ji,jj)
-
             ! Ocean has no slip boundary condition
-            v_oce1(ji,jj)  = 0.5*( (v_oce(ji,jj)+v_oce(ji,jj-1))*e1t(ji,jj)    &
-               &                 +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj)) &
-               &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)  
-
-            u_oce2(ji,jj)  = 0.5*((u_oce(ji,jj)+u_oce(ji-1,jj))*e2t(ji,jj)     &
-               &                 +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1)) &
-               &                / (e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
+            v_oce1(ji,jj)  = 0.5 * ( ( v_oce(ji  ,jj) + v_oce(ji  ,jj-1) ) * e1t(ji,jj)      &
+               &                   + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji+1,jj) )  &
+               &                   / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)  
+
+            u_oce2(ji,jj)  = 0.5 * ( ( u_oce(ji,jj  ) + u_oce(ji-1,jj  ) ) * e2t(ji,jj)      &
+               &                   + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj+1) )  &
+               &                   / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
 
             ! Wind stress at U,V-point
@@ -303,6 +291,6 @@
             ! include it later
 
-            zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj)
-            zdsshy =  ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj)
+            zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
+            zdsshy =  ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
 
             za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx
@@ -318,9 +306,14 @@
       !
       ! Time step for subcycling
-      dtevp  = rdt_ice / nevp
+      dtevp  = rdt_ice / nn_nevp
+#if defined key_lim3
+      dtotel = dtevp / ( 2._wp * rn_relast * rdt_ice )
+#else
       dtotel = dtevp / ( 2._wp * telast )
-
+#endif
+      z1_dtotel = 1._wp / ( 1._wp + dtotel )
+      z1_dtevp  = 1._wp / dtevp
       !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter)
-      ecc2 = ecc * ecc
+      ecc2 = rn_ecc * rn_ecc
       ecci = 1. / ecc2
 
@@ -331,5 +324,5 @@
 
       !                                               !----------------------!
-      DO jter = 1 , nevp                              !    loop over jter    !
+      DO jter = 1 , nn_nevp                           !    loop over jter    !
          !                                            !----------------------!        
          DO jj = k_j1, k_jpj-1
@@ -339,5 +332,5 @@
 
          DO jj = k_j1+1, k_jpj-1
-            DO ji = fs_2, jpim1   !RB bug no vect opt due to tmi
+            DO ji = fs_2, fs_jpim1   !RB bug no vect opt due to zmask
 
                !  
@@ -360,122 +353,80 @@
                !
                !
-               divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      &
-                  &             -e2u(ji-1,jj)*u_ice(ji-1,jj)                  &
-                  &             +e1v(ji,jj)*v_ice(ji,jj)                      &
-                  &             -e1v(ji,jj-1)*v_ice(ji,jj-1)                  &
-                  &             )                                             &
-                  &            / area(ji,jj)
-
-               zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    &
-                  &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                &
-                  &           )*e2t(ji,jj)*e2t(ji,jj)                      &
-                  &          -( v_ice(ji,jj)/e1v(ji,jj)                    &
-                  &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                &
-                  &           )*e1t(ji,jj)*e1t(ji,jj)                      &
-                  &         )                                              &
-                  &        / area(ji,jj)
+               divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
+                  &            ) * r1_e1e2t(ji,jj)
+
+               zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
+                  &         - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
+                  &         ) * r1_e1e2t(ji,jj)
 
                !
-               zds(ji,jj) = ( ( u_ice(ji,jj+1)/e1u(ji,jj+1)                &
-                  &            -u_ice(ji,jj)/e1u(ji,jj)                    &
-                  &           )*e1f(ji,jj)*e1f(ji,jj)                      &
-                  &          +( v_ice(ji+1,jj)/e2v(ji+1,jj)                &
-                  &            -v_ice(ji,jj)/e2v(ji,jj)                    &
-                  &           )*e2f(ji,jj)*e2f(ji,jj)                      &
-                  &         )                                              &
-                  &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) &
-                  &        * tmi(ji,jj) * tmi(ji,jj+1)                     &
-                  &        * tmi(ji+1,jj) * tmi(ji+1,jj+1)
-
-
-               v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   &
-                  &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) &
-                  &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
-
-               u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   &
-                  &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) &
-                  &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
-
-            END DO
-         END DO
-         CALL lbc_lnk( v_ice1, 'U', -1. )   ;   CALL lbc_lnk( u_ice2, 'V', -1. )      ! lateral boundary cond.
-
-!CDIR NOVERRCHK
+               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
+                  &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
+                  &         ) * r1_e1e2f(ji,jj) * ( 2._wp - fmask(ji,jj,1) )   &
+                  &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1)
+
+
+               v_ice1(ji,jj)  = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji+1,jj)     &
+                  &                      + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) )   &
+                  &                      / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
+
+               u_ice2(ji,jj)  = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     &
+                  &                      + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) )   &
+                  &                      / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+            END DO
+         END DO
+
+         CALL lbc_lnk_multi( v_ice1, 'U', -1., u_ice2, 'V', -1. )      ! lateral boundary cond.
+         
          DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
             DO ji = fs_2, fs_jpim1
 
                !- Calculate Delta at centre of grid cells
-               zdst      = (  e2u(ji  , jj) * v_ice1(ji  ,jj)          &
-                  &          - e2u(ji-1, jj) * v_ice1(ji-1,jj)          &
-                  &          + e1v(ji, jj  ) * u_ice2(ji,jj  )          &
-                  &          - e1v(ji, jj-1) * u_ice2(ji,jj-1)          &
-                  &          )                                          &
-                  &         / area(ji,jj)
-
-               delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )  
-               delta_i(ji,jj) = delta + creepl
-               !-Calculate stress tensor components zs1 and zs2 
-               !-at centre of grid cells (see section 3.5 of CICE user's guide).
-               zs1(ji,jj) = ( zs1(ji,jj) + dtotel * ( ( divu_i(ji,jj) / delta_i(ji,jj) - delta / delta_i(ji,jj) )  &
-                  &         * zpresh(ji,jj) ) ) / ( 1._wp + dtotel )
-               zs2(ji,jj) = ( zs2(ji,jj) + dtotel * ( ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) ) )  &
-                  &         / ( 1._wp + dtotel )
-
-            END DO
-         END DO
-
-         CALL lbc_lnk( zs1(:,:), 'T', 1. )
-         CALL lbc_lnk( zs2(:,:), 'T', 1. )
-
-!CDIR NOVERRCHK
-         DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
-            DO ji = fs_2, fs_jpim1
+               zdst          = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )   &
+                  &            + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1)   &
+                  &            ) * r1_e1e2t(ji,jj)
+
+               delta          = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )  
+               delta_i(ji,jj) = delta + rn_creepl
+
                !- Calculate Delta on corners
-               zddc  =      ( ( v_ice1(ji,jj+1)/e1u(ji,jj+1)                &
-                  &            -v_ice1(ji,jj)/e1u(ji,jj)                    &
-                  &           )*e1f(ji,jj)*e1f(ji,jj)                       &
-                  &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                &
-                  &            -u_ice2(ji,jj)/e2v(ji,jj)                    &
-                  &           )*e2f(ji,jj)*e2f(ji,jj)                       &
-                  &         )                                               &
-                  &        / ( e1f(ji,jj) * e2f(ji,jj) )
-
-               zdtc  =      (-( v_ice1(ji,jj+1)/e1u(ji,jj+1)                &
-                  &            -v_ice1(ji,jj)/e1u(ji,jj)                    &
-                  &           )*e1f(ji,jj)*e1f(ji,jj)                       &
-                  &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                &
-                  &            -u_ice2(ji,jj)/e2v(ji,jj)                    &
-                  &           )*e2f(ji,jj)*e2f(ji,jj)                       &
-                  &         )                                               &
-                  &        / ( e1f(ji,jj) * e2f(ji,jj) )
-
-               zddc = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl
-
-               !-Calculate stress tensor component zs12 at corners (see section 3.5 of CICE user's guide).
-               zs12(ji,jj) = ( zs12(ji,jj) + dtotel *  &
-                  &          ( ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) ) )  &
-                  &          / ( 1.0 + dtotel ) 
-
-            END DO ! ji
-         END DO ! jj
-
-         CALL lbc_lnk( zs12(:,:), 'F', 1. )
-
+               zddc  = (  ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  &
+                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  &
+                  &    ) * r1_e1e2f(ji,jj)
+
+               zdtc  = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  &
+                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  &
+                  &    ) * r1_e1e2f(ji,jj)
+
+               zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl
+
+               !-Calculate stress tensor components zs1 and zs2 at centre of grid cells (see section 3.5 of CICE user's guide).
+               zs1(ji,jj)  = ( zs1 (ji,jj) + dtotel * ( divu_i(ji,jj) - delta ) / delta_i(ji,jj)   * zpresh(ji,jj)   &
+                  &          ) * z1_dtotel
+               zs2(ji,jj)  = ( zs2 (ji,jj) + dtotel *         ecci * zdt(ji,jj) / delta_i(ji,jj)   * zpresh(ji,jj)   &
+                  &          ) * z1_dtotel
+               !-Calculate stress tensor component zs12 at corners
+               zs12(ji,jj) = ( zs12(ji,jj) + dtotel *         ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj)  &
+                  &          ) * z1_dtotel 
+
+            END DO
+         END DO
+
+         CALL lbc_lnk_multi( zs1 , 'T', 1., zs2, 'T', 1., zs12, 'F', 1. )
+ 
          ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002)
          DO jj = k_j1+1, k_jpj-1
             DO ji = fs_2, fs_jpim1
                !- contribution of zs1, zs2 and zs12 to zf1
-               zf1(ji,jj) = 0.5*( (zs1(ji+1,jj)-zs1(ji,jj))*e2u(ji,jj) &
-                  &              +(zs2(ji+1,jj)*e2t(ji+1,jj)**2-zs2(ji,jj)*e2t(ji,jj)**2)/e2u(ji,jj) &
-                  &              +2.0*(zs12(ji,jj)*e1f(ji,jj)**2-zs12(ji,jj-1)*e1f(ji,jj-1)**2)/e1u(ji,jj) &
-                  &             ) / ( e1u(ji,jj)*e2u(ji,jj) )
+               zf1(ji,jj) = 0.5 * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)  &
+                  &             + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj)          &
+                  &             + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj)  &
+                  &                ) * r1_e1e2u(ji,jj)
                ! contribution of zs1, zs2 and zs12 to zf2
-               zf2(ji,jj) = 0.5*( (zs1(ji,jj+1)-zs1(ji,jj))*e1v(ji,jj) &
-                  &              -(zs2(ji,jj+1)*e1t(ji,jj+1)**2 - zs2(ji,jj)*e1t(ji,jj)**2)/e1v(ji,jj) &
-                  &              + 2.0*(zs12(ji,jj)*e2f(ji,jj)**2 -    &
-                  zs12(ji-1,jj)*e2f(ji-1,jj)**2)/e2v(ji,jj) &
-                  &             ) / ( e1v(ji,jj)*e2v(ji,jj) )
+               zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)  &
+                  &             - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj)          &
+                  &             + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj)  &
+                  &               )  * r1_e1e2v(ji,jj)
             END DO
          END DO
@@ -487,23 +438,19 @@
          IF (MOD(jter,2).eq.0) THEN 
 
-!CDIR NOVERRCHK
             DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1
-                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj)
-                  z0           = zmass1(ji,jj)/dtevp
+                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1)
+                  z0           = zmass1(ji,jj) * z1_dtevp
 
                   ! SB modif because ocean has no slip boundary condition
-                  zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)         &
-                     &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   &
-                     &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
-                  za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + &
-                     (zv_ice1-v_oce1(ji,jj))**2) * (1.0-zfrld1(ji,jj))
-                  zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + &
-                     za*(u_oce1(ji,jj))
-                  zcca         = z0+za
+                  zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji  ,jj)     &
+                     &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   &
+                     &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+                  za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  &
+                     &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) )
+                  zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj)
+                  zcca         = z0 + za
                   zccb         = zcorl1(ji,jj)
-                  u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask 
-
+                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 
                END DO
             END DO
@@ -511,5 +458,5 @@
             CALL lbc_lnk( u_ice(:,:), 'U', -1. )
 #if defined key_agrif && defined key_lim2
-            CALL agrif_rhg_lim2( jter, nevp, 'U' )
+            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' )
 #endif
 #if defined key_bdy
@@ -517,23 +464,19 @@
 #endif         
 
-!CDIR NOVERRCHK
             DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1
 
-                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj)
-                  z0           = zmass2(ji,jj)/dtevp
+                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1)
+                  z0           = zmass2(ji,jj) * z1_dtevp
                   ! SB modif because ocean has no slip boundary condition
-                  zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)     &
-                     &                 + (u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   &
-                     &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
-                  za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + & 
-                     (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj))
-                  zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + &
-                     za2ct(ji,jj) + za*(v_oce2(ji,jj))
-                  zcca         = z0+za
+                  zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       &
+                     &                 + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   &
+                     &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+                  za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  & 
+                     &                         ( v_ice(ji,jj) - v_oce(ji,jj))**2 ) * ( 1.0 - zfrld2(ji,jj) )
+                  zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj)
+                  zcca         = z0 + za
                   zccb         = zcorl2(ji,jj)
-                  v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask
-
+                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch
                END DO
             END DO
@@ -541,5 +484,5 @@
             CALL lbc_lnk( v_ice(:,:), 'V', -1. )
 #if defined key_agrif && defined key_lim2
-            CALL agrif_rhg_lim2( jter, nevp, 'V' )
+            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' )
 #endif
 #if defined key_bdy
@@ -548,23 +491,19 @@
 
          ELSE 
-!CDIR NOVERRCHK
             DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1
-                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj)
-                  z0           = zmass2(ji,jj)/dtevp
+                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1)
+                  z0           = zmass2(ji,jj) * z1_dtevp
                   ! SB modif because ocean has no slip boundary condition
-                  zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)      &
-                     &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   &
-                     &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)   
-
-                  za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + &
-                     (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj))
-                  zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + &
-                     za2ct(ji,jj) + za*(v_oce2(ji,jj))
-                  zcca         = z0+za
+                  zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       &
+                     &                  +( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   &
+                     &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)   
+
+                  za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  &
+                     &                         ( v_ice(ji,jj) - v_oce(ji,jj) )**2 ) * ( 1.0 - zfrld2(ji,jj) )
+                  zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj)
+                  zcca         = z0 + za
                   zccb         = zcorl2(ji,jj)
-                  v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask
-
+                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch
                END DO
             END DO
@@ -572,5 +511,5 @@
             CALL lbc_lnk( v_ice(:,:), 'V', -1. )
 #if defined key_agrif && defined key_lim2
-            CALL agrif_rhg_lim2( jter, nevp, 'V' )
+            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' )
 #endif
 #if defined key_bdy
@@ -578,27 +517,24 @@
 #endif         
 
-!CDIR NOVERRCHK
             DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1
-                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj)
-                  z0           = zmass1(ji,jj)/dtevp
-                  zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)      &
-                     &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   &
-                     &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
-
-                  za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + &
-                     (zv_ice1-v_oce1(ji,jj))**2)*(1.0-zfrld1(ji,jj))
-                  zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + &
-                     za*(u_oce1(ji,jj))
-                  zcca         = z0+za
+                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1)
+                  z0           = zmass1(ji,jj) * z1_dtevp
+                  zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji,jj)       &
+                     &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   &
+                     &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+
+                  za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  &
+                     &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) )
+                  zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj)
+                  zcca         = z0 + za
                   zccb         = zcorl1(ji,jj)
-                  u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask 
-               END DO ! ji
-            END DO ! jj
+                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 
+               END DO
+            END DO
 
             CALL lbc_lnk( u_ice(:,:), 'U', -1. )
 #if defined key_agrif && defined key_lim2
-            CALL agrif_rhg_lim2( jter, nevp, 'U' )
+            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' )
 #endif
 #if defined key_bdy
@@ -611,8 +547,7 @@
             !---  Convergence test.
             DO jj = k_j1+1 , k_jpj-1
-               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ) ,           &
-                  ABS( v_ice(:,jj) - zv_ice(:,jj) ) )
-            END DO
-            zresm = MAXVAL( zresr( 1:jpi , k_j1+1:k_jpj-1 ) )
+               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) )
+            END DO
+            zresm = MAXVAL( zresr( 1:jpi, k_j1+1:k_jpj-1 ) )
             IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain
          ENDIF
@@ -625,24 +560,20 @@
       ! 4) Prevent ice velocities when the ice is thin
       !------------------------------------------------------------------------------!
-      ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the
-      ! ocean velocity, 
-      ! This prevents high velocity when ice is thin
-!CDIR NOVERRCHK
+      ! If the ice volume is below zvmin then ice velocity should equal the
+      ! ocean velocity. This prevents high velocity when ice is thin
       DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
          DO ji = fs_2, fs_jpim1
-            zdummy = vt_i(ji,jj)
-            IF ( zdummy .LE. hminrhg ) THEN
+            IF ( vt_i(ji,jj) <= zvmin ) THEN
                u_ice(ji,jj) = u_oce(ji,jj)
                v_ice(ji,jj) = v_oce(ji,jj)
-            ENDIF ! zdummy
+            ENDIF
          END DO
       END DO
 
-      CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
-      CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
+      CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. )
+
 #if defined key_agrif && defined key_lim2
-      CALL agrif_rhg_lim2( nevp , nevp, 'U' )
-      CALL agrif_rhg_lim2( nevp , nevp, 'V' )
+      CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' )
+      CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'V' )
 #endif
 #if defined key_bdy
@@ -653,93 +584,64 @@
       DO jj = k_j1+1, k_jpj-1 
          DO ji = fs_2, fs_jpim1
-            zdummy = vt_i(ji,jj)
-            IF ( zdummy .LE. hminrhg ) THEN
-               v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   &
-                  &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) &
-                  &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
-
-               u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   &
-                  &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) &
-                  &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
-            ENDIF ! zdummy
+            IF ( vt_i(ji,jj) <= zvmin ) THEN
+               v_ice1(ji,jj)  = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji,  jj-1) ) * e1t(ji+1,jj)     &
+                  &                      + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) )   &
+                  &                      / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+
+               u_ice2(ji,jj)  = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     &
+                  &                      + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) )   &
+                  &                      / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+            ENDIF 
          END DO
       END DO
 
-      CALL lbc_lnk( u_ice2(:,:), 'V', -1. ) 
-      CALL lbc_lnk( v_ice1(:,:), 'U', -1. )
+      CALL lbc_lnk_multi( u_ice2(:,:), 'V', -1., v_ice1(:,:), 'U', -1. )
 
       ! Recompute delta, shear and div, inputs for mechanical redistribution 
-!CDIR NOVERRCHK
       DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
-         DO ji = fs_2, jpim1   !RB bug no vect opt due to tmi
+         DO ji = fs_2, jpim1   !RB bug no vect opt due to zmask
             !- divu_i(:,:), zdt(:,:): divergence and tension at centre 
             !- zds(:,:): shear on northeast corner of grid cells
-            zdummy = vt_i(ji,jj)
-            IF ( zdummy .LE. hminrhg ) THEN
-
-               divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      &
-                  &             -e2u(ji-1,jj)*u_ice(ji-1,jj)                  &
-                  &             +e1v(ji,jj)*v_ice(ji,jj)                      &
-                  &             -e1v(ji,jj-1)*v_ice(ji,jj-1)                  &
-                  &            )                                              &
-                  &            / area(ji,jj)
-
-               zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    &
-                  &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                &
-                  &           )*e2t(ji,jj)*e2t(ji,jj)                      &
-                  &          -( v_ice(ji,jj)/e1v(ji,jj)                    &
-                  &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                &
-                  &           )*e1t(ji,jj)*e1t(ji,jj)                      &
-                  &         )                                              &
-                  &        / area(ji,jj)
+            IF ( vt_i(ji,jj) <= zvmin ) THEN
+
+               divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj  ) * u_ice(ji-1,jj  )   &
+                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji  ,jj-1) * v_ice(ji  ,jj-1)   &
+                  &            ) * r1_e1e2t(ji,jj)
+
+               zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)  &
+                  &          -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)  &
+                  &         ) * r1_e1e2t(ji,jj)
                !
                ! SB modif because ocean has no slip boundary condition 
-               zds(ji,jj) = ( ( u_ice(ji,jj+1) / e1u(ji,jj+1)              &
-                  &           - u_ice(ji,jj)   / e1u(ji,jj) )              &
-                  &           * e1f(ji,jj) * e1f(ji,jj)                    &
-                  &          + ( v_ice(ji+1,jj) / e2v(ji+1,jj)             &
-                  &            - v_ice(ji,jj)  / e2v(ji,jj) )              &
-                  &           * e2f(ji,jj) * e2f(ji,jj) )                  &
-                  &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) &
-                  &        * tmi(ji,jj) * tmi(ji,jj+1)                     &
-                  &        * tmi(ji+1,jj) * tmi(ji+1,jj+1)
-
-               zdst = (  e2u( ji  , jj   ) * v_ice1(ji  ,jj  )    &
-                  &           - e2u( ji-1, jj   ) * v_ice1(ji-1,jj  )    &
-                  &           + e1v( ji  , jj   ) * u_ice2(ji  ,jj  )    &
-                  &           - e1v( ji  , jj-1 ) * u_ice2(ji  ,jj-1)  ) / area(ji,jj)
-
-               delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )  
-               delta_i(ji,jj) = delta + creepl
+               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  &
+                  &          +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  &
+                  &         ) * r1_e1e2f(ji,jj) * ( 2.0 - fmask(ji,jj,1) )                                     &
+                  &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1)
+
+               zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )    &
+                  &   + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1) ) * r1_e1e2t(ji,jj)
+
+               delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )  
+               delta_i(ji,jj) = delta + rn_creepl
             
-            ENDIF ! zdummy
-
-         END DO !jj
-      END DO !ji
+            ENDIF
+         END DO
+      END DO
       !
       !------------------------------------------------------------------------------!
       ! 5) Store stress tensor and its invariants
       !------------------------------------------------------------------------------!
-      !
       ! * Invariants of the stress tensor are required for limitd_me
       !   (accelerates convergence and improves stability)
       DO jj = k_j1+1, k_jpj-1
          DO ji = fs_2, fs_jpim1
-            ! begin TECLIM change 
-            zdst= (  e2u( ji  , jj   ) * v_ice1(ji,jj)           &   
-               &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)         &   
-               &          + e1v( ji  , jj   ) * u_ice2(ji,jj)           &   
-               &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) / area(ji,jj) 
+            zdst           = (  e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)  &   
+               &              + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e1e2t(ji,jj) 
             shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst )
-            ! end TECLIM change
          END DO
       END DO
 
       ! Lateral boundary condition
-      CALL lbc_lnk( divu_i (:,:), 'T', 1. )
-      CALL lbc_lnk( delta_i(:,:), 'T', 1. )
-      ! CALL lbc_lnk( shear_i(:,:), 'F', 1. )
-      CALL lbc_lnk( shear_i(:,:), 'T', 1. )
+      CALL lbc_lnk_multi( divu_i (:,:), 'T', 1., delta_i(:,:), 'T', 1.,  shear_i(:,:), 'T', 1. )
 
       ! * Store the stress tensor for the next time step
@@ -772,5 +674,5 @@
             DO jj = k_j1+1, k_jpj-1
                DO ji = 2, jpim1
-                  IF (zpresh(ji,jj) .GT. 1.0) THEN
+                  IF (zpresh(ji,jj) > 1.0) THEN
                      sigma1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) ) 
                      sigma2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )
@@ -786,5 +688,5 @@
       !
       CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
-      CALL wrk_dealloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1                )
+      CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               )
       CALL wrk_dealloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  )
       CALL wrk_dealloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 5901)
@@ -18,5 +18,4 @@
    USE ice            ! sea-ice variables
    USE oce     , ONLY :  snwice_mass, snwice_mass_b
-   USE par_ice        ! sea-ice parameters
    USE dom_oce        ! ocean domain
    USE sbc_oce        ! Surface boundary condition: ocean fields
@@ -27,4 +26,5 @@
    USE wrk_nemo       ! work arrays
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE limctl
 
    IMPLICIT NONE
@@ -33,5 +33,5 @@
    PUBLIC   lim_rst_opn    ! routine called by icestep.F90
    PUBLIC   lim_rst_write  ! routine called by icestep.F90
-   PUBLIC   lim_rst_read   ! routine called by iceini.F90
+   PUBLIC   lim_rst_read   ! routine called by sbc_lim_init
 
    LOGICAL, PUBLIC ::   lrst_ice         !: logical to control the ice restart write 
@@ -55,4 +55,5 @@
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
+      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file 
       !!----------------------------------------------------------------------
       !
@@ -64,26 +65,33 @@
       IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc    &
          &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN
-         ! beware of the format used to write kt (default is i8.8, that should be large enough...)
-         IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
-         ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
+         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
+            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
+            ENDIF
+            ! create the file
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
+            clpath = TRIM(cn_icerst_outdir) 
+            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'
+            IF(lwp) THEN
+               WRITE(numout,*)
+               SELECT CASE ( jprstlib )
+               CASE ( jprstdimg )
+                  WRITE(numout,*) '             open ice restart binary file: ',TRIM(clpath)//clname
+               CASE DEFAULT
+                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
+               END SELECT
+               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
+                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
+               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
+               ENDIF
+            ENDIF
+            !
+            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )
+            lrst_ice = .TRUE.
          ENDIF
-         ! create the file
-         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
-         IF(lwp) THEN
-            WRITE(numout,*)
-            SELECT CASE ( jprstlib )
-            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname
-            CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname
-            END SELECT
-            IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
-               WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
-            ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
-            ENDIF
-         ENDIF
-         !
-         CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib )
-         lrst_ice = .TRUE.
       ENDIF
       !
+      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print
    END SUBROUTINE lim_rst_opn
 
@@ -142,5 +150,5 @@
          CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
       END DO
-      
+
       DO jl = 1, jpl 
          WRITE(zchar,'(I1)') jl
@@ -165,6 +173,6 @@
       CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'    , stress2_i  )
       CALL iom_rstput( iter, nitrst, numriw, 'stress12_i'   , stress12_i )
-      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass )   !clem modif
-      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) !clem modif
+      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass )
+      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b )
 
       DO jl = 1, jpl 
@@ -306,8 +314,6 @@
       !! ** purpose  :   read of sea-ice variable restart in a netcdf file
       !!----------------------------------------------------------------------
-      INTEGER :: ji, jj, jk, jl, indx
+      INTEGER :: ji, jj, jk, jl
       REAL(wp) ::   zfice, ziter
-      REAL(wp) ::   zs_inf, z_slope_s, zsmax, zsmin, zalpha   ! local scalars used for the salinity profile
-      REAL(wp), POINTER, DIMENSION(:)   ::   zs_zero 
       REAL(wp), POINTER, DIMENSION(:,:) ::   z2d
       CHARACTER(len=15) ::   znam
@@ -317,5 +323,4 @@
       !!----------------------------------------------------------------------
 
-      CALL wrk_alloc( nlay_i, zs_zero )
       CALL wrk_alloc( jpi, jpj, z2d )
 
@@ -329,9 +334,9 @@
         ! eventually read netcdf file (monobloc)  for restarting on different number of processors
         ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90
-        INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok )
+        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok )
         IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
       ENDIF
 
-      CALL iom_open ( cn_icerst_in, numrir, kiolib = jprstlib )
+      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib )
 
       CALL iom_get( numrir, 'nn_fsbc', zfice )
@@ -395,6 +400,6 @@
       CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  )
       CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i )
-      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass )   !clem modif
-      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) !clem modif
+      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass )
+      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b )
 
       DO jl = 1, jpl 
@@ -521,10 +526,10 @@
       !
       ! clem: I do not understand why the following IF is needed
-      !       I suspect something inconsistent in the main code with option num_sal=1
-      IF( num_sal == 1 ) THEN
+      !       I suspect something inconsistent in the main code with option nn_icesal=1
+      IF( nn_icesal == 1 ) THEN
          DO jl = 1, jpl 
-            sm_i(:,:,jl) = bulk_sal
+            sm_i(:,:,jl) = rn_icesal
             DO jk = 1, nlay_i 
-               s_i(:,:,jk,jl) = bulk_sal
+               s_i(:,:,jk,jl) = rn_icesal
             END DO
          END DO
@@ -533,5 +538,4 @@
       !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90
       !
-      CALL wrk_dealloc( nlay_i, zs_zero )
       CALL wrk_dealloc( jpi, jpj, z2d )
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 5901)
@@ -25,12 +25,10 @@
    USE par_oce          ! ocean parameters
    USE phycst           ! physical constants
-   USE par_ice          ! ice parameters
    USE dom_oce          ! ocean domain
-   USE dom_ice,    ONLY : tms, area
    USE ice              ! LIM sea-ice variables
    USE sbc_ice          ! Surface boundary condition: sea-ice fields
    USE sbc_oce          ! Surface boundary condition: ocean fields
    USE sbccpl
-   USE oce       , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
+   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
    USE albedo           ! albedo parameters
    USE lbclnk           ! ocean lateral boundary condition - MPP exchanges
@@ -40,12 +38,14 @@
    USE prtctl           ! Print control
    USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE traqsr           ! clem: add penetration of solar flux into the calculation of heat budget
+   USE traqsr           ! add penetration of solar flux in the calculation of heat budget
    USE iom
    USE domvvl           ! Variable volume
+   USE limctl
+   USE limcons
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_sbc_init   ! called by ice_init
+   PUBLIC   lim_sbc_init   ! called by sbc_lim_init
    PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim
    PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim
@@ -94,18 +94,15 @@
       !!              - fr_i    : ice fraction
       !!              - tn_ice  : sea-ice surface temperature
-      !!              - alb_ice : sea-ice albedo (lk_cpl=T)
+      !!              - alb_ice : sea-ice albedo (only useful in coupled mode)
       !!
       !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
       !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
       !!              These refs are now obsolete since everything has been revised
-      !!              The ref should be Rousset et al., 2015?
+      !!              The ref should be Rousset et al., 2015
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt                                   ! number of iteration
-      !
-      INTEGER  ::   ji, jj, jl, jk                                  ! dummy loop indices
-      !
-      REAL(wp) ::   zemp                                            !  local scalars
-      REAL(wp) ::   zf_mass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2)
-      REAL(wp) ::   zfcm1                                           ! New solar flux received by the ocean
+      INTEGER, INTENT(in) ::   kt                                  ! number of iteration
+      INTEGER  ::   ji, jj, jl, jk                                 ! dummy loop indices
+      REAL(wp) ::   zqmass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2)
+      REAL(wp) ::   zqsr                                           ! New solar flux received by the ocean
       !
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace
@@ -113,11 +110,14 @@
 
       ! make calls for heat fluxes before it is modified
-      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) )   !     solar flux at ocean surface
-      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) )   ! non-solar flux at ocean surface
-      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux at ice surface
-      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface
-      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux transmitted thru ice
-      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )  
-      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) )
+      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface
+      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface
+      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface
+      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface
+      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice
+      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) )  
+      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   &
+         &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) )
+      IF( iom_use('qemp_oce' ) )   CALL iom_put( "qemp_oce"  , qemp_oce(:,:) )  
+      IF( iom_use('qemp_ice' ) )   CALL iom_put( "qemp_ice"  , qemp_ice(:,:) )  
 
       ! pfrld is the lead fraction at the previous time step (actually between TRP and THD)
@@ -128,29 +128,24 @@
             !      heat flux at the ocean surface      !
             !------------------------------------------!
-            ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 
+            ! Solar heat flux reaching the ocean = zqsr (W.m-2) 
             !---------------------------------------------------
-            IF( lk_cpl ) THEN 
-               !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) )
-               zfcm1 = qsr_tot(ji,jj)
-               DO jl = 1, jpl
-                  zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl)
-               END DO
-            ELSE
-               !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj)
-               zfcm1   = pfrld(ji,jj) * qsr(ji,jj)
-               DO jl = 1, jpl
-                  zfcm1   = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl)
-               END DO
-            ENDIF
+            zqsr = qsr_tot(ji,jj)
+            DO jl = 1, jpl
+               zqsr = zqsr - a_i_b(ji,jj,jl) * (  qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) 
+            END DO
 
             ! Total heat flux reaching the ocean = hfx_out (W.m-2) 
             !---------------------------------------------------
-            zf_mass        = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
-            hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1
+            zqmass         = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
+            hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr
+
+            ! Add the residual from heat diffusion equation (W.m-2)
+            !-------------------------------------------------------
+            hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj)
 
             ! New qsr and qns used to compute the oceanic heat flux at the next time step
             !---------------------------------------------------
-            qsr(ji,jj) = zfcm1                                      
-            qns(ji,jj) = hfx_out(ji,jj) - zfcm1              
+            qsr(ji,jj) = zqsr                                      
+            qns(ji,jj) = hfx_out(ji,jj) - zqsr              
 
             !------------------------------------------!
@@ -165,14 +160,4 @@
             !                     Even if i see Ice melting as a FW and SALT flux
             !        
-            !  computing freshwater exchanges at the ice/ocean interface
-            IF( lk_cpl ) THEN 
-               zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !
-                  &   + wfx_snw(ji,jj)
-            ELSE
-               zemp =   emp(ji,jj)     *           pfrld(ji,jj)            &   ! evaporation over oceanic fraction
-                  &   - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) )          &   ! all precipitation reach the ocean
-                  &   + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas )       ! except solid precip intercepted by sea-ice
-            ENDIF
-
             ! mass flux from ice/ocean
             wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
@@ -180,6 +165,6 @@
 
             ! mass flux at the ocean/ice interface
-            fmmflx(ji,jj) = - wfx_ice(ji,jj) * r1_rdtice                    ! F/M mass flux save at least for biogeochemical model
-            emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)       ! mass flux + F/M mass flux (always ice/ocean mass exchange)
+            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice  ! F/M mass flux save at least for biogeochemical model
+            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
             
          END DO
@@ -199,5 +184,5 @@
          snwice_mass_b(:,:) = snwice_mass(:,:)                  
          ! new mass per unit area
-         snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
+         snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
          ! time evolution of snow+ice mass
          snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice
@@ -210,19 +195,17 @@
       tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                      
 
-      !------------------------------------------------!
-      !    Snow/ice albedo (only if sent to coupler)   !
-      !------------------------------------------------!
-      IF( lk_cpl ) THEN          ! coupled case
-
-            CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os )
-
-            CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos
-
-            alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
-
-            CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os )
-
-      ENDIF
-
+      !------------------------------------------------------------------------!
+      !    Snow/ice albedo (only if sent to coupler, useless in forced mode)   !
+      !------------------------------------------------------------------------!
+      CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os )    
+      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos
+      alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+      CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os )
+
+      ! conservation test
+      IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' )
+
+      ! control prints
+      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' )
 
       IF(ln_ctl) THEN
@@ -270,7 +253,5 @@
       !
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step)
-!CDIR NOVERRCHK
          DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
-!CDIR NOVERRCHK
             DO ji = fs_2, fs_jpim1
                !                                               ! 2*(U_ice-U_oce) at T-point
@@ -322,6 +303,4 @@
       !! ** input   : Namelist namicedia
       !!-------------------------------------------------------------------
-      REAL(wp) :: zsum, zarea
-      !
       INTEGER  ::   ji, jj, jk                       ! dummy loop indices
       REAL(wp) ::   zcoefu, zcoefv, zcoeff          ! local scalar
@@ -343,14 +322,9 @@
          END WHERE
       ENDIF
-      ! clem modif
-      IF( .NOT. ln_rstart ) THEN
-         fraqsr_1lev(:,:) = 1._wp
-      ENDIF
-      !
-      ! clem: snwice_mass in the restart file now
+      !
       IF( .NOT. ln_rstart ) THEN
          !                                      ! embedded sea ice
          IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
-            snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )
+            snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )
             snwice_mass_b(:,:) = snwice_mass(:,:)
          ELSE
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 5901)
@@ -22,16 +22,15 @@
    USE phycst         ! physical constants
    USE dom_oce        ! ocean space and time domain variables
-   USE oce     , ONLY : fraqsr_1lev 
    USE ice            ! LIM: sea-ice variables
-   USE par_ice        ! LIM: sea-ice parameters
    USE sbc_oce        ! Surface boundary condition: ocean fields
    USE sbc_ice        ! Surface boundary condition: ice fields
    USE thd_ice        ! LIM thermodynamic sea-ice variables
    USE dom_ice        ! LIM sea-ice domain
-   USE domvvl         ! domain: variable volume level
    USE limthd_dif     ! LIM: thermodynamics, vertical diffusion
    USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation
    USE limthd_sal     ! LIM: thermodynamics, ice salinity
    USE limthd_ent     ! LIM: thermodynamics, ice enthalpy redistribution
+   USE limthd_lac     ! LIM-3 lateral accretion
+   USE limitd_th      ! remapping thickness distribution
    USE limtab         ! LIM: 1D <==> 2D transformation
    USE limvar         ! LIM: sea-ice variables
@@ -44,10 +43,11 @@
    USE timing         ! Timing
    USE limcons        ! conservation tests
+   USE limctl
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_thd        ! called by limstp module
-   PUBLIC   lim_thd_init   ! called by iceini module
+   PUBLIC   lim_thd         ! called by limstp module
+   PUBLIC   lim_thd_init    ! called by sbc_lim_init
 
    !! * Substitutions
@@ -80,19 +80,15 @@
       !! ** References : 
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! number of iteration
+      INTEGER, INTENT(in) :: kt    ! number of iteration
       !!
       INTEGER  :: ji, jj, jk, jl   ! dummy loop indices
-      INTEGER  :: nbpb             ! nb of icy pts for thermo. cal.
+      INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations
       INTEGER  :: ii, ij           ! temporary dummy loop index
-      REAL(wp) :: zfric_umin = 0._wp        ! lower bound for the friction velocity (cice value=5.e-04)
-      REAL(wp) :: zch        = 0.0057_wp    ! heat transfer coefficient
-      REAL(wp) :: zareamin 
       REAL(wp) :: zfric_u, zqld, zqfr
-      !
       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
-      !
-      REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns
+      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04)
+      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient
+      !
       !!-------------------------------------------------------------------
-      CALL wrk_alloc( jpi, jpj, zqsr, zqns )
 
       IF( nn_timing == 1 )  CALL timing_start('limthd')
@@ -101,4 +97,5 @@
       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
+      CALL lim_var_glo2eqv
       !------------------------------------------------------------------------!
       ! 1) Initialization of some variables                                    !
@@ -106,9 +103,8 @@
       ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice
 
-
       !--------------------
       ! 1.2) Heat content    
       !--------------------
-      ! Change the units of heat content; from global units to J.m3
+      ! Change the units of heat content; from J/m2 to J/m3
       DO jl = 1, jpl
          DO jk = 1, nlay_i
@@ -116,9 +112,7 @@
                DO ji = 1, jpi
                   !0 if no ice and 1 if yes
-                  rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 )  )
+                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  )
                   !Energy of melting q(S,T) [J.m-3]
-                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i )
-                  !convert units ! very important that this line is here        
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 
+                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL( nlay_i )
                END DO
             END DO
@@ -128,9 +122,7 @@
                DO ji = 1, jpi
                   !0 if no ice and 1 if yes
-                  rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 )  )
+                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 )  )
                   !Energy of melting q(S,T) [J.m-3]
-                  e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s )
-                  !convert units ! very important that this line is here
-                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac 
+                  e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL( nlay_s )
                END DO
             END DO
@@ -140,30 +132,7 @@
       ! 2) Partial computation of forcing for the thermodynamic sea ice model.      !
       !-----------------------------------------------------------------------------!
-
-      !--- Ocean solar and non solar fluxes to be used in zqld
-      IF ( .NOT. lk_cpl ) THEN   ! --- forced case, fluxes to the lead are the same as over the ocean
-         !
-         zqsr(:,:) = qsr(:,:)      ; zqns(:,:) = qns(:,:)
-         !
-      ELSE                       ! --- coupled case, fluxes to the lead are total - intercepted
-         !
-         zqsr(:,:) = qsr_tot(:,:)  ; zqns(:,:) = qns_tot(:,:)
-         !
-         DO jl = 1, jpl
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * a_i_b(ji,jj,jl)
-                  zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * a_i_b(ji,jj,jl)
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-
-!CDIR NOVERRCHK
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
-            rswitch          = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice
+            rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
             !
             !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
@@ -173,31 +142,25 @@
             !           !  temperature and turbulent mixing (McPhee, 1992)
             !
-
             ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- !
-            ! REMARK valid at least in forced mode from clem
-            ! precip is included in qns but not in qns_ice
-            IF ( lk_cpl ) THEN
-               zqld =  tms(ji,jj) * rdt_ice *  &
-                  &    (   zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj)               &   ! pfrld already included in coupled mode
-                  &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *     &   ! heat content of precip
-                  &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )   &
-                  &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) )
-            ELSE
-               zqld =  tms(ji,jj) * rdt_ice *  &
-                  &      ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) )    &
-                  &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *             &  ! heat content of precip
-                  &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )           &
-                  &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) )
-            ENDIF
-
-            !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- !
-            zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )
+            zqld =  tmask(ji,jj,1) * rdt_ice *  &
+               &    ( pfrld(ji,jj) * qsr_oce(ji,jj) * frq_m(ji,jj) + pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) )
+
+            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- !
+            zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )
+
+            ! --- Energy from the turbulent oceanic heat flux (W/m2) --- !
+            zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin ) 
+            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2
+            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
+            ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
+            !                        the freezing point, so that we do not have SST < T_freeze
+            !                        This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0
 
             !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice
-            qlead(ji,jj) = MIN( 0._wp , zqld - zqfr ) 
+            qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr )
 
             ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting 
-            IF( at_i(ji,jj) > epsi10 .AND. zqld > 0._wp ) THEN
-               fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90
+            IF( zqld > 0._wp ) THEN
+               fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90
                qlead(ji,jj) = 0._wp
             ELSE
@@ -205,44 +168,20 @@
             ENDIF
             !
-            !-- Energy from the turbulent oceanic heat flux --- !
-            !clem zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )
-            zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin ) 
-            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 
-            ! upper bound for fhtur: we do not want SST to drop below Tfreeze. 
-            ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr)   
-            ! This is not a clean budget, so that should be corrected at some point
-            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
-
             ! -----------------------------------------
             ! Net heat flux on top of ice-ocean [W.m-2]
             ! -----------------------------------------
-            !     First  step here      : heat flux at the ocean surface + precip
-            !     Second step below     : heat flux at the ice   surface (after limthd_dif) 
-            hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         & 
-               ! heat flux above the ocean
-               &    +             pfrld(ji,jj)   * ( zqns(ji,jj) + zqsr(ji,jj) )                                                  &
-               ! latent heat of precip (note that precip is included in qns but not in qns_ice)
-               &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  &
-               &    +   ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )
+            hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 
 
             ! -----------------------------------------------------------------------------
-            ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2]
+            ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2]
             ! -----------------------------------------------------------------------------
             !     First  step here              :  non solar + precip - qlead - qturb
             !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema) 
             !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar
-            hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                       & 
-               ! Non solar heat flux received by the ocean
-               &    +        pfrld(ji,jj) * qns(ji,jj)                                                                            &
-               ! latent heat of precip (note that precip is included in qns but not in qns_ice)
-               &    +      ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)       &
-               &         * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  &
-               &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )       &
-               ! heat flux taken from the ocean where there is open water ice formation
-               &    -      qlead(ji,jj) * r1_rdtice                                                                               &
-               ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth)
-               &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                             &
-               &    -      at_i(ji,jj) *  fhld(ji,jj)
-
+            hfx_out(ji,jj) =   pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj)  &  ! Non solar heat flux received by the ocean               
+               &             - qlead(ji,jj) * r1_rdtice                         &  ! heat flux taken from the ocean where there is open water ice formation
+               &             - at_i(ji,jj) * fhtur(ji,jj)                       &  ! heat flux taken by turbulence
+               &             - at_i(ji,jj) *  fhld(ji,jj)                          ! heat flux taken during bottom growth/melt 
+                                                                                   !    (fhld should be 0 while bott growth)
          END DO
       END DO
@@ -259,9 +198,8 @@
          ENDIF
 
-         zareamin = epsi10
          nbpb = 0
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF ( a_i(ji,jj,jl) .gt. zareamin ) THEN     
+               IF ( a_i(ji,jj,jl) > epsi10 ) THEN     
                   nbpb      = nbpb  + 1
                   npb(nbpb) = (jj - 1) * jpi + ji
@@ -272,7 +210,7 @@
          ! debug point to follow
          jiindex_1d = 0
-         IF( ln_nicep ) THEN
-            DO ji = mi0(jiindx), mi1(jiindx)
-               DO jj = mj0(jjindx), mj1(jjindx)
+         IF( ln_icectl ) THEN
+            DO ji = mi0(iiceprt), mi1(iiceprt)
+               DO jj = mj0(jiceprt), mj1(jiceprt)
                   jiindex_1d = (jj - 1) * jpi + ji
                   WRITE(numout,*) ' lim_thd : Category no : ', jl 
@@ -289,83 +227,16 @@
          IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing.
 
-            !-------------------------
-            ! 4.1 Move to 1D arrays
-            !-------------------------
-
-            CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-
-            CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-            DO jk = 1, nlay_s
-               CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-               CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-            END DO
-            DO jk = 1, nlay_i
-               CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-               CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-               CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-            END DO
-
-            CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:)   , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-            IF( .NOT. lk_cpl ) THEN
-               CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-               CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
-            ENDIF
-            CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) ) 
-            CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) )
-
-            CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) )
-
-            CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) )
-
-            CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) )
-
-            CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) )
-
-            !--------------------------------
-            ! 4.3) Thermodynamic processes
-            !--------------------------------
+            !-------------------------!
+            ! --- Move to 1D arrays ---
+            !-------------------------!
+            CALL lim_thd_1d2d( nbpb, jl, 1 )
+
+            !--------------------------------------!
+            ! --- Ice/Snow Temperature profile --- !
+            !--------------------------------------!
+            CALL lim_thd_dif( 1, nbpb )
 
             !---------------------------------!
-            ! Ice/Snow Temperature profile    !
-            !---------------------------------!
-            CALL lim_thd_dif( 1, nbpb )
-
-            !---------------------------------!
-            ! Ice/Snow thicnkess              !
+            ! --- Ice/Snow thickness ---      !
             !---------------------------------!
             CALL lim_thd_dh( 1, nbpb )    
@@ -375,71 +246,30 @@
                                             
             !---------------------------------!
-            ! --- Ice salinity --- !
+            ! --- Ice salinity ---            !
             !---------------------------------!
             CALL lim_thd_sal( 1, nbpb )    
 
             !---------------------------------!
-            ! --- temperature update --- !
+            ! --- temperature update ---      !
             !---------------------------------!
             CALL lim_thd_temp( 1, nbpb )
 
-            !--------------------------------
-            ! 4.4) Move 1D to 2D vectors
-            !--------------------------------
-
-               CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj )
-            DO jk = 1, nlay_s
-               CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj)
-               CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d     (1:nbpb,jk), jpi, jpj)
-            END DO
-            DO jk = 1, nlay_i
-               CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj)
-               CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d     (1:nbpb,jk), jpi, jpj)
-               CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj)
-            END DO
-               CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj )
-
-               CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj )
-
-               CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj )
-
-               CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj )
-
-              CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb)   , jpi, jpj )
-            !
-              CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj)
-              CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj )
+            !------------------------------------!
+            ! --- lateral melting if monocat --- !
+            !------------------------------------!
+            IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN
+               CALL lim_thd_lam( 1, nbpb )
+            END IF
+
+            !-------------------------!
+            ! --- Move to 2D arrays ---
+            !-------------------------!
+            CALL lim_thd_1d2d( nbpb, jl, 2 )
+
             !
             IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ??
          ENDIF
          !
-      END DO
+      END DO !jl
 
       !------------------------------------------------------------------------------!
@@ -448,36 +278,52 @@
 
       !------------------------
-      ! 5.1) Ice heat content              
+      ! Ice heat content              
       !------------------------
-      ! Enthalpies are global variables we have to readjust the units (heat content in Joules)
+      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2)
       DO jl = 1, jpl
          DO jk = 1, nlay_i
-            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) )
+            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i
          END DO
       END DO
 
       !------------------------
-      ! 5.2) Snow heat content              
+      ! Snow heat content              
       !------------------------
-      ! Enthalpies are global variables we have to readjust the units (heat content in Joules)
+      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2)
       DO jl = 1, jpl
          DO jk = 1, nlay_s
-            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) )
+            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s
          END DO
       END DO
-
+ 
       !----------------------------------
-      ! 5.3) Change thickness to volume
+      ! Change thickness to volume
       !----------------------------------
-      CALL lim_var_eqv2glo
+      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:)
+      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:)
+      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
+
+      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat)
+      DO jl  = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i_b(ji,jj,jl) - epsi10 ) )
+               oa_i(ji,jj,jl) = rswitch * oa_i(ji,jj,jl) * a_i(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 )
+            END DO
+         END DO
+      END DO
+
+      CALL lim_var_zapsmall
 
       !--------------------------------------------
-      ! 5.4) Diagnostic thermodynamic growth rates
+      ! Diagnostic thermodynamic growth rates
       !--------------------------------------------
+      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' )   ! control print
+
       IF(ln_ctl) THEN            ! Control print
          CALL prt_ctl_info(' ')
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=area , clinfo1=' lim_thd  : cell area :')
+         CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_thd  : cell area :')
          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd  : at_i      :')
          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd  : vt_i      :')
@@ -508,9 +354,59 @@
       !
       !
-      CALL wrk_dealloc( jpi, jpj, zqsr, zqns )
-
-      !
-      ! conservation test
       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      !------------------------------------------------------------------------------|
+      !  6) Transport of ice between thickness categories.                           |
+      !------------------------------------------------------------------------------|
+      ! Given thermodynamic growth rates, transport ice between thickness categories.
+      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      IF( jpl > 1 )      CALL lim_itd_th_rem( 1, jpl, kt )
+
+      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      !------------------------------------------------------------------------------|
+      !  7) Add frazil ice growing in leads.
+      !------------------------------------------------------------------------------|
+      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      CALL lim_thd_lac
+      
+      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      ! Control print
+      IF(ln_ctl) THEN
+         CALL lim_var_glo2eqv
+
+         CALL prt_ctl_info(' ')
+         CALL prt_ctl_info(' - Cell values : ')
+         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
+         CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_th  : cell area :')
+         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :')
+         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :')
+         CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th  : vt_s      :')
+         DO jl = 1, jpl
+            CALL prt_ctl_info(' ')
+            CALL prt_ctl_info(' - Category : ', ivar1=jl)
+            CALL prt_ctl_info('   ~~~~~~~~~~')
+            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : a_i      : ')
+            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_i     : ')
+            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_s     : ')
+            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_i      : ')
+            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_s      : ')
+            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : e_s      : ')
+            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_itd_th  : t_su     : ')
+            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : t_snow   : ')
+            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ')
+            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ')
+            DO jk = 1, nlay_i
+               CALL prt_ctl_info(' ')
+               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
+               CALL prt_ctl_info('   ~~~~~~~')
+               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : t_i      : ')
+               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : e_i      : ')
+            END DO
+         END DO
+      ENDIF
       !
       IF( nn_timing == 1 )  CALL timing_stop('limthd')
@@ -518,4 +414,5 @@
    END SUBROUTINE lim_thd 
 
+ 
    SUBROUTINE lim_thd_temp( kideb, kiut )
       !!-----------------------------------------------------------------------
@@ -534,19 +431,188 @@
       DO jk = 1, nlay_i
          DO ji = kideb, kiut
-            ztmelts       =  -tmut * s_i_1d(ji,jk) + rtt
+            ztmelts       =  -tmut * s_i_1d(ji,jk) + rt0
             ! Conversion q(S,T) -> T (second order equation)
             zaaa          =  cpic
-            zbbb          =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_1d(ji,jk) / rhoic - lfus
-            zccc          =  lfus * ( ztmelts - rtt )
+            zbbb          =  ( rcp - cpic ) * ( ztmelts - rt0 ) + q_i_1d(ji,jk) * r1_rhoic - lfus
+            zccc          =  lfus * ( ztmelts - rt0 )
             zdiscrim      =  SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) )
-            t_i_1d(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa )
+            t_i_1d(ji,jk) =  rt0 - ( zbbb + zdiscrim ) / ( 2._wp * zaaa )
             
             ! mask temperature
             rswitch       =  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 
-            t_i_1d(ji,jk) =  rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rtt
+            t_i_1d(ji,jk) =  rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0
          END DO 
       END DO 
 
    END SUBROUTINE lim_thd_temp
+
+   SUBROUTINE lim_thd_lam( kideb, kiut )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_lam *** 
+      !!                 
+      !! ** Purpose :   Lateral melting in case monocategory
+      !!                          ( dA = A/2h dh )
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kideb, kiut        ! bounds for the spatial loop
+      INTEGER             ::   ji                 ! dummy loop indices
+      REAL(wp)            ::   zhi_bef            ! ice thickness before thermo
+      REAL(wp)            ::   zdh_mel, zda_mel   ! net melting
+      REAL(wp)            ::   zvi, zvs           ! ice/snow volumes 
+
+      DO ji = kideb, kiut
+         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) )
+         IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp )  THEN
+            zvi          = a_i_1d(ji) * ht_i_1d(ji)
+            zvs          = a_i_1d(ji) * ht_s_1d(ji)
+            ! lateral melting = concentration change
+            zhi_bef     = ht_i_1d(ji) - zdh_mel
+            rswitch     = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) )
+            zda_mel     = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) )
+            a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel ) 
+             ! adjust thickness
+            ht_i_1d(ji) = zvi / a_i_1d(ji)            
+            ht_s_1d(ji) = zvs / a_i_1d(ji)            
+            ! retrieve total concentration
+            at_i_1d(ji) = a_i_1d(ji)
+         END IF
+      END DO
+      
+   END SUBROUTINE lim_thd_lam
+
+   SUBROUTINE lim_thd_1d2d( nbpb, jl, kn )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_1d2d *** 
+      !!                 
+      !! ** Purpose :   move arrays from 1d to 2d and the reverse
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D
+                                        ! 2= from 1D to 2D
+      INTEGER, INTENT(in) ::   nbpb     ! size of 1D arrays
+      INTEGER, INTENT(in) ::   jl       ! ice cat
+      INTEGER             ::   jk       ! dummy loop indices
+
+      SELECT CASE( kn )
+
+      CASE( 1 )
+
+         CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+         
+         CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+         DO jk = 1, nlay_s
+            CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+         END DO
+         DO jk = 1, nlay_i
+            CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+         END DO
+         
+         CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, evap_ice_1d (1:nbpb), evap_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) ) 
+         CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) )
+         
+         CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) )
+         
+         CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) )
+         
+         CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) )
+         
+         CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) )
+
+      CASE( 2 )
+
+         CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj )
+         DO jk = 1, nlay_s
+            CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj)
+            CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d     (1:nbpb,jk), jpi, jpj)
+         END DO
+         DO jk = 1, nlay_i
+            CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj)
+            CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d     (1:nbpb,jk), jpi, jpj)
+            CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj)
+         END DO
+         CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj )
+         
+         CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj )
+         
+         CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj )
+         
+         CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj )
+         
+         CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_err_dif   , npb, hfx_err_dif_1d(1:nbpb), jpi, jpj )
+         !
+         CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj)
+         CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj )
+         !         
+      END SELECT
+
+   END SUBROUTINE lim_thd_1d2d
+
 
    SUBROUTINE lim_thd_init
@@ -563,7 +629,7 @@
       !!-------------------------------------------------------------------
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,   &
-         &                hiclim, hnzst, parsub, betas,                          & 
-         &                kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi
+      NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                       &
+         &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, &
+         &                nn_monocat, ln_it_qnsice
       !!-------------------------------------------------------------------
       !
@@ -582,26 +648,29 @@
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp )
       IF(lwm) WRITE ( numoni, namicethd )
-
-      IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )
+      !
+      IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN 
+         nn_monocat = 0
+         IF(lwp) WRITE(numout, *) '   nn_monocat must be 0 in multi-category case '
+      ENDIF
+
       !
       IF(lwp) THEN                          ! control print
          WRITE(numout,*)
          WRITE(numout,*)'   Namelist of ice parameters for ice thermodynamic computation '
-         WRITE(numout,*)'      maximum melting at the bottom                           hmelt        = ', hmelt
-         WRITE(numout,*)'      ice thick. for lateral accretion                        hiccrit      = ', hiccrit
-         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       fraz_swi     = ', fraz_swi
-         WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   maxfrazb     = ', maxfrazb
-         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  vfrazb       = ', vfrazb
-         WRITE(numout,*)'      Squeezing coefficient for collection of frazil          Cfrazb       = ', Cfrazb
-         WRITE(numout,*)'      minimum ice thickness                                   hiclim       = ', hiclim 
+         WRITE(numout,*)'      ice thick. for lateral accretion                        rn_hnewice   = ', rn_hnewice
+         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       ln_frazil    = ', ln_frazil
+         WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   rn_maxfrazb  = ', rn_maxfrazb
+         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  rn_vfrazb    = ', rn_vfrazb
+         WRITE(numout,*)'      Squeezing coefficient for collection of frazil          rn_Cfrazb    = ', rn_Cfrazb
+         WRITE(numout,*)'      minimum ice thickness                                   rn_himin     = ', rn_himin 
          WRITE(numout,*)'      numerical carac. of the scheme for diffusion in ice '
-         WRITE(numout,*)'      thickness of the surf. layer in temp. computation       hnzst        = ', hnzst
-         WRITE(numout,*)'      switch for snow sublimation  (=1) or not (=0)           parsub       = ', parsub  
-         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          betas        = ', betas
-         WRITE(numout,*)'      extinction radiation parameter in sea ice (1.0)         kappa_i      = ', kappa_i
-         WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nconv_i_thd  = ', nconv_i_thd
-         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        maxer_i_thd  = ', maxer_i_thd
-         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     thcon_i_swi  = ', thcon_i_swi
+         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          rn_betas     = ', rn_betas
+         WRITE(numout,*)'      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i
+         WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nn_conv_dif  = ', nn_conv_dif
+         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        rn_terr_dif  = ', rn_terr_dif
+         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     nn_ice_thcon = ', nn_ice_thcon
          WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i
+         WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat
+         WRITE(numout,*)'      iterate the surface non-solar flux (T) or not (F)       ln_it_qnsice = ', ln_it_qnsice
       ENDIF
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 5901)
@@ -20,5 +20,4 @@
    USE sbc_oce        ! Surface boundary condition: ocean fields
    USE ice            ! LIM variables
-   USE par_ice        ! LIM parameters
    USE thd_ice        ! LIM thermodynamics
    USE in_out_manager ! I/O manager
@@ -30,5 +29,10 @@
    PRIVATE
 
-   PUBLIC   lim_thd_dh   ! called by lim_thd
+   PUBLIC   lim_thd_dh      ! called by lim_thd
+   PUBLIC   lim_thd_snwblow ! called in sbcblk/sbcclio/sbccpl and here
+
+   INTERFACE lim_thd_snwblow
+      MODULE PROCEDURE lim_thd_snwblow_1d, lim_thd_snwblow_2d
+   END INTERFACE
 
    !!----------------------------------------------------------------------
@@ -70,8 +74,7 @@
 
       REAL(wp) ::   ztmelts             ! local scalar
-      REAL(wp) ::   zdh, zfdum  !
+      REAL(wp) ::   zfdum       
       REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment
-      REAL(wp) ::   zcoeff       ! dummy argument for snowfall partitioning over ice and leads
-      REAL(wp) ::   zs_snic  ! snow-ice salinity
+      REAL(wp) ::   zs_snic      ! snow-ice salinity
       REAL(wp) ::   zswi1        ! switch for computation of bottom salinity
       REAL(wp) ::   zswi12       ! switch for computation of bottom salinity
@@ -87,12 +90,9 @@
       REAL(wp) ::   zsstK        ! SST in Kelvin
 
-      REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness
       REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow                       (J.m-3)
       REAL(wp), POINTER, DIMENSION(:) ::   zq_su       ! heat for surface ablation                   (J.m-2)
       REAL(wp), POINTER, DIMENSION(:) ::   zq_bo       ! heat for bottom ablation                    (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zq_1cat     ! corrected heat in case 1-cat and hmelt>15cm (J.m-2)
       REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt     ! Heat budget to determine melting or freezing(W.m-2)
-      INTEGER , POINTER, DIMENSION(:) ::   icount      ! number of layers vanished by melting 
+      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2)
 
       REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel   ! snow melt 
@@ -102,11 +102,12 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah
       REAL(wp), POINTER, DIMENSION(:,:) ::   zh_i      ! ice layer thickness
+      INTEGER , POINTER, DIMENSION(:,:) ::   icount    ! number of layers vanished by melting 
 
       REAL(wp), POINTER, DIMENSION(:) ::   zqh_i       ! total ice heat content  (J.m-2)
       REAL(wp), POINTER, DIMENSION(:) ::   zqh_s       ! total snow heat content (J.m-2)
       REAL(wp), POINTER, DIMENSION(:) ::   zq_s        ! total snow enthalpy     (J.m-3)
-
-      ! mass and salt flux (clem)
-      REAL(wp) :: zdvres, zswitch_sal
+      REAL(wp), POINTER, DIMENSION(:) ::   zsnw        ! distribution of snow after wind blowing
+
+      REAL(wp) :: zswitch_sal
 
       ! Heat conservation 
@@ -115,31 +116,31 @@
       !!------------------------------------------------------------------
 
-      ! Discriminate between varying salinity (num_sal=2) and prescribed cases (other values)
-      SELECT CASE( num_sal )                       ! varying salinity or not
+      ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values)
+      SELECT CASE( nn_icesal )                       ! varying salinity or not
          CASE( 1, 3, 4 ) ;   zswitch_sal = 0       ! prescribed salinity profile
          CASE( 2 )       ;   zswitch_sal = 1       ! varying salinity profile
       END SELECT
 
-      CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema )
+      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw )
       CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s )
-      CALL wrk_alloc( jpij, nlay_i+1, zdeltah, zh_i )
-      CALL wrk_alloc( jpij, icount )
-      
+      CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i )
+      CALL wrk_alloc( jpij, nlay_i, icount )
+       
       dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp
       dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp   
- 
-      zqprec (:) = 0._wp ; zq_su  (:) = 0._wp ; zq_bo  (:) = 0._wp ; zf_tt  (:) = 0._wp
-      zq_1cat(:) = 0._wp ; zq_rema(:) = 0._wp
-
-      zh_s     (:) = 0._wp       
-      zdh_s_pre(:) = 0._wp
-      zdh_s_mel(:) = 0._wp
-      zdh_s_sub(:) = 0._wp
-      zqh_s    (:) = 0._wp      
-      zqh_i    (:) = 0._wp   
-
-      zh_i      (:,:) = 0._wp       
-      zdeltah   (:,:) = 0._wp       
-      icount    (:)   = 0
+
+      zqprec   (:) = 0._wp ; zq_su    (:) = 0._wp ; zq_bo    (:) = 0._wp ; zf_tt(:) = 0._wp
+      zq_rema  (:) = 0._wp ; zsnw     (:) = 0._wp
+      zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zqh_i(:) = 0._wp
+      zqh_s    (:) = 0._wp ; zq_s     (:) = 0._wp     
+
+      zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp       
+      icount (:,:) = 0
+
+
+      ! Initialize enthalpy at nlay_i+1
+      DO ji = kideb, kiut
+         q_i_1d(ji,nlay_i+1) = 0._wp
+      END DO
 
       ! initialize layer thicknesses and enthalpies
@@ -148,5 +149,5 @@
       DO jk = 1, nlay_i
          DO ji = kideb, kiut
-            h_i_old (ji,jk) = ht_i_1d(ji) / REAL( nlay_i )
+            h_i_old (ji,jk) = ht_i_1d(ji) * r1_nlay_i
             qh_i_old(ji,jk) = q_i_1d(ji,jk) * h_i_old(ji,jk)
          ENDDO
@@ -158,11 +159,8 @@
       !
       DO ji = kideb, kiut
-         rswitch       = 1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )
-         ztmelts       = rswitch * rtt + ( 1._wp - rswitch ) * rtt
-
          zfdum      = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
          zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 
 
-         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - ztmelts ) )
+         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) )
          zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice )
       END DO
@@ -174,5 +172,5 @@
       !------------------------------------------------------------------------------!
       DO ji = kideb, kiut
-         IF( t_s_1d(ji,1) > rtt ) THEN !!! Internal melting
+         IF( t_s_1d(ji,1) > rt0 ) THEN !!! Internal melting
             ! Contribution to heat flux to the ocean [W.m-2], < 0  
             hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_1d(ji,1) * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice
@@ -182,5 +180,5 @@
             ht_s_1d(ji)   = 0._wp
             q_s_1d (ji,1) = 0._wp
-            t_s_1d (ji,1) = rtt
+            t_s_1d (ji,1) = rt0
          END IF
       END DO
@@ -190,11 +188,7 @@
       !------------------------------------------------------------!
       !
-      DO ji = kideb, kiut     
-         zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s )
-      END DO
-      !
       DO jk = 1, nlay_s
          DO ji = kideb, kiut
-            zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * zh_s(ji)
+            zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * ht_s_1d(ji) * r1_nlay_s
          END DO
       END DO
@@ -202,5 +196,5 @@
       DO jk = 1, nlay_i
          DO ji = kideb, kiut
-            zh_i(ji,jk) = ht_i_1d(ji) / REAL( nlay_i )
+            zh_i(ji,jk) = ht_i_1d(ji) * r1_nlay_i
             zqh_i(ji)   = zqh_i(ji) + q_i_1d(ji,jk) * zh_i(ji,jk)
          END DO
@@ -225,4 +219,7 @@
       ! Martin Vancoppenolle, December 2006
 
+      CALL lim_thd_snwblow( 1. - at_i_1d(kideb:kiut), zsnw(kideb:kiut) ) ! snow distribution over ice after wind blowing
+
+      zdeltah(:,:) = 0._wp
       DO ji = kideb, kiut
          !-----------
@@ -230,8 +227,7 @@
          !-----------
          ! thickness change
-         zcoeff = ( 1._wp - ( 1._wp - at_i_1d(ji) )**betas ) / at_i_1d(ji) 
-         zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice / rhosn
-         ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K)
-         zqprec   (ji) = rhosn * ( cpic * ( rtt - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus )   
+         zdh_s_pre(ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhosn / at_i_1d(ji)
+         ! enthalpy of the precip (>0, J.m-3)
+         zqprec   (ji) = - qprec_ice_1d(ji)   
          IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp
          ! heat flux from snow precip (>0, W.m-2)
@@ -239,6 +235,4 @@
          ! mass flux, <0
          wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice
-         ! update thickness
-         ht_s_1d    (ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) )
 
          !---------------------
@@ -246,30 +240,28 @@
          !---------------------
          ! thickness change
-         IF( zdh_s_pre(ji) > 0._wp ) THEN
-         rswitch        = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zqprec(ji) + epsi20 ) )
-         zdh_s_mel (ji) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )
-         zdh_s_mel (ji) = MAX( - zdh_s_pre(ji), zdh_s_mel(ji) ) ! bound melting 
+         rswitch        = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) )
+         zdeltah (ji,1) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )
+         zdeltah (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) ) ! bound melting 
          ! heat used to melt snow (W.m-2, >0)
-         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdh_s_mel(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
+         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
          ! snow melting only = water into the ocean (then without snow precip), >0
-         wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_mel(ji) * r1_rdtice
-         
-         ! updates available heat + thickness
-         zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) )      
-         ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_mel(ji) )
-         zh_s  (ji) = ht_s_1d(ji) / REAL( nlay_s )
-
-         ENDIF
-      END DO
-
-      ! If heat still available, then melt more snow
-      zdeltah(:,:) = 0._wp ! important
+         wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice    
+         ! updates available heat + precipitations after melting
+         zq_su     (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,1) * zqprec(ji) )      
+         zdh_s_pre (ji) = zdh_s_pre(ji) + zdeltah(ji,1)
+
+         ! update thickness
+         ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) )
+      END DO
+
+      ! If heat still available (zq_su > 0), then melt more snow
+      zdeltah(:,:) = 0._wp
       DO jk = 1, nlay_s
          DO ji = kideb, kiut
             ! thickness change
             rswitch          = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) ) 
-            rswitch          = rswitch * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - q_s_1d(ji,jk) + epsi20 ) ) ) 
+            rswitch          = rswitch * ( MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,jk) - epsi20 ) ) ) 
             zdeltah  (ji,jk) = - rswitch * zq_su(ji) / MAX( q_s_1d(ji,jk), epsi20 )
-            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) ! bound melting
+            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - ht_s_1d(ji) ) ! bound melting
             zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk)    
             ! heat used to melt snow(W.m-2, >0)
@@ -277,9 +269,7 @@
             ! snow melting only = water into the ocean (then without snow precip)
             wfx_snw_1d(ji)   = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
-
             ! updates available heat + thickness
-            zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) )
+            zq_su (ji)  = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) )
             ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) )
-
          END DO
       END DO
@@ -289,31 +279,29 @@
       !----------------------
       ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates
-      ! clem comment: not counted in mass exchange in limsbc since this is an exchange with atm. (not ocean)
+      ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean)
       ! clem comment: ice should also sublimate
-      IF( lk_cpl ) THEN
-         ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice)
-         zdh_s_sub(:)      =  0._wp 
-      ELSE
-         ! forced  mode: snow thickness change due to sublimation
-         DO ji = kideb, kiut
-            zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice )
-            ! Heat flux by sublimation [W.m-2], < 0
-            !      sublimate first snow that had fallen, then pre-existing snow
-            zcoeff         =      ( MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) )   * zqprec(ji) +   &
-               &  ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_1d(ji,1) )  &
-               &  * a_i_1d(ji) * r1_rdtice
-            hfx_sub_1d(ji) = hfx_sub_1d(ji) + zcoeff
-            ! Mass flux by sublimation
-            wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice
-            ! new snow thickness
-            ht_s_1d(ji)     =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) )
-         END DO
-      ENDIF
-
+      zdeltah(:,:) = 0._wp
+      ! coupled mode: sublimation is set to 0 (evap_ice = 0) until further notice
+      ! forced  mode: snow thickness change due to sublimation
+      DO ji = kideb, kiut
+         zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice )
+         ! Heat flux by sublimation [W.m-2], < 0
+         !      sublimate first snow that had fallen, then pre-existing snow
+         zdeltah(ji,1)  = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) )
+         hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1)  &
+            &                              ) * a_i_1d(ji) * r1_rdtice
+         ! Mass flux by sublimation
+         wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice
+         ! new snow thickness
+         ht_s_1d(ji)    =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) )
+         ! update precipitations after sublimation and correct sublimation
+         zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1)
+         zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1)
+      END DO
+      
       ! --- Update snow diags --- !
       DO ji = kideb, kiut
-         dh_s_tot(ji)   = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji)
-         zh_s(ji)       = ht_s_1d(ji) / REAL( nlay_s )
-      END DO ! ji
+         dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji)
+      END DO
 
       !-------------------------------------------
@@ -324,8 +312,8 @@
       DO jk = 1, nlay_s
          DO ji = kideb,kiut
-            rswitch       =  MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) + epsi20 )  )
-            q_s_1d(ji,jk) = ( 1._wp - rswitch ) / MAX( ht_s_1d(ji), epsi20 ) *             &
-              &            ( (   MAX( 0._wp, dh_s_tot(ji) )              ) * zqprec(ji) +  &
-              &              ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_1d(ji) ) * rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus ) )
+            rswitch       = MAX(  0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 )  )
+            q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) *                          &
+              &            ( (   zdh_s_pre(ji)             ) * zqprec(ji) +  &
+              &              (   ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) )
             zq_s(ji)     =  zq_s(ji) + q_s_1d(ji,jk)
          END DO
@@ -337,45 +325,68 @@
       zdeltah(:,:) = 0._wp ! important
       DO jk = 1, nlay_i
-         DO ji = kideb, kiut 
-            zEi            = - q_i_1d(ji,jk) / rhoic                ! Specific enthalpy of layer k [J/kg, <0]
-
-            ztmelts        = - tmut * s_i_1d(ji,jk) + rtt           ! Melting point of layer k [K]
-
-            zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0]
-
-            zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0
-
-            zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0]
-
-            zdeltah(ji,jk) = - zfmdt / rhoic                       ! Melt of layer jk [m, <0]
-
-            zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0]
-
-            zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat
-
-            dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt
-
-            zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0]
-
-            zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0]
-
-            ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
-            sfx_sum_1d(ji)   = sfx_sum_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
-
-            ! Contribution to heat flux [W.m-2], < 0
-            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
-
-            ! Total heat flux used in this process [W.m-2], > 0  
-            hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
-
-            ! Contribution to mass flux
-            wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
-           
+         DO ji = kideb, kiut
+            ztmelts           = - tmut * s_i_1d(ji,jk) + rt0          ! Melting point of layer k [K]
+            
+            IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting
+
+               zEi            = - q_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]       
+               zdE            = 0._wp                                 ! Specific enthalpy difference   (J/kg, <0)
+                                                                      ! set up at 0 since no energy is needed to melt water...(it is already melted)
+               zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing     
+                                                                      ! this should normally not happen, but sometimes, heat diffusion leads to this
+               zfmdt          = - zdeltah(ji,jk) * rhoic              ! Mass flux x time step > 0
+                         
+               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt
+               
+               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0]
+
+               ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 
+               hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice
+               
+               ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
+               
+               ! Contribution to mass flux
+               wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+
+            ELSE                                !!! Surface melting
+               
+               zEi            = - q_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]
+               zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0]
+               zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0
+               
+               zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0]
+               
+               zdeltah(ji,jk) = - zfmdt * r1_rhoic                    ! Melt of layer jk [m, <0]
+               
+               zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0]
+               
+               zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat
+               
+               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt
+               
+               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0]
+               
+               zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0]
+               
+               ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
+               
+               ! Contribution to heat flux [W.m-2], < 0
+               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+               
+               ! Total heat flux used in this process [W.m-2], > 0  
+               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
+               
+               ! Contribution to mass flux
+               wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+               
+            END IF
             ! record which layers have disappeared (for bottom melting) 
             !    => icount=0 : no layer has vanished
             !    => icount=5 : 5 layers have vanished
-            rswitch     = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) 
-            icount(ji)  = icount(ji) + NINT( rswitch )
-            zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) )
+            rswitch       = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) 
+            icount(ji,jk) = NINT( rswitch )
+            zh_i(ji,jk)   = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) )
 
             ! update heat content (J.m-2) and layer thickness
@@ -408,14 +419,6 @@
       ! -> need for an iterative procedure, which converges quickly
 
-      IF ( num_sal == 2 ) THEN
-         num_iter_max = 5
-      ELSE
-         num_iter_max = 1
-      ENDIF
-
-      !clem debug. Just to be sure that enthalpy at nlay_i+1 is null
-      DO ji = kideb, kiut
-         q_i_1d(ji,nlay_i+1) = 0._wp
-      END DO
+      num_iter_max = 1
+      IF( nn_icesal == 2 ) num_iter_max = 5
 
       ! Iterative procedure
@@ -440,11 +443,11 @@
                                   + ( 1. - zswitch_sal ) * sm_i_1d(ji) 
                ! New ice growth
-               ztmelts            = - tmut * s_i_new(ji) + rtt          ! New ice melting point (K)
+               ztmelts            = - tmut * s_i_new(ji) + rt0          ! New ice melting point (K)
 
                zt_i_new           = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
                
                zEi                = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)      
-                  &               - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) )   &
-                  &               + rcp  * ( ztmelts-rtt )          
+                  &               - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) )   &
+                  &               + rcp  * ( ztmelts-rt0 )          
 
                zEw                = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
@@ -456,7 +459,7 @@
                q_i_1d(ji,nlay_i+1) = -zEi * rhoic                        ! New ice energy of melting (J/m3, >0)
                
-            ENDIF ! fc_bo_i
-         END DO ! ji
-      END DO ! iter
+            ENDIF
+         END DO
+      END DO
 
       ! Contribution to Energy and Salt Fluxes
@@ -467,11 +470,11 @@
             zfmdt          = - rhoic * dh_i_bott(ji)             ! Mass flux x time step (kg/m2, < 0)
 
-            ztmelts        = - tmut * s_i_new(ji) + rtt          ! New ice melting point (K)
+            ztmelts        = - tmut * s_i_new(ji) + rt0          ! New ice melting point (K)
             
             zt_i_new       = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
             
             zEi            = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)      
-               &               - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) )   &
-               &               + rcp  * ( ztmelts-rtt )          
+               &               - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) )   &
+               &               + rcp  * ( ztmelts-rt0 )          
             
             zEw            = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
@@ -486,5 +489,5 @@
             
             ! Contribution to salt flux, <0
-            sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_1d(ji) * zfmdt * r1_rdtice
+            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * s_i_new(ji) * r1_rdtice
 
             ! Contribution to mass flux, <0
@@ -503,23 +506,19 @@
       DO jk = nlay_i, 1, -1
          DO ji = kideb, kiut
-            IF(  zf_tt(ji)  >=  0._wp  .AND. jk > icount(ji) ) THEN   ! do not calculate where layer has already disappeared from surface melting 
-
-               ztmelts = - tmut * s_i_1d(ji,jk) + rtt  ! Melting point of layer jk (K)
+            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting 
+
+               ztmelts = - tmut * s_i_1d(ji,jk) + rt0  ! Melting point of layer jk (K)
 
                IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting
 
-                  zEi               = - q_i_1d(ji,jk) / rhoic        ! Specific enthalpy of melting ice (J/kg, <0)
-
-                  !!zEw               = rcp * ( t_i_1d(ji,jk) - rtt )  ! Specific enthalpy of meltwater at T = t_i_1d (J/kg, <0)
-
+                  zEi               = - q_i_1d(ji,jk) * r1_rhoic    ! Specific enthalpy of melting ice (J/kg, <0)
                   zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0)
                                                                     ! set up at 0 since no energy is needed to melt water...(it is already melted)
-
-                  zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing     
-                                                                   ! this should normally not happen, but sometimes, heat diffusion leads to this
+                  zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing     
+                                                                    ! this should normally not happen, but sometimes, heat diffusion leads to this
 
                   dh_i_bott (ji)    = dh_i_bott(ji) + zdeltah(ji,jk)
 
-                  zfmdt             = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0
+                  zfmdt             = - zdeltah(ji,jk) * rhoic      ! Mass flux x time step > 0
 
                   ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 
@@ -527,5 +526,5 @@
 
                   ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
-                  sfx_res_1d(ji) = sfx_res_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
+                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
                                     
                   ! Contribution to mass flux
@@ -538,35 +537,33 @@
                ELSE                               !!! Basal melting
 
-                  zEi               = - q_i_1d(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0)
-
-                  zEw               = rcp * ( ztmelts - rtt )! Specific enthalpy of meltwater (J/kg, <0)
-
-                  zdE               = zEi - zEw              ! Specific enthalpy difference   (J/kg, <0)
-
-                  zfmdt             = - zq_bo(ji) / zdE  ! Mass flux x time step (kg/m2, >0)
-
-                  zdeltah(ji,jk)    = - zfmdt / rhoic        ! Gross thickness change
-
-                  zdeltah(ji,jk)    = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change
+                  zEi             = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0)
+                  zEw             = rcp * ( ztmelts - rt0 )    ! Specific enthalpy of meltwater (J/kg, <0)
+                  zdE             = zEi - zEw                  ! Specific enthalpy difference   (J/kg, <0)
+
+                  zfmdt           = - zq_bo(ji) / zdE          ! Mass flux x time step (kg/m2, >0)
+
+                  zdeltah(ji,jk)  = - zfmdt * r1_rhoic         ! Gross thickness change
+
+                  zdeltah(ji,jk)  = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change
                   
-                  zq_bo(ji)         = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors
-
-                  dh_i_bott(ji)     = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt
-
-                  zfmdt             = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0
-
-                  zQm               = zfmdt * zEw         ! Heat exchanged with ocean
+                  zq_bo(ji)       = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors
+
+                  dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt
+
+                  zfmdt           = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0
+
+                  zQm             = zfmdt * zEw         ! Heat exchanged with ocean
 
                   ! Contribution to heat flux to the ocean [W.m-2], <0  
-                  hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+                  hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
 
                   ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
-                  sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
+                  sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoic *  a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
                   
                   ! Total heat flux used in this process [W.m-2], >0  
-                  hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
+                  hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
                   
                   ! Contribution to mass flux
-                  wfx_bom_1d(ji) =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+                  wfx_bom_1d(ji)  =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
 
                   ! update heat content (J.m-2) and layer thickness
@@ -576,31 +573,6 @@
            
             ENDIF
-         END DO ! ji
-      END DO ! jk
-
-      !------------------------------------------------------------------------------!
-      ! Excessive ablation in a 1-category model
-      !     in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15)
-      !------------------------------------------------------------------------------!
-      ! ??? keep ???
-      ! clem bug: I think this should be included above, so we would not have to 
-      !           track heat/salt/mass fluxes backwards
-!      IF( jpl == 1 ) THEN
-!         DO ji = kideb, kiut
-!            IF(  zf_tt(ji)  >=  0._wp  ) THEN
-!               zdh            = MAX( hmelt , dh_i_bott(ji) )
-!               zdvres         = zdh - dh_i_bott(ji) ! >=0
-!               dh_i_bott(ji)  = zdh
-!
-!               ! excessive energy is sent to lateral ablation
-!               rswitch = MAX( 0._wp, SIGN( 1._wp , 1._wp - at_i_1d(ji) - epsi20 ) )
-!               zq_1cat(ji) =  rswitch * rhoic * lfus * at_i_1d(ji) / MAX( 1._wp - at_i_1d(ji) , epsi20 ) * zdvres ! J.m-2 >=0
-!
-!               ! correct salt and mass fluxes
-!               sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdvres * rhoic * r1_rdtice ! this is only a raw approximation
-!               wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdvres * r1_rdtice
-!            ENDIF
-!         END DO
-!      ENDIF
+         END DO
+      END DO
 
       !-------------------------------------------
@@ -619,23 +591,22 @@
       DO ji = kideb, kiut
          zq_rema(ji)     = zq_su(ji) + zq_bo(ji) 
-!         zindh           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )   ! =1 if snow
-!         zindq           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - zq_s(ji) + epsi20 ) )
-!         zdeltah  (ji,1) = - zindh * zindq * zq_rema(ji) / MAX( zq_s(ji), epsi20 )
-!         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting
-!         zdh_s_mel(ji)   = zdh_s_mel(ji) + zdeltah(ji,1)    
-!         dh_s_tot (ji)   = dh_s_tot(ji) + zdeltah(ji,1)
-!         ht_s_1d   (ji)   = ht_s_1d(ji)   + zdeltah(ji,1)
-!        
-!         zq_rema(ji)     = zq_rema(ji) + zdeltah(ji,1) * zq_s(ji)                ! update available heat (J.m-2)
-!         ! heat used to melt snow
-!         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zq_s(ji) * r1_rdtice ! W.m-2 (>0)
-!         ! Contribution to mass flux
-!         wfx_snw_1d(ji)  =  wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice
-!    
+         rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )   ! =1 if snow
+         rswitch         = rswitch * MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,1) - epsi20 ) )
+         zdeltah  (ji,1) = - rswitch * zq_rema(ji) / MAX( q_s_1d(ji,1), epsi20 )
+         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting
+         dh_s_tot (ji)   = dh_s_tot(ji)  + zdeltah(ji,1)
+         ht_s_1d   (ji)  = ht_s_1d(ji)   + zdeltah(ji,1)
+        
+         zq_rema(ji)     = zq_rema(ji) + zdeltah(ji,1) * q_s_1d(ji,1)                ! update available heat (J.m-2)
+         ! heat used to melt snow
+         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * q_s_1d(ji,1) * r1_rdtice ! W.m-2 (>0)
+         ! Contribution to mass flux
+         wfx_snw_1d(ji)  =  wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice
+         !    
          ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
          ! Remaining heat flux (W.m-2) is sent to the ocean heat budget
-         hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_1cat(ji) + zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice
-
-         IF( ln_nicep .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)
+         hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice
+
+         IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)
       END DO
       
@@ -650,20 +621,20 @@
          dh_snowice(ji) = MAX(  0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic )  )
 
-         ht_i_1d(ji)     = ht_i_1d(ji) + dh_snowice(ji)
-         ht_s_1d(ji)     = ht_s_1d(ji) - dh_snowice(ji)
+         ht_i_1d(ji)    = ht_i_1d(ji) + dh_snowice(ji)
+         ht_s_1d(ji)    = ht_s_1d(ji) - dh_snowice(ji)
 
          ! Salinity of snow ice
          ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
-         zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji)
+         zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji)
 
          ! entrapment during snow ice formation
-         ! new salinity difference stored (to be used in limthd_ent.F90)
-         IF (  num_sal == 2  ) THEN
-            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi10 ) )
+         ! new salinity difference stored (to be used in limthd_sal.F90)
+         IF (  nn_icesal == 2  ) THEN
+            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )
             ! salinity dif due to snow-ice formation
-            dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi10 ) * rswitch     
+            dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch     
             ! salinity dif due to bottom growth 
             IF (  zf_tt(ji)  < 0._wp ) THEN
-               dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi10 ) * rswitch
+               dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch
             ENDIF
          ENDIF
@@ -691,8 +662,5 @@
          h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji)
          
-         ! Total ablation (to debug)
-         IF( ht_i_1d(ji) <= 0._wp )   a_i_1d(ji) = 0._wp
-
-      END DO !ji
+      END DO
 
       !
@@ -700,27 +668,47 @@
       ! Update temperature, energy
       !-------------------------------------------
-      !clem bug: we should take snow into account here
       DO ji = kideb, kiut
          rswitch     =  1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 
-         t_su_1d(ji) =  rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rtt
-      END DO  ! ji
+         t_su_1d(ji) =  rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rt0
+      END DO
 
       DO jk = 1, nlay_s
          DO ji = kideb,kiut
             ! mask enthalpy
-            rswitch       =  MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) )  )
-            q_s_1d(ji,jk) = ( 1.0 - rswitch ) * q_s_1d(ji,jk)
+            rswitch       = 1._wp - MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) )  )
+            q_s_1d(ji,jk) = rswitch * q_s_1d(ji,jk)
             ! recalculate t_s_1d from q_s_1d
-            t_s_1d(ji,jk) = rtt + ( 1._wp - rswitch ) * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic )
+            t_s_1d(ji,jk) = rt0 + rswitch * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic )
          END DO
       END DO
 
-      CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema )
+      ! --- ensure that a_i = 0 where ht_i = 0 ---
+      WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp
+      
+      CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw )
       CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s )
-      CALL wrk_dealloc( jpij, nlay_i+1, zdeltah, zh_i )
-      CALL wrk_dealloc( jpij, icount )
+      CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i )
+      CALL wrk_dealloc( jpij, nlay_i, icount )
       !
       !
    END SUBROUTINE lim_thd_dh
+
+
+   !!--------------------------------------------------------------------------
+   !! INTERFACE lim_thd_snwblow
+   !! ** Purpose :   Compute distribution of precip over the ice
+   !!--------------------------------------------------------------------------
+   SUBROUTINE lim_thd_snwblow_2d( pin, pout )
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pin   ! previous fraction lead ( pfrld or (1. - a_i_b) )
+      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout
+      pout = ( 1._wp - ( pin )**rn_betas )
+   END SUBROUTINE lim_thd_snwblow_2d
+
+   SUBROUTINE lim_thd_snwblow_1d( pin, pout )
+      REAL(wp), DIMENSION(:), INTENT(in   ) :: pin
+      REAL(wp), DIMENSION(:), INTENT(inout) :: pout
+      pout = ( 1._wp - ( pin )**rn_betas )
+   END SUBROUTINE lim_thd_snwblow_1d
+
    
 #else
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90	(revision 5901)
@@ -19,5 +19,4 @@
    USE phycst         ! physical constants (ocean directory) 
    USE ice            ! LIM-3 variables
-   USE par_ice        ! LIM-3 parameters
    USE thd_ice        ! LIM-3: thermodynamics
    USE in_out_manager ! I/O manager
@@ -25,5 +24,4 @@
    USE wrk_nemo       ! work arrays
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE sbc_oce, ONLY : lk_cpl
 
    IMPLICIT NONE
@@ -100,7 +98,8 @@
       INTEGER ::   nconv       ! number of iterations in iterative procedure
       INTEGER ::   minnumeqmin, maxnumeqmax
+      
       INTEGER, POINTER, DIMENSION(:) ::   numeqmin   ! reference number of top equation
       INTEGER, POINTER, DIMENSION(:) ::   numeqmax   ! reference number of bottom equation
-      INTEGER, POINTER, DIMENSION(:) ::   isnow      ! switch for presence (1) or absence (0) of snow
+      
       REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system
       REAL(wp) ::   zg1       =  2._wp        !
@@ -112,47 +111,66 @@
       REAL(wp) ::   ztmelt_i    ! ice melting temperature
       REAL(wp) ::   zerritmax   ! current maximal error on temperature 
-      REAL(wp), POINTER, DIMENSION(:) ::   ztfs        ! ice melting point
-      REAL(wp), POINTER, DIMENSION(:) ::   ztsub       ! old surface temperature (before the iterative procedure )
-      REAL(wp), POINTER, DIMENSION(:) ::   ztsubit     ! surface temperature at previous iteration
-      REAL(wp), POINTER, DIMENSION(:) ::   zh_i        ! ice layer thickness
-      REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness
-      REAL(wp), POINTER, DIMENSION(:) ::   zfsw        ! solar radiation absorbed at the surface
-      REAL(wp), POINTER, DIMENSION(:) ::   zf          ! surface flux function
-      REAL(wp), POINTER, DIMENSION(:) ::   dzf         ! derivative of the surface flux function
-      REAL(wp), POINTER, DIMENSION(:) ::   zerrit      ! current error on temperature
-      REAL(wp), POINTER, DIMENSION(:) ::   zdifcase    ! case of the equation resolution (1->4)
-      REAL(wp), POINTER, DIMENSION(:) ::   zftrice     ! solar radiation transmitted through the ice
-      REAL(wp), POINTER, DIMENSION(:) ::   zihic, zhsu
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztcond_i    ! Ice thermal conductivity
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_i    ! Radiation transmitted through the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_i    ! Radiation absorbed in the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_i    ! Kappa factor in the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztib        ! Old temperature in the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_i      ! Eta factor in the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztitemp     ! Temporary temperature in the ice to check the convergence
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zspeche_i   ! Ice specific heat
-      REAL(wp), POINTER, DIMENSION(:,:) ::   z_i         ! Vertical cotes of the layers in the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_s    ! Radiation transmited through the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_s    ! Radiation absorbed in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_s    ! Kappa factor in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_s      ! Eta factor in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztstemp     ! Temporary temperature in the snow to check the convergence
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztsb        ! Temporary temperature in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   z_s         ! Vertical cotes of the layers in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zswiterm    ! Independent term
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zswitbis    ! temporary independent term
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zdiagbis
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid     ! tridiagonal system terms
+      REAL(wp) ::   zhsu
+      
+      REAL(wp), POINTER, DIMENSION(:)     ::   isnow       ! switch for presence (1) or absence (0) of snow
+      REAL(wp), POINTER, DIMENSION(:)     ::   ztsub       ! old surface temperature (before the iterative procedure )
+      REAL(wp), POINTER, DIMENSION(:)     ::   ztsubit     ! surface temperature at previous iteration
+      REAL(wp), POINTER, DIMENSION(:)     ::   zh_i        ! ice layer thickness
+      REAL(wp), POINTER, DIMENSION(:)     ::   zh_s        ! snow layer thickness
+      REAL(wp), POINTER, DIMENSION(:)     ::   zfsw        ! solar radiation absorbed at the surface
+      REAL(wp), POINTER, DIMENSION(:)     ::   zqns_ice_b  ! solar radiation absorbed at the surface
+      REAL(wp), POINTER, DIMENSION(:)     ::   zf          ! surface flux function
+      REAL(wp), POINTER, DIMENSION(:)     ::   dzf         ! derivative of the surface flux function
+      REAL(wp), POINTER, DIMENSION(:)     ::   zerrit      ! current error on temperature
+      REAL(wp), POINTER, DIMENSION(:)     ::   zdifcase    ! case of the equation resolution (1->4)
+      REAL(wp), POINTER, DIMENSION(:)     ::   zftrice     ! solar radiation transmitted through the ice
+      REAL(wp), POINTER, DIMENSION(:)     ::   zihic
+      
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztcond_i    ! Ice thermal conductivity
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradtr_i    ! Radiation transmitted through the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradab_i    ! Radiation absorbed in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkappa_i    ! Kappa factor in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztib        ! Old temperature in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeta_i      ! Eta factor in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztitemp     ! Temporary temperature in the ice to check the convergence
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zspeche_i   ! Ice specific heat
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   z_i         ! Vertical cotes of the layers in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradtr_s    ! Radiation transmited through the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradab_s    ! Radiation absorbed in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkappa_s    ! Kappa factor in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeta_s      ! Eta factor in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztstemp     ! Temporary temperature in the snow to check the convergence
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztsb        ! Temporary temperature in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   z_s         ! Vertical cotes of the layers in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zindterm    ! 'Ind'ependent term
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zindtbis    ! Temporary 'ind'ependent term
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdiagbis    ! Temporary 'dia'gonal term
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid       ! Tridiagonal system terms
+      
       ! diag errors on heat
-      REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err
+      REAL(wp), POINTER, DIMENSION(:)     :: zdq, zq_ini, zhfx_err
+      
+      ! Mono-category
+      REAL(wp)                            :: zepsilon      ! determines thres. above which computation of G(h) is done
+      REAL(wp)                            :: zratio_s      ! dummy factor
+      REAL(wp)                            :: zratio_i      ! dummy factor
+      REAL(wp)                            :: zh_thres      ! thickness thres. for G(h) computation
+      REAL(wp)                            :: zhe           ! dummy factor
+      REAL(wp)                            :: zkimean       ! mean sea ice thermal conductivity
+      REAL(wp)                            :: zfac          ! dummy factor
+      REAL(wp)                            :: zihe          ! dummy factor
+      REAL(wp)                            :: zheshth       ! dummy factor
+      
+      REAL(wp), POINTER, DIMENSION(:)     :: zghe          ! G(he), th. conduct enhancement factor, mono-cat
+      
       !!------------------------------------------------------------------     
       ! 
-      CALL wrk_alloc( jpij, numeqmin, numeqmax, isnow )
-      CALL wrk_alloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw )
-      CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu )
-      CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0)
-      CALL wrk_alloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0)
-      CALL wrk_alloc( jpij, nlay_i+3, zswiterm, zswitbis, zdiagbis  )
-      CALL wrk_alloc( jpij, nlay_i+3, 3, ztrid )
+      CALL wrk_alloc( jpij, numeqmin, numeqmax )
+      CALL wrk_alloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )
+      CALL wrk_alloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe )
+      CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 )
+      CALL wrk_alloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 )
+      CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis  )
+      CALL wrk_alloc( jpij,nlay_i+3,3, ztrid )
 
       CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err )
@@ -161,6 +179,6 @@
       zdq(:) = 0._wp ; zq_ini(:) = 0._wp      
       DO ji = kideb, kiut
-         zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  &
-            &           SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) ) 
+         zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i +  &
+            &           SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s ) 
       END DO
 
@@ -168,13 +186,9 @@
       ! 1) Initialization                                                            !
       !------------------------------------------------------------------------------!
-      ! clem clean: replace just ztfs by rtt
       DO ji = kideb , kiut
-         ! is there snow or not
-         isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) )  )
-         ! surface temperature of fusion
-         ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt
+         isnow(ji)= 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) )  ! is there snow or not
          ! layer thickness
-         zh_i(ji) = ht_i_1d(ji) / REAL( nlay_i )
-         zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s )
+         zh_i(ji) = ht_i_1d(ji) * r1_nlay_i
+         zh_s(ji) = ht_s_1d(ji) * r1_nlay_s
       END DO
 
@@ -188,5 +202,5 @@
       DO jk = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer
          DO ji = kideb , kiut
-            z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) / REAL( nlay_s )
+            z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) * r1_nlay_s
          END DO
       END DO
@@ -194,10 +208,10 @@
       DO jk = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer
          DO ji = kideb , kiut
-            z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) / REAL( nlay_i )
+            z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) * r1_nlay_i
          END DO
       END DO
       !
       !------------------------------------------------------------------------------|
-      ! 2) Radiations                                                                |
+      ! 2) Radiation								                                 |
       !------------------------------------------------------------------------------|
       !
@@ -212,19 +226,13 @@
       ! zftrice = io.qsr_ice       is below the surface 
       ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice 
-
+      ! fr1_i0_1d = i0 for a thin ice cover, fr1_i0_2d = i0 for a thick ice cover
+      zhsu = 0.1_wp ! threshold for the computation of i0
       DO ji = kideb , kiut
          ! switches
-         isnow(ji) = NINT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )  ) 
+         isnow(ji) = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) 
          ! hs > 0, isnow = 1
-         zhsu (ji) = hnzst  ! threshold for the computation of i0
-         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu(ji) ) )     
-
-         i0(ji)    = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) )
-         !fr1_i0_1d = i0 for a thin ice surface
-         !fr1_i0_2d = i0 for a thick ice surface
-         !            a function of the cloud cover
-         !
-         !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_1d(ji)+10.0)
-         !formula used in Cice
+         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu ) )     
+
+         i0(ji)    = ( 1._wp - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) )
       END DO
 
@@ -234,7 +242,8 @@
       !-------------------------------------------------------
       DO ji = kideb , kiut
-         zfsw   (ji) =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface
-         zftrice(ji) =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer
-         dzf    (ji) = dqns_ice_1d(ji)                    ! derivative of incoming nonsolar flux 
+         zfsw   (ji)    =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface
+         zftrice(ji)    =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer
+         dzf    (ji)    = dqns_ice_1d(ji)                    ! derivative of incoming nonsolar flux 
+         zqns_ice_b(ji) = qns_ice_1d(ji)                     ! store previous qns_ice_1d value
       END DO
 
@@ -257,5 +266,5 @@
 
       DO ji = kideb, kiut           ! ice initialization
-         zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * REAL( isnow(ji) ) + zftrice(ji) * REAL( 1 - isnow(ji) )
+         zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp - isnow(ji) )
       END DO
 
@@ -263,5 +272,5 @@
          DO ji = kideb, kiut
             !                             ! radiation transmitted below the layer-th ice layer
-            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) )
+            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) )
             !                             ! radiation absorbed by the layer-th ice layer
             zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk)
@@ -273,5 +282,4 @@
       END DO
 
-      !
       !------------------------------------------------------------------------------|
       !  3) Iterative procedure begins                                               |
@@ -281,6 +289,6 @@
          ztsub  (ji) =  t_su_1d(ji)                              ! temperature at the beg of iter pr.
          ztsubit(ji) =  t_su_1d(ji)                              ! temperature at the previous iter
-         t_su_1d   (ji) =  MIN( t_su_1d(ji), ztfs(ji) - ztsu_err )  ! necessary
-         zerrit   (ji) =  1000._wp                                ! initial value of error
+         t_su_1d(ji) =  MIN( t_su_1d(ji), rt0 - ztsu_err )       ! necessary
+         zerrit (ji) =  1000._wp                                 ! initial value of error
       END DO
 
@@ -300,5 +308,5 @@
       zerritmax =  1000._wp    ! maximal value of error on all points
 
-      DO WHILE ( zerritmax > maxer_i_thd .AND. nconv < nconv_i_thd )
+      DO WHILE ( zerritmax > rn_terr_dif .AND. nconv < nn_conv_dif )
          !
          nconv = nconv + 1
@@ -308,78 +316,118 @@
          !------------------------------------------------------------------------------|
          !
-         IF( thcon_i_swi == 0 ) THEN      ! Untersteiner (1964) formula
-            DO ji = kideb , kiut
-               ztcond_i(ji,0)        = rcdic + zbeta*s_i_1d(ji,1) / MIN(-epsi10,t_i_1d(ji,1)-rtt)
-               ztcond_i(ji,0)        = MAX(ztcond_i(ji,0),zkimin)
+         IF( nn_ice_thcon == 0 ) THEN      ! Untersteiner (1964) formula
+            DO ji = kideb , kiut
+               ztcond_i(ji,0) = rcdic + zbeta * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )
+               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin )
             END DO
             DO jk = 1, nlay_i-1
                DO ji = kideb , kiut
-                  ztcond_i(ji,jk) = rcdic + zbeta*( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) /  &
-                     MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt)
-                  ztcond_i(ji,jk) = MAX(ztcond_i(ji,jk),zkimin)
+                  ztcond_i(ji,jk) = rcdic + zbeta * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) /  &
+                     MIN(-2.0_wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0)
+                  ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin )
                END DO
             END DO
          ENDIF
 
-         IF( thcon_i_swi == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T
-            DO ji = kideb , kiut
-               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1)-rtt )   &
-                  &                   - 0.011_wp * ( t_i_1d(ji,1) - rtt )  
+         IF( nn_ice_thcon == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T
+            DO ji = kideb , kiut
+               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )   &
+                  &                   - 0.011_wp * ( t_i_1d(ji,1) - rt0 )  
                ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin )
             END DO
             DO jk = 1, nlay_i-1
                DO ji = kideb , kiut
-                  ztcond_i(ji,jk) = rcdic +                                                                     & 
-                     &                 0.090_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )                          &
-                     &                 / MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt)   &
-                     &               - 0.0055_wp* ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0*rtt )  
+                  ztcond_i(ji,jk) = rcdic +                                                                       & 
+                     &                 0.09_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )                              &
+                     &                 / MIN( -2._wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0 )   &
+                     &               - 0.0055_wp * ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0 * rt0 )  
                   ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin )
                END DO
             END DO
             DO ji = kideb , kiut
-               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN(-epsi10,t_bo_1d(ji)-rtt)   &
-                  &                        - 0.011_wp * ( t_bo_1d(ji) - rtt )  
+               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji) - rt0 )   &
+                  &                        - 0.011_wp * ( t_bo_1d(ji) - rt0 )  
                ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin )
             END DO
          ENDIF
-         !
-         !------------------------------------------------------------------------------|
-         !  5) kappa factors                                                            |
-         !------------------------------------------------------------------------------|
-         !
+         
+         !
+         !------------------------------------------------------------------------------|
+         !  5) G(he) - enhancement of thermal conductivity in mono-category case        |
+         !------------------------------------------------------------------------------|
+         !
+         ! Computation of effective thermal conductivity G(h)
+         ! Used in mono-category case only to simulate an ITD implicitly
+         ! Fichefet and Morales Maqueda, JGR 1997
+
+         zghe(:) = 1._wp
+
+         SELECT CASE ( nn_monocat )
+
+         CASE (1,3) ! LIM3
+
+            zepsilon = 0.1_wp
+            zh_thres = EXP( 1._wp ) * zepsilon * 0.5_wp
+
+            DO ji = kideb, kiut
+   
+               ! Mean sea ice thermal conductivity
+               zkimean  = SUM( ztcond_i(ji,0:nlay_i) ) / REAL( nlay_i+1, wp )
+
+               ! Effective thickness he (zhe)
+               zfac     = 1._wp / ( rcdsn + zkimean )
+               zratio_s = rcdsn   * zfac
+               zratio_i = zkimean * zfac
+               zhe      = zratio_s * ht_i_1d(ji) + zratio_i * ht_s_1d(ji)
+
+               ! G(he)
+               rswitch  = MAX( 0._wp , SIGN( 1._wp , zhe - zh_thres ) )  ! =0 if zhe < zh_thres, if >
+               zghe(ji) = ( 1._wp - rswitch ) + rswitch * 0.5_wp * ( 1._wp + LOG( 2._wp * zhe / zepsilon ) )
+   
+               ! Impose G(he) < 2.
+               zghe(ji) = MIN( zghe(ji), 2._wp )
+
+            END DO
+
+         END SELECT
+
+         !
+         !------------------------------------------------------------------------------|
+         !  6) kappa factors                                                            |
+         !------------------------------------------------------------------------------|
+         !
+         !--- Snow
          DO ji = kideb, kiut
-
-            !-- Snow kappa factors
-            zkappa_s(ji,0)         = rcdsn / MAX(epsi10,zh_s(ji))
-            zkappa_s(ji,nlay_s)    = rcdsn / MAX(epsi10,zh_s(ji))
+            zfac                  =  1. / MAX( epsi10 , zh_s(ji) )
+            zkappa_s(ji,0)        = zghe(ji) * rcdsn * zfac
+            zkappa_s(ji,nlay_s)   = zghe(ji) * rcdsn * zfac
          END DO
 
          DO jk = 1, nlay_s-1
             DO ji = kideb , kiut
-               zkappa_s(ji,jk)  = 2.0 * rcdsn / &
-                  MAX(epsi10,2.0*zh_s(ji))
-            END DO
-         END DO
-
+               zkappa_s(ji,jk)    = zghe(ji) * 2.0 * rcdsn / MAX( epsi10, 2.0 * zh_s(ji) )
+            END DO
+         END DO
+
+         !--- Ice
          DO jk = 1, nlay_i-1
             DO ji = kideb , kiut
-               !-- Ice kappa factors
-               zkappa_i(ji,jk)  = 2.0*ztcond_i(ji,jk)/ &
-                  MAX(epsi10,2.0*zh_i(ji)) 
-            END DO
-         END DO
-
-         DO ji = kideb , kiut
-            zkappa_i(ji,0)        = ztcond_i(ji,0)/MAX(epsi10,zh_i(ji))
-            zkappa_i(ji,nlay_i)   = ztcond_i(ji,nlay_i) / MAX(epsi10,zh_i(ji))
-            !-- Interface
-            zkappa_s(ji,nlay_s)   = 2.0*rcdsn*ztcond_i(ji,0)/MAX(epsi10, &
-               (ztcond_i(ji,0)*zh_s(ji) + rcdsn*zh_i(ji)))
-            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s)*REAL( isnow(ji) ) &
-               + zkappa_i(ji,0)*REAL( 1 - isnow(ji) )
-         END DO
-         !
-         !------------------------------------------------------------------------------|
-         ! 6) Sea ice specific heat, eta factors                                        |
+               zkappa_i(ji,jk)    = zghe(ji) * 2.0 * ztcond_i(ji,jk) / MAX( epsi10 , 2.0 * zh_i(ji) )
+            END DO
+         END DO
+
+         !--- Snow-ice interface
+         DO ji = kideb , kiut
+            zfac                  = 1./ MAX( epsi10 , zh_i(ji) )
+            zkappa_i(ji,0)        = zghe(ji) * ztcond_i(ji,0) * zfac
+            zkappa_i(ji,nlay_i)   = zghe(ji) * ztcond_i(ji,nlay_i) * zfac
+            zkappa_s(ji,nlay_s)   = zghe(ji) * zghe(ji) * 2.0 * rcdsn * ztcond_i(ji,0) / & 
+           &                        MAX( epsi10, ( zghe(ji) * ztcond_i(ji,0) * zh_s(ji) + zghe(ji) * rcdsn * zh_i(ji) ) )
+            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) )
+         END DO
+
+         !
+         !------------------------------------------------------------------------------|
+         ! 7) Sea ice specific heat, eta factors                                        |
          !------------------------------------------------------------------------------|
          !
@@ -387,8 +435,6 @@
             DO ji = kideb , kiut
                ztitemp(ji,jk)   = t_i_1d(ji,jk)
-               zspeche_i(ji,jk) = cpic + zgamma*s_i_1d(ji,jk)/ &
-                  MAX((t_i_1d(ji,jk)-rtt)*(ztib(ji,jk)-rtt),epsi10)
-               zeta_i(ji,jk)    = rdt_ice / MAX(rhoic*zspeche_i(ji,jk)*zh_i(ji), &
-                  epsi10)
+               zspeche_i(ji,jk) = cpic + zgamma * s_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztib(ji,jk) - rt0 ), epsi10 )
+               zeta_i(ji,jk)    = rdt_ice / MAX( rhoic * zspeche_i(ji,jk) * zh_i(ji), epsi10 )
             END DO
          END DO
@@ -397,13 +443,14 @@
             DO ji = kideb , kiut
                ztstemp(ji,jk) = t_s_1d(ji,jk)
-               zeta_s(ji,jk)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10)
-            END DO
-         END DO
-         !
-         !------------------------------------------------------------------------------|
-         ! 7) surface flux computation                                                  |
-         !------------------------------------------------------------------------------|
-         !
-         IF( .NOT. lk_cpl ) THEN   !--- forced atmosphere case
+               zeta_s(ji,jk)  = rdt_ice / MAX( rhosn * cpic * zh_s(ji), epsi10 )
+            END DO
+         END DO
+
+         !
+         !------------------------------------------------------------------------------|
+         ! 8) surface flux computation                                                  |
+         !------------------------------------------------------------------------------|
+         !
+         IF ( ln_it_qnsice ) THEN 
             DO ji = kideb , kiut
                ! update of the non solar flux according to the update in T_su
@@ -415,12 +462,11 @@
          DO ji = kideb , kiut
             ! update incoming flux
-            zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation
-               + qns_ice_1d(ji)                   ! non solar total flux 
-            ! (LWup, LWdw, SH, LH)
-         END DO
-
-         !
-         !------------------------------------------------------------------------------|
-         ! 8) tridiagonal system terms                                                  |
+            zf(ji)    =          zfsw(ji)              & ! net absorbed solar radiation
+               &         + qns_ice_1d(ji)                ! non solar total flux (LWup, LWdw, SH, LH)
+         END DO
+
+         !
+         !------------------------------------------------------------------------------|
+         ! 9) tridiagonal system terms                                                  |
          !------------------------------------------------------------------------------|
          !
@@ -437,6 +483,6 @@
                ztrid(ji,numeq,2) = 0.
                ztrid(ji,numeq,3) = 0.
-               zswiterm(ji,numeq)= 0.
-               zswitbis(ji,numeq)= 0.
+               zindterm(ji,numeq)= 0.
+               zindtbis(ji,numeq)= 0.
                zdiagbis(ji,numeq)= 0.
             ENDDO
@@ -445,11 +491,9 @@
          DO numeq = nlay_s + 2, nlay_s + nlay_i 
             DO ji = kideb , kiut
-               jk              = numeq - nlay_s - 1
-               ztrid(ji,numeq,1)  =  - zeta_i(ji,jk)*zkappa_i(ji,jk-1)
-               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,jk)*(zkappa_i(ji,jk-1) + &
-                  zkappa_i(ji,jk))
-               ztrid(ji,numeq,3)  =  - zeta_i(ji,jk)*zkappa_i(ji,jk)
-               zswiterm(ji,numeq) =  ztib(ji,jk) + zeta_i(ji,jk)* &
-                  zradab_i(ji,jk)
+               jk                 = numeq - nlay_s - 1
+               ztrid(ji,numeq,1)  =  - zeta_i(ji,jk) * zkappa_i(ji,jk-1)
+               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,jk) * ( zkappa_i(ji,jk-1) + zkappa_i(ji,jk) )
+               ztrid(ji,numeq,3)  =  - zeta_i(ji,jk) * zkappa_i(ji,jk)
+               zindterm(ji,numeq) =  ztib(ji,jk) + zeta_i(ji,jk) * zradab_i(ji,jk)
             END DO
          ENDDO
@@ -459,15 +503,13 @@
             !!ice bottom term
             ztrid(ji,numeq,1)  =  - zeta_i(ji,nlay_i)*zkappa_i(ji,nlay_i-1)   
-            ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,nlay_i)*( zkappa_i(ji,nlay_i)*zg1 &
-               +  zkappa_i(ji,nlay_i-1) )
+            ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i) * zg1 + zkappa_i(ji,nlay_i-1) )
             ztrid(ji,numeq,3)  =  0.0
-            zswiterm(ji,numeq) =  ztib(ji,nlay_i) + zeta_i(ji,nlay_i)* &
-               ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 &
-               *  t_bo_1d(ji) ) 
+            zindterm(ji,numeq) =  ztib(ji,nlay_i) + zeta_i(ji,nlay_i) *  &
+               &                  ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 *  t_bo_1d(ji) ) 
          ENDDO
 
 
          DO ji = kideb , kiut
-            IF ( ht_s_1d(ji).gt.0.0 ) THEN
+            IF ( ht_s_1d(ji) > 0.0 ) THEN
                !
                !------------------------------------------------------------------------------|
@@ -477,11 +519,9 @@
                !!snow interior terms (bottom equation has the same form as the others)
                DO numeq = 3, nlay_s + 1
-                  jk =  numeq - 1
-                  ztrid(ji,numeq,1)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk-1)
-                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,jk)*( zkappa_s(ji,jk-1) + &
-                     zkappa_s(ji,jk) )
+                  jk                  =  numeq - 1
+                  ztrid(ji,numeq,1)   =  - zeta_s(ji,jk) * zkappa_s(ji,jk-1)
+                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,jk) * ( zkappa_s(ji,jk-1) + zkappa_s(ji,jk) )
                   ztrid(ji,numeq,3)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk)
-                  zswiterm(ji,numeq)  =  ztsb(ji,jk) + zeta_s(ji,jk)* &
-                     zradab_s(ji,jk)
+                  zindterm(ji,numeq)  =  ztsb(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk)
                END DO
 
@@ -489,9 +529,8 @@
                IF ( nlay_i.eq.1 ) THEN
                   ztrid(ji,nlay_s+2,3)    =  0.0
-                  zswiterm(ji,nlay_s+2)   =  zswiterm(ji,nlay_s+2) + zkappa_i(ji,1)* &
-                     t_bo_1d(ji) 
+                  zindterm(ji,nlay_s+2)   =  zindterm(ji,nlay_s+2) + zkappa_i(ji,1) * t_bo_1d(ji) 
                ENDIF
 
-               IF ( t_su_1d(ji) .LT. rtt ) THEN
+               IF ( t_su_1d(ji) < rt0 ) THEN
 
                   !------------------------------------------------------------------------------|
@@ -503,14 +542,14 @@
 
                   !!surface equation
-                  ztrid(ji,1,1) = 0.0
-                  ztrid(ji,1,2) = dzf(ji) - zg1s*zkappa_s(ji,0)
-                  ztrid(ji,1,3) = zg1s*zkappa_s(ji,0)
-                  zswiterm(ji,1) = dzf(ji)*t_su_1d(ji)   - zf(ji)
+                  ztrid(ji,1,1)  = 0.0
+                  ztrid(ji,1,2)  = dzf(ji) - zg1s * zkappa_s(ji,0)
+                  ztrid(ji,1,3)  = zg1s * zkappa_s(ji,0)
+                  zindterm(ji,1) = dzf(ji) * t_su_1d(ji) - zf(ji)
 
                   !!first layer of snow equation
-                  ztrid(ji,2,1)  =  - zkappa_s(ji,0)*zg1s*zeta_s(ji,1)
-                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1)*(zkappa_s(ji,1) + zkappa_s(ji,0)*zg1s)
+                  ztrid(ji,2,1)  =  - zkappa_s(ji,0) * zg1s * zeta_s(ji,1)
+                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s )
                   ztrid(ji,2,3)  =  - zeta_s(ji,1)* zkappa_s(ji,1)
-                  zswiterm(ji,2) =  ztsb(ji,1) + zeta_s(ji,1)*zradab_s(ji,1)
+                  zindterm(ji,2) =  ztsb(ji,1) + zeta_s(ji,1) * zradab_s(ji,1)
 
                ELSE 
@@ -526,10 +565,8 @@
                   !!first layer of snow equation
                   ztrid(ji,2,1)  =  0.0
-                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + &
-                     zkappa_s(ji,0) * zg1s )
+                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s )
                   ztrid(ji,2,3)  =  - zeta_s(ji,1)*zkappa_s(ji,1) 
-                  zswiterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) *            &
-                     ( zradab_s(ji,1) +                         &
-                     zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 
+                  zindterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) *  &
+                     &             ( zradab_s(ji,1) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 
                ENDIF
             ELSE
@@ -539,5 +576,5 @@
                !------------------------------------------------------------------------------|
                !
-               IF (t_su_1d(ji) .LT. rtt) THEN
+               IF ( t_su_1d(ji) < rt0 ) THEN
                   !
                   !------------------------------------------------------------------------------|
@@ -553,26 +590,24 @@
                   ztrid(ji,numeqmin(ji),2)   =  dzf(ji) - zkappa_i(ji,0)*zg1    
                   ztrid(ji,numeqmin(ji),3)   =  zkappa_i(ji,0)*zg1
-                  zswiterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_1d(ji) - zf(ji)
+                  zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_1d(ji) - zf(ji)
 
                   !!first layer of ice equation
                   ztrid(ji,numeqmin(ji)+1,1) =  - zkappa_i(ji,0) * zg1 * zeta_i(ji,1)
-                  ztrid(ji,numeqmin(ji)+1,2) =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) & 
-                     + zkappa_i(ji,0) * zg1 )
-                  ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1)*zkappa_i(ji,1)  
-                  zswiterm(ji,numeqmin(ji)+1)=  ztib(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)  
+                  ztrid(ji,numeqmin(ji)+1,2) =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )
+                  ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1) * zkappa_i(ji,1)  
+                  zindterm(ji,numeqmin(ji)+1)=  ztib(ji,1) + zeta_i(ji,1) * zradab_i(ji,1)  
 
                   !!case of only one layer in the ice (surface & ice equations are altered)
 
-                  IF (nlay_i.eq.1) THEN
+                  IF ( nlay_i == 1 ) THEN
                      ztrid(ji,numeqmin(ji),1)    =  0.0
-                     ztrid(ji,numeqmin(ji),2)    =  dzf(ji) - zkappa_i(ji,0)*2.0
-                     ztrid(ji,numeqmin(ji),3)    =  zkappa_i(ji,0)*2.0
-                     ztrid(ji,numeqmin(ji)+1,1)  =  -zkappa_i(ji,0)*2.0*zeta_i(ji,1)
-                     ztrid(ji,numeqmin(ji)+1,2)  =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + &
-                        zkappa_i(ji,1))
+                     ztrid(ji,numeqmin(ji),2)    =  dzf(ji) - zkappa_i(ji,0) * 2.0
+                     ztrid(ji,numeqmin(ji),3)    =  zkappa_i(ji,0) * 2.0
+                     ztrid(ji,numeqmin(ji)+1,1)  =  -zkappa_i(ji,0) * 2.0 * zeta_i(ji,1)
+                     ztrid(ji,numeqmin(ji)+1,2)  =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) )
                      ztrid(ji,numeqmin(ji)+1,3)  =  0.0
 
-                     zswiterm(ji,numeqmin(ji)+1) =  ztib(ji,1) + zeta_i(ji,1)* &
-                        ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji) )
+                     zindterm(ji,numeqmin(ji)+1) =  ztib(ji,1) + zeta_i(ji,1) *  &
+                        &                          ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) )
                   ENDIF
 
@@ -590,19 +625,16 @@
                   !!first layer of ice equation
                   ztrid(ji,numeqmin(ji),1)      =  0.0
-                  ztrid(ji,numeqmin(ji),2)      =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,1) + zkappa_i(ji,0)* &
-                     zg1)  
+                  ztrid(ji,numeqmin(ji),2)      =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )  
                   ztrid(ji,numeqmin(ji),3)      =  - zeta_i(ji,1) * zkappa_i(ji,1)
-                  zswiterm(ji,numeqmin(ji))     =  ztib(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + &
-                     zkappa_i(ji,0) * zg1 * t_su_1d(ji) ) 
+                  zindterm(ji,numeqmin(ji))     =  ztib(ji,1) + zeta_i(ji,1) *  &
+                     &                             ( zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji) ) 
 
                   !!case of only one layer in the ice (surface & ice equations are altered)
-                  IF (nlay_i.eq.1) THEN
+                  IF ( nlay_i == 1 ) THEN
                      ztrid(ji,numeqmin(ji),1)  =  0.0
-                     ztrid(ji,numeqmin(ji),2)  =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + &
-                        zkappa_i(ji,1))
+                     ztrid(ji,numeqmin(ji),2)  =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) )
                      ztrid(ji,numeqmin(ji),3)  =  0.0
-                     zswiterm(ji,numeqmin(ji)) =  ztib(ji,1) + zeta_i(ji,1)* &
-                        (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji)) &
-                        + t_su_1d(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0
+                     zindterm(ji,numeqmin(ji)) =  ztib(ji,1) + zeta_i(ji,1) * ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) )  &
+                        &                       + t_su_1d(ji) * zeta_i(ji,1) * zkappa_i(ji,0) * 2.0
                   ENDIF
 
@@ -614,5 +646,5 @@
          !
          !------------------------------------------------------------------------------|
-         ! 9) tridiagonal system solving                                                |
+         ! 10) tridiagonal system solving                                               |
          !------------------------------------------------------------------------------|
          !
@@ -626,5 +658,5 @@
 
          DO ji = kideb , kiut
-            zswitbis(ji,numeqmin(ji)) =  zswiterm(ji,numeqmin(ji))
+            zindtbis(ji,numeqmin(ji)) =  zindterm(ji,numeqmin(ji))
             zdiagbis(ji,numeqmin(ji)) =  ztrid(ji,numeqmin(ji),2)
             minnumeqmin               =  MIN(numeqmin(ji),minnumeqmin)
@@ -635,8 +667,6 @@
             DO ji = kideb , kiut
                numeq               =  min(max(numeqmin(ji)+1,jk),numeqmax(ji))
-               zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2) - ztrid(ji,numeq,1)* &
-                  ztrid(ji,numeq-1,3)/zdiagbis(ji,numeq-1)
-               zswitbis(ji,numeq)  =  zswiterm(ji,numeq) - ztrid(ji,numeq,1)* &
-                  zswitbis(ji,numeq-1)/zdiagbis(ji,numeq-1)
+               zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2)  - ztrid(ji,numeq,1) * ztrid(ji,numeq-1,3)  / zdiagbis(ji,numeq-1)
+               zindtbis(ji,numeq)  =  zindterm(ji,numeq) - ztrid(ji,numeq,1) * zindtbis(ji,numeq-1) / zdiagbis(ji,numeq-1)
             END DO
          END DO
@@ -644,12 +674,11 @@
          DO ji = kideb , kiut
             ! ice temperatures
-            t_i_1d(ji,nlay_i)    =  zswitbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji))
-         END DO
-
-         DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1
+            t_i_1d(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji)) / zdiagbis(ji,numeqmax(ji))
+         END DO
+
+         DO numeq = nlay_i + nlay_s, nlay_s + 2, -1
             DO ji = kideb , kiut
                jk    =  numeq - nlay_s - 1
-               t_i_1d(ji,jk)  =  (zswitbis(ji,numeq) - ztrid(ji,numeq,3)* &
-                  t_i_1d(ji,jk+1))/zdiagbis(ji,numeq)
+               t_i_1d(ji,jk)  =  ( zindtbis(ji,numeq) - ztrid(ji,numeq,3) * t_i_1d(ji,jk+1) ) / zdiagbis(ji,numeq)
             END DO
          END DO
@@ -657,32 +686,31 @@
          DO ji = kideb , kiut
             ! snow temperatures      
-            IF (ht_s_1d(ji).GT.0._wp) &
-               t_s_1d(ji,nlay_s)     =  (zswitbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) &
-               *  t_i_1d(ji,1))/zdiagbis(ji,nlay_s+1) &
-               *        MAX(0.0,SIGN(1.0,ht_s_1d(ji))) 
+            IF (ht_s_1d(ji) > 0._wp) &
+               t_s_1d(ji,nlay_s)     =  ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) )  &
+               &                        / zdiagbis(ji,nlay_s+1) * MAX( 0.0, SIGN( 1.0, ht_s_1d(ji) ) ) 
 
             ! surface temperature
-            isnow(ji)     = NINT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_1d(ji) )  )  )
+            isnow(ji)   = 1._wp - MAX( 0._wp , SIGN( 1._wp , -ht_s_1d(ji) ) )
             ztsubit(ji) = t_su_1d(ji)
-            IF( t_su_1d(ji) < ztfs(ji) ) &
-               t_su_1d(ji) = ( zswitbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_1d(ji,1)   &
-               &          + REAL( 1 - isnow(ji) )*t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))  
+            IF( t_su_1d(ji) < rt0 ) &
+               t_su_1d(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3) *  &
+               &             ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))  
          END DO
          !
          !--------------------------------------------------------------------------
-         !  10) Has the scheme converged ?, end of the iterative procedure         |
+         !  11) Has the scheme converged ?, end of the iterative procedure         |
          !--------------------------------------------------------------------------
          !
          ! check that nowhere it has started to melt
-         ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd
-         DO ji = kideb , kiut
-            t_su_1d(ji) =  MAX(  MIN( t_su_1d(ji) , ztfs(ji) ) , 190._wp  )
-            zerrit(ji) =  ABS( t_su_1d(ji) - ztsubit(ji) )     
+         ! zerrit(ji) is a measure of error, it has to be under terr_dif
+         DO ji = kideb , kiut
+            t_su_1d(ji) =  MAX(  MIN( t_su_1d(ji) , rt0 ) , 190._wp  )
+            zerrit(ji)  =  ABS( t_su_1d(ji) - ztsubit(ji) )     
          END DO
 
          DO jk  =  1, nlay_s
             DO ji = kideb , kiut
-               t_s_1d(ji,jk) = MAX(  MIN( t_s_1d(ji,jk), rtt ), 190._wp  )
-               zerrit(ji)      = MAX(zerrit(ji),ABS(t_s_1d(ji,jk) - ztstemp(ji,jk)))
+               t_s_1d(ji,jk) = MAX(  MIN( t_s_1d(ji,jk), rt0 ), 190._wp  )
+               zerrit(ji)    = MAX( zerrit(ji), ABS( t_s_1d(ji,jk) - ztstemp(ji,jk) ) )
             END DO
          END DO
@@ -690,7 +718,7 @@
          DO jk  =  1, nlay_i
             DO ji = kideb , kiut
-               ztmelt_i        = -tmut * s_i_1d(ji,jk) + rtt 
-               t_i_1d(ji,jk) =  MAX(MIN(t_i_1d(ji,jk),ztmelt_i), 190._wp)
-               zerrit(ji)      =  MAX(zerrit(ji),ABS(t_i_1d(ji,jk) - ztitemp(ji,jk)))
+               ztmelt_i      = -tmut * s_i_1d(ji,jk) + rt0 
+               t_i_1d(ji,jk) =  MAX( MIN( t_i_1d(ji,jk), ztmelt_i ), 190._wp )
+               zerrit(ji)    =  MAX( zerrit(ji), ABS( t_i_1d(ji,jk) - ztitemp(ji,jk) ) )
             END DO
          END DO
@@ -706,5 +734,5 @@
       END DO  ! End of the do while iterative procedure
 
-      IF( ln_nicep .AND. lwp ) THEN
+      IF( ln_icectl .AND. lwp ) THEN
          WRITE(numout,*) ' zerritmax : ', zerritmax
          WRITE(numout,*) ' nconv     : ', nconv
@@ -713,16 +741,39 @@
       !
       !-------------------------------------------------------------------------!
-      !   11) Fluxes at the interfaces                                          !
+      !   12) Fluxes at the interfaces                                          !
       !-------------------------------------------------------------------------!
       DO ji = kideb, kiut
-         ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux) 
-         IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) ) )
          !                                ! surface ice conduction flux
-         isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) )  )
-         fc_su(ji)       =  -     REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji))   &
-            &               - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_1d(ji,1) - t_su_1d(ji))
+         isnow(ji)       = 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) )
+         fc_su(ji)       =  -           isnow(ji)   * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji))   &
+            &               - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_1d(ji,1) - t_su_1d(ji))
          !                                ! bottom ice conduction flux
          fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) )
       END DO
+
+      ! --- computes sea ice energy of melting compulsory for limthd_dh --- !
+      CALL lim_thd_enmelt( kideb, kiut )
+
+      ! --- diagnose the change in non-solar flux due to surface temperature change --- !
+      IF ( ln_it_qnsice ) THEN
+         DO ji = kideb, kiut
+            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji)  - zqns_ice_b(ji) ) * a_i_1d(ji) 
+         END DO
+      END IF
+
+      ! --- diag conservation imbalance on heat diffusion - PART 2 --- !
+      DO ji = kideb, kiut
+         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i +  &
+            &                              SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s )
+         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC
+            zhfx_err(ji) = qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice 
+         ELSE                          ! case T_su = 0degC
+            zhfx_err(ji) = fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice 
+         ENDIF
+         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
+
+         ! total heat that is sent to the ocean (i.e. not used in the heat diffusion equation)
+         hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
+      END DO 
 
       !-----------------------------------------
@@ -730,55 +781,22 @@
       !-----------------------------------------
       DO ji = kideb, kiut
-         IF( t_su_1d(ji) < rtt ) THEN  ! case T_su < 0degC
+         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC
             hfx_dif_1d(ji) = hfx_dif_1d(ji)  +   &
                &            ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji)
-         ELSE                         ! case T_su = 0degC
+         ELSE                          ! case T_su = 0degC
             hfx_dif_1d(ji) = hfx_dif_1d(ji) +    &
                &             ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji)
          ENDIF
-      END DO
-
-      ! --- computes sea ice energy of melting compulsory for limthd_dh --- !
-      CALL lim_thd_enmelt( kideb, kiut )
-
-      ! --- diag conservation imbalance on heat diffusion - PART 2 --- !
-      DO ji = kideb, kiut
-         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  &
-            &                              SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) )
-         zhfx_err(ji)   = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 
-         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
-      END DO 
-
-      ! diagnose external surface (forced case) or bottom (forced case) from heat conservation
-      IF( .NOT. lk_cpl ) THEN   ! --- forced case: qns_ice and fc_su are diagnosed
-         !
-         DO ji = kideb, kiut
-            qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji)
-            fc_su     (ji) = fc_su(ji)      - zhfx_err(ji)
-         END DO
-         !
-      ELSE                      ! --- coupled case: ocean turbulent heat flux is diagnosed
-         !
-         DO ji = kideb, kiut
-            fhtur_1d  (ji) = fhtur_1d(ji)   - zhfx_err(ji)
-         END DO
-         !
-      ENDIF
-
-      ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2)
-      DO ji = kideb, kiut
-         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
-         hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_1d(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) )
-      END DO
-   
+         ! correction on the diagnosed heat flux due to non-convergence of the algorithm used to solve heat equation
+         hfx_dif_1d(ji) = hfx_dif_1d(ji) - zhfx_err(ji) * a_i_1d(ji)
+      END DO   
       !
-      CALL wrk_dealloc( jpij, numeqmin, numeqmax, isnow )
-      CALL wrk_dealloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw )
-      CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu )
-      CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i,   &
-         &              ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )
-      CALL wrk_dealloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 )
-      CALL wrk_dealloc( jpij, nlay_i+3, zswiterm, zswitbis, zdiagbis )
-      CALL wrk_dealloc( jpij, nlay_i+3, 3, ztrid )
+      CALL wrk_dealloc( jpij, numeqmin, numeqmax )
+      CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )
+      CALL wrk_dealloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe )
+      CALL wrk_dealloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )
+      CALL wrk_dealloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 )
+      CALL wrk_dealloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis )
+      CALL wrk_dealloc( jpij,nlay_i+3,3, ztrid )
       CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err )
 
@@ -801,14 +819,15 @@
       DO jk = 1, nlay_i             ! Sea ice energy of melting
          DO ji = kideb, kiut
-            ztmelts      = - tmut  * s_i_1d(ji,jk) + rtt 
-            rswitch      = MAX( 0._wp , SIGN( 1._wp , -(t_i_1d(ji,jk) - rtt) - epsi10 ) )
-            q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                                             &
-               &                   + lfus * ( 1.0 - rswitch * ( ztmelts-rtt ) / MIN( t_i_1d(ji,jk)-rtt, -epsi10 ) )   &
-               &                   - rcp  *                 ( ztmelts-rtt )  ) 
+            ztmelts      = - tmut  * s_i_1d(ji,jk) + rt0
+            t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts ) ! Force t_i_1d to be lower than melting point
+                                                          !   (sometimes dif scheme produces abnormally high temperatures)   
+            q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                           &
+               &                    + lfus * ( 1.0 - ( ztmelts-rt0 ) / ( t_i_1d(ji,jk) - rt0 ) )   &
+               &                    - rcp  *         ( ztmelts-rt0 )  ) 
          END DO
       END DO
       DO jk = 1, nlay_s             ! Snow energy of melting
          DO ji = kideb, kiut
-            q_s_1d(ji,jk) = rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus )
+            q_s_1d(ji,jk) = rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus )
          END DO
       END DO
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90	(revision 5901)
@@ -25,5 +25,4 @@
    USE sbc_oce        ! Surface boundary condition: ocean fields
    USE ice            ! LIM variables
-   USE par_ice        ! LIM parameters
    USE thd_ice        ! LIM thermodynamics
    USE limvar         ! LIM variables
@@ -87,5 +86,5 @@
 
       !--------------------------------------------------------------------------
-      !  1) Cumulative integral of old enthalpy * thicnkess and layers interfaces
+      !  1) Cumulative integral of old enthalpy * thickness and layers interfaces
       !--------------------------------------------------------------------------
       zqh_cum0(:,0:nlay_i+2) = 0._wp 
@@ -103,5 +102,5 @@
       ! new layer thickesses
       DO ji = kideb, kiut
-         zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) / REAL( nlay_i )  
+         zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) * r1_nlay_i  
       ENDDO
 
@@ -133,6 +132,6 @@
       DO jk1 = 1, nlay_i
          DO ji = kideb, kiut
-            rswitch      = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi10 ) ) 
-            qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi10 )
+            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) ) 
+            qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 )
          ENDDO
       ENDDO
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 5901)
@@ -22,5 +22,4 @@
    USE thd_ice        ! LIM thermodynamics
    USE dom_ice        ! LIM domain
-   USE par_ice        ! LIM parameters
    USE ice            ! LIM variables
    USE limtab         ! LIM 2D <==> 1D
@@ -32,4 +31,5 @@
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
    USE limthd_ent
+   USE limvar
 
    IMPLICIT NONE
@@ -106,5 +106,4 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d   ! 1-D version of a_i
       REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d   ! 1-D version of v_i
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_1d  ! 1-D version of oa_i
       REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i
 
@@ -112,4 +111,6 @@
 
       REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel                   ! relative ice / frazil velocity
+
+      REAL(wp) :: zcai = 1.4e-3_wp
       !!-----------------------------------------------------------------------!
 
@@ -117,8 +118,10 @@
       CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
       CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )
-      CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d )
-      CALL wrk_alloc( jpij,nlay_i+1,jpl, ze_i_1d )
+      CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )
+      CALL wrk_alloc( jpij,nlay_i,jpl, ze_i_1d )
       CALL wrk_alloc( jpi,jpj, zvrel )
 
+      CALL lim_var_agg(1)
+      CALL lim_var_glo2eqv
       !------------------------------------------------------------------------------|
       ! 2) Convert units for ice internal energy
@@ -129,8 +132,6 @@
                DO ji = 1, jpi
                   !Energy of melting q(S,T) [J.m-3]
-                  rswitch          = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 )  )   !0 if no ice and 1 if yes
-                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) &
-                      &   / ( area(ji,jj) * MAX( v_i(ji,jj,jl) ,  epsi10 ) ) * REAL( nlay_i, wp )
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac
+                  rswitch          = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  )   !0 if no ice
+                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl), epsi20 ) * REAL( nlay_i, wp )
                END DO
             END DO
@@ -155,7 +156,7 @@
 
       ! Default new ice thickness 
-      hicol(:,:) = hiccrit
-
-      IF( fraz_swi == 1 ) THEN
+      hicol(:,:) = rn_hnewice
+
+      IF( ln_frazil ) THEN
 
          !--------------------
@@ -166,5 +167,5 @@
          zhicrit = 0.04 ! frazil ice thickness
          ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav
-         zsqcd   = 1.0 / SQRT( 1.3 * cai ) ! 1/SQRT(airdensity*drag)
+         zsqcd   = 1.0 / SQRT( 1.3 * zcai ) ! 1/SQRT(airdensity*drag)
          zgamafr = 0.03
 
@@ -176,8 +177,8 @@
                   !-------------
                   ! C-grid wind stress components
-                  ztaux         = ( utau_ice(ji-1,jj  ) * tmu(ji-1,jj  )   &
-                     &          +   utau_ice(ji  ,jj  ) * tmu(ji  ,jj  ) ) * 0.5_wp
-                  ztauy         = ( vtau_ice(ji  ,jj-1) * tmv(ji  ,jj-1)   &
-                     &          +   vtau_ice(ji  ,jj  ) * tmv(ji  ,jj  ) ) * 0.5_wp
+                  ztaux         = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)   &
+                     &          +   utau_ice(ji  ,jj  ) * umask(ji  ,jj  ,1) ) * 0.5_wp
+                  ztauy         = ( vtau_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)   &
+                     &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp
                   ! Square root of wind stress
                   ztenagm       =  SQRT( SQRT( ztaux**2 + ztauy**2 ) )
@@ -195,6 +196,6 @@
                   ! C-grid ice velocity
                   rswitch = MAX(  0._wp, SIGN( 1._wp , at_i(ji,jj) )  )
-                  zvgx    = rswitch * ( u_ice(ji-1,jj  ) * tmu(ji-1,jj  )  + u_ice(ji,jj) * tmu(ji,jj) ) * 0.5_wp
-                  zvgy    = rswitch * ( v_ice(ji  ,jj-1) * tmv(ji  ,jj-1)  + v_ice(ji,jj) * tmv(ji,jj) ) * 0.5_wp
+                  zvgx    = rswitch * ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp
+                  zvgy    = rswitch * ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp
 
                   !-----------------------------------
@@ -222,5 +223,5 @@
                   iterate_frazil = .true.
 
-                  DO WHILE ( iter .LT. 100 .AND. iterate_frazil ) 
+                  DO WHILE ( iter < 100 .AND. iterate_frazil ) 
                      zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj)**2 - zhicrit**2 ) &
                         - hicol(ji,jj) * zhicrit * ztwogp * zvrel2
@@ -266,7 +267,7 @@
       ! debug point to follow
       jiindex_1d = 0
-      IF( ln_nicep ) THEN
-         DO ji = mi0(jiindx), mi1(jiindx)
-            DO jj = mj0(jjindx), mj1(jjindx)
+      IF( ln_icectl ) THEN
+         DO ji = mi0(iiceprt), mi1(iiceprt)
+            DO jj = mj0(jiceprt), mj1(jiceprt)
                IF ( qlead(ji,jj)  <  0._wp ) THEN
                   jiindex_1d = (jj - 1) * jpi + ji
@@ -276,5 +277,5 @@
       ENDIF
    
-      IF( ln_nicep ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac
+      IF( ln_icectl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac
 
       !------------------------------
@@ -290,10 +291,9 @@
             CALL tab_2d_1d( nbpac, za_i_1d  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) )
             CALL tab_2d_1d( nbpac, zv_i_1d  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) )
-            CALL tab_2d_1d( nbpac, zoa_i_1d (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) )
             CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) )
             DO jk = 1, nlay_i
                CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) )
-            END DO ! jk
-         END DO ! jl
+            END DO
+         END DO
 
          CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead  , jpi, jpj, npac(1:nbpac) )
@@ -320,19 +320,19 @@
          !----------------------
          DO ji = 1, nbpac
-            zh_newice(ji) = hiccrit
-         END DO
-         IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_1d(1:nbpac)
+            zh_newice(ji) = rn_hnewice
+         END DO
+         IF( ln_frazil ) zh_newice(1:nbpac) = hicol_1d(1:nbpac)
 
          !----------------------
          ! Salinity of new ice 
          !----------------------
-         SELECT CASE ( num_sal )
+         SELECT CASE ( nn_icesal )
          CASE ( 1 )                    ! Sice = constant 
-            zs_newice(1:nbpac) = bulk_sal
+            zs_newice(1:nbpac) = rn_icesal
          CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)]
             DO ji = 1, nbpac
                ii =   MOD( npac(ji) - 1 , jpi ) + 1
                ij =      ( npac(ji) - 1 ) / jpi + 1
-               zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , s_i_max , 0.5 * sss_m(ii,ij)  )
+               zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_m(ii,ij)  )
             END DO
          CASE ( 3 )                    ! Sice = F(z) [multiyear ice]
@@ -345,9 +345,9 @@
          ! We assume that new ice is formed at the seawater freezing point
          DO ji = 1, nbpac
-            ztmelts       = - tmut * zs_newice(ji) + rtt                  ! Melting point (K)
+            ztmelts       = - tmut * zs_newice(ji) + rt0                  ! Melting point (K)
             ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_1d(ji) )                             &
-               &                       + lfus * ( 1.0 - ( ztmelts - rtt ) / MIN( t_bo_1d(ji) - rtt, -epsi10 ) )   &
-               &                       - rcp  *         ( ztmelts - rtt )  )
-         END DO ! ji
+               &                       + lfus * ( 1.0 - ( ztmelts - rt0 ) / MIN( t_bo_1d(ji) - rt0, -epsi10 ) )   &
+               &                       - rcp  *         ( ztmelts - rt0 )  )
+         END DO
 
          !----------------
@@ -356,5 +356,5 @@
          DO ji = 1, nbpac
             zo_newice(ji) = 0._wp
-         END DO ! ji
+         END DO
 
          !-------------------
@@ -363,7 +363,7 @@
          DO ji = 1, nbpac
 
-            zEi           = - ze_newice(ji) / rhoic                ! specific enthalpy of forming ice [J/kg]
-
-            zEw           = rcp * ( t_bo_1d(ji) - rt0 )             ! specific enthalpy of seawater at t_bo_1d [J/kg]
+            zEi           = - ze_newice(ji) * r1_rhoic             ! specific enthalpy of forming ice [J/kg]
+
+            zEw           = rcp * ( t_bo_1d(ji) - rt0 )            ! specific enthalpy of seawater at t_bo_1d [J/kg]
                                                                    ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied) 
                                                                    
@@ -372,5 +372,5 @@
             zfmdt         = - qlead_1d(ji) / zdE                   ! Fm.dt [kg/m2] (<0) 
                                                                    ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point   
-            zv_newice(ji) = - zfmdt / rhoic
+            zv_newice(ji) = - zfmdt * r1_rhoic
 
             zQm           = zfmdt * zEw                            ! heat to the ocean >0 associated with mass flux  
@@ -387,5 +387,5 @@
             ! A fraction zfrazb of frazil ice is accreted at the ice bottom
             rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) )
-            zfrazb        = rswitch * ( TANH ( Cfrazb * ( zvrel_1d(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb
+            zfrazb        = rswitch * ( TANH ( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb
             zv_frazb(ji)  =         zfrazb   * zv_newice(ji)
             zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji)
@@ -409,6 +409,6 @@
          ! we keep the excessive volume in memory and attribute it later to bottom accretion
          DO ji = 1, nbpac
-            IF ( za_newice(ji) >  ( amax - zat_i_1d(ji) ) ) THEN
-               zda_res(ji)   = za_newice(ji) - ( amax - zat_i_1d(ji) )
+            IF ( za_newice(ji) >  ( rn_amax - zat_i_1d(ji) ) ) THEN
+               zda_res(ji)   = za_newice(ji) - ( rn_amax - zat_i_1d(ji) )
                zdv_res(ji)   = zda_res  (ji) * zh_newice(ji) 
                za_newice(ji) = za_newice(ji) - zda_res  (ji)
@@ -459,5 +459,5 @@
             DO jk = 1, nlay_i
                DO ji = 1, nbpac
-                  h_i_old (ji,jk) = zv_i_1d(ji,jl) / REAL( nlay_i )
+                  h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i
                   qh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk)
                END DO
@@ -478,14 +478,4 @@
          ENDDO
 
-         !------------
-         ! Update age 
-         !------------
-         DO jl = 1, jpl
-            DO ji = 1, nbpac
-               rswitch          = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_1d(ji,jl) + epsi20 ) )  ! 0 if no ice and 1 if yes
-               zoa_i_1d(ji,jl)  = za_b(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * rswitch   
-            END DO 
-         END DO   
-
          !-----------------
          ! Update salinity
@@ -504,5 +494,4 @@
             CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj )
             CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj )
-            CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_1d(1:nbpac,jl), jpi, jpj )
             CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj )
             DO jk = 1, nlay_i
@@ -525,6 +514,6 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  ! heat content in Joules
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ,wp ) * unit_fac ) 
+                  ! heat content in J/m2
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 
                END DO
             END DO
@@ -536,6 +525,6 @@
       CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
       CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )
-      CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d )
-      CALL wrk_dealloc( jpij,nlay_i+1,jpl, ze_i_1d )
+      CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )
+      CALL wrk_dealloc( jpij,nlay_i,jpl, ze_i_1d )
       CALL wrk_dealloc( jpi,jpj, zvrel )
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90	(revision 5901)
@@ -18,5 +18,4 @@
    USE sbc_oce        ! Surface boundary condition: ocean fields
    USE ice            ! LIM variables
-   USE par_ice        ! LIM parameters
    USE thd_ice        ! LIM thermodynamics
    USE limvar         ! LIM variables
@@ -30,5 +29,5 @@
 
    PUBLIC   lim_thd_sal        ! called by limthd module
-   PUBLIC   lim_thd_sal_init   ! called by iceini module
+   PUBLIC   lim_thd_sal_init   ! called by sbc_lim_init
 
    !!----------------------------------------------------------------------
@@ -46,7 +45,7 @@
       !!
       !! ** Method  :  3 possibilities
-      !!               -> num_sal = 1 -> Sice = cst    [ice salinity constant in both time & space] 
-      !!               -> num_sal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005]
-      !!               -> num_sal = 3 -> Sice = S(z)   [multiyear ice]
+      !!               -> nn_icesal = 1 -> Sice = cst    [ice salinity constant in both time & space] 
+      !!               -> nn_icesal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005]
+      !!               -> nn_icesal = 3 -> Sice = S(z)   [multiyear ice]
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kideb, kiut   ! thickness category index
@@ -66,10 +65,10 @@
       ! 1) Constant salinity, constant in time                                       |
       !------------------------------------------------------------------------------|
-!!gm comment: if num_sal = 1 s_i_new, s_i_1d and sm_i_1d can be set to bulk_sal one for all in the initialisation phase !!
-!!gm           ===>>>   simplification of almost all test on num_sal value
-      IF(  num_sal == 1  ) THEN
-            s_i_1d (kideb:kiut,1:nlay_i) =  bulk_sal
-            sm_i_1d(kideb:kiut)          =  bulk_sal 
-            s_i_new(kideb:kiut)          =  bulk_sal
+!!gm comment: if nn_icesal = 1 s_i_new, s_i_1d and sm_i_1d can be set to rn_icesal one for all in the initialisation phase !!
+!!gm           ===>>>   simplification of almost all test on nn_icesal value
+      IF(  nn_icesal == 1  ) THEN
+            s_i_1d (kideb:kiut,1:nlay_i) =  rn_icesal
+            sm_i_1d(kideb:kiut)          =  rn_icesal 
+            s_i_new(kideb:kiut)          =  rn_icesal
       ENDIF
 
@@ -77,5 +76,5 @@
       !  Module 2 : Constant salinity varying in time                                |
       !------------------------------------------------------------------------------|
-      IF(  num_sal == 2  ) THEN
+      IF(  nn_icesal == 2  ) THEN
 
          DO ji = kideb, kiut
@@ -83,5 +82,5 @@
             ! Switches 
             !----------
-            iflush  = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rtt )        )     ! =1 if summer 
+            iflush  = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0 )        )     ! =1 if summer 
             igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )    ! =1 if t_su < t_bo
 
@@ -90,7 +89,7 @@
             !---------------------
             ! drainage by gravity drainage
-            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - sal_G , 0._wp ) / time_G * rdt_ice 
+            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice 
             ! drainage by flushing  
-            dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_1d(ji) - sal_F , 0._wp ) / time_F * rdt_ice
+            dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice
 
             !-----------------
@@ -116,5 +115,5 @@
       !  Module 3 : Profile of salinity, constant in time                            |
       !------------------------------------------------------------------------------|
-      IF(  num_sal == 3  )   CALL lim_var_salprof1d( kideb, kiut )
+      IF(  nn_icesal == 3  )   CALL lim_var_salprof1d( kideb, kiut )
 
       !
@@ -134,6 +133,6 @@
       !!-------------------------------------------------------------------
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicesal/ num_sal, bulk_sal, sal_G, time_G, sal_F, time_F,   &
-         &                s_i_max, s_i_min, s_i_0, s_i_1
+      NAMELIST/namicesal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, rn_sal_fl, rn_time_fl,   &
+         &                rn_simax, rn_simin 
       !!-------------------------------------------------------------------
       !
@@ -151,14 +150,12 @@
          WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity '
          WRITE(numout,*) '~~~~~~~~~~~~~~~~'
-         WRITE(numout,*) ' switch for salinity num_sal        : ', num_sal
-         WRITE(numout,*) ' bulk salinity value if num_sal = 1 : ', bulk_sal
-         WRITE(numout,*) ' restoring salinity for GD          : ', sal_G
-         WRITE(numout,*) ' restoring time for GD              : ', time_G
-         WRITE(numout,*) ' restoring salinity for flushing    : ', sal_F
-         WRITE(numout,*) ' restoring time for flushing        : ', time_F
-         WRITE(numout,*) ' Maximum tolerated ice salinity     : ', s_i_max
-         WRITE(numout,*) ' Minimum tolerated ice salinity     : ', s_i_min
-         WRITE(numout,*) ' 1st salinity for salinity profile  : ', s_i_0
-         WRITE(numout,*) ' 2nd salinity for salinity profile  : ', s_i_1
+         WRITE(numout,*) '   switch for salinity nn_icesal        = ', nn_icesal
+         WRITE(numout,*) '   bulk salinity value if nn_icesal = 1 = ', rn_icesal
+         WRITE(numout,*) '   restoring salinity for GD            = ', rn_sal_gd
+         WRITE(numout,*) '   restoring time for GD                = ', rn_time_gd
+         WRITE(numout,*) '   restoring salinity for flushing      = ', rn_sal_fl
+         WRITE(numout,*) '   restoring time for flushing          = ', rn_time_fl
+         WRITE(numout,*) '   Maximum tolerated ice salinity       = ', rn_simax
+         WRITE(numout,*) '   Minimum tolerated ice salinity       = ', rn_simin
       ENDIF
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 5901)
@@ -17,9 +17,10 @@
    USE dom_oce        ! ocean domain
    USE sbc_oce        ! ocean surface boundary condition
-   USE par_ice        ! ice parameter
    USE dom_ice        ! ice domain
    USE ice            ! ice variables
    USE limadv         ! ice advection
    USE limhdf         ! ice horizontal diffusion
+   USE limvar         ! 
+   !
    USE in_out_manager ! I/O manager
    USE lbclnk         ! lateral boundary conditions -- MPP exchanges
@@ -28,12 +29,14 @@
    USE prtctl         ! Print control
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE limvar          ! clem for ice thickness correction
-   USE timing          ! Timing
+   USE timing         ! Timing
    USE limcons        ! conservation tests
+   USE limctl         ! control prints
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_trp    ! called by ice_step
+   PUBLIC   lim_trp    ! called by sbcice_lim
+
+   INTEGER  ::   ncfl                 ! number of ice time step with CFL>1/2  
 
    !! * Substitution
@@ -58,27 +61,28 @@
       !! ** action :
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! number of iteration
+      INTEGER, INTENT(in) ::   kt           ! number of iteration
       !
-      INTEGER  ::   ji, jj, jk, jl, jn      ! dummy loop indices
+      INTEGER  ::   ji, jj, jk, jl, jt      ! dummy loop indices
       INTEGER  ::   initad                  ! number of sub-timestep for the advection
       REAL(wp) ::   zcfl , zusnit           !   -      -
+      CHARACTER(len=80) ::   cltmp
       !
-      REAL(wp), POINTER, DIMENSION(:,:)      ::   zui_u, zvi_v, zsm, zs0at, zs0ow
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi
-      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   zs0e
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zviold, zvsold   ! old ice volume...
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zaiold, zhimax   ! old ice concentration and thickness
-      REAL(wp), POINTER, DIMENSION(:,:)      ::   zeiold, zesold   ! old enthalpies
-      REAL(wp) :: zdv, zda, zvi, zvs, zsmv, zes, zei
-      !
-      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+      REAL(wp), POINTER, DIMENSION(:,:)      ::   zsm
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0ice, z0snw, z0ai, z0es , z0smi , z0oi
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0opw
+      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   z0ei
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zviold, zvsold, zsmvold  ! old ice volume...
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhimax                   ! old ice thickness
+      REAL(wp), POINTER, DIMENSION(:,:)      ::   zatold, zeiold, zesold   ! old concentration, enthalpies
+      REAL(wp) ::    zdv, zvi, zvs, zsmv, zes, zei
+      REAL(wp) ::    zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
       !!---------------------------------------------------------------------
       IF( nn_timing == 1 )  CALL timing_start('limtrp')
 
-      CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold )
-      CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi )
-      CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, zs0e )
-
-      CALL wrk_alloc( jpi, jpj, jpl, zaiold, zhimax, zviold, zvsold )   ! clem
+      CALL wrk_alloc( jpi,jpj,            zsm, zatold, zeiold, zesold )
+      CALL wrk_alloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi )
+      CALL wrk_alloc( jpi,jpj,1,          z0opw )
+      CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei )
+      CALL wrk_alloc( jpi,jpj,jpl,        zhimax, zviold, zvsold, zsmvold )
 
       IF( numit == nstart .AND. lwp ) THEN
@@ -88,8 +92,9 @@
          ENDIF
          WRITE(numout,*) '~~~~~~~~~~~~'
+         ncfl = 0                ! nb of time step with CFL > 1/2
       ENDIF
+
+      zsm(:,:) = e1e2t(:,:)
       
-      zsm(:,:) = area(:,:)
-
       !                             !-------------------------------------!
       IF( ln_limdyn ) THEN          !   Advection of sea ice properties   !
@@ -97,27 +102,33 @@
 
          ! conservation test
-         IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-         ! mass and salt flux init (clem)
+         IF( ln_limdiahsb )   CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+         ! mass and salt flux init
          zviold(:,:,:)  = v_i(:,:,:)
-         zeiold(:,:)  = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) 
-         zesold(:,:)  = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) 
-
-         !--- Thickness correction init. (clem) -------------------------------
-         CALL lim_var_glo2eqv
-         zaiold(:,:,:) = a_i(:,:,:)
+         zvsold(:,:,:)  = v_s(:,:,:)
+         zsmvold(:,:,:) = smv_i(:,:,:)
+         zeiold(:,:)    = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) 
+         zesold(:,:)    = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) 
+
+         !--- Thickness correction init. -------------------------------
+         zatold(:,:) = SUM( a_i(:,:,:), dim=3 )
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
+                  ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+                  ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+               END DO
+            END DO
+         END DO
          !---------------------------------------------------------------------
-         ! Record max of the surrounding ice thicknesses for correction in limupdate
+         ! Record max of the surrounding ice thicknesses for correction
          ! in case advection creates ice too thick.
          !---------------------------------------------------------------------
-         zhimax(:,:,:) = ht_i(:,:,:)
+         zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:)
          DO jl = 1, jpl
             DO jj = 2, jpjm1
                DO ji = 2, jpim1
-                  zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) )
-                  !zhimax(ji,jj,jl) = ( ht_i(ji  ,jj  ,jl) * tmask(ji,  jj  ,1) + ht_i(ji-1,jj-1,jl) * tmask(ji-1,jj-1,1) + ht_i(ji+1,jj+1,jl) * tmask(ji+1,jj+1,1) &
-                  !     &             + ht_i(ji-1,jj  ,jl) * tmask(ji-1,jj  ,1) + ht_i(ji  ,jj-1,jl) * tmask(ji  ,jj-1,1) &
-                  !     &             + ht_i(ji+1,jj  ,jl) * tmask(ji+1,jj  ,1) + ht_i(ji  ,jj+1,jl) * tmask(ji  ,jj+1,1) &
-                  !     &             + ht_i(ji-1,jj+1,jl) * tmask(ji-1,jj+1,1) + ht_i(ji+1,jj-1,jl) * tmask(ji+1,jj-1,1) )
+                  zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) )
                END DO
             END DO
@@ -125,74 +136,80 @@
          END DO
          
+         !=============================!
+         !==      Prather scheme     ==!
+         !=============================!
+
+         ! If ice drift field is too fast, use an appropriate time step for advection.         
+         zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) )         ! CFL test for stability
+         zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) )
+         IF(lk_mpp )   CALL mpp_max( zcfl )
+
+         IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp
+         ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp
+         ENDIF
+
+         IF( zcfl > 0.5_wp .AND. lwp )   ncfl = ncfl + 1
+!!         IF( lwp ) THEN
+!!            IF( ncfl > 0 ) THEN   
+!!               WRITE(cltmp,'(i6.1)') ncfl
+!!               CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ')
+!!            ELSE
+!!            !  WRITE(numout,*) 'lim_trp : CFL criterion for ice advection is always smaller than 1/2 '
+!!            ENDIF
+!!         ENDIF
+
          !-------------------------
          ! transported fields                                        
          !-------------------------
-         ! Snow vol, ice vol, salt and age contents, area
-         zs0ow(:,:) = ato_i(:,:) * area(:,:)               ! Open water area 
-         DO jl = 1, jpl
-            zs0sn (:,:,jl)   = v_s  (:,:,jl) * area(:,:)    ! Snow volume
-            zs0ice(:,:,jl)   = v_i  (:,:,jl) * area(:,:)    ! Ice  volume
-            zs0a  (:,:,jl)   = a_i  (:,:,jl) * area(:,:)    ! Ice area
-            zs0sm (:,:,jl)   = smv_i(:,:,jl) * area(:,:)    ! Salt content
-            zs0oi (:,:,jl)   = oa_i (:,:,jl) * area(:,:)    ! Age content
-            zs0c0 (:,:,jl)   = e_s  (:,:,1,jl)              ! Snow heat content
-            zs0e  (:,:,:,jl) = e_i  (:,:,:,jl)              ! Ice  heat content
-         END DO
-
-         !--------------------------
-         ! Advection of Ice fields  (Prather scheme)                                            
-         !--------------------------
-         ! If ice drift field is too fast, use an appropriate time step for advection.         
-         ! CFL test for stability
-         zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice / e1u(:,:) )
-         zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice / e2v(:,:) ) )
-         IF(lk_mpp )   CALL mpp_max( zcfl )
-!!gm more readability:
-!         IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp
-!         ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp
-!         ENDIF
-!!gm end
-         initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) )
-         zusnit = 1.0 / REAL( initad ) 
-         IF( zcfl > 0.5 .AND. lwp )   &
-            WRITE(numout,*) 'lim_trp   : CFL violation at day ', nday, ', cfl = ', zcfl,   &
-               &                        ': the ice time stepping is split in two'
+         z0opw(:,:,1) = ato_i(:,:) * e1e2t(:,:)             ! Open water area 
+         DO jl = 1, jpl
+            z0snw (:,:,jl)  = v_s  (:,:,  jl) * e1e2t(:,:)  ! Snow volume
+            z0ice(:,:,jl)   = v_i  (:,:,  jl) * e1e2t(:,:)  ! Ice  volume
+            z0ai  (:,:,jl)  = a_i  (:,:,  jl) * e1e2t(:,:)  ! Ice area
+            z0smi (:,:,jl)  = smv_i(:,:,  jl) * e1e2t(:,:)  ! Salt content
+            z0oi (:,:,jl)   = oa_i (:,:,  jl) * e1e2t(:,:)  ! Age content
+            z0es (:,:,jl)   = e_s  (:,:,1,jl) * e1e2t(:,:)  ! Snow heat content
+            DO jk = 1, nlay_i
+               z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content
+            END DO
+         END DO
+
 
          IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==!
-            DO jn = 1,initad
-               CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area
-                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
-               CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:),   &
-                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+            DO jt = 1, initad
+               CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area
+                  &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+               CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0opw (:,:,1), sxopw(:,:),   &
+                  &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
                DO jl = 1, jpl
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
                      &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &
                      &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
                      &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &
                      &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
                      &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &
                      &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---     
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &    !--- ice age      ---     
                      &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &
                      &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations ---
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &    !--- ice concentrations ---
                      &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   & 
                      &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents ---
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   &    !--- snow heat contents ---
                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   &
                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
-                  DO jk = 1, nlay_i                                                           !--- ice heat contents ---
-                     CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                  DO jk = 1, nlay_i                                                                !--- ice heat contents ---
+                     CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
                         &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
                         &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) )
-                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
                         &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
                         &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) )
@@ -201,40 +218,39 @@
             END DO
          ELSE
-            DO jn = 1, initad
-               CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area
-                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
-               CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:),   &
-                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+            DO jt = 1, initad
+               CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area
+                  &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+               CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0opw (:,:,1), sxopw(:,:),   &
+                  &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
                DO jl = 1, jpl
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
                      &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &
                      &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
                      &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &
                      &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
                      &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &
                      &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
-
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---
                      &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &
                      &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations ---
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations ---
                      &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &
                      &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents ---
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents ---
                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   &
                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
                   DO jk = 1, nlay_i                                                           !--- ice heat contents ---
-                     CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                     CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
                         &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
                         &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) )
-                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
                         &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
                         &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) )
@@ -247,37 +263,41 @@
          ! Recover the properties from their contents
          !-------------------------------------------
-         zs0ow(:,:) = zs0ow(:,:) / area(:,:)
-         DO jl = 1, jpl
-            zs0ice(:,:,jl) = zs0ice(:,:,jl) / area(:,:)
-            zs0sn (:,:,jl) = zs0sn (:,:,jl) / area(:,:)
-            zs0sm (:,:,jl) = zs0sm (:,:,jl) / area(:,:)
-            zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:)
-            zs0a  (:,:,jl) = zs0a  (:,:,jl) / area(:,:)
-            !
+         ato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:)
+         DO jl = 1, jpl
+            v_i  (:,:,  jl) = z0ice(:,:,jl) * r1_e1e2t(:,:)
+            v_s  (:,:,  jl) = z0snw(:,:,jl) * r1_e1e2t(:,:)
+            smv_i(:,:,  jl) = z0smi(:,:,jl) * r1_e1e2t(:,:)
+            oa_i (:,:,  jl) = z0oi (:,:,jl) * r1_e1e2t(:,:)
+            a_i  (:,:,  jl) = z0ai (:,:,jl) * r1_e1e2t(:,:)
+            e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e1e2t(:,:)
+            DO jk = 1, nlay_i
+               e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:)
+            END DO
+         END DO
+
+         at_i(:,:) = a_i(:,:,1)      ! total ice fraction
+         DO jl = 2, jpl
+            at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
          END DO
 
          !------------------------------------------------------------------------------!
-         ! 4) Diffusion of Ice fields                  
+         ! Diffusion of Ice fields                  
          !------------------------------------------------------------------------------!
 
+         !
          !--------------------------------
          !  diffusion of open water area
          !--------------------------------
-         zs0at(:,:) = zs0a(:,:,1)      ! total ice fraction
-         DO jl = 2, jpl
-            zs0at(:,:) = zs0at(:,:) + zs0a(:,:,jl)
-         END DO
-         !
          !                             ! Masked eddy diffusivity coefficient at ocean U- and V-points
          DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row
             DO ji = 1 , fs_jpim1   ! vector opt.
-               pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji  ,jj) ) ) )   &
-                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj)
-               pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji,jj  ) ) ) )   &
-                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj)
+               pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji  ,jj) ) ) )   &
+                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj)
+               pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj  ) ) ) )   &
+                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj)
             END DO
          END DO
          !
-         CALL lim_hdf( zs0ow (:,:) )   ! Diffusion
+         CALL lim_hdf( ato_i (:,:) )
 
          !------------------------------------
@@ -288,93 +308,64 @@
             DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row
                DO ji = 1 , fs_jpim1   ! vector opt.
-                  pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji  ,jj,jl) ) ) )   &
-                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)
-                  pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji,jj  ,jl) ) ) )   &
-                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)
-               END DO
-            END DO
-
-            CALL lim_hdf( zs0ice (:,:,jl) )
-            CALL lim_hdf( zs0sn  (:,:,jl) )
-            CALL lim_hdf( zs0sm  (:,:,jl) )
-            CALL lim_hdf( zs0oi  (:,:,jl) )
-            CALL lim_hdf( zs0a   (:,:,jl) )
-            CALL lim_hdf( zs0c0  (:,:,jl) )
+                  pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji  ,jj,jl) ) ) )   &
+                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)
+                  pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj  ,jl) ) ) )   &
+                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)
+               END DO
+            END DO
+
+            CALL lim_hdf( v_i  (:,:,  jl) )
+            CALL lim_hdf( v_s  (:,:,  jl) )
+            CALL lim_hdf( smv_i(:,:,  jl) )
+            CALL lim_hdf( oa_i (:,:,  jl) )
+            CALL lim_hdf( a_i  (:,:,  jl) )
+            CALL lim_hdf( e_s  (:,:,1,jl) )
             DO jk = 1, nlay_i
-               CALL lim_hdf( zs0e (:,:,jk,jl) )
+               CALL lim_hdf( e_i(:,:,jk,jl) )
             END DO
          END DO
 
          !------------------------------------------------------------------------------!
-         ! 5) Update and limit ice properties after transport                           
+         ! limit ice properties after transport                           
          !------------------------------------------------------------------------------!
-
-         !--------------------------------------------------
-         ! 5.1) Recover mean values over the grid squares.
-         !--------------------------------------------------
-         zs0at(:,:) = 0._wp
+!!gm & cr   :  MAX should not be active if adv scheme is positive !
          DO jl = 1, jpl
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zs0sn (ji,jj,jl) = MAX( 0._wp, zs0sn (ji,jj,jl) )
-                  zs0ice(ji,jj,jl) = MAX( 0._wp, zs0ice(ji,jj,jl) )
-                  zs0sm (ji,jj,jl) = MAX( 0._wp, zs0sm (ji,jj,jl) )
-                  zs0oi (ji,jj,jl) = MAX( 0._wp, zs0oi (ji,jj,jl) )
-                  zs0a  (ji,jj,jl) = MAX( 0._wp, zs0a  (ji,jj,jl) )
-                  zs0c0 (ji,jj,jl) = MAX( 0._wp, zs0c0 (ji,jj,jl) )
-                  zs0at (ji,jj)    = zs0at(ji,jj) + zs0a(ji,jj,jl)
-               END DO
-            END DO
-         END DO
-
-         !---------------------------------------------------------
-         ! 5.2) Update and mask variables
-         !---------------------------------------------------------
-         DO jl = 1, jpl          
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  rswitch = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) )
-
-                  zvi  = zs0ice(ji,jj,jl)
-                  zvs  = zs0sn (ji,jj,jl)
-                  zes  = zs0c0 (ji,jj,jl)      
-                  zsmv = zs0sm (ji,jj,jl)
-                  !
-                  ! Remove very small areas
-                  v_s(ji,jj,jl)   = rswitch * zs0sn (ji,jj,jl) 
-                  v_i(ji,jj,jl)   = rswitch * zs0ice(ji,jj,jl)
-                  a_i(ji,jj,jl)   = rswitch * zs0a  (ji,jj,jl)
-                  e_s(ji,jj,1,jl) = rswitch * zs0c0 (ji,jj,jl)      
-                  ! Ice salinity and age
-                  IF(  num_sal == 2  ) THEN
-                     smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) )
-                  ENDIF
-                  oa_i(ji,jj,jl) = MAX( rswitch * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl)
-
-                 ! Update fluxes
-                  wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 
-                  wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
-                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 
-                  hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
-              END DO
-            END DO
-         END DO
-
-         DO jl = 1, jpl
+                  v_s  (ji,jj,jl)   = MAX( 0._wp, v_s  (ji,jj,jl) )
+                  v_i  (ji,jj,jl)   = MAX( 0._wp, v_i  (ji,jj,jl) )
+                  smv_i(ji,jj,jl)   = MAX( 0._wp, smv_i(ji,jj,jl) )
+                  oa_i (ji,jj,jl)   = MAX( 0._wp, oa_i (ji,jj,jl) )
+                  a_i  (ji,jj,jl)   = MAX( 0._wp, a_i  (ji,jj,jl) )
+                  e_s  (ji,jj,1,jl) = MAX( 0._wp, e_s  (ji,jj,1,jl) )
+               END DO
+            END DO
+
             DO jk = 1, nlay_i
                DO jj = 1, jpj
                   DO ji = 1, jpi
-                     rswitch          = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) )
-                     zei              = zs0e(ji,jj,jk,jl)      
-                     e_i(ji,jj,jk,jl) = rswitch * MAX( 0._wp, zs0e(ji,jj,jk,jl) )
-                     ! Update fluxes
-                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
-                  END DO !ji
-               END DO ! jj
-            END DO ! jk
-         END DO ! jl
-
-         !--- Thickness correction in case too high (clem) --------------------------------------------------------
-         CALL lim_var_glo2eqv
+                     e_i(ji,jj,jk,jl) = MAX( 0._wp, e_i(ji,jj,jk,jl) )
+                  END DO
+               END DO
+            END DO
+         END DO
+!!gm & cr 
+
+         ! --- diags ---
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice
+               diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice
+
+               diag_trp_vi (ji,jj) = SUM(   v_i(ji,jj,:) -  zviold(ji,jj,:) ) * r1_rdtice
+               diag_trp_vs (ji,jj) = SUM(   v_s(ji,jj,:) -  zvsold(ji,jj,:) ) * r1_rdtice
+               diag_trp_smv(ji,jj) = SUM( smv_i(ji,jj,:) - zsmvold(ji,jj,:) ) * r1_rdtice
+            END DO
+         END DO
+
+         ! zap small areas
+         CALL lim_var_zapsmall
+
+         !--- Thickness correction in case too high --------------------------------------------------------
          DO jl = 1, jpl
             DO jj = 1, jpj
@@ -382,4 +373,9 @@
 
                   IF ( v_i(ji,jj,jl) > 0._wp ) THEN
+
+                     rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
+                     ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+                     ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+                     
                      zvi  = v_i  (ji,jj,jl)
                      zvs  = v_s  (ji,jj,jl)
@@ -387,48 +383,47 @@
                      zes  = e_s  (ji,jj,1,jl)
                      zei  = SUM( e_i(ji,jj,1:nlay_i,jl) )
-                     zdv  = v_i(ji,jj,jl) - zviold(ji,jj,jl)   
-                     !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)   
-                     
-                     rswitch = 1._wp
-                     IF ( ( zdv > 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) .AND. SUM( zaiold(ji,jj,1:jpl) ) < 0.80 ) .OR. &
-                        & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN                                          
-                        ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) )
-                        rswitch        = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) )
-                        a_i(ji,jj,jl)  = rswitch * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 )
-                     ELSE
-                        ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) )
-                        rswitch        = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) )
-                        a_i(ji,jj,jl)  = rswitch * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 )
+
+                     zdv  = v_i(ji,jj,jl) + v_s(ji,jj,jl) - zviold(ji,jj,jl) - zvsold(ji,jj,jl)  
+
+                     IF ( ( zdv >  0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. &
+                        & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN
+
+                        rswitch        = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) )
+                        a_i(ji,jj,jl)  = rswitch * ( v_i(ji,jj,jl) + v_s(ji,jj,jl) ) / MAX( zhimax(ji,jj,jl), epsi20 )
+
+                        ! small correction due to *rswitch for a_i
+                        v_i  (ji,jj,jl)        = rswitch * v_i  (ji,jj,jl)
+                        v_s  (ji,jj,jl)        = rswitch * v_s  (ji,jj,jl)
+                        smv_i(ji,jj,jl)        = rswitch * smv_i(ji,jj,jl)
+                        e_s(ji,jj,1,jl)        = rswitch * e_s(ji,jj,1,jl)
+                        e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl)
+
+                        ! Update mass fluxes
+                        wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice
+                        wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
+                        sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 
+                        hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0
+                        hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * r1_rdtice ! W.m-2 <0
+
                      ENDIF
 
-                     ! small correction due to *rswitch for a_i
-                     v_i  (ji,jj,jl) = rswitch * v_i  (ji,jj,jl)
-                     v_s  (ji,jj,jl) = rswitch * v_s  (ji,jj,jl)
-                     smv_i(ji,jj,jl) = rswitch * smv_i(ji,jj,jl)
-                     e_s(ji,jj,1,jl) = rswitch * e_s(ji,jj,1,jl)
-                     e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl)
-
-                     ! Update mass fluxes
-                     wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice
-                     wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
-                     sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 
-                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
-                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
                   ENDIF
+
                END DO
             END DO
          END DO
          ! -------------------------------------------------
-
-         ! --- diags ---
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice
-               diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice
-
-               diag_trp_vi(ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice
-               diag_trp_vs(ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice
-            END DO
-         END DO
+         
+         !--------------------------------------
+         ! Impose a_i < amax in mono-category
+         !--------------------------------------
+         !
+         IF ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) THEN ! simple conservative piling, comparable with LIM2
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  a_i(ji,jj,1)  = MIN( a_i(ji,jj,1), rn_amax )
+               END DO
+            END DO
+         ENDIF
 
          ! --- agglomerate variables -----------------
@@ -436,23 +431,19 @@
          vt_s (:,:) = 0._wp
          at_i (:,:) = 0._wp
-         !
          DO jl = 1, jpl
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  !
-                  vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume
-                  vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume
-                  at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration
-               END DO
-            END DO
-         END DO
-         ! -------------------------------------------------
-
-         ! open water
+                  vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl)
+                  vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl)
+                  at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl)
+               END DO
+            END DO
+         END DO
+
+         ! --- open water = 1 if at_i=0 --------------------------------
          DO jj = 1, jpj
             DO ji = 1, jpi
-               ! open water = 1 if at_i=0
                rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )
-               ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * zs0ow(ji,jj)
+               ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj)
             END DO
          END DO      
@@ -463,43 +454,17 @@
       ENDIF
 
-      IF(ln_ctl) THEN   ! Control print
-         CALL prt_ctl_info(' ')
-         CALL prt_ctl_info(' - Cell values : ')
-         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=area , clinfo1=' lim_trp  : cell area :')
-         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_trp  : at_i      :')
-         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_trp  : vt_i      :')
-         CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_trp  : vt_s      :')
-         DO jl = 1, jpl
-            CALL prt_ctl_info(' ')
-            CALL prt_ctl_info(' - Category : ', ivar1=jl)
-            CALL prt_ctl_info('   ~~~~~~~~~~')
-            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_trp  : a_i      : ')
-            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_trp  : ht_i     : ')
-            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_trp  : ht_s     : ')
-            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_trp  : v_i      : ')
-            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_trp  : v_s      : ')
-            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_trp  : e_s      : ')
-            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_trp  : t_su     : ')
-            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_trp  : t_snow   : ')
-            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_trp  : sm_i     : ')
-            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_trp  : smv_i    : ')
-            DO jk = 1, nlay_i
-               CALL prt_ctl_info(' ')
-               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
-               CALL prt_ctl_info('   ~~~~~~~')
-               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_trp  : t_i      : ')
-               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_trp  : e_i      : ')
-            END DO
-         END DO
-      ENDIF
+      ! -------------------------------------------------
+      ! control prints
+      ! -------------------------------------------------
+      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' )
       !
-      CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold )
-      CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi )
-      CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, zs0e )
-
-      CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zaiold, zhimax )   ! clem
+      CALL wrk_dealloc( jpi,jpj,            zsm, zatold, zeiold, zesold )
+      CALL wrk_dealloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi )
+      CALL wrk_dealloc( jpi,jpj,1,          z0opw )
+      CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei )
+      CALL wrk_dealloc( jpi,jpj,jpl,        zviold, zvsold, zhimax, zsmvold )
       !
       IF( nn_timing == 1 )  CALL timing_stop('limtrp')
+
    END SUBROUTINE lim_trp
 
@@ -512,5 +477,4 @@
    END SUBROUTINE lim_trp
 #endif
-
    !!======================================================================
 END MODULE limtrp
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90	(revision 5901)
@@ -5,5 +5,5 @@
    !!======================================================================
    !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code
-   !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
+   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -13,40 +13,25 @@
    !!    lim_update1   : computes update of sea-ice global variables from trend terms
    !!----------------------------------------------------------------------
-   USE limrhg          ! ice rheology
-
-   USE dom_oce
-   USE oce             ! dynamics and tracers variables
-   USE in_out_manager
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice fields
    USE dom_ice
+   USE dom_oce
    USE phycst          ! physical constants
    USE ice
-   USE limdyn
-   USE limtrp
-   USE limthd
-   USE limsbc
-   USE limdiahsb
-   USE limwri
-   USE limrst
    USE thd_ice         ! LIM thermodynamic sea-ice variables
-   USE par_ice
    USE limitd_th
-   USE limitd_me
    USE limvar
-   USE prtctl           ! Print control
-   USE lbclnk           ! lateral boundary condition - MPP exchanges
-   USE wrk_nemo         ! work arrays
-   USE lib_fortran     ! glob_sum
-   USE in_out_manager   ! I/O manager
-   USE iom              ! I/O manager
-   USE lib_mpp          ! MPP library
+   USE prtctl          ! Print control
+   USE wrk_nemo        ! work arrays
    USE timing          ! Timing
-   USE limcons        ! conservation tests
+   USE limcons         ! conservation tests
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE in_out_manager  ! I/O manager
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_update1   ! routine called by ice_step
+   PUBLIC   lim_update1
 
    !! * Substitutions
@@ -54,10 +39,10 @@
    !!----------------------------------------------------------------------
    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE lim_update1
+   SUBROUTINE lim_update1( kt )
       !!-------------------------------------------------------------------
       !!               ***  ROUTINE lim_update1  ***
@@ -67,9 +52,8 @@
       !!                
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! number of iteration
       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      INTEGER  ::   i_ice_switch
       REAL(wp) ::   zsal
-      !
-      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
       !!-------------------------------------------------------------------
       IF( nn_timing == 1 )  CALL timing_start('limupdate1')
@@ -77,19 +61,15 @@
       IF( ln_limdyn ) THEN 
 
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*) ' lim_update1 ' 
+         WRITE(numout,*) ' ~~~~~~~~~~~ '
+      ENDIF
+
       ! conservation test
       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
-      !-----------------
-      ! zap small values
-      !-----------------
-      CALL lim_itd_me_zapsmall
-
-      CALL lim_var_glo2eqv
-     
       !----------------------------------------------------
-      ! Rebin categories with thickness out of bounds
-      !----------------------------------------------------
-      IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl)
-
+      ! ice concentration should not exceed amax 
+      !-----------------------------------------------------
       at_i(:,:) = 0._wp
       DO jl = 1, jpl
@@ -97,45 +77,26 @@
       END DO
 
-      !----------------------------------------------------
-      ! ice concentration should not exceed amax 
-      !-----------------------------------------------------
       DO jl  = 1, jpl
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-                  a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) )
-                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+               IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
+                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
                ENDIF
             END DO
          END DO
       END DO
-
-      at_i(:,:) = 0._wp
-      DO jl = 1, jpl
-         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
-      END DO
     
-      ! --------------------------------------
-      ! Final thickness distribution rebinning
-      ! --------------------------------------
-      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)
-
-      !-----------------
-      ! zap small values
-      !-----------------
-      CALL lim_itd_me_zapsmall
-
       !---------------------
       ! Ice salinity bounds
       !---------------------
-      IF (  num_sal == 2  ) THEN 
+      IF (  nn_icesal == 2  ) THEN 
          DO jl = 1, jpl
             DO jj = 1, jpj 
                DO ji = 1, jpi
                   zsal            = smv_i(ji,jj,jl)
-                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl)
                   ! salinity stays in bounds
-                  i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
-                  smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) )
+                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
+                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) )
                   ! associated salt flux
                   sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
@@ -145,26 +106,45 @@
       ENDIF
 
+      !----------------------------------------------------
+      ! Rebin categories with thickness out of bounds
+      !----------------------------------------------------
+      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)
+
+      !-----------------
+      ! zap small values
+      !-----------------
+      CALL lim_var_zapsmall
+
       ! -------------------------------------------------
       ! Diagnostics
       ! -------------------------------------------------
-      d_u_ice_dyn(:,:)     = u_ice(:,:)     - u_ice_b(:,:)
-      d_v_ice_dyn(:,:)     = v_ice(:,:)     - v_ice_b(:,:)
-      d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - a_i_b  (:,:,:)
-      d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - v_s_b  (:,:,:)  
-      d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - v_i_b  (:,:,:)   
-      d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - e_s_b  (:,:,:,:)  
-      d_e_i_trp  (:,:,1:nlay_i,:) = e_i  (:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:)
-      d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - oa_i_b (:,:,:)
-      d_smv_i_trp(:,:,:)   = 0._wp
-      IF(  num_sal == 2  ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:)
+      DO jl  = 1, jpl
+         afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi            
+            ! heat content variation (W.m-2)
+            diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  & 
+               &                   SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    &
+               &                 ) * r1_rdtice
+            ! salt, volume
+            diag_smvi(ji,jj) = SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
+            diag_vice(ji,jj) = SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice
+            diag_vsnw(ji,jj) = SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice
+         END DO
+      END DO
 
       ! conservation test
       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
+      ! -------------------------------------------------
+      ! control prints
+      ! -------------------------------------------------
       IF(ln_ctl) THEN   ! Control print
          CALL prt_ctl_info(' ')
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=area       , clinfo1=' lim_update1  : cell area   :')
+         CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' lim_update1  : cell area   :')
          CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update1  : at_i        :')
          CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update1  : vt_i        :')
@@ -172,5 +152,4 @@
          CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update1  : strength    :')
          CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update1  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :')
-         CALL prt_ctl(tab2d_1=d_u_ice_dyn, clinfo1=' lim_update1  : d_u_ice_dyn :', tab2d_2=d_v_ice_dyn, clinfo2=' d_v_ice_dyn :')
          CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update1  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :')
 
@@ -187,26 +166,18 @@
             CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update1  : a_i         : ')
             CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : a_i_b       : ')
-            CALL prt_ctl(tab2d_1=d_a_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_a_i_trp   : ')
             CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update1  : v_i         : ')
             CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_i_b       : ')
-            CALL prt_ctl(tab2d_1=d_v_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_i_trp   : ')
             CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update1  : v_s         : ')
             CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_s_b       : ')
-            CALL prt_ctl(tab2d_1=d_v_s_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_s_trp   : ')
-            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1        : ')
-            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1_b      : ')
-            CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : de_i1_trp   : ')
-            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2        : ')
-            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2_b      : ')
-            CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : de_i2_trp   : ')
+            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_i1        : ')
+            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_i1_b      : ')
+            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)      , clinfo1= ' lim_update1  : e_i2        : ')
+            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)      , clinfo1= ' lim_update1  : e_i2_b      : ')
             CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow      : ')
             CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow_b    : ')
-            CALL prt_ctl(tab2d_1=d_e_s_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : d_e_s_trp   : ')
             CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update1  : smv_i       : ')
             CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update1  : smv_i_b     : ')
-            CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl)        , clinfo1= ' lim_update1  : d_smv_i_trp : ')
             CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update1  : oa_i        : ')
             CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update1  : oa_i_b      : ')
-            CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl)        , clinfo1= ' lim_update1  : d_oa_i_trp  : ')
 
             DO jk = 1, nlay_i
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90	(revision 5901)
@@ -5,5 +5,5 @@
    !!======================================================================
    !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code
-   !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
+   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -13,32 +13,22 @@
    !!    lim_update2   : computes update of sea-ice global variables from trend terms
    !!----------------------------------------------------------------------
-   USE limrhg          ! ice rheology
-
-   USE dom_oce
-   USE oce             ! dynamics and tracers variables
-   USE in_out_manager
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice fields
    USE dom_ice
+   USE dom_oce
    USE phycst          ! physical constants
    USE ice
-   USE limdyn
-   USE limtrp
-   USE limthd
-   USE limsbc
-   USE limdiahsb
-   USE limwri
-   USE limrst
    USE thd_ice         ! LIM thermodynamic sea-ice variables
-   USE par_ice
    USE limitd_th
-   USE limitd_me
    USE limvar
-   USE prtctl           ! Print control
-   USE lbclnk           ! lateral boundary condition - MPP exchanges
-   USE wrk_nemo         ! work arrays
-   USE lib_fortran     ! glob_sum
+   USE prtctl          ! Print control
+   USE lbclnk          ! lateral boundary condition - MPP exchanges
+   USE wrk_nemo        ! work arrays
    USE timing          ! Timing
-   USE limcons        ! conservation tests
+   USE limcons         ! conservation tests
+   USE limctl
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE in_out_manager
 
    IMPLICIT NONE
@@ -51,10 +41,10 @@
    !!----------------------------------------------------------------------
    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE lim_update2
+   SUBROUTINE lim_update2( kt )
       !!-------------------------------------------------------------------
       !!               ***  ROUTINE lim_update2  ***
@@ -64,37 +54,29 @@
       !!
       !!---------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk, jl    ! dummy loop indices
-      INTEGER  ::   i_ice_switch
-      REAL(wp) ::   zh, zsal
-      !
-      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+      INTEGER, INTENT(in) ::   kt    ! number of iteration
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      REAL(wp) ::   zsal
+      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
       !!-------------------------------------------------------------------
       IF( nn_timing == 1 )  CALL timing_start('limupdate2')
 
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*) ' lim_update2 '
+         WRITE(numout,*) ' ~~~~~~~~~~~ '
+      ENDIF
+
       ! conservation test
       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
-      !-----------------
-      ! zap small values
-      !-----------------
-      CALL lim_itd_me_zapsmall
-
-      CALL lim_var_glo2eqv
-
-      !----------------------------------------------------
-      ! Rebin categories with thickness out of bounds
-      !----------------------------------------------------
-      IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl)
-
       !----------------------------------------------------------------------
-      ! Constrain the thickness of the smallest category above hiclim
+      ! Constrain the thickness of the smallest category above himin
       !----------------------------------------------------------------------
       DO jj = 1, jpj 
          DO ji = 1, jpi
-            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < hiclim ) THEN
-               zh             = hiclim / ht_i(ji,jj,1)
-               ht_s(ji,jj,1) = ht_s(ji,jj,1) * zh
-               ht_i(ji,jj,1) = ht_i(ji,jj,1) * zh
-               a_i (ji,jj,1) = a_i(ji,jj,1)  / zh
+            rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,1) - epsi20 ) )   !0 if no ice and 1 if yes
+            ht_i(ji,jj,1) = v_i (ji,jj,1) / MAX( a_i(ji,jj,1) , epsi20 ) * rswitch
+            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < rn_himin ) THEN
+               a_i (ji,jj,1) = a_i (ji,jj,1) * ht_i(ji,jj,1) / rn_himin
+               oa_i(ji,jj,1) = oa_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin
             ENDIF
          END DO
@@ -112,7 +94,7 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-                  a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) )
-                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+               IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
+                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
                ENDIF
             END DO
@@ -120,40 +102,34 @@
       END DO
 
-      at_i(:,:) = 0.0
-      DO jl = 1, jpl
-         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
-      END DO
-
-      ! --------------------------------------
-      ! Final thickness distribution rebinning
-      ! --------------------------------------
-      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl )
-
-      !-----------------
-      ! zap small values
-      !-----------------
-      CALL lim_itd_me_zapsmall
-
       !---------------------
-      ! 2.11) Ice salinity
+      ! Ice salinity
       !---------------------
-      IF (  num_sal == 2  ) THEN 
+      IF (  nn_icesal == 2  ) THEN 
          DO jl = 1, jpl
             DO jj = 1, jpj 
                DO ji = 1, jpi
                   zsal            = smv_i(ji,jj,jl)
-                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl)
                   ! salinity stays in bounds
-                  i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
-                  smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl)
+                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
+                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) )
                   ! associated salt flux
                   sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
-               END DO ! ji
-            END DO ! jj
-         END DO !jl
+               END DO
+            END DO
+         END DO
       ENDIF
 
+      !----------------------------------------------------
+      ! Rebin categories with thickness out of bounds
+      !----------------------------------------------------
+      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl )
+
+      !-----------------
+      ! zap small values
+      !-----------------
+      CALL lim_var_zapsmall
+
       !------------------------------------------------------------------------------
-      ! 2) Corrections to avoid wrong values                                        |
+      ! Corrections to avoid wrong values                                        |
       !------------------------------------------------------------------------------
       ! Ice drift
@@ -173,32 +149,41 @@
       CALL lbc_lnk( v_ice(:,:), 'V', -1. )
       !mask velocities
-      u_ice(:,:) = u_ice(:,:) * tmu(:,:)
-      v_ice(:,:) = v_ice(:,:) * tmv(:,:)
+      u_ice(:,:) = u_ice(:,:) * umask(:,:,1)
+      v_ice(:,:) = v_ice(:,:) * vmask(:,:,1)
  
       ! -------------------------------------------------
       ! Diagnostics
       ! -------------------------------------------------
-      d_a_i_thd(:,:,:)   = a_i(:,:,:)   - a_i_b(:,:,:) 
-      d_v_s_thd(:,:,:)   = v_s(:,:,:)   - v_s_b(:,:,:)
-      d_v_i_thd(:,:,:)   = v_i(:,:,:)   - v_i_b(:,:,:)  
-      d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - e_s_b(:,:,:,:) 
-      d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:)
-      !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - oa_i_b (:,:,:)
-      d_smv_i_thd(:,:,:) = 0._wp
-      IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:)
-      ! diag only (clem)
-      dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday
-
-      ! heat content variation (W.m-2)
+      DO jl  = 1, jpl
+         oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice / rday   ! ice natural aging
+         afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice
+      END DO
+      afx_tot = afx_thd + afx_dyn
+
       DO jj = 1, jpj
          DO ji = 1, jpi            
-            diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) +  & 
-               &                     SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) )    &
-               &                   ) * unit_fac * r1_rdtice / area(ji,jj)   
+            ! heat content variation (W.m-2)
+            diag_heat(ji,jj) = diag_heat(ji,jj) -  &
+               &               ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  & 
+               &                 SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    &
+               &               ) * r1_rdtice   
+            ! salt, volume
+            diag_smvi(ji,jj) = diag_smvi(ji,jj) + SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
+            diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice
+            diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice
          END DO
       END DO
 
       ! conservation test
-      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      ! necessary calls (at least for coupling)
+      CALL lim_var_glo2eqv
+      CALL lim_var_agg(2)
+
+      ! -------------------------------------------------
+      ! control prints
+      ! -------------------------------------------------
+      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' )   ! control print
 
       IF(ln_ctl) THEN   ! Control print
@@ -206,5 +191,5 @@
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=area       , clinfo1=' lim_update2  : cell area   :')
+         CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' lim_update2  : cell area   :')
          CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update2  : at_i        :')
          CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update2  : vt_i        :')
@@ -226,26 +211,18 @@
             CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update2  : a_i         : ')
             CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : a_i_b       : ')
-            CALL prt_ctl(tab2d_1=d_a_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_a_i_thd   : ')
             CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update2  : v_i         : ')
             CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_i_b       : ')
-            CALL prt_ctl(tab2d_1=d_v_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_i_thd   : ')
             CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update2  : v_s         : ')
             CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_s_b       : ')
-            CALL prt_ctl(tab2d_1=d_v_s_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_s_thd   : ')
-            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1        : ')
-            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1_b      : ')
-            CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : de_i1_thd   : ')
-            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2        : ')
-            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2_b      : ')
-            CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : de_i2_thd   : ')
+            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_i1        : ')
+            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_i1_b      : ')
+            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)      , clinfo1= ' lim_update2  : e_i2        : ')
+            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)      , clinfo1= ' lim_update2  : e_i2_b      : ')
             CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow      : ')
             CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow_b    : ')
-            CALL prt_ctl(tab2d_1=d_e_s_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : d_e_s_thd   : ')
             CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update2  : smv_i       : ')
             CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update2  : smv_i_b     : ')
-            CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl)        , clinfo1= ' lim_update2  : d_smv_i_thd : ')
             CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update2  : oa_i        : ')
             CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update2  : oa_i_b      : ')
-            CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl)        , clinfo1= ' lim_update2  : d_oa_i_thd  : ')
 
             DO jk = 1, nlay_i
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 5901)
@@ -30,5 +30,5 @@
    !!======================================================================
    !! History :   -   ! 2006-01 (M. Vancoppenolle) Original code
-   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -36,16 +36,8 @@
    !!   'key_lim3'                                      LIM3 sea-ice model
    !!----------------------------------------------------------------------
-   !!   lim_var_agg       : 
-   !!   lim_var_glo2eqv   :
-   !!   lim_var_eqv2glo   :
-   !!   lim_var_salprof   : 
-   !!   lim_var_salprof1d :
-   !!   lim_var_bv        :
-   !!----------------------------------------------------------------------
    USE par_oce        ! ocean parameters
    USE phycst         ! physical constants (ocean directory) 
    USE sbc_oce        ! Surface boundary condition: ocean fields
    USE ice            ! ice variables
-   USE par_ice        ! ice parameters
    USE thd_ice        ! ice variables (thermodynamics)
    USE dom_ice        ! ice domain
@@ -58,14 +50,16 @@
    PRIVATE
 
-   PUBLIC   lim_var_agg          !
-   PUBLIC   lim_var_glo2eqv      !
-   PUBLIC   lim_var_eqv2glo      !
-   PUBLIC   lim_var_salprof      !
-   PUBLIC   lim_var_icetm        !
-   PUBLIC   lim_var_bv           !
-   PUBLIC   lim_var_salprof1d    !
+   PUBLIC   lim_var_agg          
+   PUBLIC   lim_var_glo2eqv      
+   PUBLIC   lim_var_eqv2glo      
+   PUBLIC   lim_var_salprof      
+   PUBLIC   lim_var_icetm        
+   PUBLIC   lim_var_bv           
+   PUBLIC   lim_var_salprof1d    
+   PUBLIC   lim_var_zapsmall
+   PUBLIC   lim_var_itd
 
    !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! NEMO/LIM3 3.5 , UCL - NEMO Consortium (2011)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -129,9 +123,9 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content
-                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
-                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * rswitch   ! ice salinity
-                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
-                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi10 ) * rswitch   ! ice age
+                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                           ! snow heat content
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi20 ) ) 
+                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi20 ) * rswitch   ! ice salinity
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi20 ) ) 
+                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi20 ) * rswitch   ! ice age
                END DO
             END DO
@@ -167,18 +161,20 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes
-               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
-               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
-               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
-            END DO
-         END DO
-      END DO
-
-      IF(  num_sal == 2  )THEN
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes
+               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+            END DO
+         END DO
+      END DO
+
+      IF(  nn_icesal == 2  )THEN
          DO jl = 1, jpl
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes
-                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * rswitch
+                  rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes
+                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * rswitch
+                  !                                      ! bounding salinity
+                  sm_i(ji,jj,jl) = MAX( sm_i(ji,jj,jl), rn_simin )
                END DO
             END DO
@@ -191,24 +187,19 @@
       ! Ice temperatures
       !-------------------
-!CDIR NOVERRCHK
-      DO jl = 1, jpl
-!CDIR NOVERRCHK
+      DO jl = 1, jpl
          DO jk = 1, nlay_i
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   !                                                              ! Energy of melting q(S,T) [J.m-3]
-                  rswitch   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )     ! rswitch = 0 if no ice and 1 if yes
-                  zq_i    = rswitch * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp) 
-                  zq_i    = zq_i * unit_fac                             !convert units
-                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt                       ! Ice layer melt temperature
+                  rswitch = MAX( 0.0 , SIGN( 1.0 , v_i(ji,jj,jl) - epsi20 ) )     ! rswitch = 0 if no ice and 1 if yes
+                  zq_i    = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL(nlay_i,wp) 
+                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rt0              ! Ice layer melt temperature
                   !
                   zaaa       =  cpic                  ! Conversion q(S,T) -> T (second order equation)
-                  zbbb       =  ( rcp - cpic ) * ( ztmelts - rtt ) + zq_i / rhoic - lfus
-                  zccc       =  lfus * (ztmelts-rtt)
+                  zbbb       =  ( rcp - cpic ) * ( ztmelts - rt0 ) + zq_i * r1_rhoic - lfus
+                  zccc       =  lfus * (ztmelts-rt0)
                   zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) )
-                  t_i(ji,jj,jk,jl) = rtt + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
-                  t_i(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) )       ! 100-rtt < t_i < rtt
+                  t_i(ji,jj,jk,jl) = rt0 + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
+                  t_i(ji,jj,jk,jl) = MIN( ztmelts, MAX( rt0 - 100._wp, t_i(ji,jj,jk,jl) ) )  ! -100 < t_i < ztmelts
                END DO
             END DO
@@ -226,10 +217,9 @@
                DO ji = 1, jpi
                   !Energy of melting q(S,T) [J.m-3]
-                  rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) )     ! rswitch = 0 if no ice and 1 if yes
-                  zq_s  = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp)
-                  zq_s  = zq_s * unit_fac                                    ! convert units
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 ) )     ! rswitch = 0 if no ice and 1 if yes
+                  zq_s  = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL(nlay_s,wp)
                   !
-                  t_s(ji,jj,jk,jl) = rtt + rswitch * ( - zfac1 * zq_s + zfac2 )
-                  t_s(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15, t_s(ji,jj,jk,jl) ) )     ! 100-rtt < t_i < rtt
+                  t_s(ji,jj,jk,jl) = rt0 + rswitch * ( - zfac1 * zq_s + zfac2 )
+                  t_s(ji,jj,jk,jl) = MIN( rt0, MAX( rt0 - 100._wp , t_s(ji,jj,jk,jl) ) )     ! -100 < t_s < rt0
                END DO
             END DO
@@ -240,4 +230,9 @@
       ! Mean temperature
       !-------------------
+      vt_i (:,:) = 0._wp
+      DO jl = 1, jpl
+         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl)
+      END DO
+
       tm_i(:,:) = 0._wp
       DO jl = 1, jpl
@@ -245,11 +240,12 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  )
-                  tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   &
-                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  )
-               END DO
-            END DO
-         END DO
-      END DO
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
+                  tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  &
+                     &            / MAX( vt_i(ji,jj) , epsi10 )
+               END DO
+            END DO
+         END DO
+      END DO
+      tm_i = tm_i + rt0
       !
    END SUBROUTINE lim_var_glo2eqv
@@ -270,5 +266,4 @@
       v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:)
       smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
-      oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:)
       !
    END SUBROUTINE lim_var_eqv2glo
@@ -281,17 +276,19 @@
       !! ** Purpose :   computes salinity profile in function of bulk salinity     
       !!
-      !! ** Method  : If bulk salinity greater than s_i_1, 
+      !! ** Method  : If bulk salinity greater than zsi1, 
       !!              the profile is assumed to be constant (S_inf)
-      !!              If bulk salinity lower than s_i_0,
+      !!              If bulk salinity lower than zsi0,
       !!              the profile is linear with 0 at the surface (S_zero)
-      !!              If it is between s_i_0 and s_i_1, it is a
+      !!              If it is between zsi0 and zsi1, it is a
       !!              alpha-weighted linear combination of s_inf and s_zero
       !!
-      !! ** References : Vancoppenolle et al., 2007 (in preparation)
+      !! ** References : Vancoppenolle et al., 2007
       !!------------------------------------------------------------------
       INTEGER  ::   ji, jj, jk, jl   ! dummy loop index
-      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac, zsal      ! local scalar
-      REAL(wp) ::   zswi0, zswi01, zswibal, zargtemp , zs_zero   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha   ! 3D pointer
+      REAL(wp) ::   zfac0, zfac1, zsal
+      REAL(wp) ::   zswi0, zswi01, zargtemp , zs_zero   
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha
+      REAL(wp), PARAMETER :: zsi0 = 3.5_wp
+      REAL(wp), PARAMETER :: zsi1 = 4.5_wp
       !!------------------------------------------------------------------
 
@@ -301,10 +298,10 @@
       ! Vertically constant, constant in time
       !---------------------------------------
-      IF(  num_sal == 1  )   s_i(:,:,:,:) = bulk_sal
+      IF(  nn_icesal == 1  )   s_i(:,:,:,:) = rn_icesal
 
       !-----------------------------------
       ! Salinity profile, varying in time
       !-----------------------------------
-      IF(  num_sal == 2  ) THEN
+      IF(  nn_icesal == 2  ) THEN
          !
          DO jk = 1, nlay_i
@@ -315,11 +312,12 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) )
-               END DO
-            END DO
-         END DO
-         !
-         dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )       ! Weighting factor between zs_zero and zs_inf
-         dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,jl) - epsi20 ) )
+                  z_slope_s(ji,jj,jl) = rswitch * 2._wp * sm_i(ji,jj,jl) / MAX( epsi20 , ht_i(ji,jj,jl) )
+               END DO
+            END DO
+         END DO
+         !
+         zfac0 = 1._wp / ( zsi0 - zsi1 )       ! Weighting factor between zs_zero and zs_inf
+         zfac1 = zsi1  / ( zsi1 - zsi0 )
          !
          zalpha(:,:,:) = 0._wp
@@ -327,18 +325,18 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise
-                  zswi0  = MAX( 0._wp   , SIGN( 1._wp  , s_i_0 - sm_i(ji,jj,jl) ) ) 
-                  ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 
-                  zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp   , SIGN( 1._wp  , s_i_1 - sm_i(ji,jj,jl) ) ) 
-                  ! If 2.sm_i GE sss_m then zswibal = 1
+                  ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
+                  zswi0  = MAX( 0._wp   , SIGN( 1._wp  , zsi0 - sm_i(ji,jj,jl) ) ) 
+                  ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws 
+                  zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp   , SIGN( 1._wp  , zsi1 - sm_i(ji,jj,jl) ) ) 
+                  ! If 2.sm_i GE sss_m then rswitch = 1
                   ! this is to force a constant salinity profile in the Baltic Sea
-                  zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
-                  zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 )
-                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zswibal )
-               END DO
-            END DO
-         END DO
-
-         dummy_fac = 1._wp / REAL( nlay_i )                   ! Computation of the profile
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
+                  zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * zfac0 + zfac1 )
+                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - rswitch )
+               END DO
+            END DO
+         END DO
+
+         ! Computation of the profile
          DO jl = 1, jpl
             DO jk = 1, nlay_i
@@ -346,13 +344,15 @@
                   DO ji = 1, jpi
                      !                                      ! linear profile with 0 at the surface
-                     zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * dummy_fac
+                     zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * r1_nlay_i
                      !                                      ! weighting the profile
                      s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl)
-                  END DO ! ji
-               END DO ! jj
-            END DO ! jk
-         END DO ! jl
-         !
-      ENDIF ! num_sal
+                     !                                      ! bounding salinity
+                     s_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( s_i(ji,jj,jk,jl), rn_simin ) )
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF ! nn_icesal
 
       !-------------------------------------------------------
@@ -360,12 +360,11 @@
       !-------------------------------------------------------
 
-      IF(  num_sal == 3  ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
+      IF(  nn_icesal == 3  ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
          !
          sm_i(:,:,:) = 2.30_wp
          !
          DO jl = 1, jpl
-!CDIR NOVERRCHK
             DO jk = 1, nlay_i
-               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
+               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
                zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  )
                s_i(:,:,jk,jl) =  zsal
@@ -373,5 +372,5 @@
          END DO
          !
-      ENDIF ! num_sal
+      ENDIF ! nn_icesal
       !
       CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha )
@@ -390,4 +389,9 @@
 
       ! Mean sea ice temperature
+      vt_i (:,:) = 0._wp
+      DO jl = 1, jpl
+         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl)
+      END DO
+
       tm_i(:,:) = 0._wp
       DO jl = 1, jpl
@@ -395,11 +399,12 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  )
-                  tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   &
-                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  )
-               END DO
-            END DO
-         END DO
-      END DO
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
+                  tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  &
+                     &            / MAX( vt_i(ji,jj) , epsi10 )
+               END DO
+            END DO
+         END DO
+      END DO
+      tm_i = tm_i + rt0
 
    END SUBROUTINE lim_var_icetm
@@ -420,4 +425,9 @@
       !!------------------------------------------------------------------
       !
+      vt_i (:,:) = 0._wp
+      DO jl = 1, jpl
+         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl)
+      END DO
+
       bv_i(:,:) = 0._wp
       DO jl = 1, jpl
@@ -425,9 +435,9 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) )  )
-                  zbvi  = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 )   &
-                     &                   * v_i(ji,jj,jl)    / REAL(nlay_i,wp)
-                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  )
-                  bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi10 )
+                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) )  )
+                  zbvi  = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 )   &
+                     &                   * v_i(ji,jj,jl) * r1_nlay_i
+                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi20 ) )  )
+                  bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi20 )
                END DO
             END DO
@@ -448,9 +458,11 @@
       !
       INTEGER  ::   ji, jk    ! dummy loop indices
-      INTEGER  ::   ii, ij  ! local integers
-      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal   ! local scalars
-      REAL(wp) ::   zalpha, zswi0, zswi01, zswibal, zs_zero              !   -      -
+      INTEGER  ::   ii, ij    ! local integers
+      REAL(wp) ::   zfac0, zfac1, zargtemp, zsal   ! local scalars
+      REAL(wp) ::   zalpha, zswi0, zswi01, zs_zero              !   -      -
       !
       REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s
+      REAL(wp), PARAMETER :: zsi0 = 3.5_wp
+      REAL(wp), PARAMETER :: zsi1 = 4.5_wp
       !!---------------------------------------------------------------------
 
@@ -460,5 +472,5 @@
       ! Vertically constant, constant in time
       !---------------------------------------
-      IF( num_sal == 1 )   s_i_1d(:,:) = bulk_sal
+      IF( nn_icesal == 1 )   s_i_1d(:,:) = rn_icesal
 
       !------------------------------------------------------
@@ -466,39 +478,38 @@
       !------------------------------------------------------
 
-      IF(  num_sal == 2  ) THEN
+      IF(  nn_icesal == 2  ) THEN
          !
          DO ji = kideb, kiut          ! Slope of the linear profile zs_zero
-            z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) )
+            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )
+            z_slope_s(ji) = rswitch * 2._wp * sm_i_1d(ji) / MAX( epsi20 , ht_i_1d(ji) )
          END DO
 
          ! Weighting factor between zs_zero and zs_inf
          !---------------------------------------------
-         dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )
-         dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )
-         dummy_fac2 = 1._wp / REAL(nlay_i,wp)
-
-!CDIR NOVERRCHK
+         zfac0 = 1._wp / ( zsi0 - zsi1 )
+         zfac1 = zsi1 / ( zsi1 - zsi0 )
          DO jk = 1, nlay_i
-!CDIR NOVERRCHK
             DO ji = kideb, kiut
                ii =  MOD( npb(ji) - 1 , jpi ) + 1
                ij =     ( npb(ji) - 1 ) / jpi + 1
-               ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise
-               zswi0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_1d(ji) ) ) 
-               ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 
-               zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_1d(ji) ) ) 
-               ! if 2.sm_i GE sss_m then zswibal = 1
+               ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
+               zswi0  = MAX( 0._wp , SIGN( 1._wp  , zsi0 - sm_i_1d(ji) ) ) 
+               ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws 
+               zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i_1d(ji) ) ) 
+               ! if 2.sm_i GE sss_m then rswitch = 1
                ! this is to force a constant salinity profile in the Baltic Sea
-               zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )
+               rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )
                !
-               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zswibal )
+               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * zfac0 + zfac1 )  ) * ( 1._wp - rswitch )
                !
-               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2
+               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * r1_nlay_i
                ! weighting the profile
                s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji)
-            END DO ! ji
-         END DO ! jk
-
-      ENDIF ! num_sal
+               ! bounding salinity
+               s_i_1d(ji,jk) = MIN( rn_simax, MAX( s_i_1d(ji,jk), rn_simin ) )
+            END DO 
+         END DO 
+
+      ENDIF 
 
       !-------------------------------------------------------
@@ -506,12 +517,11 @@
       !-------------------------------------------------------
 
-      IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
+      IF( nn_icesal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
          !
          sm_i_1d(:) = 2.30_wp
          !
-!CDIR NOVERRCHK
          DO jk = 1, nlay_i
-            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
-            zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  )
+            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
+            zsal =  1.6_wp * ( 1._wp - COS( rpi * zargtemp**( 0.407_wp / ( 0.573_wp + zargtemp ) ) ) )
             DO ji = kideb, kiut
                s_i_1d(ji,jk) = zsal
@@ -524,4 +534,252 @@
       !
    END SUBROUTINE lim_var_salprof1d
+
+   SUBROUTINE lim_var_zapsmall
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_var_zapsmall ***
+      !!
+      !! ** Purpose :   Remove too small sea ice areas and correct fluxes
+      !!
+      !! history : LIM3.5 - 01-2014 (C. Rousset) original code
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices
+      REAL(wp) ::   zsal, zvi, zvs, zei, zes
+      !!-------------------------------------------------------------------
+      at_i (:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
+      END DO
+
+      DO jl = 1, jpl
+
+         !-----------------------------------------------------------------
+         ! Zap ice energy and use ocean heat to melt ice
+         !-----------------------------------------------------------------
+         DO jk = 1, nlay_i
+            DO jj = 1 , jpj
+               DO ji = 1 , jpi
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch  &
+                     &                                       / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch
+                  zei              = e_i(ji,jj,jk,jl)
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * rswitch
+                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * rswitch + rt0 * ( 1._wp - rswitch )
+                  ! update exchanges with ocean
+                  hfx_res(ji,jj)   = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * r1_rdtice ! W.m-2 <0
+               END DO
+            END DO
+         END DO
+
+         DO jj = 1 , jpj
+            DO ji = 1 , jpi
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
+               rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch
+               rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch
+               rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch  &
+                  &                              / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch
+               zsal = smv_i(ji,jj,  jl)
+               zvi  = v_i  (ji,jj,  jl)
+               zvs  = v_s  (ji,jj,  jl)
+               zes  = e_s  (ji,jj,1,jl)
+               !-----------------------------------------------------------------
+               ! Zap snow energy 
+               !-----------------------------------------------------------------
+               t_s(ji,jj,1,jl) = t_s(ji,jj,1,jl) * rswitch + rt0 * ( 1._wp - rswitch )
+               e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * rswitch
+
+               !-----------------------------------------------------------------
+               ! zap ice and snow volume, add water and salt to ocean
+               !-----------------------------------------------------------------
+               ato_i(ji,jj)    = a_i  (ji,jj,jl) * ( 1._wp - rswitch ) + ato_i(ji,jj)
+               a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * rswitch
+               v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * rswitch
+               v_s  (ji,jj,jl) = v_s  (ji,jj,jl) * rswitch
+               t_su (ji,jj,jl) = t_su (ji,jj,jl) * rswitch + t_bo(ji,jj) * ( 1._wp - rswitch )
+               oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * rswitch
+               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * rswitch
+
+               ! update exchanges with ocean
+               sfx_res(ji,jj)  = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
+               wfx_res(ji,jj)  = wfx_res(ji,jj) - ( v_i(ji,jj,jl)   - zvi  ) * rhoic * r1_rdtice
+               wfx_snw(ji,jj)  = wfx_snw(ji,jj) - ( v_s(ji,jj,jl)   - zvs  ) * rhosn * r1_rdtice
+               hfx_res(ji,jj)  = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0
+            END DO
+         END DO
+      END DO 
+
+      ! to be sure that at_i is the sum of a_i(jl)
+      at_i (:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
+      END DO
+
+      ! open water = 1 if at_i=0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )
+            ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj)
+         END DO
+      END DO
+
+      !
+   END SUBROUTINE lim_var_zapsmall
+
+   SUBROUTINE lim_var_itd( zhti, zhts, zai, zht_i, zht_s, za_i )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_var_itd   ***
+      !!
+      !! ** Purpose :  converting 1-cat ice to multiple ice categories
+      !!
+      !!                  ice thickness distribution follows a gaussian law
+      !!               around the concentration of the most likely ice thickness
+      !!                           (similar as limistate.F90)
+      !!
+      !! ** Method:   Iterative procedure
+      !!                
+      !!               1) Try to fill the jpl ice categories (bounds hi_max(0:jpl)) with a gaussian
+      !!
+      !!               2) Check whether the distribution conserves area and volume, positivity and
+      !!                  category boundaries
+      !!              
+      !!               3) If not (input ice is too thin), the last category is empty and
+      !!                  the number of categories is reduced (jpl-1)
+      !!
+      !!               4) Iterate until ok (SUM(itest(:) = 4)
+      !!
+      !! ** Arguments : zhti: 1-cat ice thickness
+      !!                zhts: 1-cat snow depth
+      !!                zai : 1-cat ice concentration
+      !!
+      !! ** Output    : jpl-cat 
+      !!
+      !!  (Example of application: BDY forcings when input are cell averaged)  
+      !!
+      !!-------------------------------------------------------------------
+      !! History : LIM3.5 - 2012    (M. Vancoppenolle)  Original code
+      !!                    2014    (C. Rousset)        Rewriting
+      !!-------------------------------------------------------------------
+      !! Local variables
+      INTEGER  :: ji, jk, jl             ! dummy loop indices
+      INTEGER  :: ijpij, i_fill, jl0  
+      REAL(wp) :: zarg, zV, zconv, zdh
+      REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zai    ! input ice/snow variables
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zht_i, zht_s, za_i ! output ice/snow variables
+      INTEGER , POINTER, DIMENSION(:)         ::   itest
+ 
+      CALL wrk_alloc( 4, itest )
+      !--------------------------------------------------------------------
+      ! initialisation of variables
+      !--------------------------------------------------------------------
+      ijpij = SIZE(zhti,1)
+      zht_i(1:ijpij,1:jpl) = 0._wp
+      zht_s(1:ijpij,1:jpl) = 0._wp
+      za_i (1:ijpij,1:jpl) = 0._wp
+
+      ! ----------------------------------------
+      ! distribution over the jpl ice categories
+      ! ----------------------------------------
+      DO ji = 1, ijpij
+         
+         IF( zhti(ji) > 0._wp ) THEN
+
+         ! initialisation of tests
+         itest(:)  = 0
+         
+         i_fill = jpl + 1                                             !====================================
+         DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories  
+            ! iteration                                               !====================================
+            i_fill = i_fill - 1
+            
+            ! initialisation of ice variables for each try
+            zht_i(ji,1:jpl) = 0._wp
+            za_i (ji,1:jpl) = 0._wp
+            
+            ! *** case very thin ice: fill only category 1
+            IF ( i_fill == 1 ) THEN
+               zht_i(ji,1) = zhti(ji)
+               za_i (ji,1) = zai (ji)
+
+            ! *** case ice is thicker: fill categories >1
+            ELSE
+
+               ! Fill ice thicknesses except the last one (i_fill) by hmean 
+               DO jl = 1, i_fill - 1
+                  zht_i(ji,jl) = hi_mean(jl)
+               END DO
+               
+               ! find which category (jl0) the input ice thickness falls into
+               jl0 = i_fill
+               DO jl = 1, i_fill
+                  IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN
+                     jl0 = jl
+		     CYCLE
+                  ENDIF
+               END DO
+               
+               ! Concentrations in the (i_fill-1) categories 
+               za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl))
+               DO jl = 1, i_fill - 1
+                  IF ( jl == jl0 ) CYCLE
+                  zarg        = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp )
+                  za_i(ji,jl) =   za_i (ji,jl0) * EXP(-zarg**2)
+               END DO
+               
+               ! Concentration in the last (i_fill) category
+               za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) )
+               
+               ! Ice thickness in the last (i_fill) category
+               zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) )
+               zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / za_i(ji,i_fill) 
+               
+            ENDIF ! case ice is thick or thin
+            
+            !---------------------
+            ! Compatibility tests
+            !--------------------- 
+            ! Test 1: area conservation
+            zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) )
+            IF ( zconv < epsi06 ) itest(1) = 1
+            
+            ! Test 2: volume conservation
+            zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) )
+            IF ( zconv < epsi06 ) itest(2) = 1
+            
+            ! Test 3: thickness of the last category is in-bounds ?
+            IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1
+            
+            ! Test 4: positivity of ice concentrations
+            itest(4) = 1
+            DO jl = 1, i_fill
+               IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0
+            END DO            
+                                                           !============================
+         END DO                                            ! end iteration on categories
+                                                           !============================
+         ENDIF ! if zhti > 0
+      END DO ! i loop
+
+      ! ------------------------------------------------
+      ! Adding Snow in each category where za_i is not 0
+      ! ------------------------------------------------ 
+      DO jl = 1, jpl
+         DO ji = 1, ijpij
+            IF( za_i(ji,jl) > 0._wp ) THEN
+               zht_s(ji,jl) = zht_i(ji,jl) * ( zhts(ji) / zhti(ji) )
+               ! In case snow load is in excess that would lead to transformation from snow to ice
+               ! Then, transfer the snow excess into the ice (different from limthd_dh)
+               zdh = MAX( 0._wp, ( rhosn * zht_s(ji,jl) + ( rhoic - rau0 ) * zht_i(ji,jl) ) * r1_rau0 ) 
+               ! recompute ht_i, ht_s avoiding out of bounds values
+               zht_i(ji,jl) = MIN( hi_max(jl), zht_i(ji,jl) + zdh )
+               zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic * r1_rhosn )
+            ENDIF
+         ENDDO
+      ENDDO
+
+      CALL wrk_dealloc( 4, itest )
+      !
+    END SUBROUTINE lim_var_itd
+
 
 #else
@@ -542,4 +800,8 @@
    SUBROUTINE lim_var_salprof1d    ! Emtpy routines
    END SUBROUTINE lim_var_salprof1d
+   SUBROUTINE lim_var_zapsmall
+   END SUBROUTINE lim_var_zapsmall
+   SUBROUTINE lim_var_itd
+   END SUBROUTINE lim_var_itd
 #endif
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 5901)
@@ -24,5 +24,4 @@
    USE lib_mpp         ! MPP library
    USE wrk_nemo        ! work arrays
-   USE par_ice
    USE iom
    USE timing          ! Timing
@@ -61,5 +60,5 @@
       REAL(wp) ::  z1_365
       REAL(wp) ::  ztmp
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei, zt_i, zt_s
       REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, z2da, z2db, zswi    ! 2D workspace
       !!-------------------------------------------------------------------
@@ -67,5 +66,5 @@
       IF( nn_timing == 1 )  CALL timing_start('limwri')
 
-      CALL wrk_alloc( jpi, jpj, jpl, zoi, zei )
+      CALL wrk_alloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s )
       CALL wrk_alloc( jpi, jpj     , z2d, z2da, z2db, zswi )
 
@@ -73,4 +72,5 @@
       ! Mean category values
       !-----------------------------
+      z1_365 = 1._wp / 365._wp
 
       CALL lim_var_icetm      ! mean sea ice temperature
@@ -107,12 +107,12 @@
          DO jj = 2 , jpjm1
             DO ji = 2 , jpim1
-               z2da(ji,jj)  = (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp
-               z2db(ji,jj)  = (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp
+               z2da(ji,jj)  = (  u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp
+               z2db(ji,jj)  = (  v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp
            END DO
          END DO
          CALL lbc_lnk( z2da, 'T', -1. )
          CALL lbc_lnk( z2db, 'T', -1. )
-         CALL iom_put( "uice_ipa"     , z2da                )       ! ice velocity u component
-         CALL iom_put( "vice_ipa"     , z2db                )       ! ice velocity v component
+         CALL iom_put( "uice_ipa"     , z2da             )       ! ice velocity u component
+         CALL iom_put( "vice_ipa"     , z2db             )       ! ice velocity v component
          DO jj = 1, jpj                                 
             DO ji = 1, jpi
@@ -120,5 +120,5 @@
             END DO
          END DO
-         CALL iom_put( "icevel"       , z2d                 )       ! ice velocity module
+         CALL iom_put( "icevel"       , z2d              )       ! ice velocity module
       ENDIF
       !
@@ -128,10 +128,10 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * oa_i(ji,jj,jl)
+                  rswitch    = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) )
+                  z2d(ji,jj) = z2d(ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj), 0.1 )
                END DO
             END DO
          END DO
-         z1_365 = 1._wp / 365._wp
-         CALL iom_put( "miceage"     , z2d * z1_365         )        ! mean ice age
+         CALL iom_put( "miceage"     , z2d * z1_365      )        ! mean ice age
       ENDIF
 
@@ -139,8 +139,8 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               z2d(ji,jj) = ( tm_i(ji,jj) - rtt ) * zswi(ji,jj)
-            END DO
-         END DO
-         CALL iom_put( "micet"       , z2d                  )        ! mean ice temperature
+               z2d(ji,jj) = ( tm_i(ji,jj) - rt0 ) * zswi(ji,jj)
+            END DO
+         END DO
+         CALL iom_put( "micet"       , z2d               )        ! mean ice temperature
       ENDIF
       !
@@ -150,9 +150,9 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rtt ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )
+                  z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )
                END DO
             END DO
          END DO
-         CALL iom_put( "icest"       , z2d                 )        ! ice surface temperature
+         CALL iom_put( "icest"       , z2d              )        ! ice surface temperature
       ENDIF
 
@@ -164,5 +164,5 @@
             END DO
          END DO
-         CALL iom_put( "icecolf"     , z2d                 )        ! frazil ice collection thickness
+         CALL iom_put( "icecolf"     , z2d              )        ! frazil ice collection thickness
       ENDIF
 
@@ -176,5 +176,5 @@
       CALL iom_put( "utau_ice"    , utau_ice            )        ! wind stress over ice along i-axis at I-point
       CALL iom_put( "vtau_ice"    , vtau_ice            )        ! wind stress over ice along j-axis at I-point
-      CALL iom_put( "snowpre"     , sprecip             )        ! snow precipitation 
+      CALL iom_put( "snowpre"     , sprecip * 86400.    )        ! snow precipitation 
       CALL iom_put( "micesalt"    , smt_i               )        ! mean ice salinity
 
@@ -186,4 +186,5 @@
       CALL iom_put( "icetrp"      , diag_trp_vi * rday  )        ! ice volume transport
       CALL iom_put( "snwtrp"      , diag_trp_vs * rday  )        ! snw volume transport
+      CALL iom_put( "saltrp"      , diag_trp_smv * rday * rhoic ) ! salt content transport
       CALL iom_put( "deitrp"      , diag_trp_ei         )        ! advected ice enthalpy (W/m2)
       CALL iom_put( "destrp"      , diag_trp_es         )        ! advected snw enthalpy (W/m2)
@@ -200,34 +201,38 @@
 
       ztmp = rday / rhoic
-      CALL iom_put( "vfxres"     , wfx_res * ztmp  )             ! daily prod./melting due to limupdate 
-      CALL iom_put( "vfxopw"     , wfx_opw * ztmp  )             ! daily lateral thermodynamic ice production
-      CALL iom_put( "vfxsni"     , wfx_sni * ztmp  )             ! daily snowice ice production
-      CALL iom_put( "vfxbog"     , wfx_bog * ztmp  )             ! daily bottom thermodynamic ice production
-      CALL iom_put( "vfxdyn"     , wfx_dyn * ztmp  )             ! daily dynamic ice production (rid/raft)
-      CALL iom_put( "vfxsum"     , wfx_sum * ztmp  )             ! surface melt 
-      CALL iom_put( "vfxbom"     , wfx_bom * ztmp  )             ! bottom melt 
-      CALL iom_put( "vfxice"     , wfx_ice * ztmp  )             ! total ice growth/melt 
-      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp  )             ! total snw growth/melt 
-      CALL iom_put( "vfxsub"     , wfx_sub * ztmp  )             ! sublimation (snow) 
-      CALL iom_put( "vfxspr"     , wfx_spr * ztmp  )             ! precip (snow) 
-
-      CALL iom_put ('hfxthd', hfx_thd(:,:) )   !  
-      CALL iom_put ('hfxdyn', hfx_dyn(:,:) )   !  
-      CALL iom_put ('hfxres', hfx_res(:,:) )   !  
-      CALL iom_put ('hfxout', hfx_out(:,:) )   !  
-      CALL iom_put ('hfxin' , hfx_in(:,:) )   !  
-      CALL iom_put ('hfxsnw', hfx_snw(:,:) )   !  
-      CALL iom_put ('hfxsub', hfx_sub(:,:) )   !  
-      CALL iom_put ('hfxerr', hfx_err(:,:) )   !  
-      CALL iom_put ('hfxerr_rem', hfx_err_rem(:,:) )   !  
-      
-      CALL iom_put ('hfxsum', hfx_sum(:,:) )   !  
-      CALL iom_put ('hfxbom', hfx_bom(:,:) )   !  
-      CALL iom_put ('hfxbog', hfx_bog(:,:) )   !  
-      CALL iom_put ('hfxdif', hfx_dif(:,:) )   !  
-      CALL iom_put ('hfxopw', hfx_opw(:,:) )   !  
-      CALL iom_put ('hfxtur', fhtur(:,:) * at_i(:,:) )   ! turbulent heat flux at ice base 
-      CALL iom_put ('hfxdhc', diag_heat_dhc(:,:) )          ! Heat content variation in snow and ice 
-      CALL iom_put ('hfxspr', hfx_spr(:,:) )          ! Heat content of snow precip 
+      CALL iom_put( "vfxres"     , wfx_res * ztmp       )        ! daily prod./melting due to limupdate 
+      CALL iom_put( "vfxopw"     , wfx_opw * ztmp       )        ! daily lateral thermodynamic ice production
+      CALL iom_put( "vfxsni"     , wfx_sni * ztmp       )        ! daily snowice ice production
+      CALL iom_put( "vfxbog"     , wfx_bog * ztmp       )        ! daily bottom thermodynamic ice production
+      CALL iom_put( "vfxdyn"     , wfx_dyn * ztmp       )        ! daily dynamic ice production (rid/raft)
+      CALL iom_put( "vfxsum"     , wfx_sum * ztmp       )        ! surface melt 
+      CALL iom_put( "vfxbom"     , wfx_bom * ztmp       )        ! bottom melt 
+      CALL iom_put( "vfxice"     , wfx_ice * ztmp       )        ! total ice growth/melt 
+      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp       )        ! total snw growth/melt 
+      CALL iom_put( "vfxsub"     , wfx_sub * ztmp       )        ! sublimation (snow) 
+      CALL iom_put( "vfxspr"     , wfx_spr * ztmp       )        ! precip (snow)
+      
+      CALL iom_put( "afxtot"     , afx_tot * rday       )        ! concentration tendency (total)
+      CALL iom_put( "afxdyn"     , afx_dyn * rday       )        ! concentration tendency (dynamics)
+      CALL iom_put( "afxthd"     , afx_thd * rday       )        ! concentration tendency (thermo)
+
+      CALL iom_put ('hfxthd'     , hfx_thd(:,:)         )   !  
+      CALL iom_put ('hfxdyn'     , hfx_dyn(:,:)         )   !  
+      CALL iom_put ('hfxres'     , hfx_res(:,:)         )   !  
+      CALL iom_put ('hfxout'     , hfx_out(:,:)         )   !  
+      CALL iom_put ('hfxin'      , hfx_in(:,:)          )   !  
+      CALL iom_put ('hfxsnw'     , hfx_snw(:,:)         )   !  
+      CALL iom_put ('hfxsub'     , hfx_sub(:,:)         )   !  
+      CALL iom_put ('hfxerr'     , hfx_err(:,:)         )   !  
+      CALL iom_put ('hfxerr_rem' , hfx_err_rem(:,:)     )   !  
+      
+      CALL iom_put ('hfxsum'     , hfx_sum(:,:)         )   !  
+      CALL iom_put ('hfxbom'     , hfx_bom(:,:)         )   !  
+      CALL iom_put ('hfxbog'     , hfx_bog(:,:)         )   !  
+      CALL iom_put ('hfxdif'     , hfx_dif(:,:)         )   !  
+      CALL iom_put ('hfxopw'     , hfx_opw(:,:)         )   !  
+      CALL iom_put ('hfxtur'     , fhtur(:,:) * SUM(a_i_b(:,:,:), dim=3) ) ! turbulent heat flux at ice base 
+      CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice 
+      CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip 
       
       !--------------------------------
@@ -239,4 +244,16 @@
       CALL iom_put( "salinity_cat"     , sm_i        )        ! salinity for categories
 
+      ! ice temperature
+      IF ( iom_use( "icetemp_cat" ) ) THEN 
+         zt_i(:,:,:) = SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i
+         CALL iom_put( "icetemp_cat"   , zt_i - rt0  )
+      ENDIF
+      
+      ! snow temperature
+      IF ( iom_use( "snwtemp_cat" ) ) THEN 
+         zt_s(:,:,:) = SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s
+         CALL iom_put( "snwtemp_cat"   , zt_s - rt0  )
+      ENDIF
+
       ! Compute ice age
       IF ( iom_use( "iceage_cat" ) ) THEN 
@@ -244,10 +261,11 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
-                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * rswitch
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) )
+                  rswitch = rswitch * MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - 0.1 ) )
+                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 0.1 ) * rswitch
                END DO
             END DO
          END DO
-         CALL iom_put( "iceage_cat"     , zoi         )        ! ice age for categories
+         CALL iom_put( "iceage_cat"   , zoi * z1_365 )        ! ice age for categories
       ENDIF
 
@@ -260,12 +278,12 @@
                   DO ji = 1, jpi
                      rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
-                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* &
-                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * &
-                        rswitch / nlay_i
+                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 *  &
+                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * &
+                        rswitch * r1_nlay_i
                   END DO
                END DO
             END DO
          END DO
-         CALL iom_put( "brinevol_cat"     , zei         )        ! brine volume for categories
+         CALL iom_put( "brinevol_cat"     , zei      )        ! brine volume for categories
       ENDIF
 
@@ -274,5 +292,5 @@
       !     not yet implemented
       
-      CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei )
+      CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s )
       CALL wrk_dealloc( jpi, jpj     , z2d, zswi, z2da, z2db )
 
@@ -348,5 +366,5 @@
       CALL histwrite( kid, "iicethic", kt, icethi        , jpi*jpj, (/1/) )    
       CALL histwrite( kid, "iiceconc", kt, at_i          , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "iicetemp", kt, tm_i - rtt    , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "iicetemp", kt, tm_i - rt0    , jpi*jpj, (/1/) )
       CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) )
       CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90	(revision 5901)
@@ -92,5 +92,5 @@
          zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
          zindb  = zindh * zinda
-         ztmu   = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
+         ztmu   = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) ) 
          zcmo(ji,jj,1)  = ht_s (ji,jj,1)
          zcmo(ji,jj,2)  = ht_i (ji,jj,1)
@@ -99,10 +99,10 @@
          zcmo(ji,jj,5)  = sist  (ji,jj)
          zcmo(ji,jj,6)  = fhtur  (ji,jj)
-         zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
-            + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+         zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * umask(ji,jj,1) + u_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
+            + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
             / ztmu 
 
-         zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
-            + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+         zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * umask(ji,jj,1) + v_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
+            + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
             / ztmu
          zcmo(ji,jj,9)  = sst_m(ji,jj)
@@ -135,5 +135,5 @@
                zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
                zindb  = zindh * zinda
-               ztmu   = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )
+               ztmu   = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) )
                rcmoy(ji,jj,1)  = ht_s (ji,jj,1)
                rcmoy(ji,jj,2)  = ht_i (ji,jj,1)
@@ -142,10 +142,10 @@
                rcmoy(ji,jj,5)  = sist  (ji,jj)
                rcmoy(ji,jj,6)  = fhtur  (ji,jj)
-               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
-                  + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * umask(ji,jj,1) + u_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
+                  + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
                   / ztmu
 
-               rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
-                  + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+               rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * umask(ji,jj,1) + v_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
+                  + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
                   / ztmu
                rcmoy(ji,jj,9)  = sst_m(ji,jj)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90	(revision 5891)
+++ 	(revision )
@@ -1,25 +1,0 @@
-MODULE par_ice
-   !!======================================================================
-   !!                       ***  MODULE par_ice   ***
-   !! LIM-3 Sea Ice :   definition of parameters
-   !!======================================================================
-   !! History :  3.0  ! 2003-08  (M. Vancoppenolle)  LIM-3
-   !!----------------------------------------------------------------------
-   USE par_oce
-
-   IMPLICIT NONE
-   PUBLIC          
-
-   !                                             !!! ice thermodynamics
-   INTEGER, PUBLIC, PARAMETER ::   nlay_i   = 5   !: number of ice layers
-   INTEGER, PUBLIC, PARAMETER ::   nlay_s   = 1   !: number of snow layers
-
-   !                                             !!! ice mechanical redistribution
-   INTEGER, PUBLIC, PARAMETER ::   jpl      = 5   !: number of ice categories
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!======================================================================
-END MODULE par_ice
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 5901)
@@ -6,7 +6,7 @@
    !! History :  3.0  !  2002-11  (C. Ethe)  F90: Free form and module
    !!----------------------------------------------------------------------
-   USE par_ice        ! LIM-3 parameters
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
+   USE ice, ONLY :   nlay_i, nlay_s
 
    IMPLICIT NONE
@@ -19,14 +19,11 @@
    !!---------------------------
    !                               !!! ** ice-thermo namelist (namicethd) **
-   REAL(wp), PUBLIC ::   hmelt       !: maximum melting at the bottom; active only for one category
-   REAL(wp), PUBLIC ::   hiclim      !: minimum ice thickness
-   REAL(wp), PUBLIC ::   hnzst       !: thick. of the surf. layer in temp. comp.
-   REAL(wp), PUBLIC ::   parsub      !: switch for snow sublimation or not
-   REAL(wp), PUBLIC ::   maxfrazb    !: maximum portion of frazil ice collecting at the ice bottom
-   REAL(wp), PUBLIC ::   vfrazb      !: threshold drift speed for collection of bottom frazil ice
-   REAL(wp), PUBLIC ::   Cfrazb      !: squeezing coefficient for collection of bottom frazil ice
-   REAL(wp), PUBLIC ::   hiccrit     !: ice th. for lateral accretion in the NH (SH) (m)
+   REAL(wp), PUBLIC ::   rn_himin    !: minimum ice thickness
+   REAL(wp), PUBLIC ::   rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom
+   REAL(wp), PUBLIC ::   rn_vfrazb   !: threshold drift speed for collection of bottom frazil ice
+   REAL(wp), PUBLIC ::   rn_Cfrazb   !: squeezing coefficient for collection of bottom frazil ice
+   REAL(wp), PUBLIC ::   rn_hnewice  !: thickness for new ice formation (m)
 
-   INTEGER , PUBLIC ::   fraz_swi    !: use of frazil ice collection in function of wind (1) or not (0)
+   LOGICAL , PUBLIC ::   ln_frazil   !: use of frazil ice collection as function of wind (T) or not (F)
 
    !!-----------------------------
@@ -37,6 +34,7 @@
    !: are the variables corresponding to 2d vectors
 
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: number of points where computations has to be done
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: correspondance between points (lateral accretion)
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: address vector for 1d vertical thermo computations
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nplm   !: address vector for mono-category lateral melting
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: address vector for new ice formation
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d     
@@ -56,4 +54,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_1d
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d
 
    ! heat flux associated with ice-atmosphere mass exchange
@@ -90,7 +89,6 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qla_ice_1d    !: <==> the 2D  qla_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqla_ice_1d   !: <==> the 2D  dqla_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tatm_ice_1d   !: <==> the 2D  tatm_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   evap_ice_1d   !: <==> the 2D  evap_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qprec_ice_1d  !: <==> the 2D  qprec_ice
    !                                                     ! to reintegrate longwave flux inside the ice thermodynamics
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice
@@ -140,35 +138,31 @@
       !!---------------------------------------------------------------------!
 
-      ALLOCATE( npb      (jpij) , npac     (jpij),                          &
-         !                                                                  !
-         &      qlead_1d (jpij) , ftr_ice_1d  (jpij) ,     &
-         &      qsr_ice_1d (jpij) ,     &
-         &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) ,     &
-         &      t_bo_1d   (jpij) ,                                          &
-         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,     & 
-         &      hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , &
-         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , &
-         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , &
-         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij),       STAT=ierr(1) )
+      ALLOCATE( npb      (jpij) , nplm      (jpij) , npac       (jpij) ,   &
+         &      qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) ,   &
+         &      fr1_i0_1d(jpij) , fr2_i0_1d (jpij) , qns_ice_1d(jpij)  ,   &
+         &      t_bo_1d   (jpij) ,                                         &
+         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,    & 
+         &      hfx_dif_1d(jpij) , hfx_opw_1d(jpij) ,                      &
+         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      &
+         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) ,   &
+         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(1) )
       !
-      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d     (jpij) ,     &
-         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,     &
-         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , &
-         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) ,  wfx_res_1d (jpij) ,  &
-         &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,     &
-         &      tatm_ice_1d(jpij) ,      &   
-         &      i0         (jpij) ,     &  
-         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) ,   &
-         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , &
-         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &     
+      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d    (jpij) ,                     &
+         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,                     &
+         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) ,  &
+         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) ,  &
+         &      dqns_ice_1d(jpij) , evap_ice_1d (jpij),                                         &
+         &      qprec_ice_1d(jpij), i0         (jpij) ,                                         &  
+         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  &
+         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) ,                     &
+         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,                     &     
          &      dsm_i_si_1d(jpij) , hicol_1d    (jpij)                     , STAT=ierr(2) )
       !
-      ALLOCATE( t_su_1d    (jpij) , a_i_1d    (jpij) , ht_i_1d   (jpij) ,    &   
-         &      ht_s_1d    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &    
+      ALLOCATE( t_su_1d   (jpij) , a_i_1d   (jpij) , ht_i_1d  (jpij) ,    &   
+         &      ht_s_1d   (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &    
          &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &    
-         &      dh_snowice(jpij) , sm_i_1d   (jpij) , s_i_new  (jpij) ,    &
-         &      t_s_1d(jpij,nlay_s),                                       &
-         &      t_i_1d(jpij,nlay_i+1), s_i_1d(jpij,nlay_i+1)                ,     &            
-         &      q_i_1d(jpij,nlay_i+1), q_s_1d(jpij,nlay_i+1)                ,     &
+         &      dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    &
+         &      t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) ,  &            
+         &      q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) ,                        &
          &      qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3))
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif2model.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 5901)
@@ -1,62 +1,64 @@
 #if defined key_agrif
-   !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-   SUBROUTINE Agrif2Model
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif2Model ***
-      !!--------------------------------------------- 
-   END SUBROUTINE Agrif2model
+!!----------------------------------------------------------------------
+!! NEMO/NST 3.6 , NEMO Consortium (2010)
+!! $Id$
+!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+!!----------------------------------------------------------------------
+SUBROUTINE Agrif2Model
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif2Model ***
+   !!--------------------------------------------- 
+END SUBROUTINE Agrif2model
 
-   SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_Set_numberofcells ***
-      !!--------------------------------------------- 
-      USE Agrif_Types
-      IMPLICIT NONE
+SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_Set_numberofcells ***
+   !!--------------------------------------------- 
+   USE Agrif_Grids
+   IMPLICIT NONE
 
-      Type(Agrif_Grid), Pointer :: Agrif_Gr
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
 
-      IF ( associated(Agrif_Curgrid) )THEN
+   IF ( ASSOCIATED(Agrif_Curgrid) )THEN
 #include "SetNumberofcells.h"
-      ENDIF
+   ENDIF
 
-   END SUBROUTINE Agrif_Set_numberofcells
+END SUBROUTINE Agrif_Set_numberofcells
 
-   SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr)
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_Get_numberofcells ***
-      !!--------------------------------------------- 
-      USE Agrif_Types
-      IMPLICIT NONE
+SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr)
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_Get_numberofcells ***
+   !!--------------------------------------------- 
+   USE Agrif_Grids
+   IMPLICIT NONE
 
-      Type(Agrif_Grid), Pointer :: Agrif_Gr
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
 
+   IF ( ASSOCIATED(Agrif_Curgrid) ) THEN
 #include "GetNumberofcells.h"
+   ENDIF
 
-   END SUBROUTINE Agrif_Get_numberofcells
+END SUBROUTINE Agrif_Get_numberofcells
 
-   SUBROUTINE Agrif_Allocationcalls(Agrif_Gr)
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_Allocationscalls ***
-      !!--------------------------------------------- 
-      USE Agrif_Types 
+SUBROUTINE Agrif_Allocationcalls(Agrif_Gr)
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_Allocationscalls ***
+   !!--------------------------------------------- 
+   USE Agrif_Grids 
 #include "include_use_Alloc_agrif.h"
-      IMPLICIT NONE
+   IMPLICIT NONE
 
-      Type(Agrif_Grid), Pointer :: Agrif_Gr
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
 
 #include "allocations_calls_agrif.h"
 
-   END SUBROUTINE Agrif_Allocationcalls
+END SUBROUTINE Agrif_Allocationcalls
 
-   SUBROUTINE Agrif_probdim_modtype_def()
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_probdim_modtype_def ***
-      !!--------------------------------------------- 
-      USE Agrif_Types
-      IMPLICIT NONE
+SUBROUTINE Agrif_probdim_modtype_def()
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_probdim_modtype_def ***
+   !!--------------------------------------------- 
+   USE Agrif_Types
+   IMPLICIT NONE
 
 #include "modtype_agrif.h"
@@ -64,43 +66,24 @@
 #include "keys_agrif.h"
 
-      Return
+   RETURN
 
-   END SUBROUTINE Agrif_probdim_modtype_def
+END SUBROUTINE Agrif_probdim_modtype_def
 
-   SUBROUTINE Agrif_clustering_def()
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_clustering_def ***
-      !!--------------------------------------------- 
-      Use Agrif_Types
-      IMPLICIT NONE
+SUBROUTINE Agrif_clustering_def()
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_clustering_def ***
+   !!--------------------------------------------- 
+   IMPLICIT NONE
 
-      Return
+   RETURN
 
-   END SUBROUTINE Agrif_clustering_def
+END SUBROUTINE Agrif_clustering_def
 
-   SUBROUTINE Agrif_comm_def(modelcomm)
-
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_clustering_def ***
-      !!--------------------------------------------- 
-      Use Agrif_Types
-      Use lib_mpp
-
-      IMPLICIT NONE
-
-      INTEGER :: modelcomm
-
-#if defined key_mpp_mpi
-      modelcomm = mpi_comm_opa
+#else
+SUBROUTINE Agrif2Model
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif2Model ***
+   !!--------------------------------------------- 
+   WRITE(*,*) 'Impossible to bet here'
+END SUBROUTINE Agrif2model
 #endif
-      Return
-
-   END SUBROUTINE Agrif_comm_def
-#else
-   SUBROUTINE Agrif2Model
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif2Model ***
-      !!--------------------------------------------- 
-      WRITE(*,*) 'Impossible to bet here'
-   END SUBROUTINE Agrif2model
-#endif
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 5901)
@@ -9,5 +9,5 @@
    !!            3.4   !  09-2012  (R. Benshila, C. Herbaut) update and EVP
    !!----------------------------------------------------------------------
-#if defined key_agrif && defined key_lim2
+#if defined key_agrif && defined key_lim2 
    !!----------------------------------------------------------------------
    !!   'key_lim2'  :                                 LIM 2.0 sea-ice model
@@ -41,4 +41,8 @@
    PUBLIC interp_adv_ice
 
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PRIVATE :: uice_agr, vice_agr
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PRIVATE :: tabice_agr 
+
+
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.4 , NEMO Consortium (2012)
@@ -65,6 +69,6 @@
       u_ice_nst(:,:) = 0.
       v_ice_nst(:,:) = 0.
-      CALL Agrif_Bc_variable( u_ice_nst, u_ice_id ,procname=interp_u_ice, calledweight=1. )
-      CALL Agrif_Bc_variable( v_ice_nst, v_ice_id ,procname=interp_v_ice, calledweight=1. )
+      CALL Agrif_Bc_variable( u_ice_id ,procname=interp_u_ice, calledweight=1. )
+      CALL Agrif_Bc_variable( v_ice_id ,procname=interp_v_ice, calledweight=1. )
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .FALSE.
@@ -138,5 +142,4 @@
       !!  we are in inside a new parent ice time step
       !!-----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj) :: zuice, zvice
       INTEGER :: ji,jj
       REAL(wp) :: zrhox, zrhoy
@@ -155,33 +158,36 @@
          Agrif_SpecialValue=-9999.
          Agrif_UseSpecialValue = .TRUE.
-         zuice = 0.
-         zvice = 0.
-         CALL Agrif_Bc_variable(zuice,u_ice_id,procname=interp_u_ice, calledweight=1.)
-         CALL Agrif_Bc_variable(zvice,v_ice_id,procname=interp_v_ice, calledweight=1.)
+         IF( .NOT. ALLOCATED(uice_agr) )THEN
+            ALLOCATE(uice_agr(jpi,jpj), vice_agr(jpi,jpj))
+         ENDIF
+         uice_agr = 0.
+         vice_agr = 0.
+         CALL Agrif_Bc_variable(u_ice_id,procname=interp_u_ice, calledweight=1.)
+         CALL Agrif_Bc_variable(v_ice_id,procname=interp_v_ice, calledweight=1.)
          Agrif_SpecialValue=0.
          Agrif_UseSpecialValue = .FALSE.
          !  
          zrhox = agrif_rhox() ;    zrhoy = agrif_rhoy()      
-         zuice(:,:) =  zuice(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)
-         zvice(:,:) =  zvice(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)
+         uice_agr(:,:) =  uice_agr(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)
+         vice_agr(:,:) =  vice_agr(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)
          ! fill  boundaries
          DO jj = 1, jpj
             DO ji = 1, 2
-               u_ice_oe(ji,  jj,2) = zuice(ji       ,jj) 
-               u_ice_oe(ji+2,jj,2) = zuice(nlci+ji-3,jj)
+               u_ice_oe(ji,  jj,2) = uice_agr(ji       ,jj) 
+               u_ice_oe(ji+2,jj,2) = uice_agr(nlci+ji-3,jj)
             END DO
          END DO
          DO jj = 1, jpj
-            v_ice_oe(2,jj,2) = zvice(2     ,jj) 
-            v_ice_oe(4,jj,2) = zvice(nlci-1,jj)
+            v_ice_oe(2,jj,2) = vice_agr(2     ,jj) 
+            v_ice_oe(4,jj,2) = vice_agr(nlci-1,jj)
          END DO
          DO ji = 1, jpi
-            u_ice_sn(ji,2,2) = zuice(ji,2     ) 
-            u_ice_sn(ji,4,2) = zuice(ji,nlcj-1)
+            u_ice_sn(ji,2,2) = uice_agr(ji,2     ) 
+            u_ice_sn(ji,4,2) = uice_agr(ji,nlcj-1)
          END DO
          DO jj = 1, 2
             DO ji = 1, jpi
-               v_ice_sn(ji,jj  ,2) = zvice(ji,jj       ) 
-               v_ice_sn(ji,jj+2,2) = zvice(ji,nlcj+jj-3)
+               v_ice_sn(ji,jj  ,2) = vice_agr(ji,jj       ) 
+               v_ice_sn(ji,jj+2,2) = vice_agr(ji,nlcj+jj-3)
             END DO
          END DO
@@ -334,5 +340,4 @@
       !!  we are in inside a new parent ice time step
      !!-----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 
       INTEGER :: ji,jj,jn
       !!-----------------------------------------------------------------------
@@ -345,8 +350,11 @@
          adv_ice_sn(:,:,:,1) =  adv_ice_sn(:,:,:,2)
          ! interpolation of boundaries
-         ztab(:,:,:) = 0.
+         IF(.NOT.ALLOCATED(tabice_agr))THEN
+            ALLOCATE(tabice_agr(jpi,jpj,7))   
+         ENDIF
+         tabice_agr(:,:,:) = 0.
          Agrif_SpecialValue=-9999.
          Agrif_UseSpecialValue = .TRUE.
-         CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. )
+         CALL Agrif_Bc_variable( adv_ice_id ,procname=interp_adv_ice,calledweight=1. )
          Agrif_SpecialValue=0.
          Agrif_UseSpecialValue = .FALSE.
@@ -356,6 +364,6 @@
             DO jj = 1, jpj
                DO ji=1,2
-                  adv_ice_oe(ji  ,jj,jn,2) = ztab(ji       ,jj,jn) 
-                  adv_ice_oe(ji+2,jj,jn,2) = ztab(nlci-2+ji,jj,jn)
+                  adv_ice_oe(ji  ,jj,jn,2) = tabice_agr(ji       ,jj,jn) 
+                  adv_ice_oe(ji+2,jj,jn,2) = tabice_agr(nlci-2+ji,jj,jn)
                END DO
             END DO
@@ -365,6 +373,6 @@
             Do jj =1,2
                DO ji = 1, jpi
-                  adv_ice_sn(ji,jj  ,jn,2) = ztab(ji,jj       ,jn) 
-                  adv_ice_sn(ji,jj+2,jn,2) = ztab(ji,nlcj-2+jj,jn)
+                  adv_ice_sn(ji,jj  ,jn,2) = tabice_agr(ji,jj       ,jn) 
+                  adv_ice_sn(ji,jj+2,jn,2) = tabice_agr(ji,nlcj-2+jj,jn)
                END DO
             END DO
@@ -384,5 +392,5 @@
       INTEGER :: ji,jj,jn
       REAL(wp) :: zalpha
-      REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 
+      REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr 
       !!-----------------------------------------------------------------------      
       !
@@ -391,10 +399,10 @@
       zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc))
       !
-      ztab(:,:,:) = 0.e0
+      tabice_agr(:,:,:) = 0.e0
       DO jn =1,7
          DO jj =1,2
             DO ji = 1, jpi
-               ztab(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2) 
-               ztab(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 
+               tabice_agr(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2) 
+               tabice_agr(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 
             END DO
          END DO
@@ -404,17 +412,17 @@
          DO jj = 1, jpj
             DO ji=1,2
-               ztab(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2) 
-               ztab(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 
+               tabice_agr(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2) 
+               tabice_agr(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 
             END DO
          END DO
       END DO
       !
-      CALL parcoursT( ztab(:,:, 1), frld  )
-      CALL parcoursT( ztab(:,:, 2), hicif )
-      CALL parcoursT( ztab(:,:, 3), hsnif )
-      CALL parcoursT( ztab(:,:, 4), tbif(:,:,1) )
-      CALL parcoursT( ztab(:,:, 5), tbif(:,:,2) )
-      CALL parcoursT( ztab(:,:, 6), tbif(:,:,3) )
-      CALL parcoursT( ztab(:,:, 7), qstoif )
+      CALL parcoursT( tabice_agr(:,:, 1), frld  )
+      CALL parcoursT( tabice_agr(:,:, 2), hicif )
+      CALL parcoursT( tabice_agr(:,:, 3), hsnif )
+      CALL parcoursT( tabice_agr(:,:, 4), tbif(:,:,1) )
+      CALL parcoursT( tabice_agr(:,:, 5), tbif(:,:,2) )
+      CALL parcoursT( tabice_agr(:,:, 6), tbif(:,:,3) )
+      CALL parcoursT( tabice_agr(:,:, 7), qstoif )
       !
    END SUBROUTINE agrif_trp_lim2
@@ -499,5 +507,5 @@
 
 
-   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2 )
+   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2, before )
       !!-----------------------------------------------------------------------
       !!                     *** ROUTINE interp_u_ice ***
@@ -505,4 +513,5 @@
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
       !!
       INTEGER :: ji,jj
@@ -510,28 +519,32 @@
       !
 #if defined key_lim2_vp
-      DO jj=MAX(j1,2),j2
-         DO ji=MAX(i1,2),i2
-            IF( tmu(ji,jj) == 0. ) THEN
-               tabres(ji,jj) = -9999.
-            ELSE
-               tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
-            ENDIF
-         END DO
-      END DO
+      IF( before ) THEN
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               IF( tmu(ji,jj) == 0. ) THEN
+                  tabres(ji,jj) = -9999.
+               ELSE
+                  tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
+               ENDIF
+            END DO
+         END DO
+      ENDIF
 #else
-      DO jj= j1, j2
-         DO ji= i1, i2
-            IF( umask(ji,jj,1) == 0. ) THEN
-               tabres(ji,jj) = -9999.
-            ELSE
-               tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
-            ENDIF
-         END DO
-      END DO
+      IF( before ) THEN
+         DO jj= j1, j2
+            DO ji= i1, i2
+               IF( umask(ji,jj,1) == 0. ) THEN
+                  tabres(ji,jj) = -9999.
+               ELSE
+                  tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
+               ENDIF
+            END DO
+         END DO
+      ENDIF
 #endif
    END SUBROUTINE interp_u_ice
 
 
-   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2 )
+   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2, before )
       !!-----------------------------------------------------------------------
       !!                    *** ROUTINE interp_v_ice ***
@@ -539,4 +552,5 @@
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
       !!
       INTEGER :: ji, jj
@@ -544,28 +558,32 @@
       !
 #if defined key_lim2_vp
-      DO jj=MAX(j1,2),j2
-         DO ji=MAX(i1,2),i2
-            IF( tmu(ji,jj) == 0. ) THEN
-               tabres(ji,jj) = -9999.
-            ELSE
-               tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
-            ENDIF
-         END DO
-      END DO
+      IF( before ) THEN
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               IF( tmu(ji,jj) == 0. ) THEN
+                  tabres(ji,jj) = -9999.
+               ELSE
+                  tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
+               ENDIF
+            END DO
+         END DO
+      ENDIF   
 #else
-      DO jj= j1 ,j2
-         DO ji = i1, i2
-            IF( vmask(ji,jj,1) == 0. ) THEN
-               tabres(ji,jj) = -9999.
-            ELSE
-               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
-            ENDIF
-         END DO
-      END DO
+      IF( before ) THEN
+	      DO jj= j1 ,j2
+	         DO ji = i1, i2
+	            IF( vmask(ji,jj,1) == 0. ) THEN
+	               tabres(ji,jj) = -9999.
+	            ELSE
+	               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
+	            ENDIF
+	         END DO
+	      END DO
+      ENDIF
 #endif
    END SUBROUTINE interp_v_ice
 
 
-   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2 )
+   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before )
       !!-----------------------------------------------------------------------
       !!                    *** ROUTINE interp_adv_ice ***                           
@@ -577,23 +595,26 @@
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
       !!
       INTEGER :: ji, jj, jk
       !!-----------------------------------------------------------------------
       !
-      DO jj=j1,j2
-         DO ji=i1,i2
-            IF( tms(ji,jj) == 0. ) THEN
-               tabres(ji,jj,:) = -9999. 
-            ELSE
-               tabres(ji,jj, 1) = frld  (ji,jj)
-               tabres(ji,jj, 2) = hicif (ji,jj)
-               tabres(ji,jj, 3) = hsnif (ji,jj)
-               tabres(ji,jj, 4) = tbif  (ji,jj,1)
-               tabres(ji,jj, 5) = tbif  (ji,jj,2)
-               tabres(ji,jj, 6) = tbif  (ji,jj,3)
-               tabres(ji,jj, 7) = qstoif(ji,jj)
-            ENDIF
-         END DO
-      END DO
+      IF( before ) THEN
+	      DO jj=j1,j2
+	         DO ji=i1,i2
+	            IF( tms(ji,jj) == 0. ) THEN
+	               tabres(ji,jj,:) = -9999. 
+	            ELSE
+	               tabres(ji,jj, 1) = frld  (ji,jj)
+	               tabres(ji,jj, 2) = hicif (ji,jj)
+	               tabres(ji,jj, 3) = hsnif (ji,jj)
+	               tabres(ji,jj, 4) = tbif  (ji,jj,1)
+	               tabres(ji,jj, 5) = tbif  (ji,jj,2)
+	               tabres(ji,jj, 6) = tbif  (ji,jj,3)
+	               tabres(ji,jj, 7) = qstoif(ji,jj)
+	            ENDIF
+	         END DO
+	      END DO
+      ENDIF
       !
    END SUBROUTINE interp_adv_ice
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 5901)
@@ -52,6 +52,4 @@
       INTEGER, INTENT(in) :: kt
       !!
-      REAL(wp), DIMENSION(jpi,jpj)  :: zvel
-      REAL(wp), DIMENSION(jpi,jpj,7):: zadv
       !!----------------------------------------------------------------------
       !
@@ -60,14 +58,13 @@
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
-
 # if defined TWO_WAY
       IF( MOD(nbcline,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable( zadv , adv_ice_id , procname = update_adv_ice  )
-         CALL Agrif_Update_Variable( zvel , u_ice_id   , procname = update_u_ice    )
-         CALL Agrif_Update_Variable( zvel , v_ice_id   , procname = update_v_ice    )
-      ELSE
-         CALL Agrif_Update_Variable( zadv , adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  )
-         CALL Agrif_Update_Variable( zvel , u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
-         CALL Agrif_Update_Variable( zvel , v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
+         CALL Agrif_Update_Variable( adv_ice_id , procname = update_adv_ice  )
+         CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
+         CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
+      ELSE
+         CALL Agrif_Update_Variable( adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  )
+         CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
+         CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
       ENDIF
 # endif
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 5901)
@@ -12,5 +12,5 @@
    USE par_oce      ! ocean parameters
    USE dom_oce      ! domain parameters
-   
+
    IMPLICIT NONE
    PRIVATE 
@@ -19,8 +19,10 @@
 
    !                                              !!* Namelist namagrif: AGRIF parameters
-   LOGICAL , PUBLIC ::   ln_spc_dyn      !:
-   INTEGER , PUBLIC ::   nn_cln_update   !: update frequency 
-   REAL(wp), PUBLIC ::   rn_sponge_tra   !: sponge coeff. for tracers
-   REAL(wp), PUBLIC ::   rn_sponge_dyn   !: sponge coeff. for dynamics
+   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !:
+   INTEGER , PUBLIC ::   nn_cln_update = 3         !: update frequency 
+   INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points)
+   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers
+   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics
+   LOGICAL , PUBLIC ::   ln_chk_bathy  = .FALSE.   !: check of parent bathymetry 
 
    !                                              !!! OLD namelist names
@@ -30,16 +32,42 @@
    REAL(wp), PUBLIC ::   visc_dyn                  !: sponge coeff. for dynamics
 
-   LOGICAL , PUBLIC :: spongedoneT = .FALSE.   !: tracer   sponge layer indicator
-   LOGICAL , PUBLIC :: spongedoneU = .FALSE.   !: dynamics sponge layer indicator
-   LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE. !: if true: first step
+   LOGICAL , PUBLIC :: spongedoneT = .FALSE.       !: tracer   sponge layer indicator
+   LOGICAL , PUBLIC :: spongedoneU = .FALSE.       !: dynamics sponge layer indicator
+   LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE.     !: if true: first step
+   LOGICAL , PUBLIC :: lk_agrif_doupd = .TRUE.     !: if true: send update from current grid
+   LOGICAL , PUBLIC :: lk_agrif_debug = .FALSE.    !: if true: print debugging info
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur , spe2vr , spbtr2   !: ???
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur2, spe2vr2, spbtr3   !: ???
-   
-   INTEGER :: tsn_id,tsb_id,tsa_id
-   INTEGER :: un_id, vn_id, ua_id, va_id
-   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id
-   INTEGER :: trn_id, trb_id, tra_id
-   INTEGER :: unb_id, vnb_id, ub2b_id, vb2b_id
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_tsn
+# if defined key_top
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_trn
+# endif
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_u
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_v
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsaht_spu, fsaht_spv !: sponge diffusivities
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities
+
+   ! Barotropic arrays used to store open boundary data during
+   ! time-splitting loop:
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_n, vbdy_n, hbdy_n
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s
+
+   INTEGER :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update
+   INTEGER :: un_interp_id, vn_interp_id                              ! AGRIF profiles for interpolations
+   INTEGER :: un_update_id, vn_update_id                              ! AGRIF profiles for udpates
+   INTEGER :: tsn_sponge_id, un_sponge_id, vn_sponge_id               ! AGRIF profiles for sponge layers
+# if defined key_top
+   INTEGER :: trn_id, trn_sponge_id
+# endif  
+   INTEGER :: unb_id, vnb_id, ub2b_interp_id, vb2b_interp_id
+   INTEGER :: ub2b_update_id, vb2b_update_id
+   INTEGER :: e3t_id, e1u_id, e2v_id, sshn_id
+   INTEGER :: scales_t_id
+# if defined key_zdftke
+   INTEGER :: avt_id, avm_id, en_id
+# endif  
+   INTEGER :: umsk_id, vmsk_id
+   INTEGER :: kindic_agr
 
    !!----------------------------------------------------------------------
@@ -54,6 +82,24 @@
       !!                ***  FUNCTION agrif_oce_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( spe1ur (jpi,jpj) , spe2vr (jpi,jpj) , spbtr2(jpi,jpj) ,      &
-         &      spe1ur2(jpi,jpj) , spe2vr2(jpi,jpj) , spbtr3(jpi,jpj) , STAT = agrif_oce_alloc ) 
+      INTEGER, DIMENSION(2) :: ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj),   &
+         &      fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj),   &
+         &      tabspongedone_tsn(jpi,jpj),           &
+# if defined key_top         
+         &      tabspongedone_trn(jpi,jpj),           &
+# endif         
+         &      tabspongedone_u  (jpi,jpj),           &
+         &      tabspongedone_v  (jpi,jpj), STAT = ierr(1) )
+
+      ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj),   &
+         &      ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj),   & 
+         &      ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi),   & 
+         &      ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi), STAT = ierr(2) )
+
+      agrif_oce_alloc = MAXVAL(ierr)
+      !
    END FUNCTION agrif_oce_alloc
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 5901)
@@ -7,4 +7,5 @@
    !!             -   !  2005-11  (XXX) 
    !!            3.2  !  2009-04  (R. Benshila) 
+   !!            3.6  !  2014-09  (R. Benshila) 
    !!----------------------------------------------------------------------
 #if defined key_agrif && ! defined key_offline
@@ -29,139 +30,42 @@
    USE wrk_nemo
    USE dynspg_oce
-
+   USE zdf_oce
+ 
    IMPLICIT NONE
    PRIVATE
 
-   ! Barotropic arrays used to store open boundary data during
-   ! time-splitting loop:
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_n, vbdy_n, hbdy_n
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s
-    
+   INTEGER :: bdy_tinterp = 0
+
    PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts
-   PUBLIC   interpu, interpv, interpunb, interpvnb, interpsshn
+   PUBLIC   interpun, interpvn, interpun2d, interpvn2d 
+   PUBLIC   interptsn,  interpsshn
+   PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b
+   PUBLIC   interpe3t, interpumsk, interpvmsk
+# if defined key_zdftke
+   PUBLIC   Agrif_tke, interpavm
+# endif
 
 #  include "domzgr_substitute.h90"  
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
-   CONTAINS
-   
+CONTAINS
+
    SUBROUTINE Agrif_tra
       !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_Tra  ***
-      !!----------------------------------------------------------------------
-      !!
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3
-      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsa
+      !!                  ***  ROUTINE Agrif_tra  ***
       !!----------------------------------------------------------------------
       !
       IF( Agrif_Root() )   RETURN
-
-      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztsa ) 
 
       Agrif_SpecialValue    = 0.e0
       Agrif_UseSpecialValue = .TRUE.
-      ztsa(:,:,:,:) = 0.e0
-
-      CALL Agrif_Bc_variable( ztsa, tsn_id, procname=interptsn )
+
+      CALL Agrif_Bc_variable( tsn_id, procname=interptsn )
       Agrif_UseSpecialValue = .FALSE.
-
-      zrhox = Agrif_Rhox()
-
-      alpha1 = ( zrhox - 1. ) * 0.5
-      alpha2 = 1. - alpha1
-
-      alpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
-      alpha4 = 1. - alpha3
-
-      alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-      alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-      alpha5 = 1. - alpha6 - alpha7
-
-      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
-
-         DO jn = 1, jpts
-            tsa(nlci,:,:,jn) = alpha1 * ztsa(nlci,:,:,jn) + alpha2 * ztsa(nlci-1,:,:,jn)
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
-                     tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
-                  ELSE
-                     tsa(nlci-1,jj,jk,jn)=(alpha4*tsa(nlci,jj,jk,jn)+alpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
-                        tsa(nlci-1,jj,jk,jn)=( alpha6*tsa(nlci-2,jj,jk,jn)+alpha5*tsa(nlci,jj,jk,jn)  &
-                           &                 + alpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         ENDDO
-      ENDIF
-
-      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
-
-         DO jn = 1, jpts
-            tsa(:,nlcj,:,jn) = alpha1 * ztsa(:,nlcj,:,jn) + alpha2 * ztsa(:,nlcj-1,:,jn)
-            DO jk = 1, jpkm1
-               DO ji = 1, jpi
-                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
-                     tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
-                  ELSE
-                     tsa(ji,nlcj-1,jk,jn)=(alpha4*tsa(ji,nlcj,jk,jn)+alpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
-                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
-                        tsa(ji,nlcj-1,jk,jn)=( alpha6*tsa(ji,nlcj-2,jk,jn)+alpha5*tsa(ji,nlcj,jk,jn)  &
-                           &                 + alpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         ENDDO 
-      ENDIF
-
-      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
-         DO jn = 1, jpts
-            tsa(1,:,:,jn) = alpha1 * ztsa(1,:,:,jn) + alpha2 * ztsa(2,:,:,jn)
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  IF( umask(2,jj,jk) == 0.e0 ) THEN
-                     tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
-                  ELSE
-                     tsa(2,jj,jk,jn)=(alpha4*tsa(1,jj,jk,jn)+alpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
-                     IF( un(2,jj,jk) < 0.e0 ) THEN
-                        tsa(2,jj,jk,jn)=(alpha6*tsa(3,jj,jk,jn)+alpha5*tsa(1,jj,jk,jn)+alpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      ENDIF
-
-      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
-         DO jn = 1, jpts
-            tsa(:,1,:,jn) = alpha1 * ztsa(:,1,:,jn) + alpha2 * ztsa(:,2,:,jn)
-            DO jk=1,jpk      
-               DO ji=1,jpi
-                  IF( vmask(ji,2,jk) == 0.e0 ) THEN
-                     tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
-                  ELSE
-                     tsa(ji,2,jk,jn)=(alpha4*tsa(ji,1,jk,jn)+alpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
-                     IF( vn(ji,2,jk) < 0.e0 ) THEN
-                        tsa(ji,2,jk,jn)=(alpha6*tsa(ji,3,jk,jn)+alpha5*tsa(ji,1,jk,jn)+alpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         ENDDO
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztsa ) 
       !
    END SUBROUTINE Agrif_tra
@@ -175,16 +79,27 @@
       INTEGER, INTENT(in) ::   kt
       !!
-      INTEGER :: ji,jj,jk
+      INTEGER :: ji,jj,jk, j1,j2, i1,i2
       REAL(wp) :: timeref
       REAL(wp) :: z2dt, znugdt
       REAL(wp) :: zrhox, zrhoy
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva
-      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1, zua2d, zva2d
+      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1
       !!----------------------------------------------------------------------  
 
       IF( Agrif_Root() )   RETURN
 
-      CALL wrk_alloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d )
-      CALL wrk_alloc( jpi, jpj, jpk, zua, zva )
+      CALL wrk_alloc( jpi, jpj, spgv1, spgu1 )
+
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+
+      CALL Agrif_Bc_variable(un_interp_id,procname=interpun)
+      CALL Agrif_Bc_variable(vn_interp_id,procname=interpvn)
+
+#if defined key_dynspg_flt
+      CALL Agrif_Bc_variable(e1u_id,calledweight=1., procname=interpun2d)
+      CALL Agrif_Bc_variable(e2v_id,calledweight=1., procname=interpvn2d)
+#endif
+
+      Agrif_UseSpecialValue = .FALSE.
 
       zrhox = Agrif_Rhox()
@@ -192,5 +107,4 @@
 
       timeref = 1.
-
       ! time step: leap-frog
       z2dt = 2. * rdt
@@ -200,50 +114,28 @@
       znugdt =  grav * z2dt    
 
-      Agrif_SpecialValue=0.
-      Agrif_UseSpecialValue = ln_spc_dyn
-
-      zua = 0.
-      zva = 0.
-      CALL Agrif_Bc_variable(zua,un_id,procname=interpu)
-      CALL Agrif_Bc_variable(zva,vn_id,procname=interpv)
-      zua2d = 0.
-      zva2d = 0.
-
+      ! prevent smoothing in ghost cells
+      i1=1
+      i2=jpi
+      j1=1
+      j2=jpj
+      IF((nbondj == -1).OR.(nbondj == 2)) j1 = 3
+      IF((nbondj == +1).OR.(nbondj == 2)) j2 = nlcj-2
+      IF((nbondi == -1).OR.(nbondi == 2)) i1 = 3
+      IF((nbondi == +1).OR.(nbondi == 2)) i2 = nlci-2
+
+
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
 #if defined key_dynspg_flt
-      Agrif_SpecialValue=0.
-      Agrif_UseSpecialValue = ln_spc_dyn
-      CALL Agrif_Bc_variable(zua2d,e1u_id,calledweight=1.,procname=interpu2d)
-      CALL Agrif_Bc_variable(zva2d,e2v_id,calledweight=1.,procname=interpv2d)
-#endif
-      Agrif_UseSpecialValue = .FALSE.
-
-
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-
-#if defined key_dynspg_flt
-         DO jj=1,jpj
-            laplacu(2,jj) = timeref * (zua2d(2,jj)/(zrhoy*e2u(2,jj)))*umask(2,jj,1)
-         END DO
-#endif
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk)
+            END DO
+         END DO
+
+         spgu(2,:)=0.
 
          DO jk=1,jpkm1
             DO jj=1,jpj
-               ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(zrhoy*e2u(1:2,jj)))
-               ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u_a(1:2,jj,jk)
-            END DO
-         END DO
-
-#if defined key_dynspg_flt
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk)
-            END DO
-         END DO
-
-         spgu(2,:)=0.
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               spgu(2,jj)=spgu(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk)
+               spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk)
             END DO
          END DO
@@ -251,5 +143,5 @@
          DO jj=1,jpj
             IF (umask(2,jj,1).NE.0.) THEN
-               spgu(2,jj)=spgu(2,jj)*hur_a(2,jj)
+               spgu(2,jj)=spgu(2,jj)/hu(2,jj)
             ENDIF
          END DO
@@ -259,5 +151,5 @@
 
          DO jk=1,jpkm1
-            DO jj=1,jpj
+            DO jj=j1,j2
                ua(2,jj,jk) = 0.25*(ua(1,jj,jk)+2.*ua(2,jj,jk)+ua(3,jj,jk))
                ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
@@ -269,5 +161,5 @@
          DO jk=1,jpkm1
             DO jj=1,jpj
-               spgu1(2,jj)=spgu1(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk)
+               spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk)
             END DO
          END DO
@@ -275,18 +167,11 @@
          DO jj=1,jpj
             IF (umask(2,jj,1).NE.0.) THEN
-               spgu1(2,jj)=spgu1(2,jj)*hur_a(2,jj)
-            ENDIF
-         END DO
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
+               spgu1(2,jj)=spgu1(2,jj)/hu(2,jj)
+            ENDIF
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=j1,j2
                ua(2,jj,jk) = (ua(2,jj,jk)+spgu(2,jj)-spgu1(2,jj))*umask(2,jj,jk)
-            END DO
-         END DO
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               va(2,jj,jk) = (zva(2,jj,jk)/(zrhox*e1v(2,jj)))*vmask(2,jj,jk)
-               va(2,jj,jk) = va(2,jj,jk) / fse3v_a(2,jj,jk)
             END DO
          END DO
@@ -300,9 +185,7 @@
             END DO
          END DO
-
          DO jj=1,jpj
             spgv1(2,jj)=spgv1(2,jj)*hvr_a(2,jj)
          END DO
-
          DO jk=1,jpkm1
             DO jj=1,jpj
@@ -316,35 +199,18 @@
       IF((nbondi == 1).OR.(nbondi == 2)) THEN
 #if defined key_dynspg_flt
-         DO jj=1,jpj
-            laplacu(nlci-2,jj) = timeref * (zua2d(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj)))
-         END DO
-#endif
-
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk)
+            END DO
+         END DO
+         spgu(nlci-2,:)=0.
          DO jk=1,jpkm1
             DO jj=1,jpj
-               ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(zrhoy*e2u(nlci-2:nlci-1,jj)))
-               ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u_a(nlci-2:nlci-1,jj,jk)
-            END DO
-         END DO
-
-#if defined key_dynspg_flt
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk)
-            END DO
-         END DO
-
-
-         spgu(nlci-2,:)=0.
-
-         do jk=1,jpkm1
-            do jj=1,jpj
-               spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk)
-            enddo
-         enddo
-
+               spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)
+            ENDDO
+         ENDDO
          DO jj=1,jpj
             IF (umask(nlci-2,jj,1).NE.0.) THEN
-               spgu(nlci-2,jj)=spgu(nlci-2,jj)*hur_a(nlci-2,jj)
+               spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj)
             ENDIF
          END DO
@@ -352,38 +218,26 @@
          spgu(nlci-2,:) = ua_b(nlci-2,:)
 #endif
-
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk))
+
+               ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk)
+
+            END DO
+         END DO
+         spgu1(nlci-2,:)=0.
          DO jk=1,jpkm1
             DO jj=1,jpj
-               ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk))
-
-               ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk)
-
-            END DO
-         END DO
-
-         spgu1(nlci-2,:)=0.
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk)
-            END DO
-         END DO
-
+               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk)
+            END DO
+         END DO
          DO jj=1,jpj
             IF (umask(nlci-2,jj,1).NE.0.) THEN
-               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*hur_a(nlci-2,jj)
-            ENDIF
-         END DO
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
+               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj)
+            ENDIF
+         END DO
+         DO jk=1,jpkm1
+            DO jj=j1,j2
                ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+spgu(nlci-2,jj)-spgu1(nlci-2,jj))*umask(nlci-2,jj,jk)
-            END DO
-         END DO
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj-1
-               va(nlci-1,jj,jk) = (zva(nlci-1,jj,jk)/(zrhox*e1v(nlci-1,jj)))*vmask(nlci-1,jj,jk)
-               va(nlci-1,jj,jk) = va(nlci-1,jj,jk) / fse3v_a(nlci-1,jj,jk)
             END DO
          END DO
@@ -414,17 +268,4 @@
 
 #if defined key_dynspg_flt
-         DO ji=1,jpi
-            laplacv(ji,2) = timeref * (zva2d(ji,2)/(zrhox*e1v(ji,2)))
-         END DO
-#endif
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               va(ji,1:2,jk) = (zva(ji,1:2,jk)/(zrhox*e1v(ji,1:2)))
-               va(ji,1:2,jk) = va(ji,1:2,jk) / fse3v_a(ji,1:2,jk)
-            END DO
-         END DO
-
-#if defined key_dynspg_flt
          DO jk=1,jpkm1
             DO ji=1,jpi
@@ -437,5 +278,5 @@
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv(ji,2)=spgv(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)
+               spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)
             END DO
          END DO
@@ -443,5 +284,5 @@
          DO ji=1,jpi
             IF (vmask(ji,2,1).NE.0.) THEN
-               spgv(ji,2)=spgv(ji,2)*hvr_a(ji,2)
+               spgv(ji,2)=spgv(ji,2)/hv(ji,2)
             ENDIF
          END DO
@@ -451,5 +292,5 @@
 
          DO jk=1,jpkm1
-            DO ji=1,jpi
+            DO ji=i1,i2
                va(ji,2,jk)=0.25*(va(ji,1,jk)+2.*va(ji,2,jk)+va(ji,3,jk))
                va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk)
@@ -461,5 +302,5 @@
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv1(ji,2)=spgv1(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)
+               spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)
             END DO
          END DO
@@ -467,5 +308,5 @@
          DO ji=1,jpi
             IF (vmask(ji,2,1).NE.0.) THEN
-               spgv1(ji,2)=spgv1(ji,2)*hvr_a(ji,2)
+               spgv1(ji,2)=spgv1(ji,2)/hv(ji,2)
             ENDIF
          END DO
@@ -474,11 +315,4 @@
             DO ji=1,jpi
                va(ji,2,jk) = (va(ji,2,jk)+spgv(ji,2)-spgv1(ji,2))*vmask(ji,2,jk)
-            END DO
-         END DO
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               ua(ji,2,jk) = (zua(ji,2,jk)/(zrhoy*e2u(ji,2)))*umask(ji,2,jk) 
-               ua(ji,2,jk) = ua(ji,2,jk) / fse3u_a(ji,2,jk)
             END DO
          END DO
@@ -508,17 +342,4 @@
 
 #if defined key_dynspg_flt
-         DO ji=1,jpi
-            laplacv(ji,nlcj-2) = timeref * (zva2d(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)))
-         END DO
-#endif
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               va(ji,nlcj-2:nlcj-1,jk) = (zva(ji,nlcj-2:nlcj-1,jk)/(zrhox*e1v(ji,nlcj-2:nlcj-1)))
-               va(ji,nlcj-2:nlcj-1,jk) = va(ji,nlcj-2:nlcj-1,jk) / fse3v_a(ji,nlcj-2:nlcj-1,jk)
-            END DO
-         END DO
-
-#if defined key_dynspg_flt
          DO jk=1,jpkm1
             DO ji=1,jpi
@@ -527,9 +348,10 @@
          END DO
 
+
          spgv(:,nlcj-2)=0.
 
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
+               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
             END DO
          END DO
@@ -537,7 +359,8 @@
          DO ji=1,jpi
             IF (vmask(ji,nlcj-2,1).NE.0.) THEN
-               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*hvr_a(ji,nlcj-2)
-            ENDIF
-         END DO
+               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2)
+            ENDIF
+         END DO
+
 #else
          spgv(:,nlcj-2)=va_b(:,nlcj-2)
@@ -545,5 +368,5 @@
 
          DO jk=1,jpkm1
-            DO ji=1,jpi
+            DO ji=i1,i2
                va(ji,nlcj-2,jk)=0.25*(va(ji,nlcj-3,jk)+2.*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk))
                va(ji,nlcj-2,jk) = va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk)
@@ -555,5 +378,5 @@
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
+               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
             END DO
          END DO
@@ -561,5 +384,5 @@
          DO ji=1,jpi
             IF (vmask(ji,nlcj-2,1).NE.0.) THEN
-               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*hvr_a(ji,nlcj-2)
+               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2)
             ENDIF
          END DO
@@ -568,11 +391,4 @@
             DO ji=1,jpi
                va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+spgv(ji,nlcj-2)-spgv1(ji,nlcj-2))*vmask(ji,nlcj-2,jk)
-            END DO
-         END DO
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/(zrhoy*e2u(ji,nlcj-1)))*umask(ji,nlcj-1,jk)
-               ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u_a(ji,nlcj-1,jk)
             END DO
          END DO
@@ -600,6 +416,5 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d )
-      CALL wrk_dealloc( jpi, jpj, jpk, zua, zva )
+      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1 )
       !
    END SUBROUTINE Agrif_dyn
@@ -620,9 +435,9 @@
          DO jj=1,jpj
             va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj)
-! Specified fluxes:
+            ! Specified fluxes:
             ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj)
-! Characteristics method:
-!alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
-!alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
+            ! Characteristics method:
+            !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
+            !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
          END DO
       ENDIF
@@ -631,9 +446,9 @@
          DO jj=1,jpj
             va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj)
-! Specified fluxes:
+            ! Specified fluxes:
             ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj)
-! Characteristics method:
-!alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
-!alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
+            ! Characteristics method:
+            !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
+            !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
          END DO
       ENDIF
@@ -642,9 +457,9 @@
          DO ji=1,jpi
             ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2)
-! Specified fluxes:
+            ! Specified fluxes:
             va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2)
-! Characteristics method:
-!alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
-!alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
+            ! Characteristics method:
+            !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
+            !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
          END DO
       ENDIF
@@ -653,9 +468,9 @@
          DO ji=1,jpi
             ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1)
-! Specified fluxes:
+            ! Specified fluxes:
             va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2)
-! Characteristics method:
-!alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
-!alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
+            ! Characteristics method:
+            !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
+            !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
          END DO
       ENDIF
@@ -672,9 +487,5 @@
       INTEGER :: ji, jj
       LOGICAL :: ll_int_cons
-      REAL(wp) :: zrhox, zrhoy, zrhot, zt
-      REAL(wp) :: zaa, zab, zat
-      REAL(wp) :: zt0, zt1
-      REAL(wp), POINTER, DIMENSION(:,:) :: zunb, zvnb, zsshn
-      REAL(wp), POINTER, DIMENSION(:,:) :: zuab, zvab, zubb, zvbb, zutn, zvtn
+      REAL(wp) :: zrhot, zt
       !!----------------------------------------------------------------------  
 
@@ -682,18 +493,7 @@
 
       ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in
-                             ! the forward case only
-
-      zrhox = Agrif_Rhox()
-      zrhoy = Agrif_Rhoy()
+      ! the forward case only
+
       zrhot = Agrif_rhot()
-
-      IF ( kt==nit000 ) THEN ! Allocate boundary data arrays
-         ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj))
-         ALLOCATE( ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj))
-         ALLOCATE( ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi))
-         ALLOCATE( ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi))
-      ENDIF
-
-      CALL wrk_alloc( jpi, jpj, zunb, zvnb, zsshn )
 
       ! "Central" time index for interpolation:
@@ -707,5 +507,5 @@
       Agrif_SpecialValue    = 0.e0
       Agrif_UseSpecialValue = .TRUE.
-      CALL Agrif_Bc_variable(zsshn, sshn_id,calledweight=zt, procname=interpsshn )
+      CALL Agrif_Bc_variable(sshn_id,calledweight=zt, procname=interpsshn )
       Agrif_UseSpecialValue = .FALSE.
 
@@ -715,333 +515,827 @@
 
       IF (ll_int_cons) THEN ! Conservative interpolation
-         CALL wrk_alloc( jpi, jpj, zuab, zvab, zubb, zvbb, zutn, zvtn )
-         zuab(:,:) = 0._wp ; zvab(:,:) = 0._wp
-         zubb(:,:) = 0._wp ; zvbb(:,:) = 0._wp
-         zutn(:,:) = 0._wp ; zvtn(:,:) = 0._wp
-         CALL Agrif_Bc_variable(zubb,unb_id ,calledweight=0._wp, procname=interpunb) ! Before
-         CALL Agrif_Bc_variable(zvbb,vnb_id ,calledweight=0._wp, procname=interpvnb)
-         CALL Agrif_Bc_variable(zuab,unb_id ,calledweight=1._wp, procname=interpunb) ! After
-         CALL Agrif_Bc_variable(zvab,vnb_id ,calledweight=1._wp, procname=interpvnb)
-         CALL Agrif_Bc_variable(zutn,ub2b_id,calledweight=1._wp, procname=interpub2b)! Time integrated
-         CALL Agrif_Bc_variable(zvtn,vb2b_id,calledweight=1._wp, procname=interpvb2b)
-         
+         ! orders matters here !!!!!!
+         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1._wp, procname=interpub2b) ! Time integrated
+         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1._wp, procname=interpvb2b)
+         bdy_tinterp = 1
+         CALL Agrif_Bc_variable(unb_id ,calledweight=1._wp, procname=interpunb) ! After
+         CALL Agrif_Bc_variable(vnb_id ,calledweight=1._wp, procname=interpvnb)
+         bdy_tinterp = 2
+         CALL Agrif_Bc_variable(unb_id ,calledweight=0._wp, procname=interpunb) ! Before
+         CALL Agrif_Bc_variable(vnb_id ,calledweight=0._wp, procname=interpvnb)         
+      ELSE ! Linear interpolation
+         bdy_tinterp = 0
+         ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 
+         ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 
+         ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 
+         ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 
+         CALL Agrif_Bc_variable(unb_id,calledweight=zt, procname=interpunb)
+         CALL Agrif_Bc_variable(vnb_id,calledweight=zt, procname=interpvnb)
+      ENDIF
+      Agrif_UseSpecialValue = .FALSE.
+      ! 
+   END SUBROUTINE Agrif_dta_ts
+
+   SUBROUTINE Agrif_ssh( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_DYN  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) ::   kt
+      !!
+      !!----------------------------------------------------------------------  
+
+      IF( Agrif_Root() )   RETURN
+
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         ssha(2,:)=ssha(3,:)
+         sshn(2,:)=sshn(3,:)
+      ENDIF
+
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         ssha(nlci-1,:)=ssha(nlci-2,:)
+         sshn(nlci-1,:)=sshn(nlci-2,:)
+      ENDIF
+
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         ssha(:,2)=ssha(:,3)
+         sshn(:,2)=sshn(:,3)
+      ENDIF
+
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         ssha(:,nlcj-1)=ssha(:,nlcj-2)
+         sshn(:,nlcj-1)=sshn(:,nlcj-2)
+      ENDIF
+
+   END SUBROUTINE Agrif_ssh
+
+   SUBROUTINE Agrif_ssh_ts( jn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_ssh_ts  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) ::   jn
+      !!
+      INTEGER :: ji,jj
+      !!----------------------------------------------------------------------  
+
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+            ssha_e(2,jj) = hbdy_w(jj)
+         END DO
+      ENDIF
+
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+            ssha_e(nlci-1,jj) = hbdy_e(jj)
+         END DO
+      ENDIF
+
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO ji=1,jpi
+            ssha_e(ji,2) = hbdy_s(ji)
+         END DO
+      ENDIF
+
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO ji=1,jpi
+            ssha_e(ji,nlcj-1) = hbdy_n(ji)
+         END DO
+      ENDIF
+
+   END SUBROUTINE Agrif_ssh_ts
+
+# if defined key_zdftke
+   SUBROUTINE Agrif_tke
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_tke  ***
+      !!----------------------------------------------------------------------  
+      REAL(wp) ::   zalpha
+      !
+      zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp )
+      IF( zalpha > 1. )   zalpha = 1.
+      
+      Agrif_SpecialValue    = 0.e0
+      Agrif_UseSpecialValue = .TRUE.
+      
+      CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)       
+              
+      Agrif_UseSpecialValue = .FALSE.
+      !
+   END SUBROUTINE Agrif_tke
+# endif
+
+   SUBROUTINE interptsn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptsn ***
+      !!---------------------------------------------
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER :: imin, imax, jmin, jmax
+      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
+      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+
+      IF (before) THEN         
+         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE
+         !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         !
+         zrhox = Agrif_Rhox()
+         ! 
+         zalpha1 = ( zrhox - 1. ) * 0.5
+         zalpha2 = 1. - zalpha1
+         ! 
+         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
+         zalpha4 = 1. - zalpha3
+         ! 
+         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+         zalpha5 = 1. - zalpha6 - zalpha7
+         !
+         imin = i1
+         imax = i2
+         jmin = j1
+         jmax = j2
+         ! 
+         ! Remove CORNERS
+         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
+         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
+         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
+         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
+         !
+         IF( eastern_side) THEN
+            DO jn = 1, jpts
+               tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
+                        tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                     ELSE
+                        tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
+                           tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 
+                                 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         ! 
+         IF( northern_side ) THEN            
+            DO jn = 1, jpts
+               tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO ji = imin,imax
+                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
+                        tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                     ELSE
+                        tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
+                           tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  &
+                                 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         !
+         IF( western_side) THEN            
+            DO jn = 1, jpts
+               tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(2,jj,jk) == 0.e0 ) THEN
+                        tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
+                     ELSE
+                        tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
+                        IF( un(2,jj,jk) < 0.e0 ) THEN
+                           tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+         IF( southern_side ) THEN           
+            DO jn = 1, jpts
+               tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
+               DO jk=1,jpk      
+                  DO ji=imin,imax
+                     IF( vmask(ji,2,jk) == 0.e0 ) THEN
+                        tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
+                     ELSE
+                        tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
+                        IF( vn(ji,2,jk) < 0.e0 ) THEN
+                           tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         !
+         ! Treatment of corners
+         ! 
+         ! East south
+         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
+         ENDIF
+         ! East north
+         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
+         ENDIF
+         ! West south
+         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tsa(2,2,:,:) = ptab(2,2,:,:)
+         ENDIF
+         ! West north
+         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE interptsn
+
+   SUBROUTINE interpsshn(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      !
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = sshn(i1:i2,j1:j2)
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         IF(western_side)  hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
+         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
+         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
+         IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
+      ENDIF
+      !
+   END SUBROUTINE interpsshn
+
+   SUBROUTINE interpun(ptab,i1,i2,j1,j2,k1,k2, before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpun ***
+      !!---------------------------------------------    
+      !!
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: zrhoy	
+      !!---------------------------------------------    
+      !
+      IF (before) THEN 
+         DO jk=1,jpk
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
+                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+         zrhoy = Agrif_Rhoy()
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj)))
+               ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u(i1:i2,jj,jk)
+            END DO
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE interpun
+
+
+   SUBROUTINE interpun2d(ptab,i1,i2,j1,j2,before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpun ***
+      !!---------------------------------------------    
+      !
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !
+      INTEGER :: ji,jj
+      REAL(wp) :: ztref
+      REAL(wp) :: zrhoy	
+      !!---------------------------------------------    
+      !
+      ztref = 1.
+
+      IF (before) THEN 
+         DO jj=j1,j2
+            DO ji=i1,MIN(i2,nlci-1)
+               ptab(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) 
+            END DO
+         END DO
+      ELSE
+         zrhoy = Agrif_Rhoy()
+         DO jj=j1,j2
+            laplacu(i1:i2,jj) = ztref * (ptab(i1:i2,jj)/(zrhoy*e2u(i1:i2,jj))) !*umask(i1:i2,jj,1)
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE interpun2d
+
+
+   SUBROUTINE interpvn(ptab,i1,i2,j1,j2,k1,k2, before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn ***
+      !!---------------------------------------------    
+      !
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: zrhox	
+      !!---------------------------------------------    
+      !      
+      IF (before) THEN          
+         !interpv entre 1 et k2 et interpv2d en jpkp1
+         DO jk=k1,jpk
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
+                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE          
+         zrhox= Agrif_Rhox()
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj)))
+               va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v(i1:i2,jj,jk)
+            END DO
+         END DO
+      ENDIF
+      !        
+   END SUBROUTINE interpvn
+
+   SUBROUTINE interpvn2d(ptab,i1,i2,j1,j2,before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn ***
+      !!---------------------------------------------    
+      !
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !
+      INTEGER :: ji,jj
+      REAL(wp) :: zrhox	
+      REAL(wp) :: ztref
+      !!---------------------------------------------    
+      ! 
+      ztref = 1.    
+      IF (before) THEN 
+         !interpv entre 1 et k2 et interpv2d en jpkp1
+         DO jj=j1,MIN(j2,nlcj-1)
+            DO ji=i1,i2
+               ptab(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) * vmask(ji,jj,1)
+            END DO
+         END DO
+      ELSE           
+         zrhox = Agrif_Rhox()
+         DO ji=i1,i2
+            laplacv(ji,j1:j2) = ztref * (ptab(ji,j1:j2)/(zrhox*e1v(ji,j1:j2)))
+         END DO
+      ENDIF
+      !      
+   END SUBROUTINE interpvn2d
+
+   SUBROUTINE interpunb(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpunb  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !!
+      INTEGER :: ji,jj
+      REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      !
+      IF (before) THEN 
+         DO jj=j1,j2
+            DO ji=i1,i2
+               ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj) 
+            END DO
+         END DO
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhoy = Agrif_Rhoy()
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot      
+         ! Polynomial interpolation coefficients:
+         IF( bdy_tinterp == 1 ) THEN
+            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
+                  &      - zt0**2._wp * (       zt0 - 1._wp)        )
+         ELSEIF( bdy_tinterp == 2 ) THEN
+            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
+                  &      - zt0        * (       zt0 - 1._wp)**2._wp ) 
+
+         ELSE
+            ztcoeff = 1
+         ENDIF
+         !   
+         IF(western_side) THEN
+            ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(eastern_side) THEN
+            ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(southern_side) THEN
+            ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
+         ENDIF
+         IF(northern_side) THEN
+            ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
+         ENDIF
+         !            
+         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
+            IF(western_side) THEN
+               ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2))   &
+                     &                                  * umask(i1,j1:j2,1)
+            ENDIF
+            IF(eastern_side) THEN
+               ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2))   &
+                     &                                  * umask(i1,j1:j2,1)
+            ENDIF
+            IF(southern_side) THEN
+               ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1))   &
+                     &                                  * umask(i1:i2,j1,1)
+            ENDIF
+            IF(northern_side) THEN
+               ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1))   &
+                     &                                  * umask(i1:i2,j1,1)
+            ENDIF
+         ENDIF
+      ENDIF
+      ! 
+   END SUBROUTINE interpunb
+
+   SUBROUTINE interpvnb(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvnb  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !!
+      INTEGER :: ji,jj
+      REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff   
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      ! 
+      IF (before) THEN 
+         DO jj=j1,j2
+            DO ji=i1,i2
+               ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj) 
+            END DO
+         END DO
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhox = Agrif_Rhox()
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot      
+         IF( bdy_tinterp == 1 ) THEN
+            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
+                  &      - zt0**2._wp * (       zt0 - 1._wp)        )
+         ELSEIF( bdy_tinterp == 2 ) THEN
+            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
+                  &      - zt0        * (       zt0 - 1._wp)**2._wp ) 
+
+         ELSE
+            ztcoeff = 1
+         ENDIF
+         !
+         IF(western_side) THEN
+            vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(eastern_side) THEN
+            vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(southern_side) THEN
+            vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)
+         ENDIF
+         IF(northern_side) THEN
+            vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
+         ENDIF
+         !            
+         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
+            IF(western_side) THEN
+               vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
+                     &                                  * vmask(i1,j1:j2,1)
+            ENDIF
+            IF(eastern_side) THEN
+               vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
+                     &                                  * vmask(i1,j1:j2,1)
+            ENDIF
+            IF(southern_side) THEN
+               vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
+                     &                                  * vmask(i1:i2,j1,1)
+            ENDIF
+            IF(northern_side) THEN
+               vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
+                     &                                  * vmask(i1:i2,j1,1)
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE interpvnb
+
+   SUBROUTINE interpub2b(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpub2b  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !!
+      INTEGER :: ji,jj
+      REAL(wp) :: zrhot, zt0, zt1,zat
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      IF( before ) THEN
+         DO jj=j1,j2
+            DO ji=i1,i2
+               ptab(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj)
+            END DO
+         END DO
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhot = Agrif_rhot()
          ! Time indexes bounds for integration
          zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
          zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
-
          ! Polynomial interpolation coefficients:
-         zaa = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
-                 &      - zt0**2._wp * (       zt0 - 1._wp)        )
-         zab = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
-                 &      - zt0        * (       zt0 - 1._wp)**2._wp )
          zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        &
-                 &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        ) 
-
-         ! Do time interpolation
-         IF((nbondi == -1).OR.(nbondi == 2)) THEN
-            DO jj=1,jpj
-               zunb(2,jj) = zaa * zuab(2,jj) + zab * zubb(2,jj) + zat * zutn(2,jj)
-               zvnb(2,jj) = zaa * zvab(2,jj) + zab * zvbb(2,jj) + zat * zvtn(2,jj)
-            END DO
-         ENDIF
-         IF((nbondi == 1).OR.(nbondi == 2)) THEN
-            DO jj=1,jpj
-               zunb(nlci-2,jj) = zaa * zuab(nlci-2,jj) + zab * zubb(nlci-2,jj) + zat * zutn(nlci-2,jj)
-               zvnb(nlci-1,jj) = zaa * zvab(nlci-1,jj) + zab * zvbb(nlci-1,jj) + zat * zvtn(nlci-1,jj)
-            END DO
-         ENDIF
-         IF((nbondj == -1).OR.(nbondj == 2)) THEN
-            DO ji=1,jpi
-               zunb(ji,2) = zaa * zuab(ji,2) + zab * zubb(ji,2) + zat * zutn(ji,2)
-               zvnb(ji,2) = zaa * zvab(ji,2) + zab * zvbb(ji,2) + zat * zvtn(ji,2)
-            END DO
-         ENDIF
-         IF((nbondj == 1).OR.(nbondj == 2)) THEN
-            DO ji=1,jpi
-               zunb(ji,nlcj-1) = zaa * zuab(ji,nlcj-1) + zab * zubb(ji,nlcj-1) + zat * zutn(ji,nlcj-1)
-               zvnb(ji,nlcj-2) = zaa * zvab(ji,nlcj-2) + zab * zvbb(ji,nlcj-2) + zat * zvtn(ji,nlcj-2)
-            END DO
-         ENDIF
-         CALL wrk_dealloc( jpi, jpj, zuab, zvab, zubb, zvbb, zutn, zvtn )
-
-      ELSE ! Linear interpolation
-         zunb(:,:) = 0._wp ; zvnb(:,:) = 0._wp
-         CALL Agrif_Bc_variable(zunb,unb_id,calledweight=zt, procname=interpunb)
-         CALL Agrif_Bc_variable(zvnb,vnb_id,calledweight=zt, procname=interpvnb)
-      ENDIF
-      Agrif_UseSpecialValue = .FALSE.
-
-      ! Fill boundary data arrays:
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-               ubdy_w(jj) = (zunb(2,jj)/(zrhoy*e2u(2,jj))) * umask(2,jj,1)
-               vbdy_w(jj) = (zvnb(2,jj)/(zrhox*e1v(2,jj))) * vmask(2,jj,1)
-               hbdy_w(jj) = zsshn(2,jj) * tmask(2,jj,1)
-         END DO
-      ENDIF
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-               ubdy_e(jj) = zunb(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj)) * umask(nlci-2,jj,1)
-               vbdy_e(jj) = zvnb(nlci-1,jj)/(zrhox*e1v(nlci-1,jj)) * vmask(nlci-1,jj,1)
-               hbdy_e(jj) = zsshn(nlci-1,jj) * tmask(nlci-1,jj,1)
-         END DO
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-               ubdy_s(ji) = zunb(ji,2)/(zrhoy*e2u(ji,2)) * umask(ji,2,1)
-               vbdy_s(ji) = zvnb(ji,2)/(zrhox*e1v(ji,2)) * vmask(ji,2,1)
-               hbdy_s(ji) = zsshn(ji,2) * tmask(ji,2,1)
-         END DO
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-            ubdy_n(ji) = zunb(ji,nlcj-1)/(zrhoy*e2u(ji,nlcj-1)) * umask(ji,nlcj-1,1)
-            vbdy_n(ji) = zvnb(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)) * vmask(ji,nlcj-2,1)
-            hbdy_n(ji) = zsshn(ji,nlcj-1) * tmask(ji,nlcj-1,1)
-         END DO
-      ENDIF
-
-      CALL wrk_dealloc( jpi, jpj, zunb, zvnb, zsshn )
-
-   END SUBROUTINE Agrif_dta_ts
-
-   SUBROUTINE Agrif_ssh( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_DYN  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) ::   kt
-      !!
-      !!----------------------------------------------------------------------  
-
-      IF( Agrif_Root() )   RETURN
-
-
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         ssha(2,:)=ssha(3,:)
-         sshn(2,:)=sshn(3,:)
-      ENDIF
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         ssha(nlci-1,:)=ssha(nlci-2,:)
-         sshn(nlci-1,:)=sshn(nlci-2,:)        
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         ssha(:,2)=ssha(:,3)
-         sshn(:,2)=sshn(:,3)
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         ssha(:,nlcj-1)=ssha(:,nlcj-2)
-         sshn(:,nlcj-1)=sshn(:,nlcj-2)                
-      ENDIF
-
-   END SUBROUTINE Agrif_ssh
-
-   SUBROUTINE Agrif_ssh_ts( jn )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_ssh_ts  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) ::   jn
+               &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        ) 
+         ! 
+         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
+         IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
+      ENDIF
+      ! 
+   END SUBROUTINE interpub2b
+
+   SUBROUTINE interpvb2b(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvb2b  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
       !!
       INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-            ssha_e(2,jj) = hbdy_w(jj)
-         END DO
-      ENDIF
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-            ssha_e(nlci-1,jj) = hbdy_e(jj)
-         END DO
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-            ssha_e(ji,2) = hbdy_s(ji)
-         END DO
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-            ssha_e(ji,nlcj-1) = hbdy_n(ji)
-         END DO
-      ENDIF
-
-   END SUBROUTINE Agrif_ssh_ts
-
-   SUBROUTINE interpsshn(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpsshn  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      tabres(i1:i2,j1:j2) = sshn(i1:i2,j1:j2)
-
-   END SUBROUTINE interpsshn
-
-   SUBROUTINE interpu(tabres,i1,i2,j1,j2,k1,k2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpu  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj,jk
-      !!----------------------------------------------------------------------  
-
-      DO jk=k1,k2
+      REAL(wp) :: zrhot, zt0, zt1,zat
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      !
+      IF( before ) THEN
          DO jj=j1,j2
             DO ji=i1,i2
-               tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
-               tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-   END SUBROUTINE interpu
-
-
-   SUBROUTINE interpu2d(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpu2d  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      DO jj=j1,j2
-         DO ji=i1,i2
-            tabres(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) &
-               * umask(ji,jj,1)
-         END DO
-      END DO
-
-   END SUBROUTINE interpu2d
-
-
-   SUBROUTINE interpv(tabres,i1,i2,j1,j2,k1,k2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpv  ***
-      !!----------------------------------------------------------------------  
+               ptab(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj)
+            END DO
+         END DO
+      ELSE      
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
+         ! Polynomial interpolation coefficients:
+         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        &
+               &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        ) 
+         !
+         IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
+         IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
+      ENDIF
+      !      
+   END SUBROUTINE interpvb2b
+
+   SUBROUTINE interpe3t(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpe3t  ***
+      !!----------------------------------------------------------------------  
+      ! 
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-      !!
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
       INTEGER :: ji, jj, jk
-      !!----------------------------------------------------------------------  
-
-      DO jk=k1,k2
-         DO jj=j1,j2
-            DO ji=i1,i2
-               tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
-               tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-   END SUBROUTINE interpv
-
-
-   SUBROUTINE interpv2d(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpu2d  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      DO jj=j1,j2
-         DO ji=i1,i2
-            tabres(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) &
-               * vmask(ji,jj,1)
-         END DO
-      END DO
-
-   END SUBROUTINE interpv2d
-
-   SUBROUTINE interpunb(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpunb  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      DO jj=j1,j2
-         DO ji=i1,i2
-            tabres(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj) 
-         END DO
-      END DO
-
-   END SUBROUTINE interpunb
-
-   SUBROUTINE interpvnb(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpvnb  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      DO jj=j1,j2
-         DO ji=i1,i2
-            tabres(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj)
-         END DO
-      END DO
-
-   END SUBROUTINE interpvnb
-
-   SUBROUTINE interpub2b(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpub2b  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      DO jj=j1,j2
-         DO ji=i1,i2
-            tabres(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj)
-         END DO
-      END DO
-
-   END SUBROUTINE interpub2b
-
-   SUBROUTINE interpvb2b(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpvb2b  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      DO jj=j1,j2
-         DO ji=i1,i2
-            tabres(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj)
-         END DO
-      END DO
-
-   END SUBROUTINE interpvb2b
+      LOGICAL :: western_side, eastern_side, northern_side, southern_side
+      REAL(wp) :: ztmpmsk      
+      !!----------------------------------------------------------------------  
+      !    
+      IF (before) THEN
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = tmask(ji,jj,jk) * e3t_0(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ! Get velocity mask at boundary edge points:
+                  IF (western_side)  ztmpmsk = umask(ji    ,jj    ,1)
+                  IF (eastern_side)  ztmpmsk = umask(nlci-2,jj    ,1)
+                  IF (northern_side) ztmpmsk = vmask(ji    ,nlcj-2,1)
+                  IF (southern_side) ztmpmsk = vmask(ji    ,2     ,1)
+
+                  IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk))*ztmpmsk > 1.D-2) THEN
+                     IF (western_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                     ELSEIF (eastern_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                     ELSEIF (southern_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
+                     ELSEIF (northern_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
+                     ENDIF
+                     WRITE(numout,*) '      ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk)
+                     kindic_agr = kindic_agr + 1
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+      ! 
+   END SUBROUTINE interpe3t
+
+   SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpumsk  ***
+      !!----------------------------------------------------------------------  
+      ! 
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER :: ji, jj, jk
+      LOGICAL :: western_side, eastern_side   
+      !!----------------------------------------------------------------------  
+      !    
+      IF (before) THEN
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = umask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                   ! Velocity mask at boundary edge points:
+                  IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN
+                     IF (western_side) THEN
+                        WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ELSEIF (eastern_side) THEN
+                        WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+      ! 
+   END SUBROUTINE interpumsk
+
+   SUBROUTINE interpvmsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvmsk  ***
+      !!----------------------------------------------------------------------  
+      ! 
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER :: ji, jj, jk
+      LOGICAL :: northern_side, southern_side     
+      !!----------------------------------------------------------------------  
+      !    
+      IF (before) THEN
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                   ! Velocity mask at boundary edge points:
+                  IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN
+                     IF (southern_side) THEN
+                        WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ELSEIF (northern_side) THEN
+                        WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+      ! 
+   END SUBROUTINE interpvmsk
+
+# if defined key_zdftke
+
+   SUBROUTINE interpavm(ptab,i1,i2,j1,j2,k1,k2,before)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interavm  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!----------------------------------------------------------------------  
+      !      
+      IF( before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)
+      ENDIF
+      !
+   END SUBROUTINE interpavm
+
+# endif /* key_zdftke */
 
 #else
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 5901)
@@ -1,5 +1,5 @@
 #define SPONGE && define SPONGE_TOP
 
-Module agrif_opa_sponge
+MODULE agrif_opa_sponge
 #if defined key_agrif  && ! defined key_offline
    USE par_oce
@@ -9,11 +9,13 @@
    USE agrif_oce
    USE wrk_nemo  
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn
-
-  !! * Substitutions
+   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn
+   PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge
+
+   !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
@@ -23,5 +25,5 @@
    !!----------------------------------------------------------------------
 
-   CONTAINS
+CONTAINS
 
    SUBROUTINE Agrif_Sponge_Tra
@@ -30,55 +32,17 @@
       !!---------------------------------------------
       !!
-      INTEGER :: ji,jj,jk,jn
       REAL(wp) :: timecoeff
-      REAL(wp) :: ztsa, zabe1, zabe2, zbtr
-      REAL(wp), POINTER, DIMENSION(:,:    ) :: ztu, ztv
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: tsbdiff
 
 #if defined SPONGE
-      CALL wrk_alloc( jpi, jpj, ztu, ztv )
-      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  )
-
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
 
+      CALL Agrif_Sponge
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .TRUE.
-      ztab = 0.e0
-      CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn)
+      tabspongedone_tsn = .FALSE.
+
+      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge)
+
       Agrif_UseSpecialValue = .FALSE.
-
-      tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:)
-
-      CALL Agrif_Sponge
-
-      DO jn = 1, jpts
-         DO jk = 1, jpkm1
-            !
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
-                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
-                  ztu(ji,jj) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )
-                  ztv(ji,jj) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
-               ENDDO
-            ENDDO
-
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-                  ! horizontal diffusive trends
-                  ztsa = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  )   &
-                  &              + ztv(ji,jj) - ztv(ji  ,jj-1)  )
-                  ! add it to the general tracer trends
-                  tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa
-               END DO
-            END DO
-            !
-         ENDDO
-      ENDDO
-
-      CALL wrk_dealloc( jpi, jpj, ztu, ztv )
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  )
 #endif
 
@@ -90,89 +54,21 @@
       !!---------------------------------------------
       !!
-      INTEGER :: ji,jj,jk
       REAL(wp) :: timecoeff
-      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab
 
 #if defined SPONGE
-      CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )
-
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
 
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = ln_spc_dyn
-      ztab = 0.e0
-      CALL Agrif_Bc_Variable(ztab, ua_id,calledweight=timecoeff,procname=interpun)
+
+      tabspongedone_u = .FALSE.
+      tabspongedone_v = .FALSE.         
+      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge)
+
+      tabspongedone_u = .FALSE.
+      tabspongedone_v = .FALSE.
+      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge)
+
       Agrif_UseSpecialValue = .FALSE.
-
-      ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:) ) * umask(:,:,:)
-
-      ztab = 0.e0
-      Agrif_SpecialValue=0.
-      Agrif_UseSpecialValue = ln_spc_dyn
-      CALL Agrif_Bc_Variable(ztab, va_id,calledweight=timecoeff,procname=interpvn)
-      Agrif_UseSpecialValue = .FALSE.
-
-      vbdiff(:,:,:) = ( vb(:,:,:) - ztab(:,:,:) ) * vmask(:,:,:)
-
-      CALL Agrif_Sponge
-
-      DO jk = 1,jpkm1
-         ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:)
-         vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:)
-      ENDDO
-      
-      hdivdiff = 0.
-      rotdiff = 0.
-
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-
-         !                                             ! --------
-         ! Horizontal divergence                       !   div
-         !                                             ! --------
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-               zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-               hdivdiff(ji,jj,jk) =  (  e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) * ubdiff(ji  ,jj  ,jk)     &
-                  &                   - e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) * ubdiff(ji-1,jj  ,jk)     &
-                  &                   + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * vbdiff(ji  ,jj  ,jk)     &
-                  &                   - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * vbdiff(ji  ,jj-1,jk)  ) * zbtr
-            END DO
-         END DO
-
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1   ! vector opt.
-               zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk)
-               rotdiff(ji,jj,jk) = (  e2v(ji+1,jj  ) * vbdiff(ji+1,jj  ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk)    &
-                  &                 - e1u(ji  ,jj+1) * ubdiff(ji  ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk)  ) &
-                  &               * fmask(ji,jj,jk) * zbtr
-            END DO
-         END DO
-
-      ENDDO
-
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-               ! horizontal diffusive trends
-               zua = - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
-                     + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk) ) / e1u(ji,jj)
-
-               zva = + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
-                     + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) / e2v(ji,jj)
-               ! add it to the general momentum trends
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
-               va(ji,jj,jk) = va(ji,jj,jk) + zva
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-      CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )
 #endif
 
@@ -199,11 +95,10 @@
          CALL wrk_alloc( jpi, jpj, ztabramp )
 
-         ispongearea  = 2 + 2 * Agrif_irhox()
+         ispongearea  = 2 + nn_sponge_len * Agrif_irhox()
          ilci = nlci - ispongearea
          ilcj = nlcj - ispongearea 
          z1spongearea = 1._wp / REAL( ispongearea - 2 )
-         spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
-
-         ztabramp(:,:) = 0.
+
+         ztabramp(:,:) = 0._wp
 
          IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
@@ -254,54 +149,15 @@
       ! Tracers
       IF( .NOT. spongedoneT ) THEN
-         spe1ur(:,:) = 0.
-         spe2vr(:,:) = 0.
-
-         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
-            spe1ur(2:ispongearea-1,:       ) = visc_tra                                        &
-               &                             *    0.5 * (  ztabramp(2:ispongearea-1,:      )   &
-               &                                         + ztabramp(3:ispongearea  ,:      ) ) &
-               &                             * e2u(2:ispongearea-1,:) / e1u(2:ispongearea-1,:)
-
-            spe2vr(2:ispongearea  ,1:jpjm1 ) = visc_tra                                        &
-               &                             *    0.5 * (  ztabramp(2:ispongearea  ,1:jpjm1)   &
-               &                                         + ztabramp(2:ispongearea,2  :jpj  ) ) &
-               &                             * e1v(2:ispongearea,1:jpjm1) / e2v(2:ispongearea,1:jpjm1)
-         ENDIF
-
-         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
-            spe1ur(ilci+1:nlci-2,:        ) = visc_tra                                   &
-               &                            * 0.5 * (  ztabramp(ilci+1:nlci-2,:      )   & 
-               &                                     + ztabramp(ilci+2:nlci-1,:      ) ) &
-               &                            * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:)
-
-            spe2vr(ilci+1:nlci-1,1:jpjm1  )  = visc_tra                                  &
-               &                            * 0.5 * (  ztabramp(ilci+1:nlci-1,1:jpjm1)   & 
-               &                                     + ztabramp(ilci+1:nlci-1,2:jpj  ) ) & 
-               &                            * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1)
-         ENDIF
-
-         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
-            spe1ur(1:jpim1,2:ispongearea  ) = visc_tra                                     &
-               &                            * 0.5 * (  ztabramp(1:jpim1,2:ispongearea  )   & 
-               &                                     + ztabramp(2:jpi  ,2:ispongearea  ) ) &
-               &                            * e2u(1:jpim1,2:ispongearea) / e1u(1:jpim1,2:ispongearea)
-   
-            spe2vr(:      ,2:ispongearea-1) = visc_tra                                     &
-               &                            * 0.5 * (  ztabramp(:      ,2:ispongearea-1)   &
-               &                                     + ztabramp(:      ,3:ispongearea  ) ) &
-               &                            * e1v(:,2:ispongearea-1) / e2v(:,2:ispongearea-1)
-         ENDIF
-
-         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
-            spe1ur(1:jpim1,ilcj+1:nlcj-1) = visc_tra                                   &
-               &                          * 0.5 * (  ztabramp(1:jpim1,ilcj+1:nlcj-1)   &
-               &                                   + ztabramp(2:jpi  ,ilcj+1:nlcj-1) ) &
-               &                                * e2u(1:jpim1,ilcj+1:nlcj-1) / e1u(1:jpim1,ilcj+1:nlcj-1)
-
-            spe2vr(:      ,ilcj+1:nlcj-2) = visc_tra                                   &
-               &                          * 0.5 * (  ztabramp(:      ,ilcj+1:nlcj-2)   &
-               &                                   + ztabramp(:      ,ilcj+2:nlcj-1) ) &
-               &                                * e1v(:,ilcj+1:nlcj-2) / e2v(:,ilcj+1:nlcj-2)
-         ENDIF
+         fsaht_spu(:,:) = 0._wp
+         fsaht_spv(:,:) = 0._wp
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! vector opt.
+               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj  ))
+               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji  ,jj+1))
+            END DO
+         END DO
+
+         CALL lbc_lnk( fsaht_spu, 'U', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( fsaht_spv, 'V', 1. )
          spongedoneT = .TRUE.
       ENDIF
@@ -309,44 +165,17 @@
       ! Dynamics
       IF( .NOT. spongedoneU ) THEN
-         spe1ur2(:,:) = 0.
-         spe2vr2(:,:) = 0.
-
-         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
-            spe1ur2(2:ispongearea-1,:      ) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(2:ispongearea-1,:      ) &
-               &                                      + ztabramp(3:ispongearea  ,:      ) )
-            spe2vr2(2:ispongearea  ,1:jpjm1) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(2:ispongearea  ,1:jpjm1) &
-               &                                      + ztabramp(2:ispongearea  ,2:jpj  ) ) 
-         ENDIF
-
-         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
-            spe1ur2(ilci+1:nlci-2  ,:      ) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(ilci+1:nlci-2, :       ) &
-               &                                      + ztabramp(ilci+2:nlci-1, :       ) )                      
-            spe2vr2(ilci+1:nlci-1  ,1:jpjm1) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(ilci+1:nlci-1,1:jpjm1  ) &
-               &                                      + ztabramp(ilci+1:nlci-1,2:jpj    ) ) 
-         ENDIF
-
-         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
-            spe1ur2(1:jpim1,2:ispongearea  ) = visc_dyn                                   &  
-               &                             * 0.5 * (  ztabramp(1:jpim1,2:ispongearea  ) &
-               &                                      + ztabramp(2:jpi  ,2:ispongearea  ) ) 
-            spe2vr2(:      ,2:ispongearea-1) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(:      ,2:ispongearea-1) &
-               &                                      + ztabramp(:      ,3:ispongearea  ) )
-         ENDIF
-
-         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
-            spe1ur2(1:jpim1,ilcj+1:nlcj-1  ) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(1:jpim1,ilcj+1:nlcj-1  ) &
-               &                                      + ztabramp(2:jpi  ,ilcj+1:nlcj-1  ) ) 
-            spe2vr2(:      ,ilcj+1:nlcj-2  ) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(:      ,ilcj+1:nlcj-2  ) &
-               &                                      + ztabramp(:      ,ilcj+2:nlcj-1  ) )
-         ENDIF
+         fsahm_spt(:,:) = 0._wp
+         fsahm_spf(:,:) = 0._wp
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! vector opt.
+               fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj)
+               fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) &
+                                                     &  +ztabramp(ji,jj) + ztabramp(ji+1,jj  ) )
+            END DO
+         END DO
+
+         CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( fsahm_spf, 'F', 1. )
          spongedoneU = .TRUE.
-         spbtr3(:,:) = 1. / ( e1f(:,:) * e2f(:,:) )
       ENDIF
       !
@@ -357,36 +186,277 @@
    END SUBROUTINE Agrif_Sponge
 
-   SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
-      !!---------------------------------------------
-      !!   *** ROUTINE interptsn ***
+   SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptsn_sponge ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-
-      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
-
-   END SUBROUTINE interptsn
-
-   SUBROUTINE interpun(tabres,i1,i2,j1,j2,k1,k2)
-      !!---------------------------------------------
-      !!   *** ROUTINE interpun ***
-      !!---------------------------------------------
+      LOGICAL, INTENT(in) :: before
+
+
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::   iku, ikv
+      REAL(wp) :: ztsa, zabe1, zabe2, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff
+      !
+      IF (before) THEN
+         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE   
+   
+         tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)    
+         DO jn = 1, jpts            
+            DO jk = 1, jpkm1
+               DO jj = j1,j2-1
+                  DO ji = i1,i2-1
+                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk)
+                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk)
+                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
+                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
+                  ENDDO
+               ENDDO
+
+               IF( ln_zps ) THEN      ! set gradient at partial step level
+                  DO jj = j1,j2-1
+                     DO ji = i1,i2-1
+                        ! last level
+                        iku = mbku(ji,jj)
+                        ikv = mbkv(ji,jj)
+                        IF( iku == jk ) THEN
+                           ztu(ji,jj,jk) = 0._wp
+                        ENDIF
+                        IF( ikv == jk ) THEN
+                           ztv(ji,jj,jk) = 0._wp
+                        ENDIF
+                     END DO
+                  END DO
+               ENDIF
+            ENDDO
+
+            DO jk = 1, jpkm1
+               DO jj = j1+1,j2-1
+                  DO ji = i1+1,i2-1
+
+                     IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 
+                        zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk)
+                        ! horizontal diffusive trends
+                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  )
+                        ! add it to the general tracer trends
+                        tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa
+                     ENDIF
+
+                  ENDDO
+               ENDDO
+
+            ENDDO
+         ENDDO
+
+         tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+
+      ENDIF
+
+   END SUBROUTINE interptsn_sponge
+
+   SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpun_sponge ***
+      !!---------------------------------------------    
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-
-      tabres(i1:i2,j1:j2,k1:k2) = un(i1:i2,j1:j2,k1:k2)
-
-   END SUBROUTINE interpun
-
-   SUBROUTINE interpvn(tabres,i1,i2,j1,j2,k1,k2)
-      !!---------------------------------------------
-      !!   *** ROUTINE interpvn ***
-      !!---------------------------------------------
+      LOGICAL, INTENT(in) :: before
+
+      INTEGER :: ji,jj,jk
+
+      ! sponge parameters 
+      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ubdiff
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff
+      INTEGER :: jmax
+      !
+
+
+      IF (before) THEN
+         tabres = un(i1:i2,j1:j2,:)
+      ELSE
+
+         ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:)
+
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+
+            !                                             ! --------
+            ! Horizontal divergence                       !   div
+            !                                             ! --------
+            DO jj = j1,j2
+               DO ji = i1+1,i2   ! vector opt.
+                  zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
+                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*fse3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) &
+                                     &   -e2u(ji-1,jj)*fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr
+               END DO
+            END DO
+
+            DO jj = j1,j2-1
+               DO ji = i1,i2   ! vector opt.
+                  zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
+                  rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) &
+                                       +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) & 
+                                    & ) * fmask(ji,jj,jk) * zbtr 
+               END DO
+            END DO
+         ENDDO
+
+         !
+
+
+
+         DO jj = j1+1, j2-1
+            DO ji = i1+1, i2-1   ! vector opt.
+
+               IF (.NOT. tabspongedone_u(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+                     ! horizontal diffusive trends
+                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) )   &
+                           + ( hdivdiff(ji+1,jj,jk) - ze1v  ) / e1u(ji,jj)
+
+                     ! add it to the general momentum trends
+                     ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+
+                  END DO
+               ENDIF
+
+            END DO
+         END DO
+
+         tabspongedone_u(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+
+         jmax = j2-1
+         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-3)
+
+         DO jj = j1+1, jmax
+            DO ji = i1+1, i2   ! vector opt.
+
+               IF (.NOT. tabspongedone_v(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+
+                     ! horizontal diffusive trends
+                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) )   &
+                           + ( hdivdiff(ji,jj+1,jk) - ze1v  ) / e2v(ji,jj)
+
+                     ! add it to the general momentum trends
+                     va(ji,jj,jk) = va(ji,jj,jk) + zva
+                  END DO
+               ENDIF
+
+            END DO
+         END DO
+
+
+         tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE.
+
+      ENDIF
+
+
+   END SUBROUTINE interpun_sponge
+
+
+   SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2, before,nb,ndir)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn_sponge ***
+      !!--------------------------------------------- 
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-
-      tabres(i1:i2,j1:j2,k1:k2) = vn(i1:i2,j1:j2,k1:k2)
-
-   END SUBROUTINE interpvn
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+
+      INTEGER :: ji,jj,jk
+
+      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
+
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff
+      INTEGER :: imax
+      !
+
+      IF (before) THEN 
+         tabres = vn(i1:i2,j1:j2,:)
+      ELSE
+
+         vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(:,:,:))*vmask(i1:i2,j1:j2,:)
+
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+
+            !                                             ! --------
+            ! Horizontal divergence                       !   div
+            !                                             ! --------
+            DO jj = j1+1,j2
+               DO ji = i1,i2   ! vector opt.
+                  zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
+                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  &
+                                     &  -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr
+               END DO
+            END DO
+            DO jj = j1,j2
+               DO ji = i1,i2-1   ! vector opt.
+                  zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
+                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 
+                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk) &
+                                    & ) * fmask(ji,jj,jk) * zbtr
+               END DO
+            END DO
+         ENDDO
+
+         !                                                ! ===============
+         !                                                
+
+         imax = i2-1
+         IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3)
+
+         DO jj = j1+1, j2
+            DO ji = i1+1, imax   ! vector opt.
+               IF (.NOT. tabspongedone_u(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+                     ! horizontal diffusive trends
+                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) &
+                           / e1u(ji,jj)
+
+
+                     ! add it to the general momentum trends
+                     ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+                  END DO
+
+               ENDIF
+            END DO
+         END DO
+
+         tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE.
+
+         DO jj = j1+1, j2-1
+            DO ji = i1+1, i2-1   ! vector opt.
+               IF (.NOT. tabspongedone_v(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+                     ! horizontal diffusive trends
+
+                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) &
+                           / e2v(ji,jj)
+
+                     ! add it to the general momentum trends
+                     va(ji,jj,jk) = va(ji,jj,jk) + zva
+                  END DO
+               ENDIF
+            END DO
+         END DO
+         tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+      ENDIF
+
+   END SUBROUTINE interpvn_sponge
 
 #else
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 5901)
@@ -1,4 +1,5 @@
-#define TWO_WAY
-
+#define TWO_WAY        /* TWO WAY NESTING */
+#undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/
+ 
 MODULE agrif_opa_update
 #if defined key_agrif  && ! defined key_offline
@@ -11,14 +12,15 @@
    USE wrk_nemo  
    USE dynspg_oce
+   USE zdf_oce        ! vertical physics: ocean variables 
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn
-
-   INTEGER, PUBLIC :: nbcline = 0
-
+   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales
+# if defined key_zdftke
+   PUBLIC Agrif_Update_Tke
+# endif
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -27,98 +29,151 @@
 CONTAINS
 
-   SUBROUTINE Agrif_Update_Tra( kt )
+   RECURSIVE SUBROUTINE Agrif_Update_Tra( )
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Update_Tra ***
       !!---------------------------------------------
-      !!
-      INTEGER, INTENT(in) :: kt
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab
-
-
-      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
-#if defined TWO_WAY
-      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab )
+      ! 
+      IF (Agrif_Root()) RETURN
+      !
+#if defined TWO_WAY  
+      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed(), 'nbcline', nbcline
 
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
-
+      ! 
       IF (MOD(nbcline,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS)
-      ELSE
-         CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS)
-      ENDIF
-
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(tsn_id, procname=updateTS)
+# else
+         CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS)
+# endif
+      ELSE
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS)
+# else
+         CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS)
+# endif
+      ENDIF
+      !
       Agrif_UseSpecialValueInUpdate = .FALSE.
-
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab )
+      !
+      IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update:
+         CALL Agrif_ChildGrid_To_ParentGrid()
+         CALL Agrif_Update_Tra()
+         CALL Agrif_ParentGrid_To_ChildGrid()
+      ENDIF
+      !
 #endif
-
+      !
    END SUBROUTINE Agrif_Update_Tra
 
-   SUBROUTINE Agrif_Update_Dyn( kt )
+   RECURSIVE SUBROUTINE Agrif_Update_Dyn( )
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Update_Dyn ***
       !!---------------------------------------------
-      !!
-      INTEGER, INTENT(in) :: kt
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab
-
-
-      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) Return
+      ! 
+      IF (Agrif_Root()) RETURN
+      !
 #if defined TWO_WAY
-      CALL wrk_alloc( jpi, jpj,      ztab2d )
-      CALL wrk_alloc( jpi, jpj, jpk, ztab   )
-
+      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed(), 'nbcline', nbcline
+
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+      Agrif_SpecialValueFineGrid = 0.
+      !     
       IF (mod(nbcline,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable(ztab,un_id,procname = updateU)
-         CALL Agrif_Update_Variable(ztab,vn_id,procname = updateV)
-      ELSE
-         CALL Agrif_Update_Variable(ztab,un_id,locupdate=(/0,1/),procname = updateU)
-         CALL Agrif_Update_Variable(ztab,vn_id,locupdate=(/0,1/),procname = updateV)         
-      ENDIF
-
-      CALL Agrif_Update_Variable(ztab2d,e1u_id,procname = updateU2d)
-      CALL Agrif_Update_Variable(ztab2d,e2v_id,procname = updateV2d)
-
-#if defined key_dynspg_ts
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(un_update_id,procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,procname = updateV)
+# else
+         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV)
+# endif
+      ELSE
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV)         
+# else
+         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV)
+# endif
+      ENDIF
+
+# if ! defined DECAL_FEEDBACK
+      CALL Agrif_Update_Variable(e1u_id,procname = updateU2d)
+      CALL Agrif_Update_Variable(e2v_id,procname = updateV2d)  
+# else
+      CALL Agrif_Update_Variable(e1u_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU2d)
+      CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d)  
+# endif
+
+# if defined key_dynspg_ts
       IF (ln_bt_fw) THEN
          ! Update time integrated transports
          IF (mod(nbcline,nbclineupdate) == 0) THEN
-            CALL Agrif_Update_Variable(ztab2d,ub2b_id,procname = updateub2b)
-            CALL Agrif_Update_Variable(ztab2d,vb2b_id,procname = updatevb2b)
+#  if ! defined DECAL_FEEDBACK
+            CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b)
+            CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b)
+#  else
+            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b)
+            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b)
+#  endif
          ELSE
-            CALL Agrif_Update_Variable(ztab2d,ub2b_id,locupdate=(/0,1/),procname = updateub2b)
-            CALL Agrif_Update_Variable(ztab2d,vb2b_id,locupdate=(/0,1/),procname = updatevb2b)
+#  if ! defined DECAL_FEEDBACK
+            CALL Agrif_Update_Variable(ub2b_update_id,locupdate=(/0,1/),procname = updateub2b)
+            CALL Agrif_Update_Variable(vb2b_update_id,locupdate=(/0,1/),procname = updatevb2b)
+#  else
+            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateub2b)
+            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updatevb2b)
+#  endif
          ENDIF
-      END IF 
+      END IF
+# endif
+      !
+      nbcline = nbcline + 1
+      !
+      Agrif_UseSpecialValueInUpdate = .TRUE.
+      Agrif_SpecialValueFineGrid = 0.
+# if ! defined DECAL_FEEDBACK
+      CALL Agrif_Update_Variable(sshn_id,procname = updateSSH)
+# else
+      CALL Agrif_Update_Variable(sshn_id,locupdate=(/1,0/),procname = updateSSH)
+# endif
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+      ! 
 #endif
-
-      nbcline = nbcline + 1
-
-      Agrif_UseSpecialValueInUpdate = .TRUE. 
+      !
+      ! Do recursive update:
+      IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update:
+         CALL Agrif_ChildGrid_To_ParentGrid()
+         CALL Agrif_Update_Dyn()
+         CALL Agrif_ParentGrid_To_ChildGrid()
+      ENDIF
+      !
+   END SUBROUTINE Agrif_Update_Dyn
+
+# if defined key_zdftke
+   SUBROUTINE Agrif_Update_Tke( kt )
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Update_Tke ***
+      !!---------------------------------------------
+      !!
+      INTEGER, INTENT(in) :: kt
+      !       
+      IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN
+#  if defined TWO_WAY
+
+      Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
-      CALL Agrif_Update_Variable(ztab2d,sshn_id,procname = updateSSH)
+
+      CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN  )
+      CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT )
+      CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM )
+
       Agrif_UseSpecialValueInUpdate = .FALSE.
 
-      CALL wrk_dealloc( jpi, jpj,      ztab2d )
-      CALL wrk_dealloc( jpi, jpj, jpk, ztab   )
-
-!Done in step
-!      CALL Agrif_ChildGrid_To_ParentGrid()
-!      CALL recompute_diags( kt )
-!      CALL Agrif_ParentGrid_To_ChildGrid()
-
-#endif
-
-   END SUBROUTINE Agrif_Update_Dyn
-
-   SUBROUTINE recompute_diags( kt )
-      !!---------------------------------------------
-      !!   *** ROUTINE recompute_diags ***
-      !!---------------------------------------------
-      INTEGER, INTENT(in) :: kt
-
-   END SUBROUTINE recompute_diags
+#  endif
+      
+   END SUBROUTINE Agrif_Update_Tke
+# endif /* key_zdftke */
 
    SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
@@ -127,11 +182,11 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-      LOGICAL, iNTENT(in) :: before
-
+      LOGICAL, INTENT(in) :: before
+      !!
       INTEGER :: ji,jj,jk,jn
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          DO jn = n1,n2
@@ -146,5 +201,5 @@
       ELSE
          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
-         ! Add asselin part
+            ! Add asselin part
             DO jn = n1,n2
                DO jk=k1,k2
@@ -153,6 +208,6 @@
                         IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
                            tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 
-                              & + atfp * ( tabres(ji,jj,jk,jn) &
-                              &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+                                 & + atfp * ( tabres(ji,jj,jk,jn) &
+                                 &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
                         ENDIF
                      ENDDO
@@ -161,5 +216,4 @@
             ENDDO
          ENDIF
-
          DO jn = n1,n2
             DO jk=k1,k2
@@ -174,5 +228,5 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updateTS
 
@@ -182,12 +236,13 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-
+      !!
       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !! 
       INTEGER :: ji, jj, jk
       REAL(wp) :: zrhoy
-
+      !!---------------------------------------------
+      ! 
       IF (before) THEN
          zrhoy = Agrif_Rhoy()
@@ -209,5 +264,5 @@
                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
                      ub(ji,jj,jk) = ub(ji,jj,jk) & 
-                       & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)
+                           & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)
                   ENDIF
                   !
@@ -217,5 +272,5 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updateu
 
@@ -225,12 +280,13 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-
+      !!
       INTEGER :: i1,i2,j1,j2,k1,k2
       INTEGER :: ji,jj,jk
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres
       LOGICAL :: before
-
+      !!
       REAL(wp) :: zrhox
-
+      !!---------------------------------------------      
+      !
       IF (before) THEN
          zrhox = Agrif_Rhox()
@@ -252,5 +308,5 @@
                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
                      vb(ji,jj,jk) = vb(ji,jj,jk) & 
-                       & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)
+                           & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)
                   ENDIF
                   !
@@ -260,5 +316,5 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updatev
 
@@ -268,13 +324,14 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-
+      !!
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !! 
       INTEGER :: ji, jj, jk
       REAL(wp) :: zrhoy
       REAL(wp) :: zcorr
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          zrhoy = Agrif_Rhoy()
@@ -326,5 +383,5 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updateu2d
 
@@ -333,13 +390,13 @@
       !!          *** ROUTINE updatev2d ***
       !!---------------------------------------------
-
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !! 
       INTEGER :: ji, jj, jk
       REAL(wp) :: zrhox
       REAL(wp) :: zcorr
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          zrhox = Agrif_Rhox()
@@ -391,19 +448,19 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updatev2d
 
+
    SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before )
       !!---------------------------------------------
       !!          *** ROUTINE updateSSH ***
       !!---------------------------------------------
-#  include "domzgr_substitute.h90"
-
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !!
       INTEGER :: ji, jj
-
+      !!---------------------------------------------
+      ! 
       IF (before) THEN
          DO jj=j1,j2
@@ -413,11 +470,10 @@
          END DO
       ELSE
-
 #if ! defined key_dynspg_ts
          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
             DO jj=j1,j2
                DO ji=i1,i2
-                sshb(ji,jj) =   sshb(ji,jj) &
-                 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
+                  sshb(ji,jj) =   sshb(ji,jj) &
+                        & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
                END DO
             END DO
@@ -430,5 +486,5 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updateSSH
 
@@ -437,12 +493,12 @@
       !!          *** ROUTINE updateub2b ***
       !!---------------------------------------------
-
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !!
       INTEGER :: ji, jj
       REAL(wp) :: zrhoy
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          zrhoy = Agrif_Rhoy()
@@ -460,5 +516,5 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updateub2b
 
@@ -467,12 +523,12 @@
       !!          *** ROUTINE updatevb2b ***
       !!---------------------------------------------
-
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !!
       INTEGER :: ji, jj
       REAL(wp) :: zrhox
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          zrhox = Agrif_Rhox()
@@ -490,6 +546,112 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updatevb2b
+
+
+   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before )
+      ! currently not used
+      !!---------------------------------------------
+      !!           *** ROUTINE updateT ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"
+
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      LOGICAL, iNTENT(in) :: before
+
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: ztemp
+
+      IF (before) THEN
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
+                  tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk)
+                  tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy()
+         tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox()
+         tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy()
+      ELSE
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  IF( tabres(ji,jj,jk,1) .NE. 0. ) THEN 
+                     print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
+                     print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk)
+                     print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk)
+                     ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3)))
+                     print *,'CORR = ',ztemp-1.
+                     print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, &
+                           tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp
+                     e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp
+                     e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp
+                  END IF
+               END DO
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE update_scales
+
+# if defined key_zdftke
+   SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateen ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2)
+      ELSE
+         en(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
+      ENDIF
+      !
+   END SUBROUTINE updateEN
+
+
+   SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateavt ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
+      ENDIF
+      !
+   END SUBROUTINE updateAVT
+
+
+   SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateavm ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
+      ENDIF
+      !
+   END SUBROUTINE updateAVM
+
+# endif /* key_zdftke */ 
 
 #else
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 5901)
@@ -7,4 +7,5 @@
    USE agrif_oce
    USE agrif_top_sponge
+   USE par_trc
    USE trc
    USE lib_mpp
@@ -14,10 +15,10 @@
    PRIVATE
 
-   PUBLIC Agrif_trc
+   PUBLIC Agrif_trc, interptrn
 
 #  include "domzgr_substitute.h90"  
 #  include "vectopt_loop_substitute.h90"
   !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -28,114 +29,160 @@
    SUBROUTINE Agrif_trc
       !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_Tra  ***
-      !!----------------------------------------------------------------------
-      !!
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3
-      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra
+      !!                  ***  ROUTINE Agrif_trc  ***
       !!----------------------------------------------------------------------
       !
       IF( Agrif_Root() )   RETURN
 
-      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra )
-
       Agrif_SpecialValue    = 0.e0
       Agrif_UseSpecialValue = .TRUE.
-      ztra(:,:,:,:) = 0.e0
 
-      CALL Agrif_Bc_variable( ztra, trn_id, procname=interptrn )
+      CALL Agrif_Bc_variable( trn_id, procname=interptrn )
       Agrif_UseSpecialValue = .FALSE.
+      !
+   END SUBROUTINE Agrif_trc
 
-      zrhox = Agrif_Rhox()
+   SUBROUTINE interptrn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptrn ***
+      !!---------------------------------------------
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER :: imin, imax, jmin, jmax
+      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
+      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
 
-      alpha1 = ( zrhox - 1. ) * 0.5
-      alpha2 = 1. - alpha1
-
-      alpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
-      alpha4 = 1. - alpha3
-
-      alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-      alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-      alpha5 = 1. - alpha6 - alpha7
-      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
-
-         DO jn = 1, jptra
-            tra(nlci,:,:,jn) = alpha1 * ztra(nlci,:,:,jn) + alpha2 * ztra(nlci-1,:,:,jn)
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
-                     tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
-                  ELSE
-                     tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
-                        tra(nlci-1,jj,jk,jn)=( alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn)  &
-                           &                 + alpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+      IF (before) THEN         
+         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE
+         !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         !
+         zrhox = Agrif_Rhox()
+         ! 
+         zalpha1 = ( zrhox - 1. ) * 0.5
+         zalpha2 = 1. - zalpha1
+         ! 
+         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
+         zalpha4 = 1. - zalpha3
+         ! 
+         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+         zalpha5 = 1. - zalpha6 - zalpha7
+         !
+         imin = i1
+         imax = i2
+         jmin = j1
+         jmax = j2
+         ! 
+         ! Remove CORNERS
+         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
+         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
+         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
+         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
+         !
+         IF( eastern_side) THEN
+            DO jn = 1, jptra
+               tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
+                        tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                     ELSE
+                        tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
+                           tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 
+                                 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                        ENDIF
                      ENDIF
-                  ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         ! 
+         IF( northern_side ) THEN            
+            DO jn = 1, jptra
+               tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO ji = imin,imax
+                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
+                        tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                     ELSE
+                        tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
+                           tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn)  &
+                                 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         !
+         IF( western_side) THEN            
+            DO jn = 1, jptra
+               tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(2,jj,jk) == 0.e0 ) THEN
+                        tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
+                     ELSE
+                        tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)        
+                        IF( un(2,jj,jk) < 0.e0 ) THEN
+                           tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
                END DO
             END DO
-         ENDDO
-      ENDIF
-
-      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
-
-         DO jn = 1, jptra
-            tra(:,nlcj,:,jn) = alpha1 * ztra(:,nlcj,:,jn) + alpha2 * ztra(:,nlcj-1,:,jn)
-            DO jk = 1, jpkm1
-               DO ji = 1, jpi
-                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
-                     tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
-                  ELSE
-                     tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)
-                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
-                        tra(ji,nlcj-1,jk,jn)=( alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn)  &
-                           &                 + alpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+         ENDIF
+         !
+         IF( southern_side ) THEN           
+            DO jn = 1, jptra
+               tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
+               DO jk=1,jpk      
+                  DO ji=imin,imax
+                     IF( vmask(ji,2,jk) == 0.e0 ) THEN
+                        tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
+                     ELSE
+                        tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
+                        IF( vn(ji,2,jk) < 0.e0 ) THEN
+                           tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
+                        ENDIF
                      ENDIF
-                  ENDIF
+                  END DO
                END DO
-            END DO
-         ENDDO
-      ENDIF
-      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
-         DO jn = 1, jptra
-            tra(1,:,:,jn) = alpha1 * ztra(1,:,:,jn) + alpha2 * ztra(2,:,:,jn)
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  IF( umask(2,jj,jk) == 0.e0 ) THEN
-                     tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
-                  ELSE
-                     tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)
-                     IF( un(2,jj,jk) < 0.e0 ) THEN
-                        tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn)+alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      ENDIF
-
-      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
-         DO jn = 1, jptra
-            tra(:,1,:,jn) = alpha1 * ztra(:,1,:,jn) + alpha2 * ztra(:,2,:,jn)
-            DO jk=1,jpk
-               DO ji=1,jpi
-                  IF( vmask(ji,2,jk) == 0.e0 ) THEN
-                     tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
-                  ELSE
-                     tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
-                     IF( vn(ji,2,jk) < 0.e0 ) THEN
-                        tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)+alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         ENDDO
+            ENDDO
+         ENDIF
+         !
+         ! Treatment of corners
+         ! 
+         ! East south
+         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
+         ENDIF
+         ! East north
+         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
+         ENDIF
+         ! West south
+         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tra(2,2,:,:) = ptab(2,2,:,:)
+         ENDIF
+         ! West north
+         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
+         ENDIF
+         !
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )
-      !
-
-   END SUBROUTINE Agrif_trc
+   END SUBROUTINE interptrn
 
 #else
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 5901)
@@ -1,7 +1,8 @@
 #define SPONGE_TOP
 
-Module agrif_top_sponge
+MODULE agrif_top_sponge
 #if defined key_agrif && defined key_top
    USE par_oce
+   USE par_trc
    USE oce
    USE dom_oce
@@ -16,71 +17,31 @@
    PRIVATE
 
-   PUBLIC Agrif_Sponge_Trc, interptrn
+   PUBLIC Agrif_Sponge_trc, interptrn_sponge
 
-  !! * Substitutions
+   !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
-   CONTAINS
+CONTAINS
 
-   SUBROUTINE Agrif_Sponge_Trc
+   SUBROUTINE Agrif_Sponge_trc
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Sponge_Trc ***
       !!---------------------------------------------
       !! 
-      INTEGER :: ji,jj,jk,jn
       REAL(wp) :: timecoeff
-      REAL(wp) :: ztra, zabe1, zabe2, zbtr
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff
 
 #if defined SPONGE_TOP
-      CALL wrk_alloc( jpi, jpj, ztru, ztrv )
-      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff )
-
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
-
+      CALL Agrif_sponge
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .TRUE.
-      ztabr = 0.e0
-      CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn)
+      tabspongedone_trn = .FALSE.
+      CALL Agrif_Bc_Variable(trn_sponge_id,calledweight=timecoeff,procname=interptrn_sponge)
       Agrif_UseSpecialValue = .FALSE.
-
-      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:)
-
-      CALL Agrif_sponge
-
-      DO jn = 1, jptra
-         DO jk = 1, jpkm1
-            !
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
-                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
-                  ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
-                  ztrv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
-               ENDDO
-            ENDDO
-
-            DO jj = 2,jpjm1
-               DO ji = 2,jpim1
-                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-                  ! horizontal diffusive trends
-                  ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1)  )
-                  ! add it to the general tracer trends
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-            !
-         ENDDO
-      ENDDO
- 
-      CALL wrk_dealloc( jpi, jpj, ztru, ztrv )
-      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr )
 
 #endif
@@ -88,14 +49,57 @@
    END SUBROUTINE Agrif_Sponge_Trc
 
-   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
+   SUBROUTINE interptrn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
       !!---------------------------------------------
-      !!   *** ROUTINE interptn ***
+      !!   *** ROUTINE interptrn_sponge ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+
+
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+
+      REAL(wp) :: ztra, zabe1, zabe2, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::trbdiff
       !
-      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      IF (before) THEN
+         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE      
 
-   END SUBROUTINE interptrn
+         trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)      
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+
+               DO jj = j1,j2-1
+                  DO ji = i1,i2-1
+                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk)
+                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk)
+                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                  ENDDO
+               ENDDO
+
+               DO jj = j1+1,j2-1
+                  DO ji = i1+1,i2-1
+
+                     IF (.NOT. tabspongedone_trn(ji,jj)) THEN 
+                        zbtr = r1_e1e2t(ji,jj) / fse3t(ji,jj,jk)
+                        ! horizontal diffusive trends
+                        ztra = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  ) + ztv(ji,jj) - ztv(ji  ,jj-1)  )
+                        ! add it to the general tracer trends
+                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+                     ENDIF
+
+                  ENDDO
+               ENDDO
+
+            ENDDO
+         ENDDO
+
+         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+      ENDIF
+      !                 
+   END SUBROUTINE interptrn_sponge
 
 #else
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 5901)
@@ -1,3 +1,4 @@
 #define TWO_WAY
+#undef DECAL_FEEDBACK
 
 MODULE agrif_top_update
@@ -8,4 +9,5 @@
    USE dom_oce
    USE agrif_oce
+   USE par_trc
    USE trc
    USE wrk_nemo  
@@ -24,5 +26,5 @@
    !!----------------------------------------------------------------------
 
-   CONTAINS
+CONTAINS
 
    SUBROUTINE Agrif_Update_Trc( kt )
@@ -30,75 +32,65 @@
       !!   *** ROUTINE Agrif_Update_Trc ***
       !!---------------------------------------------
-      !!
       INTEGER, INTENT(in) :: kt
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra
-
-  
-      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
-
-#if defined TWO_WAY
-      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra )
-
+      !!---------------------------------------------
+      ! 
+      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
+#if defined TWO_WAY   
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
- 
-     IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable(ztra,trn_id, procname=updateTRC)
+      ! 
+      IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(trn_id, procname=updateTRC)
+# else
+         CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC)
+# endif
       ELSE
-         CALL Agrif_Update_Variable(ztra,trn_id,locupdate=(/0,2/), procname=updateTRC)
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(trn_id,locupdate=(/0,2/), procname=updateTRC)
+# else
+         CALL Agrif_Update_Variable(trn_id,locupdate=(/1,2/), procname=updateTRC)
+# endif
       ENDIF
-
+      !
       Agrif_UseSpecialValueInUpdate = .FALSE.
       nbcline_trc = nbcline_trc + 1
-
-      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )
 #endif
-
+      !
    END SUBROUTINE Agrif_Update_Trc
 
-   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
+   SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
       !!---------------------------------------------
-      !!   *** ROUTINE UpdateTrc ***
+      !!           *** ROUTINE updateT ***
       !!---------------------------------------------
+#  include "domzgr_substitute.h90"
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
-      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
       LOGICAL, INTENT(in) :: before
-   
+      !!
       INTEGER :: ji,jj,jk,jn
-
-         IF( before ) THEN
-            DO jn = n1, n2
-               DO jk = k1, k2
-                  DO jj = j1, j2
-                     DO ji = i1, i2
-                        tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
-                     ENDDO
-                  ENDDO
-               ENDDO
-            ENDDO
-         ELSE
-            IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         DO jn = n1,n2
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
+                  END DO
+               END DO
+            END DO
+         END DO
+      ELSE
+         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
             ! Add asselin part
-               DO jn = n1, n2
-                  DO jk = k1, k2
-                     DO jj = j1, j2
-                        DO ji = i1, i2
-                           IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
-                              trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 
-                                 & + atfp * ( tabres(ji,jj,jk,jn) &
-                                               - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
-                           ENDIF
-                        ENDDO
-                     ENDDO
-                  ENDDO
-               ENDDO
-            ENDIF
-
-            DO jn = n1, n2
-               DO jk = k1, k2
-                  DO jj = j1, j2
-                     DO ji = i1, i2
-                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
-                           trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk)
+            DO jn = n1,n2
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN
+                           trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 
+                                 & + atfp * ( ptab(ji,jj,jk,jn) &
+                                 &             - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
                         ENDIF
                      ENDDO
@@ -107,5 +99,17 @@
             ENDDO
          ENDIF
-
+         DO jn = n1,n2
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 
+                        trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk)
+                     END IF
+                  END DO
+               END DO
+            END DO
+         END DO
+      ENDIF
+      ! 
    END SUBROUTINE updateTRC
 
@@ -119,3 +123,3 @@
    END SUBROUTINE agrif_top_update_empty
 #endif
-END Module agrif_top_update
+END MODULE agrif_top_update
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 5901)
@@ -17,5 +17,4 @@
    USE par_oce
    USE dom_oce
-   USE Agrif_Util
    USE nemogcm
    !
@@ -31,5 +30,9 @@
       jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
       jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
-      jpk     = jpkdta 
+! JC: change to allow for different vertical levels
+!     jpk is already set
+!     keep it jpk possibly different from jpkdta which 
+!     hold parent grid vertical levels number (set earlier)
+!      jpk     = jpkdta 
       jpim1   = jpi-1 
       jpjm1   = jpj-1 
@@ -64,7 +67,7 @@
    ! 0. Initializations
    !-------------------
-   IF( cp_cfg == 'orca' ) then
+   IF( cp_cfg == 'orca' ) THEN
       IF ( jp_cfg == 2 .OR. jp_cfg == 025 .OR. jp_cfg == 05 &
-  &                      .OR. jp_cfg == 4 ) THEN
+            &                      .OR. jp_cfg == 4 ) THEN
          jp_cfg = -1    ! set special value for jp_cfg on fine grids
          cp_cfg = "default"
@@ -120,10 +123,10 @@
 SUBROUTINE agrif_declare_var_dom
    !!----------------------------------------------------------------------
-   !!                 *** ROUTINE agrif_declarE_var ***
+   !!                 *** ROUTINE agrif_declare_var ***
    !!
    !! ** Purpose :: Declaration of variables to be interpolated
    !!----------------------------------------------------------------------
    USE agrif_util
-   USE par_oce       !   ONLY : jpts
+   USE par_oce       
    USE oce
    IMPLICIT NONE
@@ -132,23 +135,26 @@
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
-
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
 
    ! 2. Type of interpolation
    !-------------------------
-   Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
 
    ! 3. Location of interpolation
    !-----------------------------
-   Call Agrif_Set_bc(e1u_id,(/0,0/))
-   Call Agrif_Set_bc(e2v_id,(/0,0/))
+   CALL Agrif_Set_bc(e1u_id,(/0,0/))
+   CALL Agrif_Set_bc(e2v_id,(/0,0/))
 
    ! 5. Update type
    !--------------- 
-   Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
-   Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
-
+   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
+
+! High order updates
+!   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting)
+!   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average)
+    !
 END SUBROUTINE agrif_declare_var_dom
 
@@ -167,4 +173,5 @@
    USE nemogcm
    USE sol_oce
+   USE lib_mpp
    USE in_out_manager
    USE agrif_opa_update
@@ -174,14 +181,7 @@
    IMPLICIT NONE
    !
-   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp
-   REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp
-   REAL(wp), DIMENSION(:,:    ), ALLOCATABLE :: tab2d
    LOGICAL :: check_namelist
-   !!----------------------------------------------------------------------
-
-   ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) )
-   ALLOCATE( tabuvtemp(jpi, jpj, jpk)       )
-   ALLOCATE( tab2d(jpi, jpj)                )
-
+   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3
+   !!----------------------------------------------------------------------
 
    ! 1. Declaration of the type of variable which have to be interpolated
@@ -193,44 +193,69 @@
    Agrif_SpecialValue=0.
    Agrif_UseSpecialValue = .TRUE.
-   Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn)
-   Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn)
-
-   Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu)
-   Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv)
-   Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun)
-   Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn)
-
-   Call Agrif_Bc_variable(tab2d,unb_id,calledweight=1.,procname=interpunb)
-   Call Agrif_Bc_variable(tab2d,vnb_id,calledweight=1.,procname=interpvnb)
-   Call Agrif_Bc_variable(tab2d,sshn_id,calledweight=1.,procname=interpsshn)
-   Agrif_UseSpecialValue = .FALSE.
+   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
+   CALL Agrif_Sponge
+   tabspongedone_tsn = .FALSE.
+   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
+   ! reset tsa to zero
+   tsa(:,:,:,:) = 0.
+
+   Agrif_UseSpecialValue = ln_spc_dyn
+   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
+   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
+   tabspongedone_u = .FALSE.
+   tabspongedone_v = .FALSE.
+   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
+   tabspongedone_u = .FALSE.
+   tabspongedone_v = .FALSE.
+   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
+
+#if defined key_dynspg_ts
+   Agrif_UseSpecialValue = .TRUE.
+   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
+
+   Agrif_UseSpecialValue = ln_spc_dyn
+   CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
+   CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
+   CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
+   CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
+   ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0
+   ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 
+   ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 
+   ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0
+#endif
+
+   Agrif_UseSpecialValue = .FALSE. 
+   ! reset velocities to zero
+   ua(:,:,:) = 0.
+   va(:,:,:) = 0.
 
    ! 3. Some controls
    !-----------------
-   check_namelist = .true.
-
-   IF( check_namelist ) THEN
+   check_namelist = .TRUE.
+
+   IF( check_namelist ) THEN 
 
       ! Check time steps           
-      IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN
-         WRITE(*,*) 'incompatible time step between grids'
-         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
-         WRITE(*,*) 'child  grid value : ',nint(rdt)
-         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
-         STOP
+      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
+         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
+         WRITE(cl_check2,*)  NINT(rdt)
+         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
+         CALL ctl_warn( 'incompatible time step between grids',   &
+               &               'parent grid value : '//cl_check1    ,   & 
+               &               'child  grid value : '//cl_check2    ,   & 
+               &               'value on child grid will be changed to : '//cl_check3 )
+         rdt=Agrif_Parent(rdt)/Agrif_Rhot()
       ENDIF
 
       ! Check run length
       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
-           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
-         WRITE(*,*) 'incompatible run length between grids'
-         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
-              Agrif_Parent(nit000)+1),' time step'
-         WRITE(*,*) 'child  grid value : ', &
-              (nitend-nit000+1),' time step'
-         WRITE(*,*) 'value on child grid should be : ', &
-              Agrif_IRhot() * (Agrif_Parent(nitend)- &
-              Agrif_Parent(nit000)+1)
-         STOP
+            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
+         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
+         CALL ctl_warn( 'incompatible run length between grids'               ,   &
+               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
+               &              ' nitend on fine grid will be change to : '//cl_check2    )
+         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
       ENDIF
 
@@ -238,5 +263,5 @@
       IF( ln_zps ) THEN
          ! check parameters for partial steps 
-         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
+         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
             WRITE(*,*) 'incompatible e3zps_min between grids'
             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
@@ -253,14 +278,47 @@
          ENDIF
       ENDIF
+      ! check if masks and bathymetries match
+      IF(ln_chk_bathy) THEN
+         !
+         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
+         !
+         kindic_agr = 0
+         ! check if umask agree with parent along western and eastern boundaries:
+         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
+         ! check if vmask agree with parent along northern and southern boundaries:
+         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
+	 ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
+         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
+         !
+         IF (lk_mpp) CALL mpp_sum( kindic_agr )
+         IF( kindic_agr /= 0 ) THEN             		
+            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
+         ELSE
+            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
+         END IF
+      ENDIF
+      !
    ENDIF
-
-   CALL Agrif_Update_tra(0)
-   CALL Agrif_Update_dyn(0)
-
+   ! 
+   ! Do update at initialisation because not done before writing restarts
+   ! This would indeed change boundary conditions values at initial time
+   ! hence produce restartability issues.
+   ! Note that update below is recursive (with lk_agrif_doupd=T):
+   ! 
+! JC: I am not sure if Agrif_MaxLevel() is the "relative"
+!     or the absolute maximum nesting level...TBC                        
+   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 
+      ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics
+      CALL Agrif_Update_tra()
+      CALL Agrif_Update_dyn()
+   ENDIF
+   !
+# if defined key_zdftke
+   CALL Agrif_Update_tke(0)
+# endif
+   !
+   Agrif_UseSpecialValueInUpdate = .FALSE.
    nbcline = 0
-   !
-   DEALLOCATE(tabtstemp)
-   DEALLOCATE(tabuvtemp)
-   DEALLOCATE(tab2d)
+   lk_agrif_doupd = .FALSE.
    !
 END SUBROUTINE Agrif_InitValues_cont
@@ -276,4 +334,5 @@
    USE par_oce       !   ONLY : jpts
    USE oce
+   USE agrif_oce
    IMPLICIT NONE
    !!----------------------------------------------------------------------
@@ -281,68 +340,120 @@
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id)
-
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id)
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id)
-
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id)
-   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id)
-   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id)
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
+
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
+
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
+
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
+
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
+
+   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
+
+# if defined key_zdftke
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
+# endif
 
    ! 2. Type of interpolation
    !-------------------------
    CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
-   CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear)
-
-   Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-
-   Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
 
    CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
-   Call Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-   Call Agrif_Set_bcinterp(ub2b_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(vb2b_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+
+   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
+   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
+   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
+
+# if defined key_zdftke
+   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear)
+# endif
+
 
    ! 3. Location of interpolation
    !-----------------------------
-   Call Agrif_Set_bc(un_id,(/0,1/))
-   Call Agrif_Set_bc(vn_id,(/0,1/))
-
-   Call Agrif_Set_bc(sshn_id,(/0,1/))
-   Call Agrif_Set_bc(unb_id,(/0,1/))
-   Call Agrif_Set_bc(vnb_id,(/0,1/))
-   Call Agrif_Set_bc(ub2b_id,(/0,1/))
-   Call Agrif_Set_bc(vb2b_id,(/0,1/))
-
-   Call Agrif_Set_bc(tsn_id,(/0,1/))
-   Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/))
-
-   Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/))
-   Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/))
+   CALL Agrif_Set_bc(tsn_id,(/0,1/))
+   CALL Agrif_Set_bc(un_interp_id,(/0,1/))
+   CALL Agrif_Set_bc(vn_interp_id,(/0,1/))
+
+!   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/))
+!   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/))
+!   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/))
+   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+
+   CALL Agrif_Set_bc(sshn_id,(/0,0/))
+   CALL Agrif_Set_bc(unb_id ,(/0,0/))
+   CALL Agrif_Set_bc(vnb_id ,(/0,0/))
+   CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/))
+   CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/))
+
+   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9
+   CALL Agrif_Set_bc(umsk_id,(/0,0/))
+   CALL Agrif_Set_bc(vmsk_id,(/0,0/))
+
+# if defined key_zdftke
+   CALL Agrif_Set_bc(avm_id ,(/0,1/))
+# endif
 
    ! 5. Update type
    !--------------- 
-   Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
-   Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average)
-
-   Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
-   Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average)
-
-   Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
-   Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
-
-   Call Agrif_Set_Updatetype(ub2b_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
-   Call Agrif_Set_Updatetype(vb2b_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
-
+   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
+
+   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
+
+   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+
+   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
+
+   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+
+# if defined key_zdftke
+   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
+   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
+   CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
+# endif
+
+! High order updates
+!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
+!   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
+!   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
+!
+!   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
+!   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
+!   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
+ 
+   !
 END SUBROUTINE agrif_declare_var
 # endif
@@ -365,9 +476,5 @@
    IMPLICIT NONE
    !
-   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: zvel
-   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv
-   !!----------------------------------------------------------------------
-
-   ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7))
+   !!----------------------------------------------------------------------
 
    ! 1. Declaration of the type of variable which have to be interpolated
@@ -401,6 +508,4 @@
    CALL Agrif_Update_lim2(0)
    !
-   DEALLOCATE( zvel, zadv )
-   !
 END SUBROUTINE Agrif_InitValues_cont_lim2
 
@@ -431,19 +536,19 @@
    !-------------------------
    CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
-   Call Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
 
    ! 3. Location of interpolation
    !-----------------------------
-   Call Agrif_Set_bc(adv_ice_id ,(/0,1/))
-   Call Agrif_Set_bc(u_ice_id,(/0,1/))
-   Call Agrif_Set_bc(v_ice_id,(/0,1/))
+   CALL Agrif_Set_bc(adv_ice_id ,(/0,1/))
+   CALL Agrif_Set_bc(u_ice_id,(/0,1/))
+   CALL Agrif_Set_bc(v_ice_id,(/0,1/))
 
    ! 5. Update type
    !---------------
-   Call Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
-   Call Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
-   Call Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
-
+   CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
+   CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+   ! 
 END SUBROUTINE agrif_declare_var_lim2
 #  endif
@@ -462,6 +567,8 @@
    USE nemogcm
    USE par_trc
+   USE lib_mpp
    USE trc
    USE in_out_manager
+   USE agrif_opa_sponge
    USE agrif_top_update
    USE agrif_top_interp
@@ -470,9 +577,7 @@
    IMPLICIT NONE
    !
-   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp
+   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
    LOGICAL :: check_namelist
    !!----------------------------------------------------------------------
-
-   ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) )
 
 
@@ -485,35 +590,42 @@
    Agrif_SpecialValue=0.
    Agrif_UseSpecialValue = .TRUE.
-   Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn)
-   Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn)
+   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
    Agrif_UseSpecialValue = .FALSE.
+   CALL Agrif_Sponge
+   tabspongedone_trn = .FALSE.
+   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
+   ! reset tsa to zero
+   tra(:,:,:,:) = 0.
+
 
    ! 3. Some controls
    !-----------------
-   check_namelist = .true.
+   check_namelist = .TRUE.
 
    IF( check_namelist ) THEN
-#  if defined offline     
+# if defined key_offline
       ! Check time steps
-      IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
-         WRITE(*,*) 'incompatible time step between grids'
-         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
-         WRITE(*,*) 'child  grid value : ',nint(rdt)
-         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
-         STOP
+      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
+         WRITE(cl_check1,*)  Agrif_Parent(rdt)
+         WRITE(cl_check2,*)  rdt
+         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
+         CALL ctl_warn( 'incompatible time step between grids',   &
+               &               'parent grid value : '//cl_check1    ,   & 
+               &               'child  grid value : '//cl_check2    ,   & 
+               &               'value on child grid will be changed to  &
+               &               :'//cl_check3  )
+         rdt=rdt*Agrif_Rhot()
       ENDIF
 
       ! Check run length
       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
-           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
-         WRITE(*,*) 'incompatible run length between grids'
-         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
-              Agrif_Parent(nit000)+1),' time step'
-         WRITE(*,*) 'child  grid value : ', &
-              (nitend-nit000+1),' time step'
-         WRITE(*,*) 'value on child grid should be : ', &
-              Agrif_IRhot() * (Agrif_Parent(nitend)- &
-              Agrif_Parent(nit000)+1)
-         STOP
+            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
+         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
+         CALL ctl_warn( 'incompatible run length between grids'               ,   &
+               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
+               &              ' nitend on fine grid will be change to : '//cl_check2    )
+         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
       ENDIF
 
@@ -521,5 +633,5 @@
       IF( ln_zps ) THEN
          ! check parameters for partial steps 
-         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
+         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
             WRITE(*,*) 'incompatible e3zps_min between grids'
             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
@@ -528,5 +640,5 @@
             STOP
          ENDIF
-         IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
+         IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN
             WRITE(*,*) 'incompatible e3zps_rat between grids'
             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
@@ -538,13 +650,13 @@
 #  endif         
       ! Check passive tracer cell
-      IF( nn_dttrc .ne. 1 ) THEN
+      IF( nn_dttrc .NE. 1 ) THEN
          WRITE(*,*) 'nn_dttrc should be equal to 1'
       ENDIF
    ENDIF
 
-!ch   CALL Agrif_Update_trc(0)
+   CALL Agrif_Update_trc(0)
+   !
+   Agrif_UseSpecialValueInUpdate = .FALSE.
    nbcline_trc = 0
-   !
-   DEALLOCATE(tabtrtemp)
    !
 END SUBROUTINE Agrif_InitValues_cont_top
@@ -558,4 +670,5 @@
    !!----------------------------------------------------------------------
    USE agrif_util
+   USE agrif_oce
    USE dom_oce
    USE trc
@@ -565,24 +678,26 @@
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
 
    ! 2. Type of interpolation
    !-------------------------
    CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
-   CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear)
+   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
 
    ! 3. Location of interpolation
    !-----------------------------
-   Call Agrif_Set_bc(trn_id,(/0,1/))
-   Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/))
+   CALL Agrif_Set_bc(trn_id,(/0,1/))
+!   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/))
+   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
 
    ! 5. Update type
    !--------------- 
-   Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
-   Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average)
-
-
+   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
+
+!   Higher order update
+!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
+
+   !
 END SUBROUTINE agrif_declare_var_top
 # endif
@@ -592,5 +707,4 @@
    !!   *** ROUTINE Agrif_detect ***
    !!----------------------------------------------------------------------
-   USE Agrif_Types
    !
    INTEGER, DIMENSION(2) :: ksizex
@@ -614,15 +728,16 @@
    !
    INTEGER  ::   ios                 ! Local integer output status for namelist read
-   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
-   !!----------------------------------------------------------------------
-   !
-      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
-      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
-      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namagrif )
+   INTEGER  ::   iminspon
+   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
+   !!--------------------------------------------------------------------------------------
+   !
+   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
+   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
+
+   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
+   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
+902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
+   IF(lwm) WRITE ( numond, namagrif )
    !
    IF(lwp) THEN                    ! control print
@@ -635,4 +750,5 @@
       WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
       WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
+      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
       WRITE(numout,*) 
    ENDIF
@@ -643,5 +759,10 @@
    visc_dyn      = rn_sponge_dyn
    !
-   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed')
+   ! Check sponge length:
+   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
+   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
+   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
+   !
+   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
 # if defined key_lim2
    IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed')
@@ -664,10 +785,45 @@
    SELECT CASE( i )
    CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
-   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
-   CASE(3)   ;   indglob = indloc
-   CASE(4)   ;   indglob = indloc
+   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
+   CASE DEFAULT
+      indglob = indloc
    END SELECT
    !
 END SUBROUTINE Agrif_InvLoc
+
+SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_get_proc_info ***
+   !!----------------------------------------------------------------------
+   USE par_oce
+   IMPLICIT NONE
+   !
+   INTEGER, INTENT(out) :: imin, imax
+   INTEGER, INTENT(out) :: jmin, jmax
+   !!----------------------------------------------------------------------
+   !
+   imin = nimppt(Agrif_Procrank+1)  ! ?????
+   jmin = njmppt(Agrif_Procrank+1)  ! ?????
+   imax = imin + jpi - 1
+   jmax = jmin + jpj - 1
+   ! 
+END SUBROUTINE Agrif_get_proc_info
+
+SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
+   !!----------------------------------------------------------------------
+   USE par_oce
+   IMPLICIT NONE
+   !
+   INTEGER,  INTENT(in)  :: imin, imax
+   INTEGER,  INTENT(in)  :: jmin, jmax
+   INTEGER,  INTENT(in)  :: nbprocs
+   REAL(wp), INTENT(out) :: grid_cost
+   !!----------------------------------------------------------------------
+   !
+   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
+   !
+END SUBROUTINE Agrif_estimate_parallel_cost
 
 # endif
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/domain.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/domain.F90	(revision 5891)
+++ 	(revision )
@@ -1,428 +1,0 @@
-MODULE domain
-   !!==============================================================================
-   !!                       ***  MODULE domain   ***
-   !! Ocean initialization : domain initialization
-   !!==============================================================================
-
-   !!----------------------------------------------------------------------
-   !!   dom_init       : initialize the space and time domain
-   !!   dom_nam        : read and contral domain namelists
-   !!   dom_ctl        : control print for the ocean domain
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! 
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distributed memory computing library
-
-   USE domstp          ! domain: set the time-step
-   USE domrea          ! domain: write the meshmask file
-   USE dommsk          ! domain : mask
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC dom_init       ! called by opa.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE dom_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_init  ***
-      !!                    
-      !! ** Purpose :   Domain initialization. Call the routines that are 
-      !!      required to create the arrays which define the space and time
-      !!      domain of the ocean model.
-      !!
-      !! ** Method  :
-      !!      - dom_stp: defined the model time step
-      !!      - dom_rea: read the meshmask file if nmsh=1
-      !!
-      !! History :
-      !!        !  90-10  (C. Levy - G. Madec)  Original code
-      !!        !  91-11  (G. Madec)
-      !!        !  92-01  (M. Imbard) insert time step initialization
-      !!        !  96-06  (G. Madec) generalized vertical coordinate 
-      !!        !  97-02  (G. Madec) creation of domwri.F
-      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
-      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER ::   jk                ! dummy loop argument
-      INTEGER ::   iconf = 0         ! temporary integers
-      !!----------------------------------------------------------------------
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_init : domain initialization'
-         WRITE(numout,*) '~~~~~~~~'
-      ENDIF
-
-      CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
-      CALL dom_zgr      ! Vertical mesh and bathymetry option
-      CALL dom_rea      ! Create a domain file
-
-     !
-      ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines
-      !        but could be usefull in many other routines
-      e12t    (:,:) = e1t(:,:) * e2t(:,:)
-      e1e2t   (:,:) = e1t(:,:) * e2t(:,:)
-      e12u    (:,:) = e1u(:,:) * e2u(:,:)
-      e12v    (:,:) = e1v(:,:) * e2v(:,:)
-      e12f    (:,:) = e1f(:,:) * e2f(:,:)
-      r1_e12t (:,:) = 1._wp    / e12t(:,:)
-      r1_e12u (:,:) = 1._wp    / e12u(:,:)
-      r1_e12v (:,:) = 1._wp    / e12v(:,:)
-      r1_e12f (:,:) = 1._wp    / e12f(:,:)
-      re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)
-      re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)
-      !
-      hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points
-      hv(:,:) = 0._wp
-      DO jk = 1, jpk
-         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
-         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
-      END DO
-      !                                        ! Inverse of the local depth
-      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)
-      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)
-
-      CALL dom_stp      ! Time step
-      CALL dom_msk      ! Masks
-      CALL dom_ctl      ! Domain control
-
-   END SUBROUTINE dom_init
-
-   SUBROUTINE dom_nam
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE dom_nam  ***
-      !!                    
-      !! ** Purpose :   read domaine namelists and print the variables.
-      !!
-      !! ** input   : - namrun namelist
-      !!              - namdom namelist
-      !!              - namcla namelist
-      !!----------------------------------------------------------------------
-      USE ioipsl
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
-         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
-         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz, nn_euler
-      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
-         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
-         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , ln_crs, &
-         &             jphgr_msh, &
-         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
-         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
-         &             ppa2, ppkth2, ppacr2
-      NAMELIST/namcla/ nn_cla
-#if defined key_netcdf4
-      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
-#endif
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
-      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
-      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namrun )
-      !
-      IF(lwp) THEN                  ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
-         WRITE(numout,*) '~~~~~~~ '
-         WRITE(numout,*) '   Namelist namrun'  
-         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
-         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
-         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
-         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
-         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
-         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
-         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
-         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
-         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
-         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
-         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
-         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
-         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
-         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
-         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
-      ENDIF
-      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
-      cexper = cn_exp
-      nrstdt = nn_rstctl
-      nit000 = nn_it000
-      nitend = nn_itend
-      ndate0 = nn_date0
-      nleapy = nn_leapy
-      ninist = nn_istate
-      nstock = nn_stock
-      nwrite = nn_write
-
-
-      !                             ! control of output frequency
-      IF ( nstock == 0 .OR. nstock > nitend ) THEN
-         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
-         CALL ctl_warn( ctmp1 )
-         nstock = nitend
-      ENDIF
-      IF ( nwrite == 0 ) THEN
-         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
-         CALL ctl_warn( ctmp1 )
-         nwrite = nitend
-      ENDIF
-
-      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
-      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
-      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
-
-#if defined key_agrif
-      IF( Agrif_Root() ) THEN
-#endif
-      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
-      CASE (  1 ) 
-         CALL ioconf_calendar('gregorian')
-         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
-      CASE (  0 )
-         CALL ioconf_calendar('noleap')
-         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
-      CASE ( 30 )
-         CALL ioconf_calendar('360d')
-         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
-      END SELECT
-#if defined key_agrif
-      ENDIF
-#endif
-
-      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
-      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
-903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
-      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
-904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namdom )
-
-      IF(lwp) THEN
-         WRITE(numout,*) 
-         WRITE(numout,*) '   Namelist namdom : space & time domain'
-         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
-         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
-         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
-         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
-         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
-         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
-         WRITE(numout,*) '           = 0   no file created                 '
-         WRITE(numout,*) '           = 1   mesh_mask                       '
-         WRITE(numout,*) '           = 2   mesh and mask                   '
-         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
-         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
-         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
-         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
-         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
-         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
-         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
-         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
-         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
-         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
-         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
-         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
-         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
-         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
-         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
-         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
-         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
-         WRITE(numout,*) '                                        ppa0            = ', ppa0
-         WRITE(numout,*) '                                        ppa1            = ', ppa1
-         WRITE(numout,*) '                                        ppkth           = ', ppkth
-         WRITE(numout,*) '                                        ppacr           = ', ppacr
-         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
-         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
-         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
-         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
-         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
-         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
-      ENDIF
-
-      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
-      e3zps_min = rn_e3zps_min
-      e3zps_rat = rn_e3zps_rat
-      nmsh      = nn_msh
-      nacc      = nn_acc
-      atfp      = rn_atfp
-      rdt       = rn_rdt
-      rdtmin    = rn_rdtmin
-      rdtmax    = rn_rdtmin
-      rdth      = rn_rdth
-
-      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection
-      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
-905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection
-      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
-906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
-      IF(lwm) WRITE( numond, namcla )
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namcla'
-         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
-      ENDIF
-
-#if defined key_netcdf4
-      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
-      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
-      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
-907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
-      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
-908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
-      IF(lwm) WRITE( numond, namnc4 )
-      IF(lwp) THEN                        ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
-         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
-         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
-         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
-         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
-      ENDIF
-
-      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
-      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
-      snc4set%ni   = nn_nchunks_i
-      snc4set%nj   = nn_nchunks_j
-      snc4set%nk   = nn_nchunks_k
-      snc4set%luse = ln_nc4zip
-#else
-      snc4set%luse = .FALSE.        ! No NetCDF 4 case
-#endif
-      !
-   END SUBROUTINE dom_nam
-
-   SUBROUTINE dom_zgr
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE dom_zgr  ***
-      !!                   
-      !! ** Purpose :  set the depth of model levels and the resulting 
-      !!      vertical scale factors.
-      !!
-      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
-      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
-      !!              - vertical coordinate (gdep., e3.) depending on the 
-      !!                coordinate chosen :
-      !!                   ln_zco=T   z-coordinate  
-      !!                   ln_zps=T   z-coordinate with partial steps
-      !!                   ln_zco=T   s-coordinate 
-      !!
-      !! ** Action  :   define gdep., e3., mbathy and bathy
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio = 0   ! temporary integer
-      INTEGER ::   ios
-      !!
-      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
-      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
-      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namzgr )
-
-      IF(lwp) THEN                     ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_zgr : vertical coordinate'
-         WRITE(numout,*) '~~~~~~~'
-         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
-         WRITE(numout,*) '             z-coordinate - full steps      ln_zco    = ', ln_zco
-         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps    = ', ln_zps
-         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
-         WRITE(numout,*) '             ice shelf cavity               ln_isfcav = ', ln_isfcav
-      ENDIF
-
-      ioptio = 0                       ! Check Vertical coordinate options
-      IF( ln_zco ) ioptio = ioptio + 1
-      IF( ln_zps ) ioptio = ioptio + 1
-      IF( ln_sco ) ioptio = ioptio + 1
-      IF( ln_isfcav ) ioptio = 33
-      IF ( ioptio /= 1  )   CALL ctl_stop( ' none or several vertical coordinate options used' )
-      IF ( ioptio == 33 )   CALL ctl_stop( ' isf cavity with off line module not yet done    ' )
-
-   END SUBROUTINE dom_zgr
-
-   SUBROUTINE dom_ctl
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE dom_ctl  ***
-      !!
-      !! ** Purpose :   Domain control.
-      !!
-      !! ** Method  :   compute and print extrema of masked scale factors
-      !!
-      !! History :
-      !!   8.5  !  02-08  (G. Madec)    Original code
-      !!----------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
-      INTEGER, DIMENSION(2) ::   iloc      ! 
-      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
-      !!----------------------------------------------------------------------
-
-      ! Extrema of the scale factors
-
-      IF(lwp)WRITE(numout,*)
-      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
-      IF(lwp)WRITE(numout,*) '~~~~~~~'
-
-      IF (lk_mpp) THEN
-         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
-         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
-         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
-         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
-      ELSE
-         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
-         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
-         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
-         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
-
-         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
-         iimi1 = iloc(1) + nimpp - 1
-         ijmi1 = iloc(2) + njmpp - 1
-         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
-         iimi2 = iloc(1) + nimpp - 1
-         ijmi2 = iloc(2) + njmpp - 1
-         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
-         iima1 = iloc(1) + nimpp - 1
-         ijma1 = iloc(2) + njmpp - 1
-         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
-         iima2 = iloc(1) + nimpp - 1
-         ijma2 = iloc(2) + njmpp - 1
-      ENDIF
-
-      IF(lwp) THEN
-         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
-         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
-         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
-         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
-      ENDIF
-
-   END SUBROUTINE dom_ctl
-
-   !!======================================================================
-END MODULE domain
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/dommsk.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/dommsk.F90	(revision 5891)
+++ 	(revision )
@@ -1,104 +1,0 @@
-MODULE dommsk
-   !!======================================================================
-   !!                       ***  MODULE dommsk   ***
-   !! Ocean initialization : domain land/sea masks, off-line case 
-   !!======================================================================
-   !! History :  3.3  ! 2010-10  (C. Ethe)  adapted from OPA_SRC/DOM/dommsk
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dom_msk        : compute land/ocean mask
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE lib_mpp         ! MPP library
-   USE in_out_manager  ! I/O manager
-   USE wrk_nemo  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dom_msk    ! routine called by inidom.F90
-
-   REAL(wp)        :: rn_shlat   = 2.   ! type of lateral boundary condition on velocity
-   LOGICAL, PUBLIC :: ln_vorlat  = .false.   !  consistency of vorticity boundary condition 
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dom_msk
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE dom_msk  ***
-      !!
-      !! ** Purpose :   Off-line case: defines the interior domain T-mask.
-      !!
-      !! ** Method  :   The interior ocean/land mask is computed from tmask
-      !!              setting to zero the duplicated row and lines due to
-      !!              MPP exchange halos, est-west cyclic and north fold
-      !!              boundary conditions.
-      !!
-      !! ** Action :   tmask_i  : interiorland/ocean mask at t-point
-      !!               tpol     : ???
-      !!----------------------------------------------------------------------
-      !
-      INTEGER  ::   ji, jk                   ! dummy loop indices
-      INTEGER  ::   iif, iil, ijf, ijl       ! local integers
-      INTEGER, POINTER, DIMENSION(:,:) ::  imsk 
-      !
-      !!---------------------------------------------------------------------
-      
-      CALL wrk_alloc( jpi, jpj, imsk )
-      !
-      ! Interior domain mask (used for global sum)
-      ! --------------------
-      ssmask(:,:)  = tmask(:,:,1)
-      tmask_i(:,:) = tmask(:,:,1)
-      iif = jpreci                        ! thickness of exchange halos in i-axis
-      iil = nlci - jpreci + 1
-      ijf = jprecj                        ! thickness of exchange halos in j-axis
-      ijl = nlcj - jprecj + 1
-      !
-      tmask_i( 1 :iif,   :   ) = 0._wp    ! first columns
-      tmask_i(iil:jpi,   :   ) = 0._wp    ! last  columns (including mpp extra columns)
-      tmask_i(   :   , 1 :ijf) = 0._wp    ! first rows
-      tmask_i(   :   ,ijl:jpj) = 0._wp    ! last  rows (including mpp extra rows)
-      !
-      !                                   ! north fold mask
-      tpol(1:jpiglo) = 1._wp
-      !                                
-      IF( jperio == 3 .OR. jperio == 4 )   tpol(jpiglo/2+1:jpiglo) = 0._wp    ! T-point pivot
-      IF( jperio == 5 .OR. jperio == 6 )   tpol(     1    :jpiglo) = 0._wp    ! F-point pivot
-      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row
-         IF( mjg(ijl-1) == jpjglo-1 ) THEN
-            DO ji = iif+1, iil-1
-               tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))
-            END DO
-         ENDIF
-      ENDIF 
-      !
-      IF( nprint == 1 .AND. lwp ) THEN    ! Control print
-         imsk(:,:) = INT( tmask_i(:,:) )
-         WRITE(numout,*) ' tmask_i : '
-         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
-         WRITE (numout,*)
-         WRITE (numout,*) ' dommsk: tmask for each level'
-         WRITE (numout,*) ' ----------------------------'
-         DO jk = 1, jpk
-            imsk(:,:) = INT( tmask(:,:,jk) )
-            WRITE(numout,*)
-            WRITE(numout,*) ' level = ',jk
-            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
-         END DO
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, imsk )
-      !
-   END SUBROUTINE dom_msk
-   !!======================================================================
-END MODULE dommsk
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/domrea.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/domrea.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/domrea.F90	(revision 5901)
@@ -1,34 +1,43 @@
 MODULE domrea
-   !!======================================================================
-   !!                       ***  MODULE domrea  ***
-   !! Ocean initialization : read the ocean domain meshmask file(s)
-   !!======================================================================
-   !! History :  3.3  ! 2010-05  (C. Ethe)  Full reorganization of the off-line
+   !!==============================================================================
+   !!                       ***  MODULE domrea   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! History :  OPA  ! 1990-10  (C. Levy - G. Madec)  Original code
+   !!                 ! 1992-01  (M. Imbard) insert time step initialization
+   !!                 ! 1996-06  (G. Madec) generalized vertical coordinate 
+   !!                 ! 1997-02  (G. Madec) creation of domwri.F
+   !!                 ! 2001-05  (E.Durand - G. Madec) insert closed sea
+   !!  NEMO      1.0  ! 2002-08  (G. Madec)  F90: Free form and module
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   dom_rea        : read mesh and mask file(s)
-   !!                    nmsh = 1  :   mesh_mask file
-   !!                         = 2  :   mesh and mask file
-   !!                         = 3  :   mesh_hgr, mesh_zgr and mask
+   !!   dom_init       : initialize the space and time domain
+   !!   dom_nam        : read and contral domain namelists
+   !!   dom_ctl        : control print for the ocean domain
    !!----------------------------------------------------------------------
+   USE oce             ! 
+   USE trc_oce         ! shared ocean/biogeochemical variables
    USE dom_oce         ! ocean space and time domain
-   USE dommsk          ! domain: masks
+   USE phycst          ! physical constants
+   USE domstp          ! domain: set the time-step
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
    USE lbclnk          ! lateral boundary condition - MPP exchanges
-   USE trc_oce         ! shared ocean/biogeochemical variables
-   USE lib_mpp 
-   USE in_out_manager
    USE wrk_nemo  
-
+   
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   dom_rea    ! routine called by inidom.F90
-  !! * Substitutions
+   PUBLIC   dom_rea    ! called by nemogcm.F90
+
+   !! * Substitutions
 #  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! NEMO/OFF 3.7 , NEMO Consortium (2015)
    !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
@@ -37,4 +46,369 @@
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dom_rea  ***
+      !!                    
+      !! ** Purpose :   Domain initialization. Call the routines that are 
+      !!      required to create the arrays which define the space and time
+      !!      domain of the ocean model.
+      !!
+      !! ** Method  :
+      !!      - dom_stp: defined the model time step
+      !!      - dom_rea: read the meshmask file if nmsh=1
+      !!----------------------------------------------------------------------
+      INTEGER ::   jk          ! dummy loop index
+      INTEGER ::   iconf = 0   ! local integers
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+      !
+      CALL dom_nam      ! read namelist ( namrun, namdom )
+      CALL dom_zgr      ! Vertical mesh and bathymetry option
+      CALL dom_grd      ! Create a domain file
+      !
+      !                                      ! associated horizontal metrics
+      !
+      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:)
+      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:)
+      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:)
+      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:)
+      !
+      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:)
+      e1e2u (:,:) = e1u(:,:) * e2u(:,:)   ;   r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)
+      e1e2v (:,:) = e1v(:,:) * e2v(:,:)   ;   r1_e1e2v(:,:) = 1._wp / e1e2v(:,:)
+      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:)
+      !   
+      e2_e1u(:,:) = e2u(:,:) / e1u(:,:)
+      e1_e2v(:,:) = e1v(:,:) / e2v(:,:)
+      !
+      hu(:,:) = 0._wp                        ! Ocean depth at U- and V-points
+      hv(:,:) = 0._wp
+      DO jk = 1, jpk
+         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
+         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
+      END DO
+      !                                        ! Inverse of the local depth
+      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)
+      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)
+      !
+      CALL dom_stp      ! Time step
+      CALL dom_msk      ! Masks
+      CALL dom_ctl      ! Domain control
+      !
+   END SUBROUTINE dom_rea
+
+
+   SUBROUTINE dom_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read domaine namelists and print the variables.
+      !!
+      !! ** input   : - namrun namelist
+      !!              - namdom namelist
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      INTEGER  ::   ios   ! Local integer output status for namelist read
+      !
+      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               &
+         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
+         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
+         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler
+      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
+         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
+         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , ln_crs, &
+         &             jphgr_msh, &
+         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
+         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
+         &             ppa2, ppkth2, ppacr2
+#if defined key_netcdf4
+      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
+#endif
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
+      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namrun )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namrun'  
+         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
+         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
+         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
+         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
+         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
+         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
+         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
+         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
+         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
+         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
+         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
+         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
+         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
+         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
+         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
+         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+      ENDIF
+      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
+      cexper = cn_exp
+      nrstdt = nn_rstctl
+      nit000 = nn_it000
+      nitend = nn_itend
+      ndate0 = nn_date0
+      nleapy = nn_leapy
+      ninist = nn_istate
+      nstock = nn_stock
+      nstocklist = nn_stocklist
+      nwrite = nn_write
+      !
+      !                             ! control of output frequency
+      IF ( nstock == 0 .OR. nstock > nitend ) THEN
+         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nstock = nitend
+      ENDIF
+      IF ( nwrite == 0 ) THEN
+         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nwrite = nitend
+      ENDIF
+
+      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+
+#if defined key_agrif
+      IF( Agrif_Root() ) THEN
+#endif
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE (  1 ) 
+         CALL ioconf_calendar('gregorian')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
+      CASE (  0 )
+         CALL ioconf_calendar('noleap')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
+      CASE ( 30 )
+         CALL ioconf_calendar('360d')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
+      END SELECT
+#if defined key_agrif
+      ENDIF
+#endif
+
+      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdom )
+
+      IF(lwp) THEN
+         WRITE(numout,*) 
+         WRITE(numout,*) '   Namelist namdom : space & time domain'
+         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
+         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
+         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
+         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
+         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
+         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
+         WRITE(numout,*) '           = 0   no file created                 '
+         WRITE(numout,*) '           = 1   mesh_mask                       '
+         WRITE(numout,*) '           = 2   mesh and mask                   '
+         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
+         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
+         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
+         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
+         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
+         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
+         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
+         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
+         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
+         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
+         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
+         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
+         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
+         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
+         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
+         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
+         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
+         WRITE(numout,*) '                                        ppa0            = ', ppa0
+         WRITE(numout,*) '                                        ppa1            = ', ppa1
+         WRITE(numout,*) '                                        ppkth           = ', ppkth
+         WRITE(numout,*) '                                        ppacr           = ', ppacr
+         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
+         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
+         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
+         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
+         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
+         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
+      ENDIF
+
+      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
+      e3zps_min = rn_e3zps_min
+      e3zps_rat = rn_e3zps_rat
+      nmsh      = nn_msh
+      nacc      = nn_acc
+      atfp      = rn_atfp
+      rdt       = rn_rdt
+      rdtmin    = rn_rdtmin
+      rdtmax    = rn_rdtmin
+      rdth      = rn_rdth
+
+#if defined key_netcdf4
+      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
+      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
+      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
+907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
+      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
+908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, namnc4 )
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
+         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
+         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
+         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
+         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
+      ENDIF
+
+      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
+      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
+      snc4set%ni   = nn_nchunks_i
+      snc4set%nj   = nn_nchunks_j
+      snc4set%nk   = nn_nchunks_k
+      snc4set%luse = ln_nc4zip
+#else
+      snc4set%luse = .FALSE.        ! No NetCDF 4 case
+#endif
+      !
+   END SUBROUTINE dom_nam
+
+
+   SUBROUTINE dom_zgr
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_zgr  ***
+      !!                   
+      !! ** Purpose :  set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
+      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
+      !!              - vertical coordinate (gdep., e3.) depending on the 
+      !!                coordinate chosen :
+      !!                   ln_zco=T   z-coordinate  
+      !!                   ln_zps=T   z-coordinate with partial steps
+      !!                   ln_zco=T   s-coordinate 
+      !!
+      !! ** Action  :   define gdep., e3., mbathy and bathy
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio = 0   ! temporary integer
+      INTEGER ::   ios
+      !!
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
+      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
+      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzgr )
+
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr : vertical coordinate'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
+         WRITE(numout,*) '             z-coordinate - full steps      ln_zco    = ', ln_zco
+         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps    = ', ln_zps
+         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
+         WRITE(numout,*) '             ice shelf cavity               ln_isfcav = ', ln_isfcav
+      ENDIF
+
+      ioptio = 0                       ! Check Vertical coordinate options
+      IF( ln_zco ) ioptio = ioptio + 1
+      IF( ln_zps ) ioptio = ioptio + 1
+      IF( ln_sco ) ioptio = ioptio + 1
+      IF( ln_isfcav ) ioptio = 33
+      IF ( ioptio /= 1  )   CALL ctl_stop( ' none or several vertical coordinate options used' )
+      IF ( ioptio == 33 )   CALL ctl_stop( ' isf cavity with off line module not yet done    ' )
+
+   END SUBROUTINE dom_zgr
+
+
+   SUBROUTINE dom_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_ctl  ***
+      !!
+      !! ** Purpose :   Domain control.
+      !!
+      !! ** Method  :   compute and print extrema of masked scale factors
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
+      INTEGER, DIMENSION(2) ::   iloc      ! 
+      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
+      !!----------------------------------------------------------------------
+
+      ! Extrema of the scale factors
+
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+      IF(lwp)WRITE(numout,*) '~~~~~~~'
+
+      IF (lk_mpp) THEN
+         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
+         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
+         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
+         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
+      ELSE
+         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+
+         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iimi1 = iloc(1) + nimpp - 1
+         ijmi1 = iloc(2) + njmpp - 1
+         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iimi2 = iloc(1) + nimpp - 1
+         ijmi2 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iima1 = iloc(1) + nimpp - 1
+         ijma1 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iima2 = iloc(1) + nimpp - 1
+         ijma2 = iloc(2) + njmpp - 1
+      ENDIF
+      !
+      IF(lwp) THEN
+         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
+         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
+         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
+         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
+      ENDIF
+      !
+   END SUBROUTINE dom_ctl
+
+
+   SUBROUTINE dom_grd
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_grd  ***
       !!                   
       !! ** Purpose :  Read the NetCDF file(s) which contain(s) all the
@@ -141,5 +515,4 @@
          CALL iom_get( inum2, jpdom_data, 'facvolt', facvol )
 #endif
-
          !                                                         ! horizontal mesh (inum3)
          CALL iom_get( inum3, jpdom_data, 'glamt', glamt )
@@ -344,5 +717,5 @@
       CALL wrk_dealloc( jpi, jpj, zmbk, zprt, zprw )
       !
-   END SUBROUTINE dom_rea
+   END SUBROUTINE dom_grd
 
 
@@ -359,5 +732,4 @@
       !!                                     (min value = 1 over land)
       !!----------------------------------------------------------------------
-      !
       INTEGER ::   ji, jj   ! dummy loop indices
       REAL(wp), POINTER, DIMENSION(:,:) :: zmbk
@@ -388,4 +760,100 @@
    END SUBROUTINE zgr_bot_level
 
+
+   SUBROUTINE dom_msk
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   Off-line case: defines the interior domain T-mask.
+      !!
+      !! ** Method  :   The interior ocean/land mask is computed from tmask
+      !!              setting to zero the duplicated row and lines due to
+      !!              MPP exchange halos, est-west cyclic and north fold
+      !!              boundary conditions.
+      !!
+      !! ** Action :   tmask_i  : interiorland/ocean mask at t-point
+      !!               tpol     : ???
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      INTEGER  ::   iif, iil, ijf, ijl   ! local integers
+      INTEGER, POINTER, DIMENSION(:,:) ::  imsk 
+      !!---------------------------------------------------------------------
+      
+      CALL wrk_alloc( jpi, jpj, imsk )
+      !
+      ! Interior domain mask (used for global sum)
+      ! --------------------
+      ssmask(:,:)  = tmask(:,:,1)
+      tmask_i(:,:) = tmask(:,:,1)
+      iif = jpreci                        ! thickness of exchange halos in i-axis
+      iil = nlci - jpreci + 1
+      ijf = jprecj                        ! thickness of exchange halos in j-axis
+      ijl = nlcj - jprecj + 1
+      !
+      tmask_i( 1 :iif,   :   ) = 0._wp    ! first columns
+      tmask_i(iil:jpi,   :   ) = 0._wp    ! last  columns (including mpp extra columns)
+      tmask_i(   :   , 1 :ijf) = 0._wp    ! first rows
+      tmask_i(   :   ,ijl:jpj) = 0._wp    ! last  rows (including mpp extra rows)
+      !
+      !                                   ! north fold mask
+      tpol(1:jpiglo) = 1._wp
+      !                                
+      IF( jperio == 3 .OR. jperio == 4 )   tpol(jpiglo/2+1:jpiglo) = 0._wp    ! T-point pivot
+      IF( jperio == 5 .OR. jperio == 6 )   tpol(     1    :jpiglo) = 0._wp    ! F-point pivot
+      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row
+         IF( mjg(ijl-1) == jpjglo-1 ) THEN
+            DO ji = iif+1, iil-1
+               tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))
+            END DO
+         ENDIF
+      ENDIF 
+      !
+      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at
+      ! least 1 wet u point
+      DO jj = 1, jpjm1
+         DO ji = 1, fs_jpim1   ! vector loop
+            umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:)))
+            vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:)))
+         END DO
+         DO ji = 1, jpim1      ! NO vector opt.
+            fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   &
+               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:)))
+         END DO
+      END DO
+      CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions
+      CALL lbc_lnk( vmask_i, 'V', 1._wp )
+      CALL lbc_lnk( fmask_i, 'F', 1._wp )
+
+      ! 3. Ocean/land mask at wu-, wv- and w points 
+      !----------------------------------------------
+      wmask (:,:,1) = tmask(:,:,1)        ! surface value
+      wumask(:,:,1) = umask(:,:,1) 
+      wvmask(:,:,1) = vmask(:,:,1)
+      DO jk = 2, jpk                      ! deeper value
+         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
+         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)   
+         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
+      END DO
+      !
+      IF( nprint == 1 .AND. lwp ) THEN    ! Control print
+         imsk(:,:) = INT( tmask_i(:,:) )
+         WRITE(numout,*) ' tmask_i : '
+         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
+         WRITE (numout,*)
+         WRITE (numout,*) ' dommsk: tmask for each level'
+         WRITE (numout,*) ' ----------------------------'
+         DO jk = 1, jpk
+            imsk(:,:) = INT( tmask(:,:,jk) )
+            WRITE(numout,*)
+            WRITE(numout,*) ' level = ',jk
+            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
+         END DO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, imsk )
+      !
+   END SUBROUTINE dom_msk
+
    !!======================================================================
 END MODULE domrea
+
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 5901)
@@ -26,8 +26,7 @@
    USE trc_oce         ! share ocean/biogeo variables
    USE phycst          ! physical constants
+   USE ldftra          ! lateral diffusivity coefficients
    USE trabbl          ! active tracer: bottom boundary layer
    USE ldfslp          ! lateral diffusion: iso-neutral slopes
-   USE ldfeiv          ! eddy induced velocity coef. 
-   USE ldftra_oce      ! ocean tracer   lateral physics
    USE zdfmxl          ! vertical physics: mixed layer depth
    USE eosbn2          ! equation of state - Brunt Vaisala frequency
@@ -40,4 +39,5 @@
    USE fldread         ! read input fields 
    USE timing          ! Timing
+   USE wrk_nemo
 
    IMPLICIT NONE
@@ -50,8 +50,7 @@
    LOGICAL            ::   ln_dynwzv    !: vertical velocity read in a file (T) or computed from u/v (F)
    LOGICAL            ::   ln_dynbbl    !: bbl coef read in a file (T) or computed (F)
-   LOGICAL            ::   ln_degrad    !: degradation option enabled or not
    LOGICAL            ::   ln_dynrnf    !: read runoff data in file (T) or set to zero (F)
 
-   INTEGER  , PARAMETER ::   jpfld = 21     ! maximum number of fields to read
+   INTEGER  , PARAMETER ::   jpfld = 15     ! maximum number of fields to read
    INTEGER  , SAVE      ::   jf_tem         ! index of temperature
    INTEGER  , SAVE      ::   jf_sal         ! index of salinity
@@ -68,10 +67,4 @@
    INTEGER  , SAVE      ::   jf_ubl         ! index of u-bbl coef
    INTEGER  , SAVE      ::   jf_vbl         ! index of v-bbl coef
-   INTEGER  , SAVE      ::   jf_ahu         ! index of u-diffusivity coef
-   INTEGER  , SAVE      ::   jf_ahv         ! index of v-diffusivity coef 
-   INTEGER  , SAVE      ::   jf_ahw         ! index of w-diffusivity coef
-   INTEGER  , SAVE      ::   jf_eiu         ! index of u-eiv
-   INTEGER  , SAVE      ::   jf_eiv         ! index of v-eiv
-   INTEGER  , SAVE      ::   jf_eiw         ! index of w-eiv
    INTEGER  , SAVE      ::   jf_fmf         ! index of downward salt flux
 
@@ -112,11 +105,15 @@
       !!             - interpolates data if needed
       !!----------------------------------------------------------------------
-      !
-      USE oce, ONLY:  zts    => tsa 
+      USE oce, ONLY:  zts    => tsa
       USE oce, ONLY:  zuslp  => ua   , zvslp  => va
-      USE oce, ONLY:  zwslpi => rotb , zwslpj => rotn
-      USE oce, ONLY:  zu     => ub   , zv     => vb,  zw => hdivb
+      USE oce, ONLY:  zwslpi => ua_sv , zwslpj => va_sv
+      USE oce, ONLY:  zu     => ub   , zv     => vb,  zw => rke
       !
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+!      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)  :: zts
+!      REAL(wp), DIMENSION(jpi,jpj,jpk     )  :: zuslp, zvslp, zwslpi, zwslpj
+!      REAL(wp), DIMENSION(jpi,jpj,jpk     )  :: zu, zv, zw
+      !
       !
       INTEGER  ::   ji, jj     ! dummy loop indices
@@ -138,5 +135,5 @@
          CALL fld_read( kt, 1, sf_dyn )      !==   read data at kt time step   ==!
          !
-         IF( lk_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                       
+         IF( l_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                       
             zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:)   ! temperature
             zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:)   ! salinity 
@@ -162,5 +159,5 @@
       ENDIF
       ! 
-      IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                       
+      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                       
          iswap_tem = 0
          IF(  kt /= nit000 .AND. ( sf_dyn(jf_tem)%nrec_a(2) - nrecprev_tem ) /= 0 )  iswap_tem = 1
@@ -245,5 +242,10 @@
       tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:)  * tmask(:,:,:)    ! salinity
       !
-      CALL eos    ( tsn, rhd, rhop, gdept_0(:,:,:) )                                       ! In any case, we need rhop
+      !
+      CALL eos    ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
+      CALL eos_rab( tsn, rab_n )       ! now    local thermal/haline expension ratio at T-points
+      CALL bn2    ( tsn, rab_n, rn2 ) ! before Brunt-Vaisala frequency need for zdfmxl
+
+      rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl
       CALL zdf_mxl( kt )                                                   ! In any case, we need mxl 
       !
@@ -259,7 +261,9 @@
       fr_i(:,:)        = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1)    ! Sea-ice fraction
       qsr (:,:)        = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1)    ! solar radiation
-      IF ( ln_dynrnf ) &
+      IF( ln_dynrnf ) &
       rnf (:,:)        = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1)    ! river runoffs 
 
+      !                                               ! update eddy diffusivity coeff. and/or eiv coeff. at kt
+      IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kt ) 
       !                                                      ! bbl diffusive coef
 #if defined key_trabbl && ! defined key_c1d
@@ -271,27 +275,4 @@
          CALL bbl( kt, nit000, 'TRC')
       END IF
-#endif
-#if ( ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv ) && ! defined key_c1d 
-      aeiw(:,:)        = sf_dyn(jf_eiw)%fnow(:,:,1) * tmask(:,:,1)    ! w-eiv
-      !                                                           ! Computes the horizontal values from the vertical value
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )  ! Average the diffusive coefficient at u- v- points
-            aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )  ! at u- v- points
-         END DO
-      END DO
-      CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )    ! lateral boundary condition
-#endif
-      
-#if defined key_degrad && ! defined key_c1d 
-      !                                          ! degrad option : diffusive and eiv coef are 3D
-      ahtu(:,:,:) = sf_dyn(jf_ahu)%fnow(:,:,:) * umask(:,:,:)
-      ahtv(:,:,:) = sf_dyn(jf_ahv)%fnow(:,:,:) * vmask(:,:,:)
-      ahtw(:,:,:) = sf_dyn(jf_ahw)%fnow(:,:,:) * tmask(:,:,:)
-#  if defined key_traldf_eiv 
-      aeiu(:,:,:) = sf_dyn(jf_eiu)%fnow(:,:,:) * umask(:,:,:)
-      aeiv(:,:,:) = sf_dyn(jf_eiv)%fnow(:,:,:) * vmask(:,:,:)
-      aeiw(:,:,:) = sf_dyn(jf_eiw)%fnow(:,:,:) * tmask(:,:,:)
-#  endif
 #endif
       !
@@ -334,12 +315,9 @@
       TYPE(FLD_N), DIMENSION(jpfld) ::  slf_d    ! array of namelist informations on the fields to read
       TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf  ! informations about the fields to be read
-      TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl          !   "                                 "
-      TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf  !   "                                 "
-      !!----------------------------------------------------------------------
-      !
-      NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad, ln_dynrnf,    &
+      TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, sn_fmf          !   "                                 "
+      NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_dynrnf,    &
          &                sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf,  &
-         &                sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl,          &
-         &                sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf
+         &                sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, sn_fmf  
+      !!----------------------------------------------------------------------
       !
       REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data
@@ -360,13 +338,8 @@
          WRITE(numout,*) '      vertical velocity read from file (T) or computed (F) ln_dynwzv  = ', ln_dynwzv
          WRITE(numout,*) '      bbl coef read from file (T) or computed (F)          ln_dynbbl  = ', ln_dynbbl
-         WRITE(numout,*) '      degradation option enabled (T) or not (F)            ln_degrad  = ', ln_degrad
          WRITE(numout,*) '      river runoff option enabled (T) or not (F)           ln_dynrnf  = ', ln_dynrnf
          WRITE(numout,*)
       ENDIF
       ! 
-      IF( ln_degrad .AND. .NOT.lk_degrad ) THEN
-         CALL ctl_warn( 'dta_dyn_init: degradation option requires key_degrad activated ; force ln_degrad to false' )
-         ln_degrad = .FALSE.
-      ENDIF
       IF( ln_dynbbl .AND. ( .NOT.lk_trabbl .OR. lk_c1d ) ) THEN
          CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' )
@@ -383,5 +356,5 @@
 
       !
-      IF ( ln_dynrnf ) THEN
+      IF( ln_dynrnf ) THEN
                 jf_rnf = jfld + 1  ;  jfld  = jf_rnf
          slf_d(jf_rnf) = sn_rnf
@@ -390,46 +363,23 @@
       ENDIF
 
-      !
-      IF( .NOT.ln_degrad ) THEN     ! no degrad option
-         IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN        ! eiv & bbl
-                 jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;        jf_eiw  = jfld + 3   ;   jfld = jf_eiw
-           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl  ;   slf_d(jf_eiw) = sn_eiw
-         ENDIF
-         IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN   ! no eiv & bbl
+      IF( ln_dynbbl ) THEN         ! eiv & bbl
                  jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;  jfld = jf_vbl
            slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl
-         ENDIF
-         IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN   ! eiv & no bbl
-           jf_eiw = jfld + 1 ; jfld = jf_eiw ; slf_d(jf_eiw) = sn_eiw
-         ENDIF
-      ELSE
-              jf_ahu  = jfld + 1 ;        jf_ahv  = jfld + 2 ;        jf_ahw  = jfld + 3  ;  jfld = jf_ahw
-        slf_d(jf_ahu) = sn_ahu  ;   slf_d(jf_ahv) = sn_ahv  ;   slf_d(jf_ahw) = sn_ahw
-        IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN         ! eiv & bbl
-                 jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;
-           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl
-                 jf_eiu  = jfld + 3 ;        jf_eiv  = jfld + 4 ;    jf_eiw  = jfld + 5   ;  jfld = jf_eiw 
-           slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;    slf_d(jf_eiw) = sn_eiw
-        ENDIF
-        IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN    ! no eiv & bbl
-                 jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;  jfld = jf_vbl
-           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl
-        ENDIF
-        IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN    ! eiv & no bbl
-                 jf_eiu  = jfld + 1 ;         jf_eiv  = jfld + 2 ;    jf_eiw  = jfld + 3   ; jfld = jf_eiw 
-           slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;   slf_d(jf_eiw) = sn_eiw
-        ENDIF
-      ENDIF
-  
+      ENDIF
+
+
       ALLOCATE( sf_dyn(jfld), STAT=ierr )         ! set sf structure
       IF( ierr > 0 ) THEN
          CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' )   ;   RETURN
       ENDIF
+      !                                         ! fill sf with slf_i and control print
+      CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' )
       ! Open file for each variable to get his number of dimension
       DO ifpr = 1, jfld
-         CALL iom_open( TRIM( cn_dir )//TRIM( slf_d(ifpr)%clname ), inum )
-         idv   = iom_varid( inum , slf_d(ifpr)%clvar )  ! id of the variable sdjf%clvar
-         idimv = iom_file ( inum )%ndims(idv)             ! number of dimension for variable sdjf%clvar
-         IF( inum /= 0 )   CALL iom_close( inum )       ! close file if already open
+         CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday )
+         idv   = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar )        ! id of the variable sdjf%clvar
+         idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv)                 ! number of dimension for variable sdjf%clvar
+         IF( sf_dyn(ifpr)%num /= 0 )   CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open
+         ierr1=0
          IF( idimv == 3 ) THEN    ! 2D variable
                                       ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 )
@@ -443,8 +393,6 @@
          ENDIF
       END DO
-      !                                         ! fill sf with slf_i and control print
-      CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' )
-      !
-      IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN                  ! slopes 
+      !
+      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN                  ! slopes 
          IF( sf_dyn(jf_tem)%ln_tint ) THEN      ! time interpolation
             ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    &
@@ -505,11 +453,13 @@
                zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk)
                zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk)
-               zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               zet = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
                zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet 
             END DO
          END DO
       END DO
+      !                              !  update the horizontal divergence with the runoff inflow
+      IF( ln_dynrnf )  zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / fse3t(:,:,1)
+      !
       CALL lbc_lnk( zhdiv, 'T', 1. )      ! Lateral boundary conditions on zhdiv
-      !
       ! computation of vertical velocity from the bottom
       pw(:,:,jpk) = 0._wp
@@ -534,27 +484,31 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpj   ! meridional diapycnal slopes
       !!---------------------------------------------------------------------
-#if defined key_ldfslp && ! defined key_c1d
-      CALL eos_rab( pts, rab_n )       ! now local thermal/haline expension ratio at T-points
-      CALL bn2    ( pts, rab_n, rn2  ) ! now    Brunt-Vaisala
-      IF( ln_zps )   & ! Partial steps: before Horizontal DErivative
-        &    CALL zps_hde( kt, jpts, pts, gtsu, gtsv,  &        ! Partial steps: before horizontal gradient
-        &                                        rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &             !
-        &                                 gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    )  ! of t, s, rd at the last ocean level
-        ! only gtsu, gtsv, rhd, gru , grv are used 
-
-
-         !                                                            ! of t, s, rd at the bottom ocean level
-      CALL zdf_mxl( kt )            ! mixed layer depth
-      CALL ldf_slp( kt, rhd, rn2 )  ! slopes
-      puslp (:,:,:) = uslp (:,:,:) 
-      pvslp (:,:,:) = vslp (:,:,:) 
-      pwslpi(:,:,:) = wslpi(:,:,:) 
-      pwslpj(:,:,:) = wslpj(:,:,:) 
-#else
-      puslp (:,:,:) = 0.            ! to avoid warning when compiling
-      pvslp (:,:,:) = 0.
-      pwslpi(:,:,:) = 0.
-      pwslpj(:,:,:) = 0.
-#endif
+      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                       
+         CALL eos    ( pts, rhd, rhop, gdept_0(:,:,:) )
+         CALL eos_rab( pts, rab_n )       ! now local thermal/haline expension ratio at T-points
+         CALL bn2    ( pts, rab_n, rn2  ) ! now    Brunt-Vaisala
+
+         ! Partial steps: before Horizontal DErivative
+         IF( ln_zps  .AND. .NOT. ln_isfcav)                            &
+            &            CALL zps_hde    ( kt, jpts, pts, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
+            &                                        rhd, gru , grv    )  ! of t, s, rd at the last ocean level
+         IF( ln_zps .AND.        ln_isfcav)                            &
+            &            CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
+            &                                        rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
+            &                                 gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the first ocean level
+
+         rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl
+         CALL zdf_mxl( kt )            ! mixed layer depth
+         CALL ldf_slp( kt, rhd, rn2 )  ! slopes
+         puslp (:,:,:) = uslp (:,:,:) 
+         pvslp (:,:,:) = vslp (:,:,:) 
+         pwslpi(:,:,:) = wslpi(:,:,:) 
+         pwslpj(:,:,:) = wslpj(:,:,:) 
+     ELSE
+         puslp (:,:,:) = 0.            ! to avoid warning when compiling
+         pvslp (:,:,:) = 0.
+         pwslpi(:,:,:) = 0.
+         pwslpj(:,:,:) = 0.
+     ENDIF
       !
    END SUBROUTINE dta_dyn_slp
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/istate.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/istate.F90	(revision 5891)
+++ 	(revision )
@@ -1,51 +1,0 @@
-MODULE istate
-   !!======================================================================
-   !!                     ***  MODULE  istate  ***
-   !! Ocean state   :  initial state setting, off-line case
-   !!=====================================================================
-   !! History :  3.3  ! 2010-10  (C. Ethe)  original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   istate_init   : initial state set to zero
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers 
-   USE dom_oce         ! ocean space and time domain 
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   istate_init   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!---------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE istate_init
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE istate_init  ***
-      !! 
-      !! ** Purpose :   Initialization to zero of the dynamics and tracers.
-      !!----------------------------------------------------------------------
-      !
-      !     now fields         !     after fields      !
-      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   !
-      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   !
-      wn   (:,:,:)   = 0._wp   !                       !
-      hdivn(:,:,:)   = 0._wp   !                       !
-      tsn  (:,:,:,:) = 0._wp   !                       !
-      !
-      rhd  (:,:,:) = 0.e0
-      rhop (:,:,:) = 0.e0
-      rn2  (:,:,:) = 0.e0 
-      !
-   END SUBROUTINE istate_init
-
-   !!=====================================================================
-END MODULE istate
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90	(revision 5901)
@@ -18,6 +18,6 @@
    USE c1d             ! 1D configuration
    USE domcfg          ! domain configuration               (dom_cfg routine)
-   USE domain          ! domain initialization             (dom_init routine)
-   USE istate          ! initial state setting          (istate_init routine)
+   USE domain          ! domain initialization from coordinate & bathymetry (dom_init routine)
+   USE domrea          ! domain initialization from mesh_mask            (dom_init routine)
    USE eosbn2          ! equation of state            (eos bn2 routine)
    !              ! ocean physics
@@ -26,4 +26,5 @@
    USE traqsr          ! solar radiation penetration    (tra_qsr_init routine)
    USE trabbl          ! bottom boundary layer          (tra_bbl_init routine)
+   USE traldf          ! lateral physics                (tra_ldf_init routine)
    USE zdfini          ! vertical physics: initialization
    USE sbcmod          ! surface boundary condition       (sbc_init     routine)
@@ -34,5 +35,4 @@
    USE trcstp          ! passive tracer time-stepping      (trc_stp routine)
    USE dtadyn          ! Lecture and interpolation of the dynamical fields
-   USE stpctl          ! time stepping control            (stp_ctl routine)
    !              ! I/O & MPP
    USE iom             ! I/O library
@@ -46,5 +46,5 @@
    USE timing          ! Timing
    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
-   USE lbcnfd, ONLY: isendto, nsndto
+   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
 
    USE trc
@@ -62,5 +62,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OFF 3.3 , NEMO Consortium (2010)
-   !! $Id: nemogcm.F90 2528 2010-12-27 17:33:53Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -95,5 +95,5 @@
       istp = nit000
       ! 
-      CALL iom_init( "nemo" )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
+      CALL iom_init( cxios_context )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
       ! 
       DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping
@@ -108,5 +108,5 @@
       END DO
 #if defined key_iomput
-      CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF
+      CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
 #endif
 
@@ -143,4 +143,5 @@
       INTEGER ::   ilocal_comm   ! local integer
       INTEGER ::   ios
+      LOGICAL ::   llexist
       CHARACTER(len=80), DIMENSION(16) ::   cltxt
       !!
@@ -149,7 +150,8 @@
          &             nn_bench, nn_timing
       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
-         &             jpizoom, jpjzoom, jperio
+         &             jpizoom, jpjzoom, jperio, ln_use_jattr
       !!----------------------------------------------------------------------
       cltxt = ''
+      cxios_context = 'nemo'
       !
       !                             ! Open reference namelist and configuration namelist files
@@ -181,9 +183,9 @@
       !                             !--------------------------------------------!
 #if defined key_iomput
-      CALL  xios_initialize( "nemo",return_comm=ilocal_comm )
-      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection
+      CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection
 #else
       ilocal_comm = 0
-      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
 #endif
 
@@ -233,5 +235,5 @@
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.5  (2012) '
+         WRITE(numout,*) '                  version 3.6  (2015) '
          WRITE(numout,*)
          WRITE(numout,*)
@@ -268,5 +270,10 @@
       IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration
                             CALL     dom_cfg    ! Domain configuration
-                            CALL     dom_init   ! Domain
+      !
+      INQUIRE( FILE='coordinates.nc', EXIST = llexist )   ! Check if coordinate file exist
+      !
+      IF( llexist )  THEN  ;  CALL  dom_init   !  compute the grid from coordinates and bathymetry
+      ELSE                 ;  CALL  dom_rea    !  read grid from the meskmask
+      ENDIF
                             CALL  istate_init   ! ocean initial state (Dynamics and tracers)
 
@@ -275,34 +282,22 @@
       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
 
-      !                                     ! Ocean physics
                             CALL     sbc_init   ! Forcings : surface module
-#if ! defined key_degrad
+
                             CALL ldf_tra_init   ! Lateral ocean tracer physics
-#endif
-      IF( lk_ldfslp )       CALL ldf_slp_init   ! slope of lateral mixing
-
-      !                                     ! Active tracers
+                            CALL ldf_eiv_init   ! Eddy induced velocity param
+                            CALL tra_ldf_init   ! lateral mixing
+      IF( l_ldfslp )        CALL ldf_slp_init   ! slope of lateral mixing
+
                             CALL tra_qsr_init   ! penetrative solar radiation qsr
       IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
 
-                            CALL trc_nam_run  ! Needed to get restart parameters for passive tracers
-      IF( ln_rsttr ) THEN
-        neuler = 1   ! Set time-step indicator at nit000 (leap-frog)
-        CALL trc_rst_cal( nit000, 'READ' )   ! calendar
-      ELSE
-        neuler = 0                  ! Set time-step indicator at nit000 (euler)
-        CALL day_init               ! set calendar
-      ENDIF
-      !                                     ! Dynamics
+                            CALL trc_nam_run    ! Needed to get restart parameters for passive tracers
+                            CALL trc_rst_cal( nit000, 'READ' )   ! calendar
                             CALL dta_dyn_init   ! Initialization for the dynamics
 
-      !                                     ! Passive tracers
                             CALL     trc_init   ! Passive tracers initialization
-      !
-      ! Initialise diaptr as some variables are used in if statements later (in
-      ! various advection and diffusion routines.
-                            CALL dia_ptr_init
-      !
-      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
+                            CALL dia_ptr_init   ! Initialise diaptr as some variables are used 
+      !                                         ! in various advection and diffusion routines
+      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
       !
       IF( nn_timing == 1 )  CALL timing_stop( 'nemo_init')
@@ -359,4 +354,5 @@
          WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
          WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio   
+         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
       ENDIF
       !                             ! Parameter control
@@ -449,5 +445,4 @@
       USE dom_oce,      ONLY: dom_oce_alloc
       USE zdf_oce,      ONLY: zdf_oce_alloc
-      USE ldftra_oce,   ONLY: ldftra_oce_alloc
       USE trc_oce,      ONLY: trc_oce_alloc
       !
@@ -458,5 +453,4 @@
       ierr = ierr + dia_wri_alloc   ()
       ierr = ierr + dom_oce_alloc   ()          ! ocean domain
-      ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers
       ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
       !
@@ -594,5 +588,6 @@
       !!----------------------------------------------------------------------
       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
-      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S.
+      !Mocavero, CMCC) 
       !!----------------------------------------------------------------------
 
@@ -617,27 +612,38 @@
           !loop over the other north-fold processes to find the processes
           !managing the points belonging to the sxT-dxT range
-          DO jn = jpnij - jpni +1, jpnij
-             IF ( njmppt(jn) == njmppmax ) THEN
+
+          DO jn = 1, jpni
                 !sxT is the first point (in the global domain) of the jn
                 !process
-                sxT = nimppt(jn)
+                sxT = nfiimpp(jn, jpnj)
                 !dxT is the last point (in the global domain) of the jn
                 !process
-                dxT = nimppt(jn) + nlcit(jn) - 1
+                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
                 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
                    nsndto = nsndto + 1
-                   isendto(nsndto) = jn
-                ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN
+                     isendto(nsndto) = jn
+                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
                    nsndto = nsndto + 1
-                   isendto(nsndto) = jn
+                     isendto(nsndto) = jn
                 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
                    nsndto = nsndto + 1
-                   isendto(nsndto) = jn
+                     isendto(nsndto) = jn
                 END IF
-             END IF
           END DO
+          nfsloop = 1
+          nfeloop = nlci
+          DO jn = 2,jpni-1
+           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
+              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
+                 nfsloop = nldi
+              ENDIF
+              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
+                 nfeloop = nlei
+              ENDIF
+           ENDIF
+        END DO
+
       ENDIF
       l_north_nogather = .TRUE.
-
    END SUBROUTINE nemo_northcomms
 #else
@@ -646,4 +652,51 @@
    END SUBROUTINE nemo_northcomms
 #endif
+
+   SUBROUTINE istate_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_init  ***
+      !!
+      !! ** Purpose :   Initialization to zero of the dynamics and tracers.
+      !!----------------------------------------------------------------------
+      !
+      !     now fields         !     after fields      !
+      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   !
+      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   !
+      wn   (:,:,:)   = 0._wp   !                       !
+      hdivn(:,:,:)   = 0._wp   !                       !
+      tsn  (:,:,:,:) = 0._wp   !                       !
+      !
+      rhd  (:,:,:) = 0.e0
+      rhop (:,:,:) = 0.e0
+      rn2  (:,:,:) = 0.e0
+      !
+   END SUBROUTINE istate_init
+
+   SUBROUTINE stp_ctl( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE stp_ctl  ***
+      !!
+      !! ** Purpose :   Control the run
+      !!
+      !! ** Method  : - Save the time step in numstp
+      !!
+      !! ** Actions :   'time.step' file containing the last ocean time-step
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'stp_ctl : time-stepping control'
+         WRITE(numout,*) '~~~~~~~'
+         ! open time.step file
+         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+      !
+      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
+      IF(lwp) REWIND( numstp )                       ! --------------------------
+      !
+   END SUBROUTINE stp_ctl
    !!======================================================================
 END MODULE nemogcm
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/stpctl.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/stpctl.F90	(revision 5891)
+++ 	(revision )
@@ -1,62 +1,0 @@
-MODULE stpctl
-   !!======================================================================
-   !!                       ***  MODULE  stpctl  ***
-   !! Ocean run control :  Off-line case, only save the time step in numstp
-   !!======================================================================
-   !! History :  OPA  ! 1991-03  (G. Madec) Original code
-   !!            6.0  ! 1992-06  (M. Imbard)
-   !!            8.0  ! 1997-06  (A.M. Treguier)
-   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
-   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   stp_ctl      : Control the run
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! distributed memory computing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   stp_ctl    ! routine called by opa.F90
-   
-   !!----------------------------------------------------------------------
-   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE stp_ctl( kt, kindic )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE stp_ctl  ***
-      !!                     
-      !! ** Purpose :   Control the run
-      !!
-      !! ** Method  : - Save the time step in numstp
-      !!
-      !! ** Actions :   'time.step' file containing the last ocean time-step
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index
-      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'stp_ctl : time-stepping control'
-         WRITE(numout,*) '~~~~~~~'
-         ! open time.step file
-         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-      ENDIF
-      !
-      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
-      IF(lwp) REWIND( numstp )                       !  --------------------------
-      !
-   END SUBROUTINE stp_ctl
-
-   !!======================================================================
-END MODULE stpctl
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90	(revision 5901)
@@ -129,8 +129,9 @@
          &             nn_bench, nn_timing
       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
-         &             jpizoom, jpjzoom, jperio
+         &             jpizoom, jpjzoom, jperio, ln_use_jattr
       !!----------------------------------------------------------------------
       !
       cltxt = ''
+      cxios_context = 'nemo'
       !
       !                             ! Open reference namelist and configuration namelist files
@@ -162,22 +163,22 @@
 #if defined key_iomput
       IF( Agrif_Root() ) THEN
-         IF( lk_cpl ) THEN
+         IF( lk_oasis ) THEN
             CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis
             CALL xios_initialize( "oceanx",local_comm=ilocal_comm )    ! send nemo communicator to xios
          ELSE
-            CALL  xios_initialize( "nemo",return_comm=ilocal_comm )    ! nemo local communicator given by xios
+            CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios
          ENDIF
       ENDIF
       ENDIF
-      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection
 #else
-      IF( lk_cpl ) THEN
+      IF( lk_oasis ) THEN
          IF( Agrif_Root() ) THEN
             CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis
          ENDIF
-         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt)
+         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt)
       ELSE
          ilocal_comm = 0
-         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
+         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
       ENDIF
 #endif
@@ -233,5 +234,5 @@
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.4  (2011) '
+         WRITE(numout,*) '                  version 3.6  (2015) '
          WRITE(numout,*)
          WRITE(numout,*)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90	(revision 5901)
@@ -40,4 +40,5 @@
    CHARACTER(len=128) :: &
       & alt_file                       !: altimeter file
+   !! $Id$
 CONTAINS
    SUBROUTINE ooo_data_init( ld_cl4 )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_intp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_intp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_intp.F90	(revision 5901)
@@ -16,4 +16,5 @@
    PUBLIC ooo_interp
 
+   !! $Id$
    CONTAINS
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_read.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_read.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_read.F90	(revision 5901)
@@ -22,4 +22,5 @@
    PUBLIC ooo_rea_dri
 
+   !! $Id$
 CONTAINS
    SUBROUTINE ooo_rea_dri(kfile)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_utils.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_utils.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_utils.F90	(revision 5901)
@@ -10,4 +10,5 @@
    REAL(kind=dp), PARAMETER :: obfilldbl=99999.
 
+   !! $Id$
    CONTAINS
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_write.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_write.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OOO_SRC/ooo_write.F90	(revision 5901)
@@ -29,4 +29,5 @@
    END INTERFACE
 
+   !! $Id$
    CONTAINS
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 5901)
@@ -18,6 +18,4 @@
 
    !!----------------------------------------------------------------------
-   !!   'key_asminc' : Switch on the assimilation increment interface
-   !!----------------------------------------------------------------------
    !!   asm_bkg_wri  : Write out the background state
    !!   asm_trj_wri  : Write out the model state trajectory (used with 4D-Var)
@@ -27,6 +25,6 @@
    USE zdf_oce            ! Vertical mixing variables
    USE zdfddm             ! Double diffusion mixing parameterization
-   USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory
-   USE ldfslp             ! Slopes of neutral surfaces
+   USE ldftra             ! Lateral diffusion: eddy diffusivity coefficients
+   USE ldfslp             ! Lateral diffusion: slopes of neutral surfaces
    USE tradmp             ! Tracer damping
 #if defined key_zdftke
@@ -41,7 +39,4 @@
    USE asmpar             ! Parameters for the assmilation interface
    USE zdfmxl             ! mixed layer depth
-#if defined key_traldf_c2d
-   USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine)
-#endif
 #if defined key_lim2
    USE ice_2
@@ -155,10 +150,10 @@
             CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              )
 #if defined key_lim2 || defined key_lim3
-            IF(( nn_ice == 2 ) .OR. ( nn_ice == 3 )) THEN
-	       IF(ALLOCATED(frld)) THEN
-                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1.0 - frld(:,:)   )
+            IF( nn_ice == 2  .OR.  nn_ice == 3 ) THEN
+	            IF( ALLOCATED(frld) ) THEN
+                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1._wp - frld(:,:)   )
                ELSE
-		  CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep')
-	       ENDIF
+		            CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep')
+	            ENDIF
             ENDIF
 #endif
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 5901)
@@ -14,6 +14,4 @@
 
    !!----------------------------------------------------------------------
-   !!   'key_asminc'   : Switch on the assimilation increment interface
-   !!----------------------------------------------------------------------
    !!   asm_inc_init   : Initialize the increment arrays and IAU weights
    !!   calc_date      : Compute the calendar date YYYYMMDD on a given step
@@ -28,5 +26,5 @@
    USE domvvl           ! domain: variable volume level
    USE oce              ! Dynamics and active tracers defined in memory
-   USE ldfdyn_oce       ! ocean dynamics: lateral physics
+   USE ldfdyn           ! lateral diffusion: eddy viscosity coefficients
    USE eosbn2           ! Equation of state - in situ and potential density
    USE zpshde           ! Partial step : Horizontal Derivative
@@ -56,14 +54,14 @@
     LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .FALSE.  !: No assimilation increments
 #endif
-   LOGICAL, PUBLIC :: ln_bkgwri = .FALSE.      !: No output of the background state fields
-   LOGICAL, PUBLIC :: ln_asmiau = .FALSE.      !: No applying forcing with an assimilation increment
-   LOGICAL, PUBLIC :: ln_asmdin = .FALSE.      !: No direct initialization
-   LOGICAL, PUBLIC :: ln_trainc = .FALSE.      !: No tracer (T and S) assimilation increments
-   LOGICAL, PUBLIC :: ln_dyninc = .FALSE.      !: No dynamics (u and v) assimilation increments
-   LOGICAL, PUBLIC :: ln_sshinc = .FALSE.      !: No sea surface height assimilation increment
-   LOGICAL, PUBLIC :: ln_seaiceinc             !: No sea ice concentration increment
-   LOGICAL, PUBLIC :: ln_salfix = .FALSE.      !: Apply minimum salinity check
+   LOGICAL, PUBLIC :: ln_bkgwri     !: No output of the background state fields
+   LOGICAL, PUBLIC :: ln_asmiau     !: No applying forcing with an assimilation increment
+   LOGICAL, PUBLIC :: ln_asmdin     !: No direct initialization
+   LOGICAL, PUBLIC :: ln_trainc     !: No tracer (T and S) assimilation increments
+   LOGICAL, PUBLIC :: ln_dyninc     !: No dynamics (u and v) assimilation increments
+   LOGICAL, PUBLIC :: ln_sshinc     !: No sea surface height assimilation increment
+   LOGICAL, PUBLIC :: ln_seaiceinc  !: No sea ice concentration increment
+   LOGICAL, PUBLIC :: ln_salfix     !: Apply minimum salinity check
    LOGICAL, PUBLIC :: ln_temnofreeze = .FALSE. !: Don't allow the temperature to drop below freezing
-   INTEGER, PUBLIC :: nn_divdmp                !: Apply divergence damping filter nn_divdmp times
+   INTEGER, PUBLIC :: nn_divdmp     !: Apply divergence damping filter nn_divdmp times
 
    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   t_bkg   , s_bkg      !: Background temperature and salinity
@@ -90,5 +88,4 @@
    !! * Substitutions
 #  include "domzgr_substitute.h90"
-#  include "ldfdyn_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -139,5 +136,5 @@
       ! Read Namelist nam_asminc : assimilation increment interface
       !-----------------------------------------------------------------------
-      ln_seaiceinc = .FALSE.
+      ln_seaiceinc   = .FALSE.
       ln_temnofreeze = .FALSE.
 
@@ -428,13 +425,11 @@
 
       IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN
-
-         CALL wrk_alloc(jpi,jpj,hdiv) 
-
-         DO  jt = 1, nn_divdmp
-
+         !
+         CALL wrk_alloc( jpi,jpj,   hdiv ) 
+         !
+         DO jt = 1, nn_divdmp
+            !
             DO jk = 1, jpkm1
-
                hdiv(:,:) = 0._wp
-
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -444,30 +439,26 @@
                          + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * v_bkginc(ji  ,jj  ,jk)     &
                          - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * v_bkginc(ji  ,jj-1,jk)  )  &
-                         / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                         / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
                   END DO
                END DO
-
                CALL lbc_lnk( hdiv, 'T', 1. )   ! lateral boundary cond. (no sign change)
-
+               !
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1t(ji+1,jj)*e2t(ji+1,jj) * hdiv(ji+1,jj)   &
-                                                                        - e1t(ji  ,jj)*e2t(ji  ,jj) * hdiv(ji  ,jj) ) &
-                                                                      / e1u(ji,jj) * umask(ji,jj,jk) 
-                     v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1t(ji,jj+1)*e2t(ji,jj+1) * hdiv(ji,jj+1)   &
-                                                                        - e1t(ji,jj  )*e2t(ji,jj  ) * hdiv(ji,jj  ) ) &
-                                                                      / e2v(ji,jj) * vmask(ji,jj,jk) 
+                     u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji+1,jj) * hdiv(ji+1,jj)   &
+                        &                                               - e1e2t(ji  ,jj) * hdiv(ji  ,jj) ) &
+                        &                                             * r1_e1u(ji,jj) * umask(ji,jj,jk) 
+                     v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji,jj+1) * hdiv(ji,jj+1)   &
+                        &                                               - e1e2t(ji,jj  ) * hdiv(ji,jj  ) ) &
+                        &                                             * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
                   END DO
                END DO
-
             END DO
-
+            !
          END DO
-
-         CALL wrk_dealloc(jpi,jpj,hdiv) 
-
+         !
+         CALL wrk_dealloc( jpi,jpj,   hdiv ) 
+         !
       ENDIF
-
-
 
       !-----------------------------------------------------------------------
@@ -476,5 +467,5 @@
 
       IF ( ln_asmdin ) THEN
-
+         !
          ALLOCATE( t_bkg(jpi,jpj,jpk) )
          ALLOCATE( s_bkg(jpi,jpj,jpk) )
@@ -482,30 +473,29 @@
          ALLOCATE( v_bkg(jpi,jpj,jpk) )
          ALLOCATE( ssh_bkg(jpi,jpj)   )
-
-         t_bkg(:,:,:) = 0.0
-         s_bkg(:,:,:) = 0.0
-         u_bkg(:,:,:) = 0.0
-         v_bkg(:,:,:) = 0.0
-         ssh_bkg(:,:) = 0.0
-
+         !
+         t_bkg(:,:,:) = 0._wp
+         s_bkg(:,:,:) = 0._wp
+         u_bkg(:,:,:) = 0._wp
+         v_bkg(:,:,:) = 0._wp
+         ssh_bkg(:,:) = 0._wp
+         !
          !--------------------------------------------------------------------
          ! Read from file the background state at analysis time
          !--------------------------------------------------------------------
-
+         !
          CALL iom_open( c_asmdin, inum )
-
+         !
          CALL iom_get( inum, 'rdastp', zdate_bkg ) 
-        
+         !
          IF(lwp) THEN
             WRITE(numout,*) 
-            WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', &
-               &  NINT( zdate_bkg )
+            WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', NINT( zdate_bkg )
             WRITE(numout,*) '~~~~~~~~~~~~'
          ENDIF
-
+         !
          IF ( NINT( zdate_bkg ) /= iitdin_date ) &
             & CALL ctl_warn( ' Validity time of assimilation background state does', &
             &                ' not agree with Direct Initialization time' )
-
+         !
          IF ( ln_trainc ) THEN   
             CALL iom_get( inum, jpdom_autoglo, 'tn', t_bkg )
@@ -514,5 +504,5 @@
             s_bkg(:,:,:) = s_bkg(:,:,:) * tmask(:,:,:)
          ENDIF
-
+         !
          IF ( ln_dyninc ) THEN   
             CALL iom_get( inum, jpdom_autoglo, 'un', u_bkg )
@@ -521,12 +511,12 @@
             v_bkg(:,:,:) = v_bkg(:,:,:) * vmask(:,:,:)
          ENDIF
-        
+         !
          IF ( ln_sshinc ) THEN
             CALL iom_get( inum, jpdom_autoglo, 'sshn', ssh_bkg )
             ssh_bkg(:,:) = ssh_bkg(:,:) * tmask(:,:,1)
          ENDIF
-
+         !
          CALL iom_close( inum )
-
+         !
       ENDIF
       !
@@ -574,8 +564,6 @@
       ! If kt = kit000 - 1 then set the date to the restart date
       IF ( kt == kit000 - 1 ) THEN
-
          kdate = ndastp
          RETURN
-
       ENDIF
 
@@ -646,30 +634,27 @@
       !! ** Action  : 
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(IN) :: kt               ! Current time step
-      !
-      INTEGER :: ji,jj,jk
-      INTEGER :: it
+      INTEGER, INTENT(IN) ::   kt   ! Current time step
+      !
+      INTEGER  :: ji, jj, jk
+      INTEGER  :: it
       REAL(wp) :: zincwgt  ! IAU weight for current time step
       REAL (wp), DIMENSION(jpi,jpj,jpk) :: fzptnz ! 3d freezing point values
       !!----------------------------------------------------------------------
-
+      !
       ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 
       ! used to prevent the applied increments taking the temperature below the local freezing point 
-
       DO jk = 1, jpkm1
         CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), fsdept(:,:,jk) )
       END DO
-
-      IF ( ln_asmiau ) THEN
-
-         !--------------------------------------------------------------------
-         ! Incremental Analysis Updating
-         !--------------------------------------------------------------------
-
+         !
+         !                             !--------------------------------------
+      IF ( ln_asmiau ) THEN            ! Incremental Analysis Updating
+         !                             !--------------------------------------
+         !
          IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
-
+            !
             it = kt - nit000 + 1
             zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
-
+            !
             IF(lwp) THEN
                WRITE(numout,*) 
@@ -677,5 +662,5 @@
                WRITE(numout,*) '~~~~~~~~~~~~'
             ENDIF
-
+            !
             ! Update the tracer tendencies
             DO jk = 1, jpkm1
@@ -700,23 +685,19 @@
                ENDIF
             END DO
-
-         ENDIF
-
+            !
+         ENDIF
+         !
          IF ( kt == nitiaufin_r + 1  ) THEN   ! For bias crcn to work
             DEALLOCATE( t_bkginc )
             DEALLOCATE( s_bkginc )
          ENDIF
-
-
-      ELSEIF ( ln_asmdin ) THEN
-
-         !--------------------------------------------------------------------
-         ! Direct Initialization
-         !--------------------------------------------------------------------
-            
+         !                             !--------------------------------------
+      ELSEIF ( ln_asmdin ) THEN        ! Direct Initialization
+         !                             !--------------------------------------
+         !            
          IF ( kt == nitdin_r ) THEN
-
+            !
             neuler = 0  ! Force Euler forward step
-
+            !
             ! Initialize the now fields with the background + increment
             IF (ln_temnofreeze) THEN
@@ -745,18 +726,15 @@
 !!gm
 
-
-            IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)      &
-               &  CALL zps_hde    ( kt, jpts, tsb, gtsu, gtsv,        &  ! Partial steps: before horizontal gradient
-               &                              rhd, gru , grv          )  ! of t, s, rd at the last ocean level
-            IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)      &
-               &  CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv,    &    ! Partial steps for top cell (ISF)
-               &                                  rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-               &                           gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
-
-#if defined key_zdfkpp
-            CALL eos( tsn, rhd, fsdept_n(:,:,:) )                      ! Compute rhd
-!!gm fabien            CALL eos( tsn, rhd )                      ! Compute rhd
-#endif
-
+            IF( ln_zps .AND. .NOT. lk_c1d ) THEN      ! Partial steps: before horizontal gradient
+               IF(ln_isfcav) THEN                        ! ocean cavities: top and bottom cells (ISF)
+                  CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, gtui, gtvi,     &
+                     &                            rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
+                     &                     grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    )
+               ELSE                                      ! no ocean cavities: bottom cells
+                  CALL zps_hde    ( kt, jpts, tsb, gtsu, gtsv,        &  ! 
+                     &                        rhd, gru , grv          )  ! of t, s, rd at the last ocean level
+               ENDIF
+            ENDIF
+            !
             DEALLOCATE( t_bkginc )
             DEALLOCATE( s_bkginc )
@@ -767,5 +745,5 @@
       ENDIF
       ! Perhaps the following call should be in step
-      IF   ( ln_seaiceinc  )   CALL seaice_asm_inc ( kt )   ! apply sea ice concentration increment
+      IF ( ln_seaiceinc  )   CALL seaice_asm_inc ( kt )   ! apply sea ice concentration increment
       !
    END SUBROUTINE tra_asm_inc
@@ -788,23 +766,20 @@
       REAL(wp) :: zincwgt  ! IAU weight for current time step
       !!----------------------------------------------------------------------
-
-      IF ( ln_asmiau ) THEN
-
-         !--------------------------------------------------------------------
-         ! Incremental Analysis Updating
-         !--------------------------------------------------------------------
-
+      !
+      !                          !--------------------------------------------
+      IF ( ln_asmiau ) THEN      ! Incremental Analysis Updating
+         !                       !--------------------------------------------
+         !
          IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
-
+            !
             it = kt - nit000 + 1
             zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
-
+            !
             IF(lwp) THEN
                WRITE(numout,*) 
-               WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', &
-                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it)
                WRITE(numout,*) '~~~~~~~~~~~~'
             ENDIF
-
+            !
             ! Update the dynamic tendencies
             DO jk = 1, jpkm1
@@ -812,29 +787,26 @@
                va(:,:,jk) = va(:,:,jk) + v_bkginc(:,:,jk) * zincwgt
             END DO
-           
+            !
             IF ( kt == nitiaufin_r ) THEN
                DEALLOCATE( u_bkginc )
                DEALLOCATE( v_bkginc )
             ENDIF
-
-         ENDIF
-
-      ELSEIF ( ln_asmdin ) THEN 
-
-         !--------------------------------------------------------------------
-         ! Direct Initialization
-         !--------------------------------------------------------------------
-         
+            !
+         ENDIF
+         !                          !-----------------------------------------
+      ELSEIF ( ln_asmdin ) THEN     ! Direct Initialization
+         !                          !-----------------------------------------
+         !         
          IF ( kt == nitdin_r ) THEN
-
+            !
             neuler = 0                    ! Force Euler forward step
-
+            !
             ! Initialize the now fields with the background + increment
             un(:,:,:) = u_bkg(:,:,:) + u_bkginc(:,:,:)
             vn(:,:,:) = v_bkg(:,:,:) + v_bkginc(:,:,:)  
-
+            !
             ub(:,:,:) = un(:,:,:)         ! Update before fields
             vb(:,:,:) = vn(:,:,:)
- 
+            !
             DEALLOCATE( u_bkg    )
             DEALLOCATE( v_bkg    )
@@ -864,16 +836,14 @@
       REAL(wp) :: zincwgt  ! IAU weight for current time step
       !!----------------------------------------------------------------------
-
-      IF ( ln_asmiau ) THEN
-
-         !--------------------------------------------------------------------
-         ! Incremental Analysis Updating
-         !--------------------------------------------------------------------
-
+      !
+      !                             !-----------------------------------------
+      IF ( ln_asmiau ) THEN         ! Incremental Analysis Updating
+         !                          !-----------------------------------------
+         !
          IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
-
+            !
             it = kt - nit000 + 1
             zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
-
+            !
             IF(lwp) THEN
                WRITE(numout,*) 
@@ -882,5 +852,5 @@
                WRITE(numout,*) '~~~~~~~~~~~~'
             ENDIF
-
+            !
             ! Save the tendency associated with the IAU weighted SSH increment
             ! (applied in dynspg.*)
@@ -891,23 +861,18 @@
                DEALLOCATE( ssh_bkginc )
             ENDIF
-
-         ENDIF
-
-      ELSEIF ( ln_asmdin ) THEN
-
-         !--------------------------------------------------------------------
-         ! Direct Initialization
-         !--------------------------------------------------------------------
-
+            !
+         ENDIF
+         !                          !-----------------------------------------
+      ELSEIF ( ln_asmdin ) THEN     ! Direct Initialization
+         !                          !-----------------------------------------
+         !
          IF ( kt == nitdin_r ) THEN
-
-            neuler = 0                    ! Force Euler forward step
-
-            ! Initialize the now fields the background + increment
-            sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)  
-
-            ! Update before fields
-            sshb(:,:) = sshn(:,:)         
-
+            !
+            neuler = 0                                   ! Force Euler forward step
+            !
+            sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)   ! Initialize the now fields the background + increment
+            !
+            sshb(:,:) = sshn(:,:)                        ! Update before fields
+            !
             IF( lk_vvl ) THEN
                DO jk = 1, jpk
@@ -915,8 +880,8 @@
                END DO
             ENDIF
-
+            !
             DEALLOCATE( ssh_bkg    )
             DEALLOCATE( ssh_bkginc )
-
+            !
          ENDIF
          !
@@ -937,7 +902,5 @@
       !!
       !!----------------------------------------------------------------------
-      IMPLICIT NONE
-      !
-      INTEGER, INTENT(in)           ::   kt   ! Current time step
+      INTEGER, INTENT(in)           ::   kt       ! Current time step
       INTEGER, INTENT(in), OPTIONAL ::   kindic   ! flag for disabling the deallocation
       !
@@ -949,26 +912,23 @@
 #endif
       !!----------------------------------------------------------------------
-
-      IF ( ln_asmiau ) THEN
-
-         !--------------------------------------------------------------------
-         ! Incremental Analysis Updating
-         !--------------------------------------------------------------------
-
+      !
+      !                             !-----------------------------------------
+      IF ( ln_asmiau ) THEN         ! Incremental Analysis Updating
+         !                          !-----------------------------------------
+         !
          IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
-
+            !
             it = kt - nit000 + 1
             zincwgt = wgtiau(it)      ! IAU weight for the current time step 
             ! note this is not a tendency so should not be divided by rdt (as with the tracer and other increments)
-
+            !
             IF(lwp) THEN
                WRITE(numout,*) 
-               WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', &
-                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it)
                WRITE(numout,*) '~~~~~~~~~~~~'
             ENDIF
-
+            !
             ! Sea-ice : LIM-3 case (to add)
-
+            !
 #if defined key_lim2
             ! Sea-ice : LIM-2 case
@@ -1008,22 +968,18 @@
 
 #if defined key_cice && defined key_asminc
-            ! Sea-ice : CICE case. Zero ice increment tendency into CICE
-            ndaice_da(:,:) = 0.0_wp
-#endif
-
-         ENDIF
-
-      ELSEIF ( ln_asmdin ) THEN
-
-         !--------------------------------------------------------------------
-         ! Direct Initialization
-         !--------------------------------------------------------------------
-
+            ndaice_da(:,:) = 0._wp        ! Sea-ice : CICE case. Zero ice increment tendency into CICE
+#endif
+
+         ENDIF
+         !                          !-----------------------------------------
+      ELSEIF ( ln_asmdin ) THEN     ! Direct Initialization
+         !                          !-----------------------------------------
+         !
          IF ( kt == nitdin_r ) THEN
-
+            !
             neuler = 0                    ! Force Euler forward step
-
+            !
             ! Sea-ice : LIM-3 case (to add)
-
+            !
 #if defined key_lim2
             ! Sea-ice : LIM-2 case.
@@ -1041,5 +997,5 @@
                zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt    
             ELSEWHERE
-               zhicifinc(:,:) = 0.0_wp
+               zhicifinc(:,:) = 0._wp
             END WHERE
             !
@@ -1050,20 +1006,20 @@
             ! seaice salinity balancing (to add)
 #endif
- 
+            !
 #if defined key_cice && defined key_asminc
             ! Sea-ice : CICE case. Pass ice increment tendency into CICE
            ndaice_da(:,:) = seaice_bkginc(:,:) / rdt
 #endif
-           IF ( .NOT. PRESENT(kindic) ) THEN
-              DEALLOCATE( seaice_bkginc )
-           END IF
-
+            IF ( .NOT. PRESENT(kindic) ) THEN
+               DEALLOCATE( seaice_bkginc )
+            END IF
+            !
          ELSE
-
+            !
 #if defined key_cice && defined key_asminc
-            ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
-            ndaice_da(:,:) = 0.0_wp
-#endif
-         
+            ndaice_da(:,:) = 0._wp     ! Sea-ice : CICE case. Zero ice increment tendency into CICE
+
+#endif
+            !
          ENDIF
 
@@ -1142,7 +1098,7 @@
 !
 !#endif
-
+         !
       ENDIF
-
+      !
    END SUBROUTINE seaice_asm_inc
    
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 5901)
@@ -6,27 +6,19 @@
 
    IMPLICIT NONE
-
-   !! * Routine accessibility
    PRIVATE
 
-   !! * Shared Modules variables
-   CHARACTER (LEN=40), PUBLIC, PARAMETER :: &
-      & c_asmbkg = 'assim_background_state_Jb',  & !: Filename for storing the 
-                                                   !: background state for use 
-                                                   !: in the Jb term
-      & c_asmdin = 'assim_background_state_DI',  & !: Filename for storing the 
-                                                   !: background state for direct 
-                                                   !: initialization
-      & c_asmtrj = 'assim_trj',                  & !: Filename for storing the 
-                                                   !: reference trajectory
-      & c_asminc = 'assim_background_increments'   !: Filename for storing the 
-                                                   !: increments to the background
-                                                   !: state
+   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmbkg = 'assim_background_state_Jb'   !: Filename for storing the background state
+   !                                                                                  !  for use in the Jb term
+   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmdin = 'assim_background_state_DI'   !: Filename for storing the background state
+   !                                                                                  !  for direct initialization
+   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmtrj = 'assim_trj'                   !: Filename for storing the reference trajectory
+   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asminc = 'assim_background_increments' !: Filename for storing the increments 
+   !                                                                                  !  to the background state
 
-   INTEGER, PUBLIC :: nitbkg_r      !: Background time step referenced to nit000
-   INTEGER, PUBLIC :: nitdin_r      !: Direct Initialization time step referenced to nit000
-   INTEGER, PUBLIC :: nitiaustr_r   !: IAU starting time step referenced to nit000
-   INTEGER, PUBLIC :: nitiaufin_r   !: IAU final time step referenced to nit000
-   INTEGER, PUBLIC :: nittrjfrq     !: Frequency of trajectory output for 4D-VAR
+   INTEGER, PUBLIC ::   nitbkg_r      !: Background time step referenced to nit000
+   INTEGER, PUBLIC ::   nitdin_r      !: Direct Initialization time step referenced to nit000
+   INTEGER, PUBLIC ::   nitiaustr_r   !: IAU starting time step referenced to nit000
+   INTEGER, PUBLIC ::   nitiaufin_r   !: IAU final time step referenced to nit000
+   INTEGER, PUBLIC ::   nittrjfrq     !: Frequency of trajectory output for 4D-VAR
 
    !!----------------------------------------------------------------------
@@ -34,5 +26,4 @@
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !!======================================================================
 END MODULE asmpar
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 5901)
@@ -8,5 +8,5 @@
    !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions
    !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
-   !!            3.6  !  2012-01  (C. Rousset) add ice boundary conditions for lim3
+   !!            3.6  !  2014-01  (C. Rousset) add ice boundary conditions for lim3
    !!----------------------------------------------------------------------
 #if defined key_bdy 
@@ -22,15 +22,15 @@
 
    TYPE, PUBLIC ::   OBC_INDEX    !: Indices and weights which define the open boundary
-      INTEGER,          DIMENSION(jpbgrd) ::  nblen
-      INTEGER,          DIMENSION(jpbgrd) ::  nblenrim
-      INTEGER, POINTER, DIMENSION(:,:)   ::  nbi
-      INTEGER, POINTER, DIMENSION(:,:)   ::  nbj
-      INTEGER, POINTER, DIMENSION(:,:)   ::  nbr
-      INTEGER, POINTER, DIMENSION(:,:)   ::  nbmap
-      REAL(wp)   , POINTER, DIMENSION(:,:)   ::  nbw
-      REAL(wp)   , POINTER, DIMENSION(:,:)   ::  nbd
-      REAL(wp)   , POINTER, DIMENSION(:,:)   ::  nbdout
-      REAL(wp)   , POINTER, DIMENSION(:,:)   ::  flagu
-      REAL(wp)   , POINTER, DIMENSION(:,:)   ::  flagv
+      INTEGER ,          DIMENSION(jpbgrd) ::  nblen
+      INTEGER ,          DIMENSION(jpbgrd) ::  nblenrim
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbi
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbj
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbr
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbmap
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbw
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbd
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbdout
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagu
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagv
    END TYPE OBC_INDEX
 
@@ -41,34 +41,34 @@
 
    TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data
-      INTEGER,       DIMENSION(2)     ::  nread
-      LOGICAL                         ::  ll_ssh
-      LOGICAL                         ::  ll_u2d
-      LOGICAL                         ::  ll_v2d
-      LOGICAL                         ::  ll_u3d
-      LOGICAL                         ::  ll_v3d
-      LOGICAL                         ::  ll_tem
-      LOGICAL                         ::  ll_sal
-      LOGICAL                         ::  ll_fvl
-      REAL(wp), POINTER, DIMENSION(:)     ::  ssh
-      REAL(wp), POINTER, DIMENSION(:)     ::  u2d
-      REAL(wp), POINTER, DIMENSION(:)     ::  v2d
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  u3d
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  v3d
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  tem
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  sal
+      INTEGER          , DIMENSION(2)   ::  nread
+      LOGICAL                           ::  ll_ssh
+      LOGICAL                           ::  ll_u2d
+      LOGICAL                           ::  ll_v2d
+      LOGICAL                           ::  ll_u3d
+      LOGICAL                           ::  ll_v3d
+      LOGICAL                           ::  ll_tem
+      LOGICAL                           ::  ll_sal
+      LOGICAL                           ::  ll_fvl
+      REAL(wp), POINTER, DIMENSION(:)   ::  ssh
+      REAL(wp), POINTER, DIMENSION(:)   ::  u2d
+      REAL(wp), POINTER, DIMENSION(:)   ::  v2d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  u3d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  v3d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  tem
+      REAL(wp), POINTER, DIMENSION(:,:) ::  sal
 #if defined key_lim2
-      LOGICAL                         ::  ll_frld
-      LOGICAL                         ::  ll_hicif
-      LOGICAL                         ::  ll_hsnif
-      REAL(wp), POINTER, DIMENSION(:)     ::  frld
-      REAL(wp), POINTER, DIMENSION(:)     ::  hicif
-      REAL(wp), POINTER, DIMENSION(:)     ::  hsnif
+      LOGICAL                           ::   ll_frld
+      LOGICAL                           ::   ll_hicif
+      LOGICAL                           ::   ll_hsnif
+      REAL(wp), POINTER, DIMENSION(:)   ::   frld
+      REAL(wp), POINTER, DIMENSION(:)   ::   hicif
+      REAL(wp), POINTER, DIMENSION(:)   ::   hsnif
 #elif defined key_lim3
-      LOGICAL                         ::  ll_a_i
-      LOGICAL                         ::  ll_ht_i
-      LOGICAL                         ::  ll_ht_s
-      REAL, POINTER, DIMENSION(:,:)   ::  a_i   !: now ice leads fraction climatology
-      REAL, POINTER, DIMENSION(:,:)   ::  ht_i  !: Now ice  thickness climatology
-      REAL, POINTER, DIMENSION(:,:)   ::  ht_s  !: now snow thickness
+      LOGICAL                           ::   ll_a_i
+      LOGICAL                           ::   ll_ht_i
+      LOGICAL                           ::   ll_ht_s
+      REAL(wp), POINTER, DIMENSION(:,:) ::   a_i    !: now ice leads fraction climatology
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_i   !: Now ice  thickness climatology
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_s   !: now snow thickness
 #endif
    END TYPE OBC_DATA
@@ -86,5 +86,5 @@
    !
    INTEGER                    ::   nb_bdy                   !: number of open boundary sets
-   INTEGER                    ::   nb_jpk_bdy               ! Number of levels in the bdy data (set < 0 if consistent with planned run)
+   INTEGER,                   ::   nb_jpk_bdy               !: number of levels in the bdy data (set < 0 if consistent with planned run)
    INTEGER, DIMENSION(jp_bdy) ::   nn_rimwidth              !: boundary rim width for Flow Relaxation Scheme
    INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P 
@@ -101,15 +101,15 @@
    INTEGER, DIMENSION(jp_bdy)           ::   nn_tra_dta     !: = 0 use the initial state as bdy dta ; 
                                                             !: = 1 read it in a NetCDF file
-   LOGICAL, DIMENSION(jp_bdy) ::   ln_tra_dmp               !: =T Tracer damping
-   LOGICAL, DIMENSION(jp_bdy) ::   ln_dyn3d_dmp             !: =T Baroclinic velocity damping
-   REAL(wp),    DIMENSION(jp_bdy) ::   rn_time_dmp              !: Damping time scale in days
-   REAL(wp),    DIMENSION(jp_bdy) ::   rn_time_dmp_out          !: Damping time scale in days at radiation outflow points
+   LOGICAL , DIMENSION(jp_bdy) ::   ln_tra_dmp              !: =T Tracer damping
+   LOGICAL , DIMENSION(jp_bdy) ::   ln_dyn3d_dmp            !: =T Baroclinic velocity damping
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp             !: Damping time scale in days
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp_out         !: Damping time scale in days at radiation outflow points
 
    CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_ice_lim       ! Choice of boundary condition for sea ice variables 
-   INTEGER, DIMENSION(jp_bdy)           ::   nn_ice_lim_dta   !: = 0 use the initial state as bdy dta ; 
+   INTEGER , DIMENSION(jp_bdy)          ::   nn_ice_lim_dta   !: = 0 use the initial state as bdy dta ; 
                                                               !: = 1 read it in a NetCDF file
-   REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_tem             !: choice of the temperature of incoming sea ice
-   REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_sal             !: choice of the salinity    of incoming sea ice
-   REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_age             !: choice of the age         of incoming sea ice
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_tem              !: choice of the temperature of incoming sea ice
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_sal              !: choice of the salinity    of incoming sea ice
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_age              !: choice of the age         of incoming sea ice
    !
    
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 5901)
@@ -59,13 +59,15 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) :: kt     ! Main time step counter
-      INTEGER               :: ib_bdy ! Loop index
-
+      INTEGER, INTENT( in ) ::   kt   ! Main time step counter
+      !
+      INTEGER ::   ib_bdy   ! Loop index
+      !!----------------------------------------------------------------------
+      !
 #if defined key_lim3
       CALL lim_var_glo2eqv
 #endif
-
+      !
       DO ib_bdy=1, nb_bdy
-
+         !
          SELECT CASE( cn_ice_lim(ib_bdy) )
          CASE('none')
@@ -76,13 +78,14 @@
             CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' )
          END SELECT
-
+         !
       END DO
-
+      !
 #if defined key_lim3
       CALL lim_var_zapsmall
       CALL lim_var_agg(1)
 #endif
-
+      !
    END SUBROUTINE bdy_ice_lim
+
 
    SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy )
@@ -96,19 +99,22 @@
       !!             dimensional baroclinic ocean model with realistic topography. Tellus, 365-382.
       !!------------------------------------------------------------------------------
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
-      INTEGER,         INTENT(in) ::   kt   ! main time-step counter
+      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
+      TYPE(OBC_DATA),  INTENT(in) ::   dta     ! OBC external data
+      INTEGER,         INTENT(in) ::   kt      ! main time-step counter
       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
-
+      !
       INTEGER  ::   jpbound            ! 0 = incoming ice
-                                       ! 1 = outgoing ice
+      !                                ! 1 = outgoing ice
       INTEGER  ::   jb, jk, jgrd, jl   ! dummy loop indices
       INTEGER  ::   ji, jj, ii, ij     ! local scalar
       REAL(wp) ::   zwgt, zwgt1        ! local scalar
       REAL(wp) ::   ztmelts, zdh
-
-      !!------------------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_ice_frs')
+#if  defined key_lim2 && ! defined key_lim2_vp && defined key_agrif
+     USE ice_2, vt_s => hsnm
+     USE ice_2, vt_i => hicm
+#endif
+      !!------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_ice_frs')
       !
       jgrd = 1      ! Everything is at T-points here
@@ -177,30 +183,29 @@
             ! condition on ice thickness depends on the ice velocity
             ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values
-            jpbound = 0; ii = ji; ij = jj;
-
+            jpbound = 0   ;   ii = ji   ;   ij = jj
+            !
             IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj
             IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj
             IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1
             IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1
-
+            !
             IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions
-                                                                              !      do not make state variables dependent on velocity
-               
-
+            !                                                                 !      do not make state variables dependent on velocity
+            !
             rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice
-
+            !
             ! concentration and thickness
             a_i (ji,jj,jl) = a_i (ii,ij,jl) * rswitch
             ht_i(ji,jj,jl) = ht_i(ii,ij,jl) * rswitch
             ht_s(ji,jj,jl) = ht_s(ii,ij,jl) * rswitch
-
+            !
             ! Ice and snow volumes
             v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl)
             v_s(ji,jj,jl) = ht_s(ji,jj,jl) * a_i(ji,jj,jl)
-
+            !
             SELECT CASE( jpbound )
-
-            CASE( 0 ) ! velocity is inward
-
+            !
+            CASE( 0 )   ! velocity is inward
+               !
                ! Ice salinity, age, temperature
                sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * rn_simin
@@ -214,7 +219,7 @@
                   s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin
                END DO
-               
-            CASE( 1 ) ! velocity is outward
- 
+               !
+            CASE( 1 )   ! velocity is outward
+               !
                ! Ice salinity, age, temperature
                sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * rn_simin
@@ -228,13 +233,12 @@
                   s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin
                END DO
-
+               !
             END SELECT
-
-            ! if salinity is constant, then overwrite rn_ice_sal
-            IF( nn_icesal == 1 ) THEN
-               sm_i(ji,jj,jl)   = rn_icesal
+            !
+            IF( nn_icesal == 1 ) THEN     ! constant salinity : overwrite rn_ice_sal
+               sm_i(ji,jj  ,jl) = rn_icesal
                s_i (ji,jj,:,jl) = rn_icesal
             ENDIF
-
+            !
             ! contents
             smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl)
@@ -255,7 +259,7 @@
                e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i
             END DO
-
+            !
          END DO
- 
+         !
          CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy )
          CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy )
@@ -263,5 +267,5 @@
          CALL lbc_bdy_lnk(  v_i(:,:,jl), 'T', 1., ib_bdy )
          CALL lbc_bdy_lnk(  v_s(:,:,jl), 'T', 1., ib_bdy )
- 
+         !
          CALL lbc_bdy_lnk( smv_i(:,:,jl), 'T', 1., ib_bdy )
          CALL lbc_bdy_lnk(  sm_i(:,:,jl), 'T', 1., ib_bdy )
@@ -276,10 +280,10 @@
             CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy )
          END DO
-
+         !
       END DO !jl
-    
+      !
 #endif
       !      
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_frs')
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_ice_frs')
       !
    END SUBROUTINE bdy_ice_frs
@@ -296,11 +300,11 @@
       !! 2013-06 : C. Rousset
       !!------------------------------------------------------------------------------
-      !!
       CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points
+      !
       INTEGER  ::   jb, jgrd           ! dummy loop indices
       INTEGER  ::   ji, jj             ! local scalar
       INTEGER  ::   ib_bdy             ! Loop index
       REAL(wp) ::   zmsk1, zmsk2, zflag
-     !!------------------------------------------------------------------------------
+      !!------------------------------------------------------------------------------
       !
       IF( nn_timing == 1 ) CALL timing_start('bdy_ice_lim_dyn')
@@ -309,18 +313,15 @@
          !
          SELECT CASE( cn_ice_lim(ib_bdy) )
-
+         !
          CASE('none')
-
             CYCLE
-            
+            !
          CASE('frs')
-            
+            !
             IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions 
-                                                               !      do not change ice velocity (it is only computed by rheology)
- 
+            !                                                  !      do not change ice velocity (it is only computed by rheology)
             SELECT CASE ( cd_type )
-               
-            CASE ( 'U' )
-               
+            !     
+            CASE ( 'U' )  
                jgrd = 2      ! u velocity
                DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd)
@@ -328,10 +329,10 @@
                   jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
                   zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd)
-                  
+                  !
                   IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries
                      ! one of the two zmsk is always 0 (because of zflag)
                      zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice
                      zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji-1,jj) ) ) ! 0 if no ice
-                     
+                     !  
                      ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
                      u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
@@ -345,11 +346,9 @@
                   rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice
                   u_ice(ji,jj) = rswitch * u_ice(ji,jj)
-                  
-               ENDDO
-               
+                  !
+               END DO
                CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy )
-               
+               !
             CASE ( 'V' )
-               
                jgrd = 3      ! v velocity
                DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd)
@@ -357,10 +356,10 @@
                   jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
                   zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd)
-                  
+                  !
                   IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries
                      ! one of the two zmsk is always 0 (because of zflag)
                      zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice
                      zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj-1) ) ) ! 0 if no ice
-                     
+                     !  
                      ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
                      v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
@@ -374,19 +373,18 @@
                   rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice
                   v_ice(ji,jj) = rswitch * v_ice(ji,jj)
-                  
-               ENDDO
-               
+                  !
+               END DO
                CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy )
-                  
+               !
             END SELECT
-            
+            !
          CASE DEFAULT
             CALL ctl_stop( 'bdy_ice_lim_dyn : unrecognised option for open boundaries for ice fields' )
          END SELECT
-         
-      ENDDO
-
+         !
+      END DO
+      !
       IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_lim_dyn')
-      
+      !
     END SUBROUTINE bdy_ice_lim_dyn
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 5901)
@@ -76,5 +76,5 @@
       INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices
       INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers
-      INTEGER  ::   iw, ie, is, in, inum, id_dummy         !   -       -
+      INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy     !   -       -
       INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       -
       INTEGER  ::   jpbdtau, jpbdtas                       !   -       -
@@ -801,8 +801,8 @@
 !      is = mjg(1) + 1            ! if monotasking and no zoom, is=2
 !      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1      
-      iw = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2
-      ie = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1
-      is = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2
-      in = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1
+      iwe = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2
+      ies = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1
+      iso = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2
+      ino = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1
 
       ALLOCATE( nbondi_bdy(nb_bdy))
@@ -877,6 +877,6 @@
                ENDIF
                ! check if point is in local domain
-               IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   &
-                  & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in       ) THEN
+               IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   &
+                  & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino      ) THEN
                   !
                   icount = icount  + 1
@@ -914,4 +914,5 @@
          com_south_b = 0
          com_north_b = 0
+
          DO igrd = 1, jpbgrd
             icount  = 0
@@ -920,6 +921,6 @@
                DO ib = 1, nblendta(igrd,ib_bdy)
                   ! check if point is in local domain and equals ir
-                  IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   &
-                     & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in .AND.   &
+                  IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   &
+                     & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino .AND.   &
                      & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
                      !
@@ -1618,5 +1619,5 @@
             ELSE
                ! This is a corner
-               WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)
+               IF(lwp) WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)
                CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1))
                itest=itest+1
@@ -1632,5 +1633,5 @@
             ELSE
                ! This is a corner
-               WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)
+               IF(lwp) WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)
                CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2))
                itest=itest+1
@@ -1662,5 +1663,5 @@
             ELSE
                ! This is a corner
-               WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)
+               IF(lwp) WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)
                CALL bdy_ctl_corn(npckge(ib), icorne(ib,1))
                itest=itest+1
@@ -1676,5 +1677,5 @@
             ELSE
                ! This is a corner
-               WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)
+               IF(lwp) WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)
                CALL bdy_ctl_corn(npckge(ib), icorne(ib,2))
                itest=itest+1
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 5901)
@@ -15,13 +15,15 @@
    !!   'key_dynspg_flt'                              filtered free surface
    !!----------------------------------------------------------------------
-   USE timing          ! Timing
    USE oce             ! ocean dynamics and tracers 
-   USE sbcisf          ! ice shelf
+   USE bdy_oce         ! ocean open boundary conditions
+   USE sbc_oce         ! ocean surface boundary conditions
    USE dom_oce         ! ocean space and time domain 
    USE phycst          ! physical constants
-   USE bdy_oce         ! ocean open boundary conditions
+   USE sbcisf          ! ice shelf
+   !
+   USE in_out_manager  ! I/O manager
    USE lib_mpp         ! for mppsum
-   USE in_out_manager  ! I/O manager
-   USE sbc_oce         ! ocean surface boundary conditions
+   USE timing          ! Timing
+   USE lib_fortran     ! Fortran routines library
 
    IMPLICIT NONE
@@ -33,5 +35,5 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
    !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -78,9 +80,9 @@
       TYPE(OBC_INDEX), POINTER :: idx
       !!-----------------------------------------------------------------------------
-
-      IF( nn_timing == 1 ) CALL timing_start('bdy_vol')
-
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_vol')
+      !
       IF( ln_vol ) THEN
-
+      !
       IF( kt == nit000 ) THEN 
          IF(lwp) WRITE(numout,*)
@@ -91,13 +93,17 @@
       ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain
       ! -----------------------------------------------------------------------
-      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+rdivisf*fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0
+!!gm replace these lines :
+      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0
       IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain
+!!gm   by :
+!!gm      z_cflxemp = glob_sum(  ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:)  ) / rau0
+!!gm
 
       ! Transport through the unstructured open boundary
       ! ------------------------------------------------
-      zubtpecor = 0.e0
+      zubtpecor = 0._wp
       DO ib_bdy = 1, nb_bdy
          idx => idx_bdy(ib_bdy)
-
+         !
          jgrd = 2                               ! cumulate u component contribution first 
          DO jb = 1, idx%nblenrim(jgrd)
@@ -116,5 +122,5 @@
             END DO
          END DO
-
+         !
       END DO
       IF( lk_mpp )   CALL mpp_sum( zubtpecor )   ! sum over the global domain
@@ -123,13 +129,13 @@
       ! ------------------------------
       IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 
-      ELSE                   ;   zubtpecor =   zubtpecor             / bdysurftot
+      ELSE                      ;   zubtpecor =   zubtpecor             / bdysurftot
       END IF
 
       ! Correction of the total velocity on the unstructured boundary to respect the mass flux conservation
       ! -------------------------------------------------------------
-      ztranst = 0.e0
+      ztranst = 0._wp
       DO ib_bdy = 1, nb_bdy
          idx => idx_bdy(ib_bdy)
-
+         !
          jgrd = 2                               ! correct u component
          DO jb = 1, idx%nblenrim(jgrd)
@@ -150,5 +156,5 @@
             END DO
          END DO
-
+         !
       END DO
       IF( lk_mpp )   CALL mpp_sum( ztranst )   ! sum over the global domain
@@ -169,5 +175,5 @@
       !
       END IF ! ln_vol
-
+      !
    END SUBROUTINE bdy_vol
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90	(revision 5901)
@@ -48,5 +48,4 @@
       !!----------------------------------------------------------------------
       !
-
       REWIND( numnam_ref )              ! Namelist namc1d in reference namelist : Tracer advection scheme
       READ  ( numnam_ref, namc1d, IOSTAT = ios, ERR = 901)
@@ -57,5 +56,4 @@
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namc1d )
-
       !
       IF(lwp) THEN                    ! Control print
@@ -69,5 +67,4 @@
       ENDIF
       !
-      !
    END SUBROUTINE c1d_init
 
@@ -77,14 +74,10 @@
    !!----------------------------------------------------------------------
    USE par_kind         ! kind parameters
-
    LOGICAL, PUBLIC, PARAMETER ::   lk_c1d = .FALSE.   !: 1D config. flag de-activated
    REAL(wp)                   ::   rn_lat1d, rn_lon1d
    LOGICAL , PUBLIC           ::   ln_c1d_locpt = .FALSE. 
-
 CONTAINS
-
    SUBROUTINE c1d_init               ! Dummy routine
    END SUBROUTINE c1d_init
-
 #endif
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 5901)
@@ -82,5 +82,4 @@
       IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz
       IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz
-      IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz
       IF( lk_zdfcst  )   THEN                            ! Constant Kz (reset avt, avm[uv] to the background value)
          avt (:,:,:) = rn_avt0 * tmask(:,:,:)
@@ -93,10 +92,6 @@
       ENDIF
       IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
-
       IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing
-
-      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   &
-         &               CALL zdf_ddm( kstp )         ! double diffusive mixing
-         
+      IF( lk_zdfddm  )   CALL zdf_ddm( kstp )         ! double diffusive mixing
                          CALL zdf_mxl( kstp )         ! mixed layer depth
 
@@ -128,5 +123,4 @@
       IF( ln_traqsr )   CALL tra_qsr( kstp )       ! penetrative solar radiation qsr
       IF( ln_tradmp )   CALL tra_dmp( kstp )       ! internal damping trends- tracers
-      IF( lk_zdfkpp )   CALL tra_kpp( kstp )       ! KPP non-local tracer fluxes
                         CALL tra_zdf( kstp )       ! vertical mixing
                         CALL eos( tsn, rhd, rhop, gdept_0(:,:,:) )   ! now potential density for zdfmxl
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 5901)
@@ -11,18 +11,19 @@
    !!                       other variables needed to be passed to TOP
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers 
-   USE dom_oce         ! ocean space and time domain
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE zdf_oce         ! vertical  physics: ocean fields
-   USE zdfddm          ! vertical  physics: double diffusion
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE in_out_manager  ! I/O manager
-   USE timing          ! preformance summary
-   USE wrk_nemo        ! working array
    USE crs
    USE crsdom
    USE crslbclnk
-   USE iom
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE zdf_oce         ! vertical  physics: ocean fields
+   USE ldftra          ! ocean active tracers: lateral diffusivity & EIV coefficients
+   USE zdfddm          ! vertical  physics: double diffusion
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! 
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE timing          ! preformance summary
+   USE wrk_nemo        ! working array
 
    IMPLICIT NONE
@@ -30,5 +31,4 @@
 
    PUBLIC   crs_fld                 ! routines called by step.F90
-
 
    !! * Substitutions
@@ -37,5 +37,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -56,24 +56,20 @@
       !! ** Method  :  
       !!----------------------------------------------------------------------
-      !!
-      
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!
-      INTEGER               ::   ji, jj, jk              ! dummy loop indices
-      !!
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs 
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs !
-      REAL(wp)       :: z2dcrsu, z2dcrsv
-      !!
-       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk        ! dummy loop indices
+      REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zfse3t, zfse3u, zfse3v, zfse3w   ! 3D workspace for e3
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zt, zt_crs
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zs, zs_crs  
+      !!----------------------------------------------------------------------
       ! 
-
       IF( nn_timing == 1 )   CALL timing_start('crs_fld')
 
       !  Initialize arrays
-      CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w )
-      CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v )
-      CALL wrk_alloc( jpi, jpj, jpk, zt, zs       )
+      CALL wrk_alloc( jpi,jpj,jpk,   zfse3t, zfse3w )
+      CALL wrk_alloc( jpi,jpj,jpk,   zfse3u, zfse3v )
+      CALL wrk_alloc( jpi,jpj,jpk,   zt    , zs     )
       !
       CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
@@ -169,5 +165,5 @@
       CALL iom_put( "eken", rke_crs )
 
-      !  Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 ) 
+      !  Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 ) 
       DO jk = 1, jpkm1
          DO ji = 2, jpi_crsm1
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 5901)
@@ -7,27 +7,32 @@
    !!----------------------------------------------------------------------
 
-   USE timing                   ! Timing
+   !!----------------------------------------------------------------------
+   !!  crs_init    : 
+   !!----------------------------------------------------------------------
+   USE par_kind, ONLY: wp
    USE par_oce                  ! For parameter jpi,jpj,jphgr_msh
    USE dom_oce                  ! For parameters in par_oce (jperio, lk_vvl)
-   USE crs                  ! Coarse grid domain
+   USE crs                      ! Coarse grid domain
    USE phycst, ONLY: omega, rad ! physical constants
-   USE wrk_nemo 
-   USE in_out_manager
-   USE par_kind, ONLY: wp
-   USE iom
    USE crsdom
    USE crsdomwri
    USE crslbclnk
+   !
+   USE iom
+   USE in_out_manager
    USE lib_mpp
+   USE wrk_nemo 
+   USE timing                   ! Timing
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC  crs_init
+   PUBLIC   crs_init   ! called by nemogcm.F90 module
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
-
+   !!----------------------------------------------------------------------
    !! $Id$
+   !!----------------------------------------------------------------------
 CONTAINS
    
@@ -65,5 +70,4 @@
       !!               - Read in pertinent data ?
       !!-------------------------------------------------------------------
-      !! Local variables
       INTEGER  :: ji,jj,jk      ! dummy indices
       INTEGER  :: ierr                                ! allocation error status
@@ -183,5 +187,5 @@
      
      !
-     CALL wrk_alloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w )
+     CALL wrk_alloc( jpi,jpj,jpk,   zfse3t, zfse3u, zfse3v, zfse3w )
      !
      zfse3t(:,:,:) = fse3t(:,:,:)
@@ -200,6 +204,4 @@
      !    3.d.3   Vertical scale factors
      !
-   
-  
      CALL crs_dom_e3( e1t, e2t, zfse3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs)
      CALL crs_dom_e3( e1u, e2u, zfse3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
@@ -207,5 +209,5 @@
      CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
 
-     ! Reset 0 to e3t_0 or e3w_0
+     ! Replace 0 by e3t_0 or e3w_0
      DO jk = 1, jpk
         DO ji = 1, jpi_crs
@@ -247,13 +249,11 @@
      ENDIF
      
-     !---------------------------------------------------------
-     ! 7. Finish and clean-up
-     !---------------------------------------------------------
-     CALL wrk_dealloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w )
-
-
+      !---------------------------------------------------------
+      ! 7. Finish and clean-up
+      !---------------------------------------------------------
+      CALL wrk_dealloc( jpi,jpj,jpk,   zfse3t, zfse3u, zfse3v, zfse3w )
+      !
    END SUBROUTINE crs_init
     
    !!======================================================================
-
 END MODULE crsini
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 5901)
@@ -7,5 +7,5 @@
    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
    !!----------------------------------------------------------------------
-#if defined key_diaar5   || defined key_esopa
+#if defined key_diaar5
    !!----------------------------------------------------------------------
    !!   'key_diaar5'  :                           activate ar5 diagnotics
@@ -237,5 +237,5 @@
       IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' )
 
-      area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)
+      area(:,:) = e1e2t(:,:) * tmask_i(:,:)
 
       area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 5901)
@@ -74,5 +74,5 @@
          a_salb   = 0.e0 ! valeur de sal au debut de la simulation
          ! sshb used because diafwb called after tranxt (i.e. after the swap)
-         a_sshb = SUM( e1t(:,:) * e2t(:,:) * sshb(:,:) * tmask_i(:,:) )
+         a_sshb = SUM( e1e2t(:,:) * sshb(:,:) * tmask_i(:,:) )
          IF( lk_mpp )   CALL mpp_sum( a_sshb )      ! sum over the global domain
 
@@ -80,5 +80,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  zwei  = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
                   a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei
                END DO
@@ -88,5 +88,5 @@
       ENDIF
       
-      a_fwf    = SUM( e1t(:,:) * e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) ) 
+      a_fwf    = SUM( e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) ) 
       IF( lk_mpp )   CALL mpp_sum( a_fwf    )       ! sum over the global domain
 
@@ -98,7 +98,7 @@
          zfwfnew = 0.e0
          ! Mean sea level at nitend
-         a_sshn = SUM( e1t(:,:) * e2t(:,:) * sshn(:,:) * tmask_i(:,:) )
+         a_sshn = SUM( e1e2t(:,:) * sshn(:,:) * tmask_i(:,:) )
          IF( lk_mpp )   CALL mpp_sum( a_sshn )      ! sum over the global domain
-         zarea  = SUM( e1t(:,:) * e2t(:,:) *             tmask_i(:,:) )
+         zarea  = SUM( e1e2t(:,:) *             tmask_i(:,:) )
          IF( lk_mpp )   CALL mpp_sum( zarea  )      ! sum over the global domain
          
@@ -106,5 +106,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  zwei  = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
                   a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei
                   zvol  = zvol  + zwei
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 5901)
@@ -93,5 +93,5 @@
       ! 1 - Trends due to forcing !
       ! ------------------------- !
-      z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes
+      z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes
       z_frc_trd_t =           glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) )                               ! heat fluxes
       z_frc_trd_s =           glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) )                               ! salt fluxes
@@ -101,7 +101,6 @@
       ! Add ice shelf heat & salt input
       IF( nn_isf .GE. 1 )  THEN
-          z_frc_trd_t = z_frc_trd_t &
-              &   + glob_sum( ( risf_tsc(:,:,jp_tem) - rdivisf * fwfisf(:,:) * (-1.9) * r1_rau0 ) * surf(:,:) )
-          z_frc_trd_s = z_frc_trd_s + (1.0_wp - rdivisf) * glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) )
+          z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) )
+          z_frc_trd_s = z_frc_trd_s + glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) )
       ENDIF
 
@@ -200,5 +199,4 @@
 !      ENDIF
 !!gm end
-
 
       IF( lk_vvl ) THEN
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 5901)
@@ -8,8 +8,8 @@
    !!                 !  1997-08  (G. Madec)  optimization
    !!                 !  1999-07  (E. Guilyardi)  hd28 + heat content 
-   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
-   !!   NEMO     3.2  !  2009-07  (S. Masson) hc300 bugfix + cleaning + add new diag
-   !!----------------------------------------------------------------------
-#if   defined key_diahth   ||   defined key_esopa
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            3.2  !  2009-07  (S. Masson) hc300 bugfix + cleaning + add new diag
+   !!----------------------------------------------------------------------
+#if   defined key_diahth
    !!----------------------------------------------------------------------
    !!   'key_diahth' :                              thermocline depth diag.
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 5901)
@@ -17,4 +17,6 @@
    !!                 ! 2005-11  (V. Garnier) Surface pressure gradient organization
    !!            3.2  ! 2008-11  (B. Lemaire) creation from old diawri
+   !!            3.7  ! 2014-01  (G. Madec) remove eddy induced velocity from no-IOM output
+   !!                 !                     change name of output variables in dia_wri_state
    !!----------------------------------------------------------------------
 
@@ -27,7 +29,5 @@
    USE dynadv, ONLY: ln_dynadv_vec
    USE zdf_oce         ! ocean vertical physics
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldfdyn_oce      ! ocean dynamics: lateral physics
-   USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv
+   USE ldftra          ! lateral physics: eddy diffusivity coef.
    USE sol_oce         ! solver variables
    USE sbc_oce         ! Surface boundary condition: ocean fields
@@ -232,5 +232,5 @@
       IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value
          ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
-         z2d(:,:) = rau0 * e12t(:,:)
+         z2d(:,:) = rau0 * e1e2t(:,:)
          DO jk = 1, jpk
             z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
@@ -247,7 +247,7 @@
          DO jj = 2, jpjm1                                    ! sst gradient
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zztmp      = tsn(ji,jj,1,jp_tem)
-               zztmpx     = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) / e1u(ji-1,jj  )
-               zztmpy     = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) / e2v(ji  ,jj-1)
+               zztmp  = tsn(ji,jj,1,jp_tem)
+               zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj)
+               zztmpy = ( tsn(ji,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1)
                z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
                   &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
@@ -401,7 +401,6 @@
       !!      Each nwrite time step, output the instantaneous or mean fields
       !!----------------------------------------------------------------------
-      !!
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
       LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout
       CHARACTER (len=40) ::   clhstnam, clop, clmx           ! local names
@@ -412,5 +411,5 @@
       INTEGER  ::   jn, ierror                               ! local integers
       REAL(wp) ::   zsto, zout, zmax, zjulian, zdt           ! local scalars
-      !!
+      !
       REAL(wp), POINTER, DIMENSION(:,:)   :: zw2d       ! 2D workspace
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace
@@ -419,6 +418,6 @@
       IF( nn_timing == 1 )   CALL timing_start('dia_wri')
       !
-      CALL wrk_alloc( jpi , jpj      , zw2d )
-      IF ( ln_traldf_gdia .OR. lk_vvl )  call wrk_alloc( jpi , jpj , jpk  , zw3d )
+                     CALL wrk_alloc( jpi,jpj      , zw2d )
+      IF( lk_vvl )   CALL wrk_alloc( jpi,jpj,jpk  , zw3d )
       !
       ! Output the initial state and forcings
@@ -657,6 +656,6 @@
          
          clmx ="l_max(only(x))"    ! max index on a period
-         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX 
-            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
+!         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX 
+!            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
 #if defined key_diahth
          CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth
@@ -682,13 +681,4 @@
          CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un
             &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
-         IF( ln_traldf_gdia ) THEN
-            CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv
-                 &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
-         ELSE
-#if defined key_diaeiv
-            CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv
-            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
-#endif
-         END IF
          !                                                                                      !!! nid_U : 2D
          CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau
@@ -700,13 +690,4 @@
          CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn
             &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
-         IF( ln_traldf_gdia ) THEN
-            CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv
-                 &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
-         ELSE 
-#if defined key_diaeiv
-            CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv
-            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
-#endif
-         END IF
          !                                                                                      !!! nid_V : 2D
          CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau
@@ -718,13 +699,4 @@
          CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn
             &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
-         IF( ln_traldf_gdia ) THEN
-            CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv
-                 &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
-         ELSE
-#if defined key_diaeiv
-            CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv
-                 &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
-#endif
-         END IF
          CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt
             &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
@@ -737,13 +709,4 @@
          ENDIF
          !                                                                                      !!! nid_W : 2D
-#if defined key_traldf_c2d
-         CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity"           , "m2/s"   ,   &  ! ahtw
-            &          jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
-# if defined key_traldf_eiv 
-            CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s",   &  ! aeiw
-               &       jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
-# endif
-#endif
-
          CALL histend( nid_W, snc4chunks=snc4set )
 
@@ -853,55 +816,10 @@
 
       CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current
-      IF( ln_traldf_gdia ) THEN
-         IF (.not. ALLOCATED(psix_eiv))THEN
-            ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr )
-            IF( lk_mpp   )   CALL mpp_sum ( ierr )
-            IF( ierr > 0 )   CALL ctl_stop('STOP', 'diawri: unable to allocate psi{x,y}_eiv')
-            psix_eiv(:,:,:) = 0.0_wp
-            psiy_eiv(:,:,:) = 0.0_wp
-         ENDIF
-         DO jk=1,jpkm1
-            zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz
-         END DO
-         zw3d(:,:,jpk) = 0._wp
-         CALL histwrite( nid_U, "vozoeivu", it, zw3d, ndim_U , ndex_U )           ! i-eiv current
-      ELSE
-#if defined key_diaeiv
-         CALL histwrite( nid_U, "vozoeivu", it, u_eiv, ndim_U , ndex_U )          ! i-eiv current
-#endif
-      ENDIF
       CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
 
       CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current
-      IF( ln_traldf_gdia ) THEN
-         DO jk=1,jpk-1
-            zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz
-         END DO
-         zw3d(:,:,jpk) = 0._wp
-         CALL histwrite( nid_V, "vomeeivv", it, zw3d, ndim_V , ndex_V )           ! j-eiv current
-      ELSE
-#if defined key_diaeiv
-         CALL histwrite( nid_V, "vomeeivv", it, v_eiv, ndim_V , ndex_V )          ! j-eiv current
-#endif
-      ENDIF
       CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
 
       CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current
-      IF( ln_traldf_gdia ) THEN
-         DO jk=1,jpk-1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1  ! vector opt.
-                  zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2v(ji,jj) + &
-                       &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx
-               END DO
-            END DO
-         END DO
-         zw3d(:,:,jpk) = 0._wp
-         CALL histwrite( nid_W, "voveeivw", it, zw3d          , ndim_T, ndex_T )    ! vert. eiv current
-      ELSE
-#   if defined key_diaeiv
-         CALL histwrite( nid_W, "voveeivw", it, w_eiv          , ndim_T, ndex_T )    ! vert. eiv current
-#   endif
-      ENDIF
       CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef.
       CALL histwrite( nid_W, "votkeavm", it, avmu           , ndim_T, ndex_T )    ! T vert. eddy visc. coef.
@@ -909,10 +827,4 @@
          CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef.
       ENDIF
-#if defined key_traldf_c2d
-      CALL histwrite( nid_W, "soleahtw", it, ahtw          , ndim_hT, ndex_hT )   ! lateral eddy diff. coef.
-# if defined key_traldf_eiv
-         CALL histwrite( nid_W, "soleaeiw", it, aeiw       , ndim_hT, ndex_hT )   ! EIV coefficient at w-point
-# endif
-#endif
 
       ! 3. Close all files
@@ -925,6 +837,6 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi , jpj      , zw2d )
-      IF ( ln_traldf_gdia .OR. lk_vvl )  call wrk_dealloc( jpi , jpj , jpk  , zw3d )
+                     CALL wrk_dealloc( jpi , jpj        , zw2d )
+      IF( lk_vvl )   CALL wrk_dealloc( jpi , jpj , jpk  , zw3d )
       !
       IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
@@ -958,6 +870,4 @@
       !!----------------------------------------------------------------------
       ! 
-!     IF( nn_timing == 1 )   CALL timing_start('dia_wri_state') ! not sure this works for routines not called in first timestep
-
       ! 0. Initialisation
       ! -----------------
@@ -1018,5 +928,5 @@
          CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      ,   &   ! t-point depth
             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
-      END IF
+      ENDIF
 
 #if defined key_lim2
@@ -1042,5 +952,5 @@
       CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity
       CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity
-      CALL histwrite( id_i, "sowaflup", kt, (emp-rnf )       , jpi*jpj    , idex )    ! freshwater budget
+      CALL histwrite( id_i, "sowaflup", kt, emp-rnf          , jpi*jpj    , idex )    ! freshwater budget
       CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux
       CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux
@@ -1060,8 +970,5 @@
       ENDIF
 #endif
-       
-!     IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep
       ! 
-
    END SUBROUTINE dia_wri_state
    !!======================================================================
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90	(revision 5901)
@@ -71,19 +71,19 @@
       !!                                   =2 put at location runoff
       !!----------------------------------------------------------------------
-      INTEGER ::   jc            ! dummy loop indices
-      INTEGER :: isrow           ! local index
-      !!----------------------------------------------------------------------
-      
+      INTEGER ::   jc      ! dummy loop indices
+      INTEGER ::   isrow   ! local index
+      !!----------------------------------------------------------------------
+      !
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
       IF(lwp) WRITE(numout,*)'~~~~~~~'
-
+      !
       ! initial values
       ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1
       ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1
-
+      !
       ! set the closed seas (in data domain indices)
       ! -------------------
-
+      !
       IF( cp_cfg == "orca" ) THEN
          !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 5901)
@@ -7,7 +7,8 @@
    !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate 
    !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
-   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.4  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
    !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Add arrays associated
    !!                             to the optimization of BDY communications
+   !!            3.7  ! 2015-11  (G. Madec) introduce surface and scale factor ratio
    !!----------------------------------------------------------------------
 
@@ -20,6 +21,5 @@
 
    IMPLICIT NONE
-   PUBLIC             ! allows the acces to par_oce when dom_oce is used
-   !                  ! exception to coding rules... to be suppressed ???
+   PUBLIC             ! allows the acces to par_oce when dom_oce is used (exception to coding rules)
 
    PUBLIC dom_oce_alloc  ! Called from nemogcm.F90
@@ -107,7 +107,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dtra  !: = 2*rdttra except at nit000 (=rdttra) if neuler=0
 
-   !                                         !!* Namelist namcla : cross land advection
-   INTEGER, PUBLIC ::   nn_cla               !: =1 cross land advection for exchanges through some straits (ORCA2)
-
    !!----------------------------------------------------------------------
    !! space domain parameters
@@ -158,14 +155,17 @@
    !! horizontal curvilinear coordinate and scale factors
    !! ---------------------------------------------------------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamt, glamu   !: longitude of t-, u-, v- and f-points (degre)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamv, glamf   !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphiv, gphif   !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1t, e2t, r1_e1t, r1_e2t   !: horizontal scale factors and inverse at t-point (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1u, e2u, r1_e1u, r1_e2u   !: horizontal scale factors and inverse at u-point (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1v, e2v, r1_e1v, r1_e2v   !: horizontal scale factors and inverse at v-point (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1f, e2f, r1_e1f, r1_e2f   !: horizontal scale factors and inverse at f-point (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1e2t          !: surface at t-point (m2)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1t   , e2t  , r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1u   , e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1v   , e2v  , r1_e1v, r1_e2v   !: horizontal scale factors at v-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff                              !: coriolis factor                   [1/s]
 
    !!----------------------------------------------------------------------
@@ -216,10 +216,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0           !: reference depth at t-       points (meters)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0 , hv_0    !: reference depth at u- and v-points (meters)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   re2u_e1u       !: scale factor coeffs at u points (e2u/e1u)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   re1v_e2v       !: scale factor coeffs at v points (e1v/e2v)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12t , r1_e12t !: horizontal cell surface and inverse at t points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12u , r1_e12u !: horizontal cell surface and inverse at u points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12v , r1_e12v !: horizontal cell surface and inverse at v points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12f , r1_e12f !: horizontal cell surface and inverse at f points
 
    INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1)
@@ -265,9 +259,4 @@
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
-
-#if defined key_noslip_accurate
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  )  :: npcoa              !: ???
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: nicoa, njcoa       !: ???
-#endif
 
    !!----------------------------------------------------------------------
@@ -333,5 +322,5 @@
    INTEGER FUNCTION dom_oce_alloc()
       !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(12) :: ierr
+      INTEGER, DIMENSION(13) :: ierr
       !!----------------------------------------------------------------------
       ierr(:) = 0
@@ -346,9 +335,15 @@
          &      tpol(jpiglo)  , fpol(jpiglo)                               , STAT=ierr(2) )
          !
-      ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,   & 
-         &      glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,   &  
-         &      glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,   &  
-         &      glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,   &
-         &      e1e2t(jpi,jpj) , ff   (jpi,jpj) , STAT=ierr(3) )     
+      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     &
+         &      gphit(jpi,jpj) ,    gphiu(jpi,jpj) ,  gphiv(jpi,jpj) ,  gphif(jpi,jpj) ,     &
+         &       e1t (jpi,jpj) ,     e2t (jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,     &
+         &       e1u (jpi,jpj) ,     e2u (jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,     &
+         &       e1v (jpi,jpj) ,     e2v (jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,     &
+         &       e1f (jpi,jpj) ,     e2f (jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,     &
+         &      e1e2t(jpi,jpj) , r1_e1e2t(jpi,jpj)                                     ,     &
+         &      e1e2u(jpi,jpj) , r1_e1e2u(jpi,jpj) , e2_e1u(jpi,jpj)                   ,     &
+         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     &
+         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     &
+         &        ff (jpi,jpj)                                                         , STAT=ierr(3) )
          !
       ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) ,                         &
@@ -364,17 +359,12 @@
          &      gdept_b (jpi,jpj,jpk) ,gdepw_b(jpi,jpj,jpk) , e3w_b (jpi,jpj,jpk) ,                           &
          &      e3t_a   (jpi,jpj,jpk) , e3u_a (jpi,jpj,jpk) , e3v_a (jpi,jpj,jpk) ,                           &
-         &      ehu_a    (jpi,jpj)    , ehv_a  (jpi,jpj),                                                     &
-         &      ehur_a   (jpi,jpj)    , ehvr_a (jpi,jpj),                                                     &
-         &      ehu_b    (jpi,jpj)    , ehv_b  (jpi,jpj),                                                     &
-         &      ehur_b   (jpi,jpj)    , ehvr_b (jpi,jpj),                                  STAT=ierr(5) )                          
+         &      ehu_a   (jpi,jpj)     , ehv_a (jpi,jpj),                                                     &
+         &      ehur_a  (jpi,jpj)     , ehvr_a(jpi,jpj),                                                     &
+         &      ehu_b   (jpi,jpj)     , ehv_b (jpi,jpj),                                                     &
+         &      ehur_b  (jpi,jpj)     , ehvr_b(jpi,jpj),                                  STAT=ierr(5) )                          
 #endif
          !
-      ALLOCATE( hu      (jpi,jpj) , hur     (jpi,jpj) , hu_0(jpi,jpj) , ht_0  (jpi,jpj) ,     &
-         &      hv      (jpi,jpj) , hvr     (jpi,jpj) , hv_0(jpi,jpj) , ht    (jpi,jpj) ,     &
-         &      re2u_e1u(jpi,jpj) , re1v_e2v(jpi,jpj) ,                                       &
-         &      e12t    (jpi,jpj) , r1_e12t (jpi,jpj) ,                                       &
-         &      e12u    (jpi,jpj) , r1_e12u (jpi,jpj) ,                                       &
-         &      e12v    (jpi,jpj) , r1_e12v (jpi,jpj) ,                                       &
-         &      e12f    (jpi,jpj) , r1_e12f (jpi,jpj) ,                                   STAT=ierr(6)  )
+      ALLOCATE( hu(jpi,jpj) , hur(jpi,jpj) , hu_0(jpi,jpj) , ht_0(jpi,jpj) ,     &
+         &      hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , ht  (jpi,jpj) , STAT=ierr(6)  )
          !
       ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) ,                                     &
@@ -387,15 +377,15 @@
          &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     &
          &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     &
-         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(8) )
+         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1(jpi,jpj) , STAT=ierr(8) )
 
       ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) ,                                      &
          &     tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), &
-         &     bmask(jpi,jpj)   ,                                                       &
+         &     bmask  (jpi,jpj) ,                                                       &
          &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) )
 
 ! (ISF) Allocation of basic array   
-      ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),     &
-         &     mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           &
-         &     mikf(jpi,jpj), ssmask(jpi,jpj), STAT=ierr(10) )
+      ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),                   &
+         &      mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           &
+         &      mikf(jpi,jpj), ssmask(jpi,jpj), STAT=ierr(10) )
 
       ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     & 
@@ -403,8 +393,4 @@
 
       ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) )
-
-#if defined key_noslip_accurate
-      ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(12) )
-#endif
       !
       dom_oce_alloc = MAXVAL(ierr)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 5901)
@@ -19,4 +19,5 @@
    !!   dom_nam        : read and contral domain namelists
    !!   dom_ctl        : control print for the ocean domain
+   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate)
    !!----------------------------------------------------------------------
    USE oce             ! ocean variables
@@ -25,7 +26,4 @@
    USE phycst          ! physical constants
    USE closea          ! closed seas
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distributed memory computing library
-
    USE domhgr          ! domain: set the horizontal mesh
    USE domzgr          ! domain: set the vertical mesh
@@ -36,6 +34,9 @@
    USE c1d             ! 1D vertical configuration
    USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine)
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
    USE timing          ! Timing
-   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
 
    IMPLICIT NONE
@@ -81,5 +82,5 @@
       ENDIF
       !
-                             CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
+                             CALL dom_nam      ! read namelist ( namrun, namdom )
                              CALL dom_clo      ! Closed seas and lake
                              CALL dom_hgr      ! Horizontal mesh
@@ -88,7 +89,7 @@
       IF( ln_sco )           CALL dom_stiff    ! Maximum stiffness ratio/hydrostatic consistency
       !
-      ht_0(:,:) = 0.0_wp                       ! Reference ocean depth at T-points
-      hu_0(:,:) = 0.0_wp                       ! Reference ocean depth at U-points
-      hv_0(:,:) = 0.0_wp                       ! Reference ocean depth at V-points
+      ht_0(:,:) = 0._wp                        ! Reference ocean depth at T-points
+      hu_0(:,:) = 0._wp                        ! Reference ocean depth at U-points
+      hv_0(:,:) = 0._wp                        ! Reference ocean depth at V-points
       DO jk = 1, jpk
          ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
@@ -97,5 +98,5 @@
       END DO
       !
-      IF( lk_vvl )           CALL dom_vvl_init ! Vertical variable mesh
+      IF( lk_vvl         )   CALL dom_vvl_init ! Vertical variable mesh
       !
       IF( lk_c1d         )   CALL cor_c1d      ! 1D configuration: Coriolis set at T-point
@@ -131,5 +132,4 @@
       !! ** input   : - namrun namelist
       !!              - namdom namelist
-      !!              - namcla namelist
       !!              - namnc4 namelist   ! "key_netcdf4" only
       !!----------------------------------------------------------------------
@@ -146,5 +146,4 @@
          &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
          &             ppa2, ppkth2, ppacr2
-      NAMELIST/namcla/ nn_cla
 #if defined key_netcdf4
       NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
@@ -155,9 +154,9 @@
       REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
       READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
 
       REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namrun )
       !
@@ -251,5 +250,5 @@
 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namdom )
-
+      !
       IF(lwp) THEN
          WRITE(numout,*)
@@ -293,5 +292,5 @@
          WRITE(numout,*) '                                      ppacr2            = ', ppacr2
       ENDIF
-
+      !
       ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
       e3zps_min = rn_e3zps_min
@@ -304,26 +303,4 @@
       rdtmax    = rn_rdtmin
       rdth      = rn_rdth
-
-      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection
-      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
-905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection
-      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
-906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
-      IF(lwm) WRITE( numond, namcla )
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namcla'
-         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
-      ENDIF
-      IF ( nn_cla .EQ. 1 ) THEN
-         IF  ( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2 
-            CONTINUE
-         ELSE
-            CALL ctl_stop( 'STOP', 'Cross land advation iplemented only for ORCA2 configuration: cp_cfg = "orca" and jp_cfg = 2 ' )
-         ENDIF
-      ENDIF
 
 #if defined key_netcdf4
@@ -409,4 +386,5 @@
    END SUBROUTINE dom_ctl
 
+
    SUBROUTINE dom_stiff
       !!----------------------------------------------------------------------
@@ -427,8 +405,8 @@
       REAL(wp), DIMENSION(4) :: zr1
       !!----------------------------------------------------------------------
-      rx1(:,:) = 0.e0
-      zrxmax   = 0.e0
-      zr1(:)   = 0.e0
-      
+      rx1(:,:) = 0._wp
+      zrxmax   = 0._wp
+      zr1(:)   = 0._wp
+      !
       DO ji = 2, jpim1
          DO jj = 2, jpjm1
@@ -455,11 +433,10 @@
          END DO
       END DO
-
       CALL lbc_lnk( rx1, 'T', 1. )
-
-      zrxmax = MAXVAL(rx1)
-
+      !
+      zrxmax = MAXVAL( rx1 )
+      !
       IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain
-
+      !
       IF(lwp) THEN
          WRITE(numout,*)
@@ -467,8 +444,6 @@
          WRITE(numout,*) '~~~~~~~~~'
       ENDIF
-
+      !
    END SUBROUTINE dom_stiff
-
-
 
    !!======================================================================
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 5901)
@@ -14,5 +14,6 @@
    !!                            use of parameters in par_CONFIG-Rxx.h90, not in namelist
    !!             -   ! 2004-05  (A. Koch-Larrouy) Add Gyre configuration 
-   !!            4.0  ! 2011-02  (G. Madec) add cell surface (e1e2t)
+   !!            3.7  ! 2015-09  (G. Madec, S. Flavoni) add cell surface and their inverse
+   !!                                       add optional read of e1e2u & e1e2v
    !!----------------------------------------------------------------------
 
@@ -23,4 +24,6 @@
    USE dom_oce        ! ocean space and time domain
    USE phycst         ! physical constants
+   USE domwri         ! write 'meshmask.nc' & 'coordinate_e1e2u_v.nc' files
+   !
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
@@ -35,5 +38,5 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -106,5 +109,5 @@
       REAL(wp) ::   zphi1, zsin_alpha, zim05, zjm05
       INTEGER  ::   isrow                ! index for ORCA1 starting row
-
+      INTEGER  ::   ie1e2u_v             ! fag for u- & v-surface read in coordinate file or not
       !!----------------------------------------------------------------------
       !
@@ -122,167 +125,35 @@
          WRITE(numout,*) '             meridional grid-spacing (meters)  ppe2_m   = ', ppe2_m  
       ENDIF
-
-
-      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
-
-      CASE ( 0 )                     !  curvilinear coordinate on the sphere read in coordinate.nc file
-
+      !
+      !
+      SELECT CASE( jphgr_msh )   !  type of horizontal mesh  
+      !
+      CASE ( 0 )                     !==  read in coordinate.nc file  ==!
+         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file'
-
-         CALL hgr_read           ! Defaultl option  :   NetCDF file
-
-         !                                                ! =====================
-         IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
-            !                                             ! =====================
-            IF( nn_cla == 0 ) THEN
-               !
-               ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u = 20 km)
-               ij0 = 102   ;   ij1 = 102   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
-               IF(lwp) WRITE(numout,*)
-               IF(lwp) WRITE(numout,*) '             orca_r2: Gibraltar    : e2u reduced to 20 km'
-               !
-               ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u = 18 km)
-               ij0 =  88   ;   ij1 =  88   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  18.e3
-                                               e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  30.e3
-               IF(lwp) WRITE(numout,*)
-               IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb: e2u reduced to 30 km'
-               IF(lwp) WRITE(numout,*) '                                     e1v reduced to 18 km'
-            ENDIF
-
-            ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u = 10 km)
-            ij0 = 116   ;   ij1 = 116   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r2: Danish Straits : e2u reduced to 10 km'
-            !
+         !
+         ie1e2u_v = 0                  ! set to unread e1e2u and e1e2v
+         !
+         CALL hgr_read( ie1e2u_v )     ! read the coordinate.nc file
+         !
+         IF( ie1e2u_v == 0 ) THEN      ! e1e2u and e1e2v have not been read: compute them
+            !                          ! e2u and e1v does not include a reduction in some strait: apply reduction
+            e1e2u (:,:) = e1u(:,:) * e2u(:,:)   
+            e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
          ENDIF
-
-            !                                             ! =====================
-         IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration
-            !                                             ! =====================
-            ! This dirty section will be suppressed by simplification process: all this will come back in input files
-            ! Currently these hard-wired indices relate to configuration with
-            ! extend grid (jpjglo=332)
-            ! which had a grid-size of 362x292.
-            ! 
-            isrow = 332 - jpjglo
-            !
-            ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u = 20 km)
-            ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r1: Gibraltar : e2u reduced to 20 km'
-
-            ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u = 10 km)
-            ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r1: Bhosporus : e2u reduced to 10 km'
-
-            ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v = 13 km)
-            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  13.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r1: Lombok : e1v reduced to 10 km'
-
-            ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
-            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  8.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r1: Sumba : e1v reduced to 8 km'
-
-            ii0 =  53           ;   ii1 =  53        ! Ombai Strait (e1v = 13 km)
-            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r1: Ombai : e1v reduced to 13 km'
-
-            ii0 =  56           ;   ii1 =  56        ! Timor Passage (e1v = 20 km)
-            ij0 = 164 - isrow   ;   ij1 = 145 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r1: Timor Passage : e1v reduced to 20 km'
-
-            ii0 =  55           ;   ii1 =  55        ! West Halmahera Strait (e1v = 30 km)
-            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r1: W Halmahera : e1v reduced to 30 km'
-
-            ii0 =  58           ;   ii1 =  58        ! East Halmahera Strait (e1v = 50 km)
-            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r1: E Halmahera : e1v reduced to 50 km'
-            !
-            !
-         ENDIF
-
-         !                                                ! ======================
-         IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration
-            !                                             ! ======================
-            ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u = 20 km)
-            ij0 = 327   ;   ij1 = 327   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Gibraltar Strait'
-            !
-            ii0 = 627   ;   ii1 = 628        ! Bosphore Strait (e2u = 10 km)
-            ij0 = 343   ;   ij1 = 343   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Bosphore Strait'
-            !
-            ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u = 40 km)
-            ij0 = 232   ;   ij1 = 232   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  40.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Sumba Strait'
-            !
-            ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u = 15 km)
-            ij0 = 232   ;   ij1 = 232   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  15.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Ombai Strait'
-            !
-            ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u = 10 km)
-            ij0 = 270   ;   ij1 = 270   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Palk Strait'
-            !
-            ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v = 10 km)
-            ij0 = 232   ;   ij1 = 233   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e1v at the Lombok Strait'
-            !
-            !
-            ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v = 25 km)
-            ij0 = 276   ;   ij1 = 276   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  25.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e1v at the Bab el Mandeb'
-            !
-         ENDIF
-
-
-         ! N.B. :  General case, lat and long function of both i and j indices:
-         !     e1t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdila( zti, ztj ) )**2   &
-         !                                  + (                           fsdiph( zti, ztj ) )**2  )
-         !     e1u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdila( zui, zuj ) )**2   &
-         !                                  + (                           fsdiph( zui, zuj ) )**2  )
-         !     e1v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdila( zvi, zvj ) )**2   &
-         !                                  + (                           fsdiph( zvi, zvj ) )**2  )
-         !     e1f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdila( zfi, zfj ) )**2   &
-         !                                  + (                           fsdiph( zfi, zfj ) )**2  )
-         !
-         !     e2t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdjla( zti, ztj ) )**2   &
-         !                                  + (                           fsdjph( zti, ztj ) )**2  )
-         !     e2u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdjla( zui, zuj ) )**2   &
-         !                                  + (                           fsdjph( zui, zuj ) )**2  )
-         !     e2v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdjla( zvi, zvj ) )**2   &
-         !                                  + (                           fsdjph( zvi, zvj ) )**2  )
-         !     e2f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdjla( zfi, zfj ) )**2   &
-         !                                  + (                           fsdjph( zfi, zfj ) )**2  )
-
-
-      CASE ( 1 )                     ! geographical mesh on the sphere with regular grid-spacing
-
+         !
+      CASE ( 1 )                     !==  geographical mesh on the sphere with regular (in degree) grid-spacing  ==!
+         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing'
          IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg' 
-
+         !
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - 1 + njmpp - 1 )
-               zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - 1 + njmpp - 1 )
-               zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5
-               zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5
+               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - 1 + njmpp - 1 )
+               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - 1 + njmpp - 1 )
+               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - 1 + njmpp - 1 ) + 0.5
+               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - 1 + njmpp - 1 ) + 0.5
          ! Longitude
                glamt(ji,jj) = ppglam0 + ppe1_deg * zti
@@ -307,17 +178,16 @@
             END DO
          END DO
-
-
-      CASE ( 2:3 )                   ! f- or beta-plane with regular grid-spacing
-
+         !
+      CASE ( 2:3 )                   !==  f- or beta-plane with regular grid-spacing  ==!
+         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          f- or beta-plane with regular grid-spacing'
          IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m' 
-
+         !
          ! Position coordinates (in kilometers)
          !                          ==========
-         glam0 = 0.e0
+         glam0 = 0._wp
          gphi0 = - ppe2_m * 1.e-3
-         
+         !
 #if defined key_agrif 
          IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only
@@ -332,16 +202,16 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 )       )
-               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 ) + 0.5 )
+               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 )       )
+               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) + 0.5 )
                glamv(ji,jj) = glamt(ji,jj)
                glamf(ji,jj) = glamu(ji,jj)
-   
-               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 )       )
+               !
+               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 )       )
                gphiu(ji,jj) = gphit(ji,jj)
-               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 ) + 0.5 )
+               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) + 0.5 )
                gphif(ji,jj) = gphiv(ji,jj)
             END DO
          END DO
-
+         !
          ! Horizontal scale factors (in meters)
          !                              ======
@@ -350,12 +220,12 @@
          e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m
          e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m
-
-      CASE ( 4 )                     ! geographical mesh on the sphere, isotropic MERCATOR type
-
+         !
+      CASE ( 4 )                     !==  geographical mesh on the sphere, isotropic MERCATOR type  ==!
+         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type'
          IF(lwp) WRITE(numout,*) '          longitudinal/latitudinal spacing given by ppe1_deg'
          IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' )
-
+         !
          !  Find index corresponding to the equator, given the grid spacing e1_deg
          !  and the (approximate) southern latitude ppgphi0.
@@ -365,13 +235,13 @@
          ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg )
          IF(  ppgphi0 > 0 )  ijeq = -ijeq
-
+         !
          IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', ijeq
-
+         !
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - ijeq + njmpp - 1 )
-               zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - ijeq + njmpp - 1 )
-               zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5
-               zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5
+               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - ijeq + njmpp - 1 )
+               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - ijeq + njmpp - 1 )
+               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - ijeq + njmpp - 1 ) + 0.5
+               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - ijeq + njmpp - 1 ) + 0.5
          ! Longitude
                glamt(ji,jj) = ppglam0 + ppe1_deg * zti
@@ -396,53 +266,53 @@
             END DO
          END DO
-
-      CASE ( 5 )                   ! beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
-
+         !
+      CASE ( 5 )                   !==  beta-plane with regular grid-spacing and rotated domain ==! (GYRE configuration)
+         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          beta-plane with regular grid-spacing and rotated domain (GYRE configuration)'
          IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m'
-
+         !
          ! Position coordinates (in kilometers)
          !                          ==========
-
+         !
          ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN
-         zlam1 = -85
-         zphi1 = 29
+         zlam1 = -85._wp
+         zphi1 =  29._wp
          ! resolution in meters
-         ze1 = 106000. / FLOAT(jp_cfg)            
+         ze1 = 106000. / REAL( jp_cfg , wp )            
          ! benchmark: forced the resolution to be about 100 km
-         IF( nbench /= 0 )   ze1 = 106000.e0     
-         zsin_alpha = - SQRT( 2. ) / 2.
-         zcos_alpha =   SQRT( 2. ) / 2.
+         IF( nbench /= 0 )   ze1 = 106000._wp     
+         zsin_alpha = - SQRT( 2._wp ) * 0.5_wp
+         zcos_alpha =   SQRT( 2._wp ) * 0.5_wp
          ze1deg = ze1 / (ra * rad)
-         IF( nbench /= 0 )   ze1deg = ze1deg / FLOAT(jp_cfg)        ! benchmark: keep the lat/+lon
-         !                                                          ! at the right jp_cfg resolution
-         glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjglo-2 )
-         gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjglo-2 )
-
+         IF( nbench /= 0 )   ze1deg = ze1deg / REAL( jp_cfg , wp )   ! benchmark: keep the lat/+lon
+         !                                                           ! at the right jp_cfg resolution
+         glam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp )
+         gphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp )
+         !
          IF( nprint==1 .AND. lwp )   THEN
             WRITE(numout,*) '          ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha
             WRITE(numout,*) '          ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0
          ENDIF
-
+         !
          DO jj = 1, jpj
-           DO ji = 1, jpi
-             zim1 = FLOAT( ji + nimpp - 1 ) - 1.   ;   zim05 = FLOAT( ji + nimpp - 1 ) - 1.5
-             zjm1 = FLOAT( jj + njmpp - 1 ) - 1.   ;   zjm05 = FLOAT( jj + njmpp - 1 ) - 1.5
-
-             glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
-             gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
-
-             glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
-             gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
-
-             glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
-             gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
-
-             glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
-             gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
-           END DO
-          END DO
-
+            DO ji = 1, jpi
+               zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5
+               zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5
+               !
+               glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+               gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+               !
+               glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+               gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+               !
+               glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+               gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+               !
+               glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+               gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+            END DO
+         END DO
+         !
          ! Horizontal scale factors (in meters)
          !                              ======
@@ -451,40 +321,32 @@
          e1v(:,:) =  ze1     ;      e2v(:,:) = ze1
          e1f(:,:) =  ze1     ;      e2f(:,:) = ze1
-
+         !
       CASE DEFAULT
          WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh
          CALL ctl_stop( ctmp1 )
-
+         !
       END SELECT
       
-      ! T-cell surface
-      ! --------------
-      e1e2t(:,:) = e1t(:,:) * e2t(:,:)
-    
-      ! Useful shortcuts (JC: note the duplicated e2e2t array ! Need some cleaning)
-      ! ---------------------------------------------------------------------------
-      e12t    (:,:) = e1t(:,:) * e2t(:,:)
-      e12u    (:,:) = e1u(:,:) * e2u(:,:)
-      e12v    (:,:) = e1v(:,:) * e2v(:,:)
-      e12f    (:,:) = e1f(:,:) * e2f(:,:)
-      r1_e12t (:,:) = 1._wp    / e12t(:,:)
-      r1_e12u (:,:) = 1._wp    / e12u(:,:)
-      r1_e12v (:,:) = 1._wp    / e12v(:,:)
-      r1_e12f (:,:) = 1._wp    / e12f(:,:)
-      re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)
-      re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)
-      r1_e1t  (:,:) = 1._wp    / e1t(:,:)
-      r1_e1u  (:,:) = 1._wp    / e1u(:,:)
-      r1_e1v  (:,:) = 1._wp    / e1v(:,:)
-      r1_e1f  (:,:) = 1._wp    / e1f(:,:)
-      r1_e2t  (:,:) = 1._wp    / e2t(:,:)
-      r1_e2u  (:,:) = 1._wp    / e2u(:,:)
-      r1_e2v  (:,:) = 1._wp    / e2v(:,:)
-      r1_e2f  (:,:) = 1._wp    / e2f(:,:)
-
-      ! Control printing : Grid informations (if not restart)
-      ! ----------------
-
-      IF( lwp .AND. .NOT.ln_rstart ) THEN
+      ! associated horizontal metrics
+      ! -----------------------------
+      !
+      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:)
+      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:)
+      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:)
+      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:)
+      !
+      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:)
+      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:)
+      IF( jphgr_msh /= 0 ) THEN               ! e1e2u and e1e2v have not been set: compute them
+         e1e2u (:,:) = e1u(:,:) * e2u(:,:)   
+         e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
+      ENDIF
+      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in both cases
+      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:)
+      !   
+      e2_e1u(:,:) = e2u(:,:) / e1u(:,:)
+      e1_e2v(:,:) = e1v(:,:) / e2v(:,:)
+
+      IF( lwp .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart)
          WRITE(numout,*)
          WRITE(numout,*) '          longitude and e1 scale factors'
@@ -496,5 +358,5 @@
 9300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
             f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 )
-         
+            !
          WRITE(numout,*)
          WRITE(numout,*) '          latitude and e2 scale factors'
@@ -506,17 +368,4 @@
       ENDIF
 
-      
-      IF( nprint == 1 .AND. lwp ) THEN
-         WRITE(numout,*) '          e1u e2u '
-         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         WRITE(numout,*) '          e1v e2v  '
-         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         WRITE(numout,*) '          e1f e2f  '
-         CALL prihre( e1f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         CALL prihre( e2f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-      ENDIF
-
 
       ! ================= !
@@ -525,31 +374,31 @@
 
       SELECT CASE( jphgr_msh )   ! type of horizontal mesh
-
+      !
       CASE ( 0, 1, 4 )               ! mesh on the sphere
-
+         !
          ff(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 
-
+         !
       CASE ( 2 )                     ! f-plane at ppgphi0 
-
+         !
          ff(:,:) = 2. * omega * SIN( rad * ppgphi0 )
-
+         !
          IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1)
-
+         !
       CASE ( 3 )                     ! beta-plane
-
+         !
          zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                       ! beta at latitude ppgphi0
-         zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points
-         
+         zphi0   = ppgphi0 - REAL( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points
+         !
 #if defined key_agrif
          IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only
             IF( .NOT. Agrif_Root() ) THEN
-              zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad)
+              zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad)
             ENDIF
          ENDIF
 #endif         
          zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south
-
+         !
          ff(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south)
-         
+         !
          IF(lwp) THEN
             WRITE(numout,*) 
@@ -564,13 +413,13 @@
             IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff
          END IF
-
+         !
       CASE ( 5 )                     ! beta-plane and rotated domain (gyre configuration)
-
+         !
          zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
-         zphi0 = 15.e0                                                      ! latitude of the first row F-points
+         zphi0 = 15._wp                                                     ! latitude of the first row F-points
          zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
-
+         !
          ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
-
+         !
          IF(lwp) THEN
             WRITE(numout,*) 
@@ -578,5 +427,5 @@
             WRITE(numout,*) '          Coriolis parameter varies in this processor from ', ff(nldi,nldj),' to ', ff(nldi,nlej)
          ENDIF
-
+         !
          IF( lk_mpp ) THEN 
             zminff=ff(nldi,nldj)
@@ -586,5 +435,5 @@
             IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff
          END IF
-
+         !
       END SELECT
 
@@ -595,5 +444,5 @@
 
       IF( nperio == 2 ) THEN
-         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / FLOAT( jpi )
+         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi )
          IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' )
       ENDIF
@@ -604,19 +453,18 @@
 
 
-   SUBROUTINE hgr_read
+   SUBROUTINE hgr_read( ke1e2u_v )
       !!---------------------------------------------------------------------
       !!              ***  ROUTINE hgr_read  ***
       !!
-      !! ** Purpose :   Read a coordinate file in NetCDF format 
-      !!
-      !! ** Method  :   The mesh file has been defined trough a analytical 
-      !!      or semi-analytical method. It is read in a NetCDF file. 
-      !!     
+      !! ** Purpose :   Read a coordinate file in NetCDF format using IOM
+      !!
       !!----------------------------------------------------------------------
       USE iom
-
+      !!
+      INTEGER, INTENT( inout ) ::   ke1e2u_v   ! fag: e1e2u & e1e2v read in coordinate file (=1) or not (=0)
+      !
       INTEGER ::   inum   ! temporary logical unit
       !!----------------------------------------------------------------------
-
+      !
       IF(lwp) THEN
          WRITE(numout,*)
@@ -624,29 +472,40 @@
          WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk
       ENDIF
-      
+      !
       CALL iom_open( 'coordinates', inum )
-      
+      !
       CALL iom_get( inum, jpdom_data, 'glamt', glamt, lrowattr=ln_use_jattr )
       CALL iom_get( inum, jpdom_data, 'glamu', glamu, lrowattr=ln_use_jattr )
       CALL iom_get( inum, jpdom_data, 'glamv', glamv, lrowattr=ln_use_jattr )
       CALL iom_get( inum, jpdom_data, 'glamf', glamf, lrowattr=ln_use_jattr )
-      
+      !
       CALL iom_get( inum, jpdom_data, 'gphit', gphit, lrowattr=ln_use_jattr )
       CALL iom_get( inum, jpdom_data, 'gphiu', gphiu, lrowattr=ln_use_jattr )
       CALL iom_get( inum, jpdom_data, 'gphiv', gphiv, lrowattr=ln_use_jattr )
       CALL iom_get( inum, jpdom_data, 'gphif', gphif, lrowattr=ln_use_jattr )
-      
-      CALL iom_get( inum, jpdom_data, 'e1t', e1t, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e1u', e1u, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e1v', e1v, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e1f', e1f, lrowattr=ln_use_jattr )
-      
-      CALL iom_get( inum, jpdom_data, 'e2t', e2t, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e2u', e2u, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e2v', e2v, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e2f', e2f, lrowattr=ln_use_jattr )
-      
+      !
+      CALL iom_get( inum, jpdom_data, 'e1t'  , e1t  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1u'  , e1u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1v'  , e1v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1f'  , e1f  , lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'e2t'  , e2t  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2u'  , e2u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2v'  , e2v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2f'  , e2f  , lrowattr=ln_use_jattr )
+      !
+      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN
+         IF(lwp) WRITE(numout,*) 'hgr_read : e1e2u & e1e2v read in coordinates file'
+         CALL iom_get( inum, jpdom_data, 'e1e2u'  , e1e2u  , lrowattr=ln_use_jattr )
+         CALL iom_get( inum, jpdom_data, 'e1e2v'  , e1e2v  , lrowattr=ln_use_jattr )
+         ke1e2u_v = 1
+      ELSE
+         ke1e2u_v = 0
+      ENDIF
+      !
       CALL iom_close( inum )
       
+!!gm   THIS is TO BE REMOVED !!!!!!!
+
 ! need to be define for the extended grid south of -80S
 ! some point are undefined but you need to have e1 and e2 .NE. 0
@@ -675,4 +534,5 @@
          e2f=1.0e2
       END WHERE
+!!gm end
        
     END SUBROUTINE hgr_read
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 5901)
@@ -17,9 +17,9 @@
    !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
    !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   dom_msk        : compute land/ocean mask
-   !!   dom_msk_nsa    : update land/ocean mask when no-slip accurate option is used.
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
@@ -36,5 +36,4 @@
 
    PUBLIC   dom_msk         ! routine called by inidom.F90
-   PUBLIC   dom_msk_alloc   ! routine called by nemogcm.F90
 
    !                            !!* Namelist namlbc : lateral boundary condition *
@@ -42,7 +41,4 @@
    LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition 
    !                                            with analytical eqs.
-
-
-   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  icoord ! Workspace for dom_msk_nsa()
 
    !! * Substitutions
@@ -54,17 +50,4 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   
-   INTEGER FUNCTION dom_msk_alloc()
-      !!---------------------------------------------------------------------
-      !!                 ***  FUNCTION dom_msk_alloc  ***
-      !!---------------------------------------------------------------------
-      dom_msk_alloc = 0
-#if defined key_noslip_accurate
-      ALLOCATE(icoord(jpi*jpj*jpk,3), STAT=dom_msk_alloc)
-#endif
-      IF( dom_msk_alloc /= 0 )   CALL ctl_warn('dom_msk_alloc: failed to allocate icoord array')
-      !
-   END FUNCTION dom_msk_alloc
-
 
    SUBROUTINE dom_msk
@@ -129,6 +112,5 @@
       !!               tmask_i  : interior ocean mask
       !!----------------------------------------------------------------------
-      !
-      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+      INTEGER  ::   ji, jj, jk               ! dummy loop indices
       INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers
       INTEGER  ::   ijf, ijl, ij0, ij1       !   -       -
@@ -199,24 +181,4 @@
       END DO  
 
-!!gm  ????
-#if defined key_zdfkpp
-      IF( cp_cfg == 'orca' ) THEN
-         IF( jp_cfg == 2 )   THEN       ! land point on Bab el Mandeb zonal section
-            ij0 =  87   ;   ij1 =  88
-            ii0 = 160   ;   ii1 = 161
-            tmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0._wp
-         ELSE
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,cform_war)
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*)'          A mask must be applied on Bab el Mandeb strait'
-            IF(lwp) WRITE(numout,*)'          in case of ORCAs configurations'
-            IF(lwp) WRITE(numout,*)'          This is a problem which is not yet solved'
-            IF(lwp) WRITE(numout,*)
-         ENDIF
-      ENDIF
-#endif
-!!gm end
-
       ! Interior domain mask (used for global sum)
       ! --------------------
@@ -284,11 +246,11 @@
       ! 3. Ocean/land mask at wu-, wv- and w points 
       !----------------------------------------------
-      wmask (:,:,1) = tmask(:,:,1) ! ????????
-      wumask(:,:,1) = umask(:,:,1) ! ????????
-      wvmask(:,:,1) = vmask(:,:,1) ! ????????
-      DO jk=2,jpk
-         wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1)
-         wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1)   
-         wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1)
+      wmask (:,:,1) = tmask(:,:,1)     ! surface
+      wumask(:,:,1) = umask(:,:,1)
+      wvmask(:,:,1) = vmask(:,:,1)
+      DO jk = 2, jpk                   ! interior values
+         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
+         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)   
+         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
       END DO
 
@@ -339,10 +301,4 @@
       ENDIF
 
-
-      ! mask for second order calculation of vorticity
-      ! ----------------------------------------------
-      CALL dom_msk_nsa
-
-      
       ! Lateral boundary conditions on velocity (modify fmask)
       ! ---------------------------------------     
@@ -377,18 +333,16 @@
       IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA_R2 configuration
          !                                                 ! Increased lateral friction near of some straits
-         IF( nn_cla == 0 ) THEN
-            !                                ! Gibraltar strait  : partial slip (fmask=0.5)
-            ij0 = 101   ;   ij1 = 101
-            ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
-            ij0 = 102   ;   ij1 = 102
-            ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
-            !
-            !                                ! Bab el Mandeb : partial slip (fmask=1)
-            ij0 =  87   ;   ij1 =  88
-            ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
-            ij0 =  88   ;   ij1 =  88
-            ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
-            !
-         ENDIF
+         !                                ! Gibraltar strait  : partial slip (fmask=0.5)
+         ij0 = 101   ;   ij1 = 101
+         ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
+         ij0 = 102   ;   ij1 = 102
+         ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
+         !
+         !                                ! Bab el Mandeb : partial slip (fmask=1)
+         ij0 =  87   ;   ij1 =  88
+         ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
+         ij0 =  88   ;   ij1 =  88
+         ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
+         !
          !                                ! Danish straits  : strong slip (fmask > 2)
 ! We keep this as an example but it is instable in this case 
@@ -500,197 +454,4 @@
       !
    END SUBROUTINE dom_msk
-
-#if defined key_noslip_accurate
-   !!----------------------------------------------------------------------
-   !!   'key_noslip_accurate' :         accurate no-slip boundary condition
-   !!----------------------------------------------------------------------
-   
-   SUBROUTINE dom_msk_nsa
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE dom_msk_nsa  ***
-      !! 
-      !! ** Purpose :
-      !!
-      !! ** Method  :
-      !!
-      !! ** Action :
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk, jl      ! dummy loop indices
-      INTEGER  ::   ine, inw, ins, inn, itest, ierror, iind, ijnd
-      REAL(wp) ::   zaa
-      !!---------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_msk_nsa')
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   using Schchepetkin and O Brian scheme'
-      IF( lk_mpp )   CALL ctl_stop( ' mpp version is not yet implemented' )
-
-      ! mask for second order calculation of vorticity
-      ! ----------------------------------------------
-      ! noslip boundary condition: fmask=1  at convex corner, store
-      ! index of straight coast meshes ( 'west', refering to a coast,
-      ! means west of the ocean, aso)
-      
-      DO jk = 1, jpk
-         DO jl = 1, 4
-            npcoa(jl,jk) = 0
-            DO ji = 1, 2*(jpi+jpj)
-               nicoa(ji,jl,jk) = 0
-               njcoa(ji,jl,jk) = 0
-            END DO
-         END DO
-      END DO
-      
-      IF( jperio == 2 ) THEN
-         WRITE(numout,*) ' '
-         WRITE(numout,*) ' symetric boundary conditions need special'
-         WRITE(numout,*) ' treatment not implemented. we stop.'
-         STOP
-      ENDIF
-      
-      ! convex corners
-      
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zaa = tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
-                  &+ tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk)
-               IF( ABS(zaa-3._wp) <= 0.1_wp )   fmask(ji,jj,jk) = 1._wp
-            END DO
-         END DO
-      END DO
-
-      ! north-south straight coast
-
-      DO jk = 1, jpkm1
-         inw = 0
-         ine = 0
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               zaa = tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk)
-               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
-                  inw = inw + 1
-                  nicoa(inw,1,jk) = ji
-                  njcoa(inw,1,jk) = jj
-                  IF( nprint == 1 ) WRITE(numout,*) ' west  : ', jk, inw, ji, jj
-               ENDIF
-               zaa = tmask(ji,jj,jk) + tmask(ji,jj+1,jk)
-               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
-                  ine = ine + 1
-                  nicoa(ine,2,jk) = ji
-                  njcoa(ine,2,jk) = jj
-                  IF( nprint == 1 ) WRITE(numout,*) ' east  : ', jk, ine, ji, jj
-               ENDIF
-            END DO
-         END DO
-         npcoa(1,jk) = inw
-         npcoa(2,jk) = ine
-      END DO
-
-      ! west-east straight coast
-
-      DO jk = 1, jpkm1
-         ins = 0
-         inn = 0
-         DO jj = 2, jpjm1
-            DO ji =2, jpim1
-               zaa = tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)
-               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
-                  ins = ins + 1
-                  nicoa(ins,3,jk) = ji
-                  njcoa(ins,3,jk) = jj
-                  IF( nprint == 1 ) WRITE(numout,*) ' south : ', jk, ins, ji, jj
-               ENDIF
-               zaa = tmask(ji+1,jj,jk) + tmask(ji,jj,jk)
-               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
-                  inn = inn + 1
-                  nicoa(inn,4,jk) = ji
-                  njcoa(inn,4,jk) = jj
-                  IF( nprint == 1 ) WRITE(numout,*) ' north : ', jk, inn, ji, jj
-               ENDIF
-            END DO
-         END DO
-         npcoa(3,jk) = ins
-         npcoa(4,jk) = inn
-      END DO
-
-      itest = 2 * ( jpi + jpj )
-      DO jk = 1, jpk
-         IF( npcoa(1,jk) > itest .OR. npcoa(2,jk) > itest .OR.   &
-             npcoa(3,jk) > itest .OR. npcoa(4,jk) > itest ) THEN
-            
-            WRITE(ctmp1,*) ' level jk = ',jk
-            WRITE(ctmp2,*) ' straight coast index arraies are too small.:'
-            WRITE(ctmp3,*) ' npe, npw, nps, npn = ', npcoa(1,jk), npcoa(2,jk),   &
-                &                                     npcoa(3,jk), npcoa(4,jk)
-            WRITE(ctmp4,*) ' 2*(jpi+jpj) = ',itest,'. we stop.'
-            CALL ctl_stop( ctmp1, ctmp2, ctmp3, ctmp4 )
-        ENDIF
-      END DO
-
-      ierror = 0
-      iind = 0
-      ijnd = 0
-      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 )   iind = 2
-      IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 )   ijnd = 2
-      DO jk = 1, jpk
-         DO jl = 1, npcoa(1,jk)
-            IF( nicoa(jl,1,jk)+3 > jpi+iind ) THEN
-               ierror = ierror+1
-               icoord(ierror,1) = nicoa(jl,1,jk)
-               icoord(ierror,2) = njcoa(jl,1,jk)
-               icoord(ierror,3) = jk
-            ENDIF
-         END DO
-         DO jl = 1, npcoa(2,jk)
-            IF(nicoa(jl,2,jk)-2 < 1-iind ) THEN
-               ierror = ierror + 1
-               icoord(ierror,1) = nicoa(jl,2,jk)
-               icoord(ierror,2) = njcoa(jl,2,jk)
-               icoord(ierror,3) = jk
-            ENDIF
-         END DO
-         DO jl = 1, npcoa(3,jk)
-            IF( njcoa(jl,3,jk)+3 > jpj+ijnd ) THEN
-               ierror = ierror + 1
-               icoord(ierror,1) = nicoa(jl,3,jk)
-               icoord(ierror,2) = njcoa(jl,3,jk)
-               icoord(ierror,3) = jk
-            ENDIF
-         END DO
-         DO jl = 1, npcoa(4,jk)
-            IF( njcoa(jl,4,jk)-2 < 1) THEN
-               ierror=ierror + 1
-               icoord(ierror,1) = nicoa(jl,4,jk)
-               icoord(ierror,2) = njcoa(jl,4,jk)
-               icoord(ierror,3) = jk
-            ENDIF
-         END DO
-      END DO
-      
-      IF( ierror > 0 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '              Problem on lateral conditions'
-         IF(lwp) WRITE(numout,*) '                 Bad marking off at points:'
-         DO jl = 1, ierror
-            IF(lwp) WRITE(numout,*) 'Level:',icoord(jl,3),   &
-               &                  '  Point(',icoord(jl,1),',',icoord(jl,2),')'
-         END DO
-         CALL ctl_stop( 'We stop...' )
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_msk_nsa')
-      !
-   END SUBROUTINE dom_msk_nsa
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :                                      Empty routine
-   !!----------------------------------------------------------------------
-   SUBROUTINE dom_msk_nsa       
-   END SUBROUTINE dom_msk_nsa
-#endif
    
    !!======================================================================
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90	(revision 5901)
@@ -37,5 +37,4 @@
       !!                -> not good if located at too high latitude...
       !!----------------------------------------------------------------------
-      !
       REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
       INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
@@ -49,5 +48,5 @@
       IF( nn_timing == 1 )  CALL timing_start('dom_ngb')
       !
-      CALL wrk_alloc( jpi, jpj, zglam, zgphi, zmask, zdist )
+      CALL wrk_alloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
       !
       zmask(:,:) = 0._wp
@@ -76,5 +75,5 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, zglam, zgphi, zmask, zdist )
+      CALL wrk_dealloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
       !
       IF( nn_timing == 1 )  CALL timing_stop('dom_ngb')
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 5901)
@@ -10,6 +10,5 @@
    !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
    !!----------------------------------------------------------------------
-   !!   'key_vvl'                              variable volume
-   !!----------------------------------------------------------------------
+
    !!----------------------------------------------------------------------
    !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness
@@ -19,8 +18,5 @@
    !!   dom_vvl_rst      : read/write restart file
    !!   dom_vvl_ctl      : Check the vvl options
-   !!   dom_vvl_orca_fix : Recompute some area-weighted interpolations of vertical scale factors 
-   !!                    : to account for manual changes to e[1,2][u,v] in some Straits 
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
@@ -37,32 +33,29 @@
    PRIVATE
 
-   !! * Routine accessibility
    PUBLIC  dom_vvl_init       ! called by domain.F90
    PUBLIC  dom_vvl_sf_nxt     ! called by step.F90
    PUBLIC  dom_vvl_sf_swp     ! called by step.F90
    PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90
-   PRIVATE dom_vvl_orca_fix   ! called by dom_vvl_interpol
-
-   !!* Namelist nam_vvl
-   LOGICAL , PUBLIC                                      :: ln_vvl_zstar = .FALSE.              ! zstar  vertical coordinate
-   LOGICAL , PUBLIC                                      :: ln_vvl_ztilde = .FALSE.             ! ztilde vertical coordinate
-   LOGICAL , PUBLIC                                      :: ln_vvl_layer = .FALSE.              ! level  vertical coordinate
-   LOGICAL , PUBLIC                                      :: ln_vvl_ztilde_as_zstar = .FALSE.    ! ztilde vertical coordinate
-   LOGICAL , PUBLIC                                      :: ln_vvl_zstar_at_eqtor = .FALSE.     ! ztilde vertical coordinate
-   LOGICAL , PUBLIC                                      :: ln_vvl_kepe = .FALSE.               ! kinetic/potential energy transfer
-   !                                                                                            ! conservation: not used yet
-   REAL(wp)                                              :: rn_ahe3                   ! thickness diffusion coefficient
-   REAL(wp)                                              :: rn_rst_e3t                ! ztilde to zstar restoration timescale [days]
-   REAL(wp)                                              :: rn_lf_cutoff              ! cutoff frequency for low-pass filter  [days]
-   REAL(wp)                                              :: rn_zdef_max               ! maximum fractional e3t deformation
-   LOGICAL , PUBLIC                                      :: ln_vvl_dbg = .FALSE.      ! debug control prints
-
-   !! * Module variables
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                       ! thickness diffusion transport
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf                            ! low frequency part of hz divergence
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n           ! baroclinic scale factors
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a          ! baroclinic scale factors
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t                        ! retoring period for scale factors
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                        ! retoring period for low freq. divergence
+
+   !                                                      !!* Namelist nam_vvl
+   LOGICAL , PUBLIC :: ln_vvl_zstar           = .FALSE.    ! zstar  vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_ztilde          = .FALSE.    ! ztilde vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_layer           = .FALSE.    ! level  vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar = .FALSE.    ! ztilde vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor  = .FALSE.    ! ztilde vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_kepe            = .FALSE.    ! kinetic/potential energy transfer
+   !                                                       ! conservation: not used yet
+   REAL(wp)         :: rn_ahe3                             ! thickness diffusion coefficient
+   REAL(wp)         :: rn_rst_e3t                          ! ztilde to zstar restoration timescale [days]
+   REAL(wp)         :: rn_lf_cutoff                        ! cutoff frequency for low-pass filter  [days]
+   REAL(wp)         :: rn_zdef_max                         ! maximum fractional e3t deformation
+   LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE.                ! debug control prints
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                ! thickness diffusion transport
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf                     ! low frequency part of hz divergence
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n    ! baroclinic scale factors
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a   ! baroclinic scale factors
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t                 ! retoring period for scale factors
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence
 
    !! * Substitutions
@@ -372,8 +365,8 @@
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * re2u_e1u(ji,jj) &
-                                  & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
-                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * re1v_e2v(ji,jj) & 
-                                  & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) )
+                  un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           &
+                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
+                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
+                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) )
                   zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk)
                   zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk)
@@ -394,5 +387,5 @@
                   tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    &
                      &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    &
-                     &                                            ) * r1_e12t(ji,jj)
+                     &                                            ) * r1_e1e2t(ji,jj)
                END DO
             END DO
@@ -695,99 +688,80 @@
       !!                - vertical interpolation: simple averaging
       !!----------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in    ) ::  pe3_in     ! input e3 to be interpolated
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::  pe3_out    ! output interpolated e3
-      CHARACTER(LEN=*), INTENT( in )                    ::  pout       ! grid point of out scale factors
-      !                                                                !   =  'U', 'V', 'W, 'F', 'UW' or 'VW'
-      !! * Local declarations
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::  pe3_in    ! input e3 to be interpolated
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  pe3_out   ! output interpolated e3
+      CHARACTER(LEN=*)                , INTENT(in   ) ::  pout      ! grid point of out scale factors
+      !                                                             !   =  'U', 'V', 'W, 'F', 'UW' or 'VW'
+      !
       INTEGER ::   ji, jj, jk                                          ! dummy loop indices
-      LOGICAL ::   l_is_orca                                           ! local logical
-      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      !
       IF( nn_timing == 1 )  CALL timing_start('dom_vvl_interpol')
-         !
-      l_is_orca = .FALSE.
-      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) l_is_orca = .TRUE.      ! ORCA R2 configuration - will need to correct some locations
-
-      SELECT CASE ( pout )
-         !               ! ------------------------------------- !
-      CASE( 'U' )        ! interpolation from T-point to U-point !
-         !               ! ------------------------------------- !
-         ! horizontal surface weighted interpolation
+      !
+      SELECT CASE ( pout )    !==  type of interpolation  ==!
+         !
+      CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean
          DO jk = 1, jpk
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e12u(ji,jj)                                   &
-                     &                       * (   e12t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
-                     &                           + e12t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
+                  pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e1e2u(ji,jj)                                   &
+                     &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
+                     &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
                END DO
             END DO
          END DO
-         !
-         IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout )
-         ! boundary conditions
          CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:)
-         !               ! ------------------------------------- !
-      CASE( 'V' )        ! interpolation from T-point to V-point !
-         !               ! ------------------------------------- !
-         ! horizontal surface weighted interpolation
+         !
+      CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean
          DO jk = 1, jpk
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e12v(ji,jj)                                   &
-                     &                       * (   e12t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
-                     &                           + e12t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
+                  pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e1e2v(ji,jj)                                   &
+                     &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
+                     &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
                END DO
             END DO
          END DO
-         !
-         IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout )
-         ! boundary conditions
          CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:)
-         !               ! ------------------------------------- !
-      CASE( 'F' )        ! interpolation from U-point to F-point !
-         !               ! ------------------------------------- !
-         ! horizontal surface weighted interpolation
+         !
+      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean
          DO jk = 1, jpk
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e12f(ji,jj)               &
-                     &                       * (   e12u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
-                     &                           + e12u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
+                  pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e1e2f(ji,jj)               &
+                     &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
+                     &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
                END DO
             END DO
          END DO
-         !
-         IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout )
-         ! boundary conditions
          CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:)
-         !               ! ------------------------------------- !
-      CASE( 'W' )        ! interpolation from T-point to W-point !
-         !               ! ------------------------------------- !
-         ! vertical simple interpolation
+         !
+      CASE( 'W' )                   !* from T- to W-point : vertical simple mean
+         !
          pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1)
-         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
+         ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing
+!!gm BUG? use here wmask in case of ISF ?  to be checked
          DO jk = 2, jpk
             pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )   &
                &                            +            0.5_wp * tmask(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) )
          END DO
-         !               ! -------------------------------------- !
-      CASE( 'UW' )       ! interpolation from U-point to UW-point !
-         !               ! -------------------------------------- !
-         ! vertical simple interpolation
+         !
+      CASE( 'UW' )                  !* from U- to UW-point : vertical simple mean
+         !
          pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1)
          ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
+!!gm BUG? use here wumask in case of ISF ?  to be checked
          DO jk = 2, jpk
             pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * umask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )   &
                &                             +            0.5_wp * umask(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) )
          END DO
-         !               ! -------------------------------------- !
-      CASE( 'VW' )       ! interpolation from V-point to VW-point !
-         !               ! -------------------------------------- !
-         ! vertical simple interpolation
+         !
+      CASE( 'VW' )                  !* from V- to VW-point : vertical simple mean
+         !
          pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1)
          ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
+!!gm BUG? use here wvmask in case of ISF ?  to be checked
          DO jk = 2, jpk
             pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * vmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )   &
@@ -796,8 +770,8 @@
       END SELECT
       !
-
       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_interpol')
-
+      !
    END SUBROUTINE dom_vvl_interpol
+
 
    SUBROUTINE dom_vvl_rst( kt, cdrw )
@@ -813,8 +787,7 @@
       !!                they are set to 0.
       !!----------------------------------------------------------------------
-      !! * Arguments
       INTEGER         , INTENT(in) ::   kt     ! ocean time-step
       CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
-      !! * Local declarations
+      !
       INTEGER ::   jk
       INTEGER ::   id1, id2, id3, id4, id5     ! local integers
@@ -911,5 +884,5 @@
             END IF
          ENDIF
-
+         !
       ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
          !                                   ! ===================
@@ -931,8 +904,9 @@
             CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) )
          ENDIF
-
-      ENDIF
+         !
+      ENDIF
+      !
       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_rst')
-
+      !
    END SUBROUTINE dom_vvl_rst
 
@@ -945,21 +919,20 @@
       !!                for vertical coordinate
       !!----------------------------------------------------------------------
-      INTEGER ::   ioptio
-      INTEGER ::   ios
-
+      INTEGER ::   ioptio, ios
+      !!
       NAMELIST/nam_vvl/ ln_vvl_zstar, ln_vvl_ztilde, ln_vvl_layer, ln_vvl_ztilde_as_zstar, &
-                      & ln_vvl_zstar_at_eqtor      , rn_ahe3     , rn_rst_e3t            , &
-                      & rn_lf_cutoff               , rn_zdef_max , ln_vvl_dbg                ! not yet implemented: ln_vvl_kepe
+         &              ln_vvl_zstar_at_eqtor      , rn_ahe3     , rn_rst_e3t            , &
+         &              rn_lf_cutoff               , rn_zdef_max , ln_vvl_dbg                ! not yet implemented: ln_vvl_kepe
       !!---------------------------------------------------------------------- 
-
+      !
       REWIND( numnam_ref )              ! Namelist nam_vvl in reference namelist : 
       READ  ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in reference namelist', lwp )
-
+      !
       REWIND( numnam_cfg )              ! Namelist nam_vvl in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, nam_vvl, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, nam_vvl )
-
+      !
       IF(lwp) THEN                    ! Namelist print
          WRITE(numout,*)
@@ -994,14 +967,14 @@
          WRITE(numout,*) '                                         ln_vvl_dbg     = ', ln_vvl_dbg
       ENDIF
-
+      !
       ioptio = 0                      ! Parameter control
-      IF( ln_vvl_ztilde_as_zstar ) ln_vvl_ztilde = .true.
-      IF( ln_vvl_zstar           )        ioptio = ioptio + 1
-      IF( ln_vvl_ztilde          )        ioptio = ioptio + 1
-      IF( ln_vvl_layer           )        ioptio = ioptio + 1
-
+      IF( ln_vvl_ztilde_as_zstar )   ln_vvl_ztilde = .true.
+      IF( ln_vvl_zstar           )   ioptio = ioptio + 1
+      IF( ln_vvl_ztilde          )   ioptio = ioptio + 1
+      IF( ln_vvl_layer           )   ioptio = ioptio + 1
+      !
       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' )
       IF( .NOT. ln_vvl_zstar .AND. nn_isf .NE. 0) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
-
+      !
       IF(lwp) THEN                   ! Print the choice
          WRITE(numout,*)
@@ -1014,400 +987,10 @@
          ! IF( .NOT. ln_vvl_kepe ) WRITE(numout,*) '              kinetic to potential energy transfer : option not used'
       ENDIF
-
+      !
 #if defined key_agrif
       IF (.NOT.Agrif_Root()) CALL ctl_stop( 'AGRIF not implemented with non-linear free surface (key_vvl)' )
 #endif
-
+      !
    END SUBROUTINE dom_vvl_ctl
-
-   SUBROUTINE dom_vvl_orca_fix( pe3_in, pe3_out, pout )
-      !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE dom_vvl_orca_fix  ***
-      !!                     
-      !! ** Purpose :   Correct surface weighted, horizontally interpolated, 
-      !!                scale factors at locations that have been individually
-      !!                modified in domhgr. Such modifications break the
-      !!                relationship between e12t and e1u*e2u etc.
-      !!                Recompute some scale factors ignoring the modified metric.
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in    ) ::  pe3_in     ! input e3 to be interpolated
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::  pe3_out    ! output interpolated e3
-      CHARACTER(LEN=*), INTENT( in )                    ::  pout       ! grid point of out scale factors
-      !                                                                !   =  'U', 'V', 'W, 'F', 'UW' or 'VW'
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk                                          ! dummy loop indices
-      INTEGER ::   ij0, ij1, ii0, ii1                                  ! dummy loop indices
-      INTEGER ::   isrow                                               ! index for ORCA1 starting row
-      !! acc
-      !! Hmm with the time splitting these "fixes" seem to do more harm than good. Temporarily disabled for
-      !! the ORCA2 tests (by changing jp_cfg test from 2 to 3) pending further investigations
-      !! 
-      !                                                ! =====================
-      IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN    ! ORCA R2 configuration
-         !                                             ! =====================
-      !! acc
-         IF( nn_cla == 0 ) THEN
-            !
-            ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u was modified)
-            ij0 = 102   ;   ij1 = 102
-            DO jk = 1, jpkm1
-               DO jj = mj0(ij0), mj1(ij1)
-                  DO ji = mi0(ii0), mi1(ii1)
-                     SELECT CASE ( pout )
-                     CASE( 'U' )
-                        pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                       &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                       &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                       &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                     CASE( 'F' )
-                        pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                       &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                       &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                       &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                     END SELECT
-                  END DO
-               END DO
-            END DO
-            !
-            ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u and e1v were modified)
-            ij0 =  88   ;   ij1 =  88
-            DO jk = 1, jpkm1
-               DO jj = mj0(ij0), mj1(ij1)
-                  DO ji = mi0(ii0), mi1(ii1)
-                     SELECT CASE ( pout )
-                     CASE( 'U' )
-                        pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                       &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                       &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                       &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                     CASE( 'V' )
-                        pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                       &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                       &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                       &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                     CASE( 'F' )
-                        pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                       &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                       &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                       &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                     END SELECT
-                  END DO
-               END DO
-            END DO
-         ENDIF
-
-         ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u was modified)
-         ij0 = 116   ;   ij1 = 116
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-      ENDIF
-      !
-         !                                             ! =====================
-      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration
-         !                                             ! =====================
-         ! This dirty section will be suppressed by simplification process:
-         ! all this will come back in input files
-         ! Currently these hard-wired indices relate to configuration with
-         ! extend grid (jpjglo=332)
-         ! which had a grid-size of 362x292.
-         isrow = 332 - jpjglo
-         !
-         ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u was modified)
-         ij0 = 241 - isrow   ;   ij1 = 241 - isrow
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u was modified)
-         ij0 = 248 - isrow   ;   ij1 = 248 - isrow
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &  
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &  
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v was modified)
-         ij0 = 164 - isrow   ;   ij1 = 165 - isrow
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on]
-         ij0 = 164 - isrow   ;   ij1 = 165 - isrow
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  53          ;   ii1 =  53        ! Ombai Strait (e1v was modified)
-         ij0 = 164 - isrow  ;   ij1 = 165  - isrow  
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  56            ;   ii1 =  56        ! Timor Passage (e1v was modified)
-         ij0 = 164 - isrow    ;   ij1 = 165  - isrow  
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  55            ;   ii1 =  55        ! West Halmahera Strait (e1v was modified)
-         ij0 = 181 - isrow    ;   ij1 = 182 - isrow  
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  58            ;   ii1 =  58        ! East Halmahera Strait (e1v was modified)
-         ij0 = 181 - isrow    ;   ij1 = 182 - isrow  
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-      ENDIF
-         !                                             ! =====================
-      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration
-         !                                             ! =====================
-         !
-         ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u was modified)
-         ij0 = 327   ;   ij1 = 327
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 = 627   ;   ii1 = 628        ! Bosphorus Strait (e2u was modified)
-         ij0 = 343   ;   ij1 = 343
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &  
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &  
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u was modified)
-         ij0 = 232   ;   ij1 = 232
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u was modified)
-         ij0 = 232   ;   ij1 = 232
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u was modified)
-         ij0 = 270   ;   ij1 = 270
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v was modified)
-         ij0 = 232   ;   ij1 = 233
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v was modified)
-         ij0 = 276   ;   ij1 = 276
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-      ENDIF
-   END SUBROUTINE dom_vvl_orca_fix
 
    !!======================================================================
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 5901)
@@ -7,11 +7,10 @@
    !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
    !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file
-   !!            3.0  ! 2008-01  (S. Masson) add dom_uniq 
-   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.0  ! 2008-01  (S. Masson)  add dom_uniq 
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   dom_wri        : create and write mesh and mask file(s)
-   !!   dom_uniq       :
+   !!   dom_uniq       : identify unique point of a grid (TUVF)
    !!----------------------------------------------------------------------
    USE dom_oce         ! ocean space and time domain
@@ -26,6 +25,6 @@
    PRIVATE
 
-   PUBLIC dom_wri        ! routine called by inidom.F90
-
+   PUBLIC   dom_wri              ! routine called by inidom.F90
+   PUBLIC   dom_wri_coordinate   ! routine called by domhgr.F90
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
@@ -36,4 +35,69 @@
    !!----------------------------------------------------------------------
 CONTAINS
+
+   SUBROUTINE dom_wri_coordinate
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_wri_coordinate  ***
+      !!                   
+      !! ** Purpose :   Create the NetCDF file which contains all the
+      !!              standard coordinate information plus the surface,
+      !!              e1e2u and e1e2v. By doing so, those surface will
+      !!              not be changed by the reduction of e1u or e2v scale 
+      !!              factors in some straits. 
+      !!                 NB: call just after the read of standard coordinate
+      !!              and the reduction of scale factors in some straits
+      !!
+      !! ** output file :   coordinate_e1e2u_v.nc
+      !!----------------------------------------------------------------------
+      INTEGER           ::   inum0    ! temprary units for 'coordinate_e1e2u_v.nc' file
+      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations)
+      !                                   !  workspaces
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_wri_coordinate')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_wri_coordinate : create NetCDF coordinate file'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~'
+      
+      clnam0 = 'coordinate_e1e2u_v'  ! filename (mesh and mask informations)
+      
+      !  create 'coordinate_e1e2u_v.nc' file
+      ! ============================
+      !
+      CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib )
+      !
+      !                                                         ! horizontal mesh (inum3)
+      CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude
+      CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r4 )
+      
+      CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude
+      CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r4 )
+      
+      CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors
+      CALL iom_rstput( 0, 0, inum0, 'e1u', e1u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e1v', e1v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e1f', e1f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum0, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors
+      CALL iom_rstput( 0, 0, inum0, 'e2u', e2u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e2v', e2v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e2f', e2f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum0, 'e1e2u', e1e2u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e1e2v', e1e2v, ktype = jp_r8 )
+
+      CALL iom_close( inum0 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_wri_coordinate')
+      !
+   END SUBROUTINE dom_wri_coordinate
+
 
    SUBROUTINE dom_wri
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 5901)
@@ -219,7 +219,13 @@
          &  ppsur == pp_to_be_computed           ) THEN
          !
+#if defined key_agrif
+         za1  = (  ppdzmin - pphmax / FLOAT(jpkdta-1)  )                                                   &
+            & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpkdta-1) * (  LOG( COSH( (jpkdta - ppkth) / ppacr) )&
+            &                                                      - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+#else
          za1  = (  ppdzmin - pphmax / FLOAT(jpkm1)  )                                                      &
             & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpk-1) * (  LOG( COSH( (jpk - ppkth) / ppacr) )      &
             &                                                   - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+#endif
          za0  = ppdzmin - za1 *              TANH( (1-ppkth) / ppacr )
          zsur =   - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
@@ -236,5 +242,9 @@
               WRITE(numout,*) '            Uniform grid with ',jpk-1,' layers'
               WRITE(numout,*) '            Total depth    :', zhmax
+#if defined key_agrif
+              WRITE(numout,*) '            Layer thickness:', zhmax/(jpkdta-1)
+#else
               WRITE(numout,*) '            Layer thickness:', zhmax/(jpk-1)
+#endif
          ELSE
             IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN
@@ -260,6 +270,10 @@
       ! Reference z-coordinate (depth - scale factor at T- and W-points)
       ! ======================
-      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid       
+      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid 
+#if defined key_agrif
+         za1 = zhmax / FLOAT(jpkdta-1) 
+#else
          za1 = zhmax / FLOAT(jpk-1) 
+#endif
          DO jk = 1, jpk
             zw = FLOAT( jk )
@@ -487,25 +501,24 @@
             IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
                !                                             ! =====================
-               IF( nn_cla == 0 ) THEN
-                  ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
-                  ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
-                  DO ji = mi0(ii0), mi1(ii1)
-                     DO jj = mj0(ij0), mj1(ij1)
-                        mbathy(ji,jj) = 15
-                     END DO
+               !
+               ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
+               ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                  DO jj = mj0(ij0), mj1(ij1)
+                     mbathy(ji,jj) = 15
                   END DO
-                  IF(lwp) WRITE(numout,*)
-                  IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
-                  !
-                  ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open
-                  ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995)
-                  DO ji = mi0(ii0), mi1(ii1)
-                     DO jj = mj0(ij0), mj1(ij1)
-                        mbathy(ji,jj) = 12
-                     END DO
+               END DO
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+               !
+               ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open
+               ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                  DO jj = mj0(ij0), mj1(ij1)
+                     mbathy(ji,jj) = 12
                   END DO
-                  IF(lwp) WRITE(numout,*)
-                  IF(lwp) WRITE(numout,*) '      orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
-               ENDIF
+               END DO
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '      orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
                !
             ENDIF
@@ -531,26 +544,24 @@
             !       
             IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
-               !
-              IF( nn_cla == 0 ) THEN
-                 ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open 
-                 ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995)
-                 DO ji = mi0(ii0), mi1(ii1)
-                    DO jj = mj0(ij0), mj1(ij1)
-                       bathy(ji,jj) = 284._wp
-                    END DO
+            !
+              ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open 
+              ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995)
+              DO ji = mi0(ii0), mi1(ii1)
+                 DO jj = mj0(ij0), mj1(ij1)
+                    bathy(ji,jj) = 284._wp
                  END DO
-                 IF(lwp) WRITE(numout,*)     
-                 IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
-                 !
-                 ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open
-                 ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995)
-                 DO ji = mi0(ii0), mi1(ii1)
-                    DO jj = mj0(ij0), mj1(ij1)
-                       bathy(ji,jj) = 137._wp
-                    END DO
+               END DO
+              IF(lwp) WRITE(numout,*)     
+              IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+              !
+              ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open
+              ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                 DO jj = mj0(ij0), mj1(ij1)
+                    bathy(ji,jj) = 137._wp
                  END DO
-                 IF(lwp) WRITE(numout,*)
-                 IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
-              ENDIF
+              END DO
+              IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
               !
            ENDIF
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 5901)
@@ -174,34 +174,9 @@
             END DO
          END DO
-         IF( nn_cla == 1 ) THEN                          ! Cross Land advection
-            il0 = 138   ;   il1 = 138                          ! set T & S profile at Gibraltar Strait
-            ij0 = 101   ;   ij1 = 102
-            ii0 = 139   ;   ii1 = 139
-            DO jl = mi0(il0), mi1(il1)
-               DO jj = mj0(ij0), mj1(ij1)
-                  DO ji = mi0(ii0), mi1(ii1)
-                     sf_tsd(jp_tem)%fnow(ji,jj,:) = sf_tsd(jp_tem)%fnow(jl,jj,:)
-                     sf_tsd(jp_sal)%fnow(ji,jj,:) = sf_tsd(jp_sal)%fnow(jl,jj,:)
-                  END DO
-               END DO
-            END DO
-            il0 = 164   ;   il1 = 164                          ! set T & S profile at Bab el Mandeb Strait
-            ij0 =  87   ;   ij1 =  88
-            ii0 = 161   ;   ii1 = 163
-            DO jl = mi0(il0), mi1(il1)
-               DO jj = mj0(ij0), mj1(ij1)
-                  DO ji = mi0(ii0), mi1(ii1)
-                     sf_tsd(jp_tem)%fnow(ji,jj,:) = sf_tsd(jp_tem)%fnow(jl,jj,:)
-                     sf_tsd(jp_sal)%fnow(ji,jj,:) = sf_tsd(jp_sal)%fnow(jl,jj,:)
-                  END DO
-               END DO
-            END DO
-         ELSE                                            ! No Cross Land advection
-            ij0 =  87   ;   ij1 =  96                          ! Reduced temperature in Red Sea
-            ii0 = 148   ;   ii1 = 160
-            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp
-            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
-            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
-         ENDIF
+         ij0 =  87   ;   ij1 =  96                          ! Reduced temperature in Red Sea
+         ii0 = 148   ;   ii1 = 160
+         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp
+         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
+         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
       ENDIF
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 5901)
@@ -29,11 +29,9 @@
    USE daymod          ! calendar
    USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine)
-   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldftra          ! lateral physics: ocean active tracers
    USE zdf_oce         ! ocean vertical physics
    USE phycst          ! physical constants
    USE dtatsd          ! data temperature and salinity   (dta_tsd routine)
    USE dtauvd          ! data: U & V current             (dta_uvd routine)
-   USE zpshde          ! partial step: hor. derivative (zps_hde routine)
-   USE eosbn2          ! equation of state            (eos bn2 routine)
    USE domvvl          ! varying vertical mesh
    USE dynspg_oce      ! pressure gradient schemes
@@ -76,10 +74,10 @@
       !
 
-      IF(lwp) WRITE(numout,*) ' '
+      IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
 
-      CALL dta_tsd_init                       ! Initialisation of T & S input data
-      IF( lk_c1d ) CALL dta_uvd_init          ! Initialization of U & V input data
+                     CALL dta_tsd_init        ! Initialisation of T & S input data
+      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data
 
       rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk
@@ -103,6 +101,5 @@
          ub   (:,:,:) = 0._wp   ;   un   (:,:,:) = 0._wp
          vb   (:,:,:) = 0._wp   ;   vn   (:,:,:) = 0._wp  
-         rotb (:,:,:) = 0._wp   ;   rotn (:,:,:) = 0._wp
-         hdivb(:,:,:) = 0._wp   ;   hdivn(:,:,:) = 0._wp
+                                    hdivn(:,:,:) = 0._wp
          !
          IF( cp_cfg == 'eel' ) THEN
@@ -119,22 +116,11 @@
             ENDIF
             IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000
-               CALL wrk_alloc( jpi, jpj, jpk, 2, zuvd )
+               CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd )
                CALL dta_uvd( nit000, zuvd )
                ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:)
                vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:)
-               CALL wrk_dealloc( jpi, jpj, jpk, 2, zuvd )
+               CALL wrk_dealloc( jpi,jpj,jpk,2,   zuvd )
             ENDIF
          ENDIF
-         !
-         CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) )        ! before potential and in situ densities
-#if ! defined key_c1d
-         IF( ln_zps .AND. .NOT. ln_isfcav)                                 &
-            &            CALL zps_hde    ( nit000, jpts, tsb, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
-            &                                            rhd, gru , grv    )  ! of t, s, rd at the last ocean level
-         IF( ln_zps .AND.       ln_isfcav)                                 &
-            &            CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
-            &                                            rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-            &                                     gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
-#endif
          !   
          ! - ML - sshn could be modified by istate_eel, so that initialization of fse3t_b is done here
@@ -142,5 +128,5 @@
             DO jk = 1, jpk
                fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
-            ENDDO
+            END DO
          ENDIF
          ! 
@@ -163,6 +149,6 @@
       !
       !
-      un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp
-      ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp
+      un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp
+      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp
       !
       DO jk = 1, jpkm1
@@ -202,6 +188,6 @@
       !! References :  Philander ???
       !!----------------------------------------------------------------------
-      INTEGER  :: ji, jj, jk
-      REAL(wp) ::   zsal = 35.50
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zsal = 35.50_wp
       !!----------------------------------------------------------------------
       !
@@ -210,4 +196,5 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~   and constant salinity (',zsal,' psu)'
       !
+#if ! defined key_istate_fixed
       DO jk = 1, jpk
          tsn(:,:,jk,jp_tem) = (  ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((fsdept(:,:,jk)-80.)/30.) )   &
@@ -215,6 +202,11 @@
          tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem)
       END DO
+#else
+      tsn(:,:,:,jp_tem) = ztem * tmask(:,:,:)
+      tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)
+#endif
       tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:)
       tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
+
       !
    END SUBROUTINE istate_t_s
@@ -233,5 +225,5 @@
       !!                and relative vorticity fields
       !!----------------------------------------------------------------------
-      USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine)
+      USE divhor     ! hor. divergence      (div_hor routine)
       USE iom
       !
@@ -282,5 +274,5 @@
             tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
             !
-            ! set the dynamics: U,V, hdiv, rot (and ssh if necessary)
+            ! set the dynamics: U,V, hdiv (and ssh if necessary)
             ! ----------------
             ! Start EEL5 configuration with barotropic geostrophic velocities 
@@ -318,5 +310,7 @@
             ENDIF
             !
-            CALL div_cur( nit000 )                  ! horizontal divergence and relative vorticity (curl)
+!!gm  Check  here call to div_hor should not be necessary
+!!gm         div_hor call runoffs  not sure they are defined at that level
+            CALL div_hor( nit000 )                  ! horizontal divergence and relative vorticity (curl)
             ! N.B. the vertical velocity will be computed from the horizontal divergence field
             ! in istate by a call to wzv routine
@@ -371,5 +365,5 @@
       !!
       !! ** Method  : - set temprature field
-      !!              - set salinity field
+      !!              - set salinity   field
       !!----------------------------------------------------------------------
       INTEGER :: ji, jj, jk  ! dummy loop indices
@@ -458,5 +452,5 @@
       !!----------------------------------------------------------------------
       USE dynspg          ! surface pressure gradient             (dyn_spg routine)
-      USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine)
+      USE divhor          ! hor. divergence                       (div_hor routine)
       USE lbclnk          ! ocean lateral boundary condition (or mpp link)
       !
@@ -467,5 +461,5 @@
       !!----------------------------------------------------------------------
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zprn)
+      CALL wrk_alloc( jpi,jpj,jpk,   zprn)
       !
       IF(lwp) WRITE(numout,*) 
@@ -544,7 +538,7 @@
       indic = 0
       CALL dyn_spg( nit000, indic )       ! surface pressure gradient
-
+      !
       ! the new velocity is ua*rdt
-
+      !
       CALL lbc_lnk( ua, 'U', -1. )
       CALL lbc_lnk( va, 'V', -1. )
@@ -556,13 +550,10 @@
       un(:,:,:) = ub(:,:,:)
       vn(:,:,:) = vb(:,:,:)
-       
-      ! Compute the divergence and curl
-
-      CALL div_cur( nit000 )            ! now horizontal divergence and curl
-
-      hdivb(:,:,:) = hdivn(:,:,:)       ! set the before to the now value
-      rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zprn)
+      !
+!!gm  Check  here call to div_hor should not be necessary
+!!gm         div_hor call runoffs  not sure they are defined at that level
+      CALL div_hor( nit000 )            ! now horizontal divergence
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zprn)
       !
    END SUBROUTINE istate_uvg
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 5891)
+++ 	(revision )
@@ -1,341 +1,0 @@
-MODULE divcur
-   !!==============================================================================
-   !!                       ***  MODULE  divcur  ***
-   !! Ocean diagnostic variable : horizontal divergence and relative vorticity
-   !!==============================================================================
-   !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code
-   !!            4.0  ! 1991-11  (G. Madec)
-   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions
-   !!            7.0  ! 1996-01  (G. Madec)  s-coordinates
-   !!            8.0  ! 1997-06  (G. Madec)  lateral boundary cond., lbc
-   !!            8.1  ! 1997-08  (J.M. Molines)  Open boundaries
-   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
-   !!  NEMO      1.0  ! 2002-09  (G. Madec, E. Durand)  Free form, F90
-   !!             -   ! 2005-01  (J. Chanut) Unstructured open boundaries
-   !!             -   ! 2003-08  (G. Madec)  merged of cur and div, free form, F90
-   !!             -   ! 2005-01  (J. Chanut, A. Sellar) unstructured open boundaries
-   !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
-   !!             -   ! 2010-10  (R. Furner, G. Madec) runoff and cla added directly here
-   !!            3.6  ! 2014-11  (P. Mathiot)          isf            added directly here
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   div_cur    : Compute the horizontal divergence and relative
-   !!                vorticity fields
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce, ONLY : ln_rnf, nn_isf ! surface boundary condition: ocean
-   USE sbcrnf          ! river runoff 
-   USE sbcisf          ! ice shelf 
-   USE cla             ! cross land advection             (cla_div routine)
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   div_cur    ! routine called by step.F90 and istate.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-#if defined key_noslip_accurate
-   !!----------------------------------------------------------------------
-   !!   'key_noslip_accurate'   2nd order interior + 4th order at the coast
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE div_cur( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE div_cur  ***
-      !!
-      !! ** Purpose :   compute the horizontal divergence and the relative
-      !!              vorticity at before and now time-step
-      !!
-      !! ** Method  : I.  divergence :
-      !!         - save the divergence computed at the previous time-step
-      !!      (note that the Asselin filter has not been applied on hdivb)
-      !!         - compute the now divergence given by :
-      !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
-      !!      correct hdiv with runoff inflow (div_rnf), ice shelf melting (div_isf)
-      !!      and cross land flow (div_cla) 
-      !!              II. vorticity :
-      !!         - save the curl computed at the previous time-step
-      !!            rotb = rotn
-      !!      (note that the Asselin time filter has not been applied to rotb)
-      !!         - compute the now curl in tensorial formalism:
-      !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] )
-      !!         - Coastal boundary condition: 'key_noslip_accurate' defined,
-      !!      the no-slip boundary condition is computed using Schchepetkin
-      !!      and O'Brien (1996) scheme (i.e. 4th order at the coast).
-      !!      For example, along east coast, the one-sided finite difference
-      !!      approximation used for di[v] is:
-      !!         di[e2v vn] =  1/(e1f*e2f) * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) )
-      !!
-      !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence
-      !!              - update rotb , rotn , the before & now rel. vorticity
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !
-      INTEGER ::   ji, jj, jk, jl           ! dummy loop indices
-      INTEGER ::   ii, ij, ijt, iju, ierr   ! local integer
-      REAL(wp) ::  zraur, zdep              ! local scalar
-      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwu   ! specific 2D workspace
-      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwv   ! specific 2D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('div_cur')
-      !
-      CALL wrk_alloc( jpi  , jpj+2, zwu               )
-      CALL wrk_alloc( jpi+4, jpj  , zwv, kistart = -1 )
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and relative vorticity'
-         IF(lwp) WRITE(numout,*) '~~~~~~~   NOT optimal for auto-tasking case'
-      ENDIF
-
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !
-         hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays
-         rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays
-         !
-         !                                             ! --------
-         ! Horizontal divergence                       !   div
-         !                                             ! --------
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               hdivn(ji,jj,jk) =   &
-                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)       &
-                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)  )    &
-                  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-
-         IF( .NOT. AGRIF_Root() ) THEN
-            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east
-            IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west
-            IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north
-            IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south
-         ENDIF
-
-         !                                             ! --------
-         ! relative vorticity                          !   rot 
-         !                                             ! --------
-         ! contravariant velocity (extended for lateral b.c.)
-         ! inside the model domain
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zwu(ji,jj) = e1u(ji,jj) * un(ji,jj,jk)
-               zwv(ji,jj) = e2v(ji,jj) * vn(ji,jj,jk)
-            END DO  
-         END DO  
- 
-         ! East-West boundary conditions
-         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
-            zwv(  0  ,:) = zwv(jpi-2,:)
-            zwv( -1  ,:) = zwv(jpi-3,:)
-            zwv(jpi+1,:) = zwv(  3  ,:)
-            zwv(jpi+2,:) = zwv(  4  ,:)
-         ELSE
-            zwv(  0  ,:) = 0.e0
-            zwv( -1  ,:) = 0.e0
-            zwv(jpi+1,:) = 0.e0
-            zwv(jpi+2,:) = 0.e0
-         ENDIF
-
-         ! North-South boundary conditions
-         IF( nperio == 3 .OR. nperio == 4 ) THEN
-            ! north fold ( Grid defined with a T-point pivot) ORCA 2 degre
-            zwu(jpi,jpj+1) = 0.e0
-            zwu(jpi,jpj+2) = 0.e0
-            DO ji = 1, jpi-1
-               iju = jpi - ji + 1
-               zwu(ji,jpj+1) = - zwu(iju,jpj-3)
-               zwu(ji,jpj+2) = - zwu(iju,jpj-4)
-            END DO
-         ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN
-            ! north fold ( Grid defined with a F-point pivot) ORCA 0.5 degre\
-            zwu(jpi,jpj+1) = 0.e0
-            zwu(jpi,jpj+2) = 0.e0
-            DO ji = 1, jpi-1
-               iju = jpi - ji
-               zwu(ji,jpj  ) = - zwu(iju,jpj-1)
-               zwu(ji,jpj+1) = - zwu(iju,jpj-2)
-               zwu(ji,jpj+2) = - zwu(iju,jpj-3)
-            END DO
-            DO ji = -1, jpi+2
-               ijt = jpi - ji + 1
-               zwv(ji,jpj) = - zwv(ijt,jpj-2)
-            END DO
-            DO ji = jpi/2+1, jpi+2
-               ijt = jpi - ji + 1
-               zwv(ji,jpjm1) = - zwv(ijt,jpjm1)
-            END DO
-         ELSE
-            ! closed
-            zwu(:,jpj+1) = 0.e0
-            zwu(:,jpj+2) = 0.e0
-         ENDIF
-
-         ! relative vorticity (vertical component of the velocity curl) 
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               rotn(ji,jj,jk) = (  zwv(ji+1,jj  ) - zwv(ji,jj)      &
-                  &              - zwu(ji  ,jj+1) + zwu(ji,jj)  ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) )
-            END DO
-         END DO
-
-         ! second order accurate scheme along straight coast
-         DO jl = 1, npcoa(1,jk)
-            ii = nicoa(jl,1,jk)
-            ij = njcoa(jl,1,jk)
-            rotn(ii,ij,jk) = 1. / ( e1f(ii,ij) * e2f(ii,ij) )   &
-                           * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) )
-         END DO
-         DO jl = 1, npcoa(2,jk)
-            ii = nicoa(jl,2,jk)
-            ij = njcoa(jl,2,jk)
-            rotn(ii,ij,jk) = 1./(e1f(ii,ij)*e2f(ii,ij))   &
-               *(-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij))
-         END DO
-         DO jl = 1, npcoa(3,jk)
-            ii = nicoa(jl,3,jk)
-            ij = njcoa(jl,3,jk)
-            rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   &
-               * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) )
-         END DO
-         DO jl = 1, npcoa(4,jk)
-            ii = nicoa(jl,4,jk)
-            ij = njcoa(jl,4,jk)
-            rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   &
-               * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) )
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs   (update hdivn field)
-      IF( ln_divisf .AND. (nn_isf /= 0) )   CALL sbc_isf_div( hdivn )          ! ice shelf (update hdivn field)
-      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (Update Hor. divergence)
-      
-      ! 4. Lateral boundary conditions on hdivn and rotn
-      ! ---------------------------------=======---======
-      CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )    ! lateral boundary cond. (no sign change)
-      !
-      CALL wrk_dealloc( jpi  , jpj+2, zwu               )
-      CALL wrk_dealloc( jpi+4, jpj  , zwv, kistart = -1 )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('div_cur')
-      !
-   END SUBROUTINE div_cur
-   
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                           2nd order centered schemes
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE div_cur( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE div_cur  ***
-      !!                    
-      !! ** Purpose :   compute the horizontal divergence and the relative
-      !!      vorticity at before and now time-step
-      !!
-      !! ** Method  : - Divergence:
-      !!      - save the divergence computed at the previous time-step
-      !!      (note that the Asselin filter has not been applied on hdivb)
-      !!      - compute the now divergence given by :
-      !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
-      !!      correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla) 
-      !!              - Relavtive Vorticity :
-      !!      - save the curl computed at the previous time-step (rotb = rotn)
-      !!      (note that the Asselin time filter has not been applied to rotb)
-      !!      - compute the now curl in tensorial formalism:
-      !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] )
-      !!      Note: Coastal boundary condition: lateral friction set through
-      !!      the value of fmask along the coast (see dommsk.F90) and shlat
-      !!      (namelist parameter)
-      !!
-      !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence
-      !!              - update rotb , rotn , the before & now rel. vorticity
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk    ! dummy loop indices
-      REAL(wp) ::   zraur, zdep   ! local scalars
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('div_cur')
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and'
-         IF(lwp) WRITE(numout,*) '~~~~~~~   relative vorticity'
-      ENDIF
-
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !
-         hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays
-         rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays
-         !
-         !                                             ! --------
-         ! Horizontal divergence                       !   div 
-         !                                             ! --------
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               hdivn(ji,jj,jk) =   &
-                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)       &
-                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)  )    &
-                  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO  
-         END DO  
-
-         IF( .NOT. AGRIF_Root() ) THEN
-            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east
-            IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west
-            IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north
-            IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south
-         ENDIF
-
-         !                                             ! --------
-         ! relative vorticity                          !   rot 
-         !                                             ! --------
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               rotn(ji,jj,jk) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
-                  &              - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
-                  &           * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) )
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )                            ! runoffs (update hdivn field)
-      IF( ln_divisf .AND. (nn_isf .GT. 0) )   CALL sbc_isf_div( hdivn )          ! ice shelf (update hdivn field)
-      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field)
-      !
-      CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )     ! lateral boundary cond. (no sign change)
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('div_cur')
-      !
-   END SUBROUTINE div_cur
-   
-#endif
-   !!======================================================================
-END MODULE divcur
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90	(revision 5901)
@@ -0,0 +1,102 @@
+MODULE divhor
+   !!==============================================================================
+   !!                       ***  MODULE  divhor  ***
+   !! Ocean diagnostic variable : now horizontal divergence
+   !!==============================================================================
+   !! History :  1.0  ! 2002-09  (G. Madec, E. Durand)  Free form, F90
+   !!             -   ! 2005-01  (J. Chanut) Unstructured open boundaries
+   !!             -   ! 2003-08  (G. Madec)  merged of cur and div, free form, F90
+   !!             -   ! 2005-01  (J. Chanut, A. Sellar) unstructured open boundaries
+   !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
+   !!             -   ! 2010-10  (R. Furner, G. Madec) runoff and cla added directly here
+   !!            3.7  ! 2014-01  (G. Madec) suppression of velocity curl from in-core memory
+   !!             -   ! 2014-12  (G. Madec) suppression of cross land advection option
+   !!             -   ! 2015-10  (G. Madec) add velocity and rnf flag in argument of div_hor
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   div_hor    : Compute the horizontal divergence field
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce, ONLY : ln_rnf, nn_isf ! surface boundary condition: ocean
+   USE sbcrnf          ! river runoff 
+   USE sbcisf          ! ice shelf
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   div_hor    ! routine called by step.F90 and istate.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE div_hor( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE div_hor  ***
+      !!                    
+      !! ** Purpose :   compute the horizontal divergence at now time-step
+      !!
+      !! ** Method  :   the now divergence is computed as :
+      !!         hdivn = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
+      !!      and correct with runoff inflow (div_rnf) and cross land flow (div_cla) 
+      !!
+      !! ** Action  : - update hdivn, the now horizontal divergence
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) ::   zraur, zdep   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('div_hor')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence '
+         IF(lwp) WRITE(numout,*) '~~~~~~~   '
+      ENDIF
+      !
+      DO jk = 1, jpkm1                                      !==  Horizontal divergence  ==!
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * fse3u_n(ji  ,jj,jk) * un(ji  ,jj,jk)        &
+                  &               - e2u(ji-1,jj) * fse3u_n(ji-1,jj,jk) * un(ji-1,jj,jk)        &
+                  &               + e1v(ji,jj  ) * fse3v_n(ji,jj  ,jk) * vn(ji,jj  ,jk)        &
+                  &               - e1v(ji,jj-1) * fse3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk)   )    &
+                  &            / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )
+            END DO  
+         END DO  
+         IF( .NOT. AGRIF_Root() ) THEN
+            IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn(nlci-1,   :  ,jk) = 0._wp      ! east
+            IF( nbondi == -1 .OR. nbondi == 2 )   hdivn(  2   ,   :  ,jk) = 0._wp      ! west
+            IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn(  :   ,nlcj-1,jk) = 0._wp      ! north
+            IF( nbondj == -1 .OR. nbondj == 2 )   hdivn(  :   ,  2   ,jk) = 0._wp      ! south
+         ENDIF
+      END DO
+      !
+      IF( ln_rnf                     )   CALL sbc_rnf_div( hdivn )      !==  runoffs    ==!   (update hdivn field)
+      !
+      IF( ln_divisf .AND. nn_isf > 0 )   CALL sbc_isf_div( hdivn )      !==  ice shelf  ==!   (update hdivn field)
+      !
+      CALL lbc_lnk( hdivn, 'T', 1. )                       !==  lateral boundary cond.  ==!   (no sign change)
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('div_hor')
+      !
+   END SUBROUTINE div_hor
+   
+   !!======================================================================
+END MODULE divhor
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 5901)
@@ -76,10 +76,4 @@
       CASE ( 3 )   
                       CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme
-      !
-      CASE (-1 )                                            ! esopa: test all possibility with control print
-                      CALL dyn_keg     ( kt, nn_dynkeg )
-                      CALL dyn_zad     ( kt )
-                      CALL dyn_adv_cen2( kt )
-                      CALL dyn_adv_ubs ( kt )
       END SELECT
       !
@@ -126,5 +120,4 @@
       IF( ln_dynadv_cen2 )   ioptio = ioptio + 1
       IF( ln_dynadv_ubs  )   ioptio = ioptio + 1
-      IF( lk_esopa       )   ioptio =          1
 
       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' )
@@ -139,5 +132,4 @@
       IF( ln_dynadv_cen2 )   nadv =  2
       IF( ln_dynadv_ubs  )   nadv =  3
-      IF( lk_esopa       )   nadv = -1
 
       IF(lwp) THEN                    ! Print the choice
@@ -151,5 +143,4 @@
          IF( nadv ==  2 )   WRITE(numout,*) '         flux form   : 2nd order scheme is used'
          IF( nadv ==  3 )   WRITE(numout,*) '         flux form   : UBS       scheme is used'
-         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection formulation'
       ENDIF
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 5901)
@@ -90,6 +90,6 @@
          DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+               zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk)
+               zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk)
                !
                ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    &
@@ -114,5 +114,5 @@
       DO jk = 1, jpkm1                       ! ==================== !
          !                                         ! Vertical volume fluxesÊ
-         zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk)
+         zfw(:,:,jk) = 0.25 * e1e2t(:,:) * wn(:,:,jk)
          !
          IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes                   
@@ -144,7 +144,7 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) )    &
-                  &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  &  / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )
                va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    &
-                  &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+                  &  / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )
             END DO
          END DO
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 5901)
@@ -181,6 +181,6 @@
          DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+               zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk)
+               zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk)
                !
                ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    &
@@ -203,5 +203,5 @@
       DO jk = 1, jpkm1                       ! ==================== !
          !                                         ! Vertical volume fluxesÊ
-         zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk)
+         zfw(:,:,jk) = 0.25 * e1e2t(:,:) * wn(:,:,jk)
          !
          IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes                   
@@ -233,7 +233,7 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) )    &
-                  &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  &  / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )
                va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    &
-                  &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+                  &  / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )
             END DO
          END DO
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 5901)
@@ -1046,8 +1046,8 @@
       DO jj = 2, jpjm1
         DO ji = 2, jpim1
-          zsshu_n(ji,jj) = (e12u(ji,jj) * sshn(ji,jj) + e12u(ji+1, jj) * sshn(ji+1,jj)) * &
-                         & r1_e12u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
-          zsshv_n(ji,jj) = (e12v(ji,jj) * sshn(ji,jj) + e12v(ji+1, jj) * sshn(ji,jj+1)) * &
-                         & r1_e12v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
+          zsshu_n(ji,jj) = (e1e2u(ji,jj) * sshn(ji,jj) + e1e2u(ji+1, jj) * sshn(ji+1,jj)) * &
+                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
+          zsshv_n(ji,jj) = (e1e2v(ji,jj) * sshn(ji,jj) + e1e2v(ji+1, jj) * sshn(ji,jj+1)) * &
+                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
         END DO
       END DO
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 5901)
@@ -4,5 +4,7 @@
    !! Ocean physics:  lateral diffusivity trends 
    !!=====================================================================
-   !! History :  9.0  !  05-11  (G. Madec)  Original code (new step architecture)
+   !! History :  2.0  ! 2005-11  (G. Madec)  Original code (new step architecture)
+   !!            3.7  ! 2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification,
+   !!                 !                                  add velocity dependent coefficient and optional read in file
    !!----------------------------------------------------------------------
 
@@ -14,13 +16,10 @@
    USE dom_oce        ! ocean space and time domain
    USE phycst         ! physical constants
-   USE ldfdyn_oce     ! ocean dynamics lateral physics
-   USE ldftra_oce     ! ocean tracers  lateral physics
-   USE ldfslp         ! lateral mixing: slopes of mixing orientation
-   USE dynldf_bilapg  ! lateral mixing            (dyn_ldf_bilapg routine)
-   USE dynldf_bilap   ! lateral mixing            (dyn_ldf_bilap  routine)
-   USE dynldf_iso     ! lateral mixing            (dyn_ldf_iso    routine)
-   USE dynldf_lap     ! lateral mixing            (dyn_ldf_lap    routine)
+   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
+   USE ldfslp         ! lateral diffusion: slopes of mixing orientation
+   USE dynldf_lap_blp ! lateral mixing   (dyn_ldf_lap & dyn_ldf_blp routines)
+   USE dynldf_iso     ! lateral mixing                 (dyn_ldf_iso routine )
    USE trd_oce        ! trends: ocean variables
-   USE trddyn         ! trend manager: dynamics   (trd_dyn        routine)
+   USE trddyn         ! trend manager: dynamics   (trd_dyn      routine)
    !
    USE prtctl         ! Print control
@@ -28,6 +27,6 @@
    USE lib_mpp        ! distribued memory computing library
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -37,5 +36,12 @@
    PUBLIC   dyn_ldf_init  ! called by opa  module 
 
-   INTEGER ::   nldf = -2   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals)
+   !                      ! Flag to control the type of lateral viscous operator
+   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   ! error in setting the operator
+   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00   ! without operator (i.e. no lateral viscous trend)
+   !                          !!      laplacian     !    bilaplacian    !
+   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  ! iso-level operator
+   INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11                       ! iso-neutral or geopotential operator
+
+   INTEGER ::   nldf   ! type of lateral diffusion used defined from ln_dynldf_... (namlist logicals)
 
    !! * Substitutions
@@ -43,5 +49,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -62,6 +68,6 @@
       IF( nn_timing == 1 )  CALL timing_start('dyn_ldf')
       !
-      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )
+      IF( l_trddyn )   THEN                      ! temporary save of momentum trends
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )
          ztrdu(:,:,:) = ua(:,:,:) 
          ztrdv(:,:,:) = va(:,:,:) 
@@ -70,35 +76,8 @@
       SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
       !
-      CASE ( 0 )    ;   CALL dyn_ldf_lap    ( kt )      ! iso-level laplacian
-      CASE ( 1 )    ;   CALL dyn_ldf_iso    ( kt )      ! rotated laplacian (except dk[ dk[.] ] part)
-      CASE ( 2 )    ;   CALL dyn_ldf_bilap  ( kt )      ! iso-level bilaplacian
-      CASE ( 3 )    ;   CALL dyn_ldf_bilapg ( kt )      ! s-coord. horizontal bilaplacian
-      CASE ( 4 )                                        ! iso-level laplacian + bilaplacian
-         CALL dyn_ldf_lap    ( kt )
-         CALL dyn_ldf_bilap  ( kt )
-      CASE ( 5 )                                        ! rotated laplacian + bilaplacian (s-coord)
-         CALL dyn_ldf_iso    ( kt )
-         CALL dyn_ldf_bilapg ( kt )
+      CASE ( np_lap   )    ;   CALL dyn_ldf_lap  ( kt, ub, vb, ua, va, 1 )      ! iso-level    laplacian
+      CASE ( np_lap_i )    ;   CALL dyn_ldf_iso  ( kt )                         ! rotated      laplacian
+      CASE ( np_blp   )    ;   CALL dyn_ldf_blp  ( kt, ub, vb, ua, va    )      ! iso-level bi-laplacian
       !
-      CASE ( -1 )                                       ! esopa: test all possibility with control print
-                        CALL dyn_ldf_lap    ( kt )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf0 - Ua: ', mask1=umask,   &
-            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                        CALL dyn_ldf_iso    ( kt )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf1 - Ua: ', mask1=umask,   &
-            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                        CALL dyn_ldf_bilap  ( kt )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf2 - Ua: ', mask1=umask,   &
-            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                        CALL dyn_ldf_bilapg ( kt )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask,   &
-            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-      !
-      CASE ( -2 )                                       ! neither laplacian nor bilaplacian schemes used
-         IF( kt == nit000 ) THEN
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'dyn_ldf : no lateral diffusion on momentum setup'
-            IF(lwp) WRITE(numout,*) '~~~~~~~ '
-         ENDIF
       END SELECT
 
@@ -107,5 +86,5 @@
          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
          CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt )
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )
       ENDIF
       !                                          ! print sum trends (used for debugging)
@@ -126,7 +105,7 @@
       INTEGER ::   ioptio, ierr         ! temporary integers 
       !!----------------------------------------------------------------------
-    
+      !
       !                                   ! Namelist nam_dynldf: already read in ldfdyn module
-
+      !
       IF(lwp) THEN                        ! Namelist print
          WRITE(numout,*)
@@ -134,99 +113,76 @@
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '       Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)'
-         WRITE(numout,*) '          laplacian operator          ln_dynldf_lap   = ', ln_dynldf_lap
-         WRITE(numout,*) '          bilaplacian operator        ln_dynldf_bilap = ', ln_dynldf_bilap
-         WRITE(numout,*) '          iso-level                   ln_dynldf_level = ', ln_dynldf_level
-         WRITE(numout,*) '          horizontal (geopotential)   ln_dynldf_hor   = ', ln_dynldf_hor
-         WRITE(numout,*) '          iso-neutral                 ln_dynldf_iso   = ', ln_dynldf_iso
+         WRITE(numout,*) '          laplacian operator          ln_dynldf_lap = ', ln_dynldf_lap
+         WRITE(numout,*) '          bilaplacian operator        ln_dynldf_blp = ', ln_dynldf_blp
+         WRITE(numout,*) '          iso-level                   ln_dynldf_lev = ', ln_dynldf_lev
+         WRITE(numout,*) '          horizontal (geopotential)   ln_dynldf_hor = ', ln_dynldf_hor
+         WRITE(numout,*) '          iso-neutral                 ln_dynldf_iso = ', ln_dynldf_iso
       ENDIF
-
-      !                                   ! control the consistency
+      !                                   ! use of lateral operator or not
+      nldf = np_ERROR
       ioptio = 0
-      IF( ln_dynldf_lap   )   ioptio = ioptio + 1
-      IF( ln_dynldf_bilap )   ioptio = ioptio + 1
-      IF( ioptio <  1 ) CALL ctl_warn( '          neither laplacian nor bilaplacian operator set for dynamics' )
-      ioptio = 0
-      IF( ln_dynldf_level )   ioptio = ioptio + 1
-      IF( ln_dynldf_hor   )   ioptio = ioptio + 1
-      IF( ln_dynldf_iso   )   ioptio = ioptio + 1
-      IF( ioptio >  1 ) CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
-
-      IF( ln_dynldf_iso .AND. ln_traldf_hor ) CALL ctl_stop &
-      &   ( 'Not sensible to use geopotential diffusion for tracers with isoneutral diffusion for dynamics' )
-
-      !                                   ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals
-      ierr = 0
-      IF ( ln_dynldf_lap ) THEN      ! laplacian operator
-         IF ( ln_zco ) THEN                ! z-coordinate
-            IF ( ln_dynldf_level )   nldf = 0      ! iso-level  (no rotation)
-            IF ( ln_dynldf_hor   )   nldf = 0      ! horizontal (no rotation)
-            IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+      IF( ln_dynldf_lap )   ioptio = ioptio + 1
+      IF( ln_dynldf_blp )   ioptio = ioptio + 1
+      IF( ioptio >  1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on momentum' )
+      IF( ioptio == 0   )   nldf = np_no_ldf     ! No lateral mixing operator
+      !
+      IF( nldf /= np_no_ldf ) THEN        ! direction ==>> type of operator  
+         ioptio = 0
+         IF( ln_dynldf_lev )   ioptio = ioptio + 1
+         IF( ln_dynldf_hor )   ioptio = ioptio + 1
+         IF( ln_dynldf_iso )   ioptio = ioptio + 1
+         IF( ioptio >  1   )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
+         IF( ioptio == 0   )   CALL ctl_stop( '          use at least ONE direction (level/hor/iso)' )
+         !
+         !                                   ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals
+         ierr = 0
+         IF ( ln_dynldf_lap ) THEN      ! laplacian operator
+            IF ( ln_zco ) THEN                ! z-coordinate
+               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation)
+            ENDIF
+            IF ( ln_zps ) THEN             ! z-coordinate with partial step
+               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level              (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_lap     ! iso-level              (no rotation)
+               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation)
+            ENDIF
+            IF ( ln_sco ) THEN             ! s-coordinate
+               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_lap_i   ! horizontal             (   rotation)
+               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation)
+            ENDIF
          ENDIF
-         IF ( ln_zps ) THEN             ! z-coordinate
-            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed
-            IF ( ln_dynldf_hor   )   nldf = 0      ! horizontal (no rotation)
-            IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         !
+         IF( ln_dynldf_blp ) THEN          ! bilaplacian operator
+            IF ( ln_zco ) THEN                ! z-coordinate
+               IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation)
+            ENDIF
+            IF ( ln_zps ) THEN             ! z-coordinate with partial step
+               IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_blp     ! iso-level              (no rotation)
+               IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation)
+            ENDIF
+            IF ( ln_sco ) THEN             ! s-coordinate
+               IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation)
+               IF ( ln_dynldf_hor )   ierr = 2          ! horizontal             (   rotation)
+               IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation)
+            ENDIF
          ENDIF
-         IF ( ln_sco ) THEN             ! s-coordinate
-            IF ( ln_dynldf_level )   nldf = 0      ! iso-level  (no rotation)
-            IF ( ln_dynldf_hor   )   nldf = 1      ! horizontal (   rotation)
-            IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
-         ENDIF
-      ENDIF
-
-      IF( ln_dynldf_bilap ) THEN      ! bilaplacian operator
-         IF ( ln_zco ) THEN                ! z-coordinate
-            IF ( ln_dynldf_level )   nldf = 2      ! iso-level  (no rotation)
-            IF ( ln_dynldf_hor   )   nldf = 2      ! horizontal (no rotation)
-            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_zps ) THEN             ! z-coordinate
-            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed 
-            IF ( ln_dynldf_hor   )   nldf = 2      ! horizontal (no rotation)
-            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_sco ) THEN             ! s-coordinate
-            IF ( ln_dynldf_level )   nldf = 2      ! iso-level  (no rotation)
-            IF ( ln_dynldf_hor   )   nldf = 3      ! horizontal (   rotation)
-            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-      ENDIF
-      
-      IF( ln_dynldf_lap .AND. ln_dynldf_bilap ) THEN  ! mixed laplacian and bilaplacian operators
-         IF ( ln_zco ) THEN                ! z-coordinate
-            IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation)
-            IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation)
-            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_zps ) THEN             ! z-coordinate
-            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed 
-            IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation)
-            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_sco ) THEN             ! s-coordinate
-            IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation)
-            IF ( ln_dynldf_hor   )   nldf = 5      ! horizontal (   rotation)
-            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-      ENDIF
-
-      IF( lk_esopa )                 nldf = -1     ! esopa test
-
-      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( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
-         IF( .NOT.lk_ldfslp )   CALL ctl_stop( 'the rotation of the diffusive tensor require key_ldfslp' )
+         !
+         IF( ierr == 2 )   CALL ctl_stop( 'rotated bi-laplacian operator does not exist' )
+         !
+         IF( nldf == np_lap_i )   l_ldfslp = .TRUE.      ! rotation require the computation of the slopes
+         !
       ENDIF
 
       IF(lwp) THEN
          WRITE(numout,*)
-         IF( nldf == -2 )   WRITE(numout,*) '              neither laplacian nor bilaplacian schemes used'
-         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'
-         IF( nldf ==  4 )   WRITE(numout,*) '              laplacian and bilaplacian operators'
-         IF( nldf ==  5 )   WRITE(numout,*) '              rotated laplacian and bilaplacian operators'
+         IF( nldf == np_no_ldf )   WRITE(numout,*) '              NO lateral viscosity'
+         IF( nldf == np_lap    )   WRITE(numout,*) '              iso-level laplacian operator'
+         IF( nldf == np_lap_i  )   WRITE(numout,*) '              rotated laplacian operator with iso-level background'
+         IF( nldf == np_blp    )   WRITE(numout,*) '              iso-level bi-laplacian operator'
       ENDIF
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90	(revision 5891)
+++ 	(revision )
@@ -1,215 +1,0 @@
-MODULE dynldf_bilap
-   !!======================================================================
-   !!                     ***  MODULE  dynldf_bilap  ***
-   !! Ocean dynamics:  lateral viscosity trend
-   !!======================================================================
-   !! History :  OPA  ! 1990-09  (G. Madec)  Original code
-   !!            4.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
-   !!            6.0  ! 1996-01  (G. Madec)  statement function for e3
-   !!            8.0  ! 1997-07  (G. Madec)  lbc calls
-   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
-   !!            2.0  ! 2004-08  (C. Talandier) New trends organization
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dyn_ldf_bilap : update the momentum trend with the lateral diffusion
-   !!                   using an iso-level bilaplacian operator
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE ldfdyn_oce      ! ocean dynamics: lateral physics
-   !
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dyn_ldf_bilap   ! called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldfdyn_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dyn_ldf_bilap( kt )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE dyn_ldf_bilap  ***
-      !!
-      !! ** Purpose :   Compute the before trend of the lateral momentum
-      !!      diffusion and add it to the general trend of momentum equation.
-      !!
-      !! ** Method  :   The before horizontal momentum diffusion trend is a 
-      !!      bi-harmonic operator (bilaplacian type) which separates the
-      !!      divergent and rotational parts of the flow.
-      !!      Its horizontal components are computed as follow:
-      !!      laplacian:
-      !!          zlu = 1/e1u di[ hdivb ] - 1/(e2u*e3u) dj-1[ e3f rotb ]
-      !!          zlv = 1/e2v dj[ hdivb ] + 1/(e1v*e3v) di-1[ e3f rotb ]
-      !!      third derivative:
-      !!       * multiply by the eddy viscosity coef. at u-, v-point, resp.
-      !!          zlu = ahmu * zlu
-      !!          zlv = ahmv * zlv
-      !!       * curl and divergence of the laplacian
-      !!          zuf = 1/(e1f*e2f) ( di[e2v zlv] - dj[e1u zlu] )
-      !!          zut = 1/(e1t*e2t*e3t) ( di[e2u*e3u zlu] + dj[e1v*e3v zlv] )
-      !!      bilaplacian:
-      !!              diffu = 1/e1u di[ zut ] - 1/(e2u*e3u) dj-1[ e3f zuf ]
-      !!              diffv = 1/e2v dj[ zut ] + 1/(e1v*e3v) di-1[ e3f zuf ]
-      !!      If ln_sco=F and ln_zps=F, the vertical scale factors in the
-      !!      rotational part of the diffusion are simplified
-      !!      Add this before trend to the general trend (ua,va):
-      !!            (ua,va) = (ua,va) + (diffu,diffv)
-      !!
-      !! ** Action : - Update (ua,va) with the before iso-level biharmonic
-      !!               mixing trend.
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk                  ! dummy loop indices
-      REAL(wp) ::   zua, zva, zbt, ze2u, ze2v   ! temporary scalar
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zcu, zcv
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_bilap')
-      !
-      CALL wrk_alloc( jpi, jpj,      zcu, zcv           )
-      CALL wrk_alloc( jpi, jpj, jpk, zuf, zut, zlu, zlv ) 
-      !
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'dyn_ldf_bilap : iso-level bilaplacian operator'
-         WRITE(numout,*) '~~~~~~~~~~~~~'
-      ENDIF
-
-!!bug gm this should be enough
-!!$      zuf(:,:,jpk) = 0.e0
-!!$      zut(:,:,jpk) = 0.e0
-!!$      zlu(:,:,jpk) = 0.e0
-!!$      zlv(:,:,jpk) = 0.e0
-      zuf(:,:,:) = 0._wp
-      zut(:,:,:) = 0._wp
-      zlu(:,:,:) = 0._wp
-      zlv(:,:,:) = 0._wp
-
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         ! Laplacian
-         ! ---------
-
-         IF( ln_sco .OR. ln_zps ) THEN   ! s-coordinate or z-coordinate with partial steps
-            zuf(:,:,jk) = rotb(:,:,jk) * fse3f(:,:,jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zlu(ji,jj,jk) = - ( zuf(ji,jj,jk) - zuf(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
-                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) / e1u(ji,jj)
-   
-                  zlv(ji,jj,jk) = + ( zuf(ji,jj,jk) - zuf(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
-                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) / e2v(ji,jj)
-               END DO
-            END DO
-         ELSE                            ! z-coordinate - full step
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zlu(ji,jj,jk) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) / e2u(ji,jj)   &
-                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) / e1u(ji,jj)
-   
-                  zlv(ji,jj,jk) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) / e1v(ji,jj)   &
-                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) / e2v(ji,jj)
-               END DO  
-            END DO  
-         ENDIF
-      END DO
-      CALL lbc_lnk( zlu, 'U', -1. )   ;   CALL lbc_lnk( zlv, 'V', -1. )   ! Boundary conditions
-
-         
-      DO jk = 1, jpkm1
-   
-         ! Third derivative
-         ! ----------------
-         
-         ! Multiply by the eddy viscosity coef. (at u- and v-points)
-         zlu(:,:,jk) = zlu(:,:,jk) * ( fsahmu(:,:,jk) * (1-nkahm_smag) + nkahm_smag)
-
-         zlv(:,:,jk) = zlv(:,:,jk) * ( fsahmv(:,:,jk) * (1-nkahm_smag) + nkahm_smag)
-         
-         ! Contravariant "laplacian"
-         zcu(:,:) = e1u(:,:) * zlu(:,:,jk)
-         zcv(:,:) = e2v(:,:) * zlv(:,:,jk)
-         
-         ! Laplacian curl ( * e3f if s-coordinates or z-coordinate with partial steps)
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zuf(ji,jj,jk) = fmask(ji,jj,jk) * (  zcv(ji+1,jj  ) - zcv(ji,jj)      &
-                  &                            - zcu(ji  ,jj+1) + zcu(ji,jj)  )   &
-                  &       * fse3f(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) )
-            END DO  
-         END DO  
-
-         ! Laplacian Horizontal fluxes
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zlu(ji,jj,jk) = e2u(ji,jj) * fse3u(ji,jj,jk) * zlu(ji,jj,jk)
-               zlv(ji,jj,jk) = e1v(ji,jj) * fse3v(ji,jj,jk) * zlv(ji,jj,jk)
-            END DO
-         END DO
-
-         ! Laplacian divergence
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vector opt.
-               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-               zut(ji,jj,jk) = (  zlu(ji,jj,jk) - zlu(ji-1,jj  ,jk)   &
-                  &             + zlv(ji,jj,jk) - zlv(ji  ,jj-1,jk) ) / zbt
-            END DO
-         END DO
-      END DO
-
-
-      ! boundary conditions on the laplacian curl and div (zuf,zut)
-!!bug gm no need to do this 2 following lbc...
-      CALL lbc_lnk( zuf, 'F', 1. )
-      CALL lbc_lnk( zut, 'T', 1. )
-
-      DO jk = 1, jpkm1      
-   
-         ! Bilaplacian
-         ! -----------
-
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ze2u = e2u(ji,jj) * fse3u(ji,jj,jk)
-               ze2v = e1v(ji,jj) * fse3v(ji,jj,jk)
-               ! horizontal biharmonic diffusive trends
-               zua = - ( zuf(ji  ,jj,jk) - zuf(ji,jj-1,jk) ) / ze2u   &
-                  &  + ( zut(ji+1,jj,jk) - zut(ji,jj  ,jk) ) / e1u(ji,jj)
-
-               zva = + ( zuf(ji,jj  ,jk) - zuf(ji-1,jj,jk) ) / ze2v   &
-                  &  + ( zut(ji,jj+1,jk) - zut(ji  ,jj,jk) ) / e2v(ji,jj)
-               ! add it to the general momentum trends
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zua * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag ))
-               va(ji,jj,jk) = va(ji,jj,jk) + zva * ( fsahmv(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag ))
-            END DO
-         END DO
-
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-      CALL wrk_dealloc( jpi, jpj,      zcu, zcv           )
-      CALL wrk_dealloc( jpi, jpj, jpk, zuf, zut, zlu, zlv ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_bilap')
-      !
-   END SUBROUTINE dyn_ldf_bilap
-
-   !!======================================================================
-END MODULE dynldf_bilap
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90	(revision 5891)
+++ 	(revision )
@@ -1,493 +1,0 @@
-MODULE dynldf_bilapg
-   !!======================================================================
-   !!                       ***  MODULE  dynldf_bilapg  ***
-   !! Ocean dynamics:  lateral viscosity trend
-   !!======================================================================
-   !! History :  OPA  !  1997-07  (G. Madec)  Original code
-   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
-   !!            2.0  !  2004-08  (C. Talandier) New trends organization
-   !!----------------------------------------------------------------------
-#if defined key_ldfslp   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_ldfslp'                              Rotation of mixing tensor
-   !!----------------------------------------------------------------------
-   !!   dyn_ldf_bilapg : update the momentum trend with the horizontal part
-   !!                    of the horizontal s-coord. bilaplacian diffusion
-   !!   ldfguv         : 
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE ldfdyn_oce      ! ocean dynamics lateral physics
-   USE zdf_oce         ! ocean vertical physics
-   USE ldfslp          ! iso-neutral slopes available
-   USE ldftra_oce, ONLY: ln_traldf_iso
-   !
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dyn_ldf_bilapg       ! called by step.F90
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zfuw, zfvw , zdiu, zdiv   ! 2D workspace (ldfguv)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zdju, zdj1u, zdjv, zdj1v  ! 2D workspace (ldfguv)
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldfdyn_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION dyn_ldf_bilapg_alloc()
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE dyn_ldf_bilapg_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( zfuw(jpi,jpk) , zfvw (jpi,jpk) , zdiu(jpi,jpk) , zdiv (jpi,jpk) ,     &
-         &      zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_bilapg_alloc )
-         !
-      IF( dyn_ldf_bilapg_alloc /= 0 )   CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays')
-   END FUNCTION dyn_ldf_bilapg_alloc
-
-
-   SUBROUTINE dyn_ldf_bilapg( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE dyn_ldf_bilapg  ***
-      !!                      
-      !! ** Purpose :   Compute the before trend of the horizontal momentum
-      !!      diffusion and add it to the general trend of momentum equation.
-      !!
-      !! ** Method  :   The lateral momentum diffusive trends is provided by a 
-      !!      a 4th order operator rotated along geopotential surfaces. It is 
-      !!      computed using before fields (forward in time) and geopotential
-      !!      slopes computed in routine inildf.
-      !!         -1- compute the geopotential harmonic operator applied to
-      !!      (ub,vb) and multiply it by the eddy diffusivity coefficient
-      !!      (done by a call to ldfgpu and ldfgpv routines) The result is in
-      !!      (zwk1,zwk2) arrays. Applied the domain lateral boundary conditions
-      !!      by call to lbc_lnk.
-      !!         -2- applied to (zwk1,zwk2) the geopotential harmonic operator
-      !!      by a second call to ldfgpu and ldfgpv routines respectively. The
-      !!      result is in (zwk3,zwk4) arrays.
-      !!         -3- Add this trend to the general trend (ta,sa):
-      !!            (ua,va) = (ua,va) + (zwk3,zwk4)
-      !!
-      !! ** Action  : - Update (ua,va) arrays with the before geopotential
-      !!                biharmonic mixing trend.
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
-      !
-      INTEGER ::   ji, jj, jk                 ! dummy loop indices
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwk1, zwk2, zwk3, zwk4
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_bilapg')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 ) 
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn_ldf_bilapg : horizontal biharmonic operator in s-coordinate'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
-         !                                      ! allocate dyn_ldf_bilapg arrays
-         IF( dyn_ldf_bilapg_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_bilapg: failed to allocate arrays')
-      ENDIF
-
-      ! s-coordinate: Iso-level diffusion on tracer, but geopotential level diffusion on momentum
-      IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN
-         !
-         DO jk = 1, jpk         ! set the slopes of iso-level
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)
-                  vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)
-                  wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5
-                  wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5
-               END DO
-            END DO
-         END DO
-         ! Lateral boundary conditions on the slopes
-         CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
-         CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )
- 
-!!bug
-         IF( kt == nit000 ) then
-            IF(lwp) WRITE(numout,*) ' max slop: u', SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  &
-               &                             ' wi', sqrt(MAXVAL(wslpi))     , ' wj', sqrt(MAXVAL(wslpj))
-         endif
-!!end
-      ENDIF
-
-      zwk1(:,:,:) = 0.e0   ;   zwk3(:,:,:) = 0.e0
-      zwk2(:,:,:) = 0.e0   ;   zwk4(:,:,:) = 0.e0
-
-      ! Laplacian of (ub,vb) multiplied by ahm
-      ! --------------------------------------  
-      CALL ldfguv( ub, vb, zwk1, zwk2, 1 )      ! rotated harmonic operator applied to (ub,vb)
-      !                                         ! and multiply by ahmu, ahmv (output in (zwk1,zwk2) )
-      CALL lbc_lnk( zwk1, 'U', -1. )   ;   CALL lbc_lnk( zwk2, 'V', -1. )     ! Lateral boundary conditions
-
-      ! Bilaplacian of (ub,vb)
-      ! ---------------------- 
-      CALL ldfguv( zwk1, zwk2, zwk3, zwk4, 2 )  ! rotated harmonic operator applied to (zwk1,zwk2) 
-      !                                         ! (output in (zwk3,zwk4) )
-
-      ! Update the momentum trends
-      ! --------------------------
-      DO jj = 2, jpjm1               ! add the diffusive trend to the general momentum trends
-         DO jk = 1, jpkm1
-            DO ji = 2, jpim1
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zwk3(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + zwk4(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_bilapg')
-      !
-   END SUBROUTINE dyn_ldf_bilapg
-
-
-   SUBROUTINE ldfguv( pu, pv, plu, plv, kahm )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldfguv  ***
-      !!      
-      !! ** Purpose :   Apply a geopotential harmonic operator to (pu,pv)
-      !!      (defined at u- and v-points) and multiply it by the eddy
-      !!      viscosity coefficient (if kahm=1).
-      !!
-      !! ** Method  :   The harmonic operator rotated along geopotential 
-      !!      surfaces is applied to (pu,pv) using the slopes of geopotential
-      !!      surfaces computed in inildf routine. The result is provided in
-      !!      (plu,plv) arrays. It is computed in 2 stepv:
-      !!
-      !!      First step: horizontal part of the operator. It is computed on
-      !!      ==========  pu as follows (idem on pv)
-      !!      horizontal fluxes :
-      !!         zftu = e2u*e3u/e1u di[ pu ] - e2u*uslp dk[ mi(mk(pu)) ]
-      !!         zftv = e1v*e3v/e2v dj[ pu ] - e1v*vslp dk[ mj(mk(pu)) ]
-      !!      take the horizontal divergence of the fluxes (no divided by
-      !!      the volume element :
-      !!         plu  = di-1[ zftu ] +  dj-1[ zftv ]
-      !!
-      !!      Second step: vertical part of the operator. It is computed on
-      !!      ===========  pu as follows (idem on pv)
-      !!      vertical fluxes :
-      !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pu ]
-      !!              -     e2t     *       wslpi        di[ mi(mk(pu)) ]
-      !!              -     e1t     *       wslpj        dj[ mj(mk(pu)) ]
-      !!      take the vertical divergence of the fluxes add it to the hori-
-      !!      zontal component, divide the result by the volume element and
-      !!      if kahm=1, multiply by the eddy diffusivity coefficient:
-      !!         plu  = aht / (e1t*e2t*e3t) { plu + dk[ zftw ] }
-      !!      else:
-      !!         plu  =  1  / (e1t*e2t*e3t) { plu + dk[ zftw ] }
-      !!
-      !! ** Action :
-      !!        plu, plv        : partial harmonic operator applied to
-      !!                          pu and pv (all the components except
-      !!                          second order vertical derivative term)
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu , pv    ! 1st call: before horizontal velocity 
-      !                                                               ! 2nd call: ahm x these fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   plu, plv   ! partial harmonic operator applied to
-      !                                                               ! pu and pv (all the components except
-      !                                                               ! second order vertical derivative term)
-      INTEGER                         , INTENT(in   ) ::   kahm       ! =1 1st call ; =2 2nd call
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zabe1 , zabe2 , zcof1 , zcof2        ! local scalar
-      REAL(wp) ::   zcoef0, zcoef3, zcoef4               !   -      -
-      REAL(wp) ::   zbur, zbvr, zmkt, zmkf, zuav, zvav   !   -      -
-      REAL(wp) ::   zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      -
-      !
-      REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ldfguv')
-      !
-      CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 
-      !
-      !                               ! ********** !   ! ===============
-      DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
-         !                            ! ********** !   ! ===============
-
-         ! I.1 Vertical gradient of pu and pv at level jk and jk+1
-         ! -------------------------------------------------------
-         ! surface boundary condition: zdku(jk=1)=zdku(jk=2)
-         !                             zdkv(jk=1)=zdkv(jk=2)
-
-         zdk1u(:,:) = ( pu(:,:,jk) - pu(:,:,jk+1) ) * umask(:,:,jk+1)
-         zdk1v(:,:) = ( pv(:,:,jk) - pv(:,:,jk+1) ) * vmask(:,:,jk+1)
-
-         IF( jk == 1 ) THEN
-            zdku(:,:) = zdk1u(:,:)
-            zdkv(:,:) = zdk1v(:,:)
-         ELSE
-            zdku(:,:) = ( pu(:,:,jk-1) - pu(:,:,jk) ) * umask(:,:,jk)
-            zdkv(:,:) = ( pv(:,:,jk-1) - pv(:,:,jk) ) * vmask(:,:,jk)
-         ENDIF
-
-         !                                -----f-----
-         ! I.2 Horizontal fluxes on U          |
-         ! ------------------------===     t   u   t
-         !                                     |
-         ! i-flux at t-point              -----f-----
-         DO jj = 1, jpjm1
-            DO ji = 2, jpi
-               zabe1 = e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)
-
-               zmkt  = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   &
-                              + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. )
-
-               zcof1 = -e2t(ji,jj) * zmkt   &
-                     * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
-
-               ziut(ji,jj) = tmask(ji,jj,jk) *   &
-                           (  zabe1 * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) )   &
-                            + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
-                                       +zdk1u(ji,jj) + zdku (ji-1,jj) )  )
-            END DO
-         END DO
-
-         ! j-flux at f-point
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zabe2 = e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj)
-
-               zmkf  = 1./MAX(  umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)   &
-                              + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. )
-
-               zcof2 = -e1f(ji,jj) * zmkf   &
-                     * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
-
-               zjuf(ji,jj) = fmask(ji,jj,jk) *   &
-                           (  zabe2 * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) )   &
-                            + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     &
-                                       +zdk1u(ji,jj+1) + zdku (ji,jj) )  )
-            END DO
-         END DO
-
-         !                                 |   t   |
-         ! I.3 Horizontal fluxes on V      |       |
-         ! ------------------------===     f---v---f
-         !                                 |       |
-         ! i-flux at f-point               |   t   |
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zabe1 = e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)
-
-               zmkf  = 1./MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)   &
-                              + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. )
-
-               zcof1 = -e2f(ji,jj) * zmkf   &
-                     * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
-
-               zivf(ji,jj) = fmask(ji,jj,jk) *   &
-                           (  zabe1 * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) )   &
-                            + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj)     &
-                                       +zdk1u(ji,jj) + zdku (ji+1,jj) )  )
-            END DO
-         END DO
-
-         ! j-flux at t-point
-         DO jj = 2, jpj
-            DO ji = 1, jpim1
-               zabe2 = e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)
-
-               zmkt  = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   &
-                              + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. )
-
-               zcof2 = -e1t(ji,jj) * zmkt   &
-                     * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
-
-               zjvt(ji,jj) = tmask(ji,jj,jk) *   &
-                           (  zabe2 * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) )   &
-                            + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj)     &
-                                       +zdk1u(ji,jj-1) + zdku (ji,jj) )  )
-            END DO
-         END DO
-
-
-         ! I.4 Second derivative (divergence) (not divided by the volume)
-         ! ---------------------
-
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               plu(ji,jj,jk) = ziut (ji+1,jj) - ziut (ji,jj  )   &
-                             + zjuf (ji  ,jj) - zjuf (ji,jj-1)
-               plv(ji,jj,jk) = zivf (ji,jj  ) - zivf (ji-1,jj)   &
-                             + zjvt (ji,jj+1) - zjvt (ji,jj  ) 
-            END DO
-         END DO
-
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
-
-      !                             ! ************ !   ! ===============
-      DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
-         !                          ! ************ !   ! ===============
-
-         ! II.1 horizontal (pu,pv) gradients
-         ! ---------------------------------
-
-         DO jk = 1, jpk
-            DO ji = 2, jpi
-               ! i-gradient of u at jj
-               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( pu(ji,jj  ,jk) - pu(ji-1,jj  ,jk) )
-               ! j-gradient of u and v at jj
-               zdju (ji,jk) = fmask(ji,jj  ,jk) * ( pu(ji,jj+1,jk) - pu(ji  ,jj  ,jk) )
-               zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( pv(ji,jj  ,jk) - pv(ji  ,jj-1,jk) )
-               ! j-gradient of u and v at jj+1
-               zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( pu(ji,jj  ,jk) - pu(ji  ,jj-1,jk) )
-               zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( pv(ji,jj+1,jk) - pv(ji  ,jj  ,jk) )
-            END DO
-         END DO
-         DO jk = 1, jpk
-            DO ji = 1, jpim1
-               ! i-gradient of v at jj
-               zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( pv(ji+1,jj,jk) - pv(ji  ,jj  ,jk) )
-            END DO
-         END DO
-
-
-         ! II.2 Vertical fluxes
-         ! --------------------
-
-         ! Surface and bottom vertical fluxes set to zero
-
-         zfuw(:, 1 ) = 0.e0
-         zfvw(:, 1 ) = 0.e0
-         zfuw(:,jpk) = 0.e0
-         zfvw(:,jpk) = 0.e0
-
-         ! interior (2=<jk=<jpk-1) on pu field
-
-         DO jk = 2, jpkm1
-            DO ji = 2, jpim1
-               ! i- and j-slopes at uw-point
-               zuwslpi = 0.5 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) )
-               zuwslpj = 0.5 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) )
-               ! coef. for the vertical dirative
-               zcoef0 = e1u(ji,jj) * e2u(ji,jj) / fse3u(ji,jj,jk)   &
-                      * ( zuwslpi * zuwslpi + zuwslpj * zuwslpj )
-               ! weights for the i-k, j-k averaging at t- and f-points, resp.
-               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   &
-                             + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. )
-               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1)+fmask(ji,jj,jk-1)   &
-                             + fmask(ji,jj-1,jk  )+fmask(ji,jj,jk  ), 1. )
-               ! coef. for the horitontal derivative
-               zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi
-               zcoef4 = - e1u(ji,jj) * zmkf * zuwslpj
-               ! vertical flux on u field
-               zfuw(ji,jk) = umask(ji,jj,jk) *   &
-                           (  zcoef0 * ( pu  (ji,jj,jk-1) - pu  (ji,jj,jk) )   &
-                            + zcoef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1)     &
-                                        +zdiu (ji,jk  ) + zdiu (ji+1,jk  ) )   &
-                            + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji  ,jk-1)     &
-                                        +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) ) )
-            END DO
-         END DO
-
-         ! interior (2=<jk=<jpk-1) on pv field
-
-         DO jk = 2, jpkm1
-            DO ji = 2, jpim1
-               ! i- and j-slopes at vw-point
-               zvwslpi = 0.5 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) )
-               zvwslpj = 0.5 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) )
-               ! coef. for the vertical derivative
-               zcoef0 = e1v(ji,jj) * e2v(ji,jj) / fse3v(ji,jj,jk)   &
-                      * ( zvwslpi * zvwslpi + zvwslpj * zvwslpj )
-               ! weights for the i-k, j-k averaging at f- and t-points, resp.
-               zmkf = 1./MAX(  fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1)   &
-                             + fmask(ji-1,jj,jk  )+fmask(ji,jj,jk  ), 1. )
-               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1)   &
-                             + tmask(ji,jj,jk  )+tmask(ji,jj+1,jk  ), 1. )
-               ! coef. for the horizontal derivatives
-               zcoef3 = - e2v(ji,jj) * zmkf * zvwslpi
-               zcoef4 = - e1v(ji,jj) * zmkt * zvwslpj
-               ! vertical flux on pv field
-               zfvw(ji,jk) = vmask(ji,jj,jk) *   &
-                           (  zcoef0 * ( pv  (ji,jj,jk-1) - pv  (ji,jj,jk) )   &
-                            + zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     &
-                                        +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   &
-                            + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     &
-                                        +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )  )
-            END DO
-         END DO
-
-
-         ! II.3 Divergence of vertical fluxes added to the horizontal divergence
-         ! ---------------------------------------------------------------------
-         IF( (kahm -nkahm_smag) ==1 ) THEN
-            ! multiply the laplacian by the eddy viscosity coefficient
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  ! eddy coef. divided by the volume element
-                  zbur = fsahmu(ji,jj,jk) / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) )
-                  zbvr = fsahmv(ji,jj,jk) / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) )
-                  ! vertical divergence
-                  zuav = zfuw(ji,jk) - zfuw(ji,jk+1)
-                  zvav = zfvw(ji,jk) - zfvw(ji,jk+1)
-                  ! harmonic operator applied to (pu,pv) and multiply by ahm
-                  plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur
-                  plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr
-               END DO
-            END DO
-         ELSEIF( (kahm +nkahm_smag ) == 2 ) THEN
-            ! second call, no multiplication
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  ! inverse of the volume element
-                  zbur = 1. / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) )
-                  zbvr = 1. / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) )
-                  ! vertical divergence
-                  zuav = zfuw(ji,jk) - zfuw(ji,jk+1)
-                  zvav = zfvw(ji,jk) - zfvw(ji,jk+1)
-                  ! harmonic operator applied to (pu,pv) 
-                  plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur
-                  plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr
-               END DO
-            END DO
-         ELSE
-            IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm
-            IF(lwp)WRITE(numout,*) '         We stop'
-            STOP 'ldfguv'
-         ENDIF
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      CALL wrk_dealloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ldfguv')
-      !
-   END SUBROUTINE ldfguv
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                         NO rotation of mixing tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE dyn_ldf_bilapg( kt )               ! Dummy routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'dyn_ldf_bilapg: You should not have seen this print! error?', kt
-   END SUBROUTINE dyn_ldf_bilapg
-#endif
-
-   !!======================================================================
-END MODULE dynldf_bilapg
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 5901)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                     ***  MODULE  dynldf_iso  ***
-   !! Ocean dynamics:  lateral viscosity trend
+   !! Ocean dynamics:   lateral viscosity trend (rotated laplacian operator)
    !!======================================================================
    !! History :  OPA  !  97-07  (G. Madec)  Original code
@@ -8,8 +8,8 @@
    !!             -   !  2004-08  (C. Talandier) New trends organization
    !!            2.0  !  2005-11  (G. Madec)  s-coordinate: horizontal diffusion
+   !!            3.7  !  2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification,
+   !!                 !                                   add velocity dependent coefficient and optional read in file
    !!----------------------------------------------------------------------
-#if defined key_ldfslp   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_ldfslp'                      slopes of the direction of mixing
+
    !!----------------------------------------------------------------------
    !!   dyn_ldf_iso  : update the momentum trend with the horizontal part
@@ -19,12 +19,12 @@
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE ldfdyn_oce      ! ocean dynamics lateral physics
-   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE ldfdyn          ! lateral diffusion: eddy viscosity coef.
+   USE ldftra          ! lateral physics: eddy diffusivity
    USE zdf_oce         ! ocean vertical physics
    USE ldfslp          ! iso-neutral slopes 
    !
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE in_out_manager  ! I/O manager
    USE lib_mpp         ! MPP library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE prtctl          ! Print control
    USE wrk_nemo        ! Memory Allocation
@@ -42,5 +42,4 @@
    !! * Substitutions
 #  include "domzgr_substitute.h90"
-#  include "ldfdyn_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -83,13 +82,13 @@
       !!      horizontal fluxes associated with the rotated lateral mixing:
       !!      u-component:
-      !!         ziut = ( ahmt + ahmb0 ) e2t * e3t / e1t  di[ ub ]
-      !!               -      ahmt       e2t * mi-1(uslp) dk[ mi(mk(ub)) ]
-      !!         zjuf = ( ahmf + ahmb0 ) e1f * e3f / e2f  dj[ ub ]
-      !!               -      ahmf       e1f * mi(vslp)   dk[ mj(mk(ub)) ]
+      !!         ziut = ( ahmt + rn_ahm_b ) e2t * e3t / e1t  di[ ub ]
+      !!               -  ahmt              e2t * mi-1(uslp) dk[ mi(mk(ub)) ]
+      !!         zjuf = ( ahmf + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ]
+      !!               -  ahmf              e1f * mi(vslp)   dk[ mj(mk(ub)) ]
       !!      v-component:
-      !!         zivf = ( ahmf + ahmb0 ) e2t * e3t / e1t  di[ vb ]
-      !!               -      ahmf       e2t * mj(uslp)   dk[ mi(mk(vb)) ]
-      !!         zjvt = ( ahmt + ahmb0 ) e1f * e3f / e2f  dj[ ub ]
-      !!               -      ahmt       e1f * mj-1(vslp) dk[ mj(mk(vb)) ]
+      !!         zivf = ( ahmf + rn_ahm_b ) e2t * e3t / e1t  di[ vb ]
+      !!               -  ahmf              e2t * mj(uslp)   dk[ mi(mk(vb)) ]
+      !!         zjvt = ( ahmt + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ]
+      !!               -  ahmt              e1f * mj-1(vslp) dk[ mj(mk(vb)) ]
       !!      take the horizontal divergence of the fluxes:
       !!         diffu = 1/(e1u*e2u*e3u) {  di  [ ziut ] + dj-1[ zjuf ]  }
@@ -106,10 +105,9 @@
       !!      of the rotated operator in dynzdf module
       !!----------------------------------------------------------------------
-      !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   zabe1, zabe2, zcof1, zcof2                       ! local scalars
-      REAL(wp) ::   zmskt, zmskf, zbu, zbv, zuah, zvah               !   -      -
+      REAL(wp) ::   zmskt, zmskf                                     !   -      -
       REAL(wp) ::   zcoef0, zcoef3, zcoef4, zmkt, zmkf               !   -      -
       REAL(wp) ::   zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      -
@@ -130,5 +128,6 @@
       ENDIF
 
-      ! s-coordinate: Iso-level diffusion on tracer, but geopotential level diffusion on momentum
+!!gm bug is dyn_ldf_iso called before tra_ldf_iso ....   <<<<<===== TO BE CHECKED
+      ! s-coordinate: Iso-level diffusion on momentum but not on tracer
       IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN
          !
@@ -136,8 +135,8 @@
             DO jj = 2, jpjm1
                DO ji = 2, jpim1
-                  uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)
-                  vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)
-                  wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5
-                  wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5
+                  uslp (ji,jj,jk) = - ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
+                  vslp (ji,jj,jk) = - ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
+                  wslpi(ji,jj,jk) = - ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5
+                  wslpj(ji,jj,jk) = - ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5
                END DO
             END DO
@@ -184,11 +183,26 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, jpi   ! vector opt.
-                  zabe1 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) / e1t(ji,jj)
-
-                  zmskt = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   &
-                     &           + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. )
-
-                  zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) * r1_e1t(ji,jj)
+
+                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     &
+                     &                 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ) , 1._wp )
+
+                  zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
    
+                  ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )    &
+                     &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)      &
+                     &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         ELSE                   ! other coordinate system (zco or sco) : e3t
+            DO jj = 2, jpjm1
+               DO ji = fs_2, jpi   ! vector opt.
+                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * fse3t(ji,jj,jk) * r1_e1t(ji,jj)
+
+                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     &
+                     &                 + umask(ji-1,jj,jk+1) + umask(ji,jj,jk  ) , 1._wp )
+
+                  zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+
                   ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )   &
                      &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
@@ -196,19 +210,4 @@
                END DO
             END DO
-         ELSE                   ! other coordinate system (zco or sco) : e3t
-            DO jj = 2, jpjm1
-               DO ji = fs_2, jpi   ! vector opt.
-                  zabe1 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)
-
-                  zmskt = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   &
-                     &           + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. )
-
-                  zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
-
-                  ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )   &
-                     &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
-                     &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
          ENDIF
 
@@ -216,10 +215,10 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-               zabe2 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj)
-
-               zmskf = 1./MAX(  umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)   &
-                  &           + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. )
-
-               zcof2 = - aht0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
+               zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * fse3f(ji,jj,jk) * r1_e2f(ji,jj)
+
+               zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     &
+                  &                 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ) , 1._wp )
+
+               zcof2 = - rn_aht_0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
 
                zjuf(ji,jj) = (  zabe2 * ( ub(ji,jj+1,jk) - ub(ji,jj,jk) )   &
@@ -237,14 +236,14 @@
          DO jj = 2, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-               zabe1 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)
-
-               zmskf = 1./MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)   &
-                  &           + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. )
-
-               zcof1 = - aht0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
-
-               zivf(ji,jj) = (  zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) )   &
-                  &           + zcof1 * ( zdkv (ji,jj) + zdk1v(ji+1,jj)     &
-                  &                      +zdk1v(ji,jj) + zdkv (ji+1,jj) )  ) * fmask(ji,jj,jk)
+               zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * fse3f(ji,jj,jk) * r1_e1f(ji,jj)
+
+               zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     &
+                  &                + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
+
+               zcof1 = - rn_aht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
+
+               zivf(ji,jj) = (  zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) )    &
+                  &           + zcof1 * (  zdkv (ji,jj) + zdk1v(ji+1,jj)      &
+                  &                      + zdk1v(ji,jj) + zdkv (ji+1,jj) )  ) * fmask(ji,jj,jk)
             END DO
          END DO
@@ -254,10 +253,25 @@
             DO jj = 2, jpj
                DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe2 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) / e2t(ji,jj)
+                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) * r1_e2t(ji,jj)
+
+                  zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     &
+                     &                + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
+
+                  zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+
+                  zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )    &
+                     &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)      &
+                     &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         ELSE                   ! other coordinate system (zco or sco) : e3t
+            DO jj = 2, jpj
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * fse3t(ji,jj,jk) * r1_e2t(ji,jj)
 
                   zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   &
                      &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. )
 
-                  zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+                  zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
 
                   zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )   &
@@ -266,19 +280,4 @@
                END DO
             END DO
-         ELSE                   ! other coordinate system (zco or sco) : e3t
-            DO jj = 2, jpj
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe2 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)
-
-                  zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   &
-                     &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. )
-
-                  zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
-
-                  zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )   &
-                     &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)     &
-                     &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
          ENDIF
 
@@ -286,18 +285,10 @@
          ! Second derivative (divergence) and add to the general trend
          ! -----------------------------------------------------------
-
          DO jj = 2, jpjm1
-            DO ji = 2, jpim1          !! Question vectop possible??? !!bug
-               ! volume elements
-               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
-               ! horizontal component of isopycnal momentum diffusive trends
-               zuah =( ziut (ji+1,jj) - ziut (ji,jj  ) +   &
-                  &    zjuf (ji  ,jj) - zjuf (ji,jj-1)  ) / zbu
-               zvah =( zivf (ji,jj  ) - zivf (ji-1,jj) +   &
-                  &    zjvt (ji,jj+1) - zjvt (ji,jj  )  ) / zbv
-               ! add the trends to the general trends
-               ua (ji,jj,jk) = ua (ji,jj,jk) + zuah
-               va (ji,jj,jk) = va (ji,jj,jk) + zvah
+            DO ji = 2, jpim1          !!gm Question vectop possible??? !!bug
+               ua(ji,jj,jk) = ua(ji,jj,jk) + ( ziut(ji+1,jj) - ziut(ji,jj  )    &
+                  &                          + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )
+               va(ji,jj,jk) = va(ji,jj,jk) + ( zivf(ji,jj  ) - zivf(ji-1,jj)    &
+                  &                          + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )
             END DO
          END DO
@@ -358,13 +349,13 @@
          DO jk = 2, jpkm1
             DO ji = 2, jpim1
-               zcoef0= 0.5 * aht0 * umask(ji,jj,jk)
-
+               zcoef0= 0.5 * rn_aht_0 * umask(ji,jj,jk)
+               !
                zuwslpi = zcoef0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) )
                zuwslpj = zcoef0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) )
-
+               !
                zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   &
                              + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. )
-               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1)+fmask(ji,jj,jk-1)   &
-                             + fmask(ji,jj-1,jk  )+fmask(ji,jj,jk  ), 1. )
+               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1) + fmask(ji,jj,jk-1)   &
+                             + fmask(ji,jj-1,jk  ) + fmask(ji,jj,jk  ), 1. )
 
                zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi
@@ -376,6 +367,6 @@
                                        +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) )
                ! update avmu (add isopycnal vertical coefficient to avmu)
-               ! Caution: zcoef0 include aht0, so divided by aht0 to obtain slp^2 * aht0
-               avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / aht0
+               ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / rn_aht_0
             END DO
          END DO
@@ -384,5 +375,5 @@
          DO jk = 2, jpkm1
             DO ji = 2, jpim1
-               zcoef0= 0.5 * aht0 * vmask(ji,jj,jk)
+               zcoef0 = 0.5 * rn_aht_0 * vmask(ji,jj,jk)
 
                zvwslpi = zcoef0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) )
@@ -398,10 +389,10 @@
                ! vertical flux on v field
                zfvw(ji,jk) = zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     &
-                                       +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   &
-                           + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     &
-                                       +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )
+                  &                    +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   &
+                  &        + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     &
+                  &                    +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )
                ! update avmv (add isopycnal vertical coefficient to avmv)
-               ! Caution: zcoef0 include aht0, so divided by aht0 to obtain slp^2 * aht0
-               avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / aht0
+               ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / rn_aht_0
             END DO
          END DO
@@ -412,13 +403,6 @@
          DO jk = 1, jpkm1
             DO ji = 2, jpim1
-               ! volume elements
-               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
-               ! part of the k-component of isopycnal momentum diffusive trends
-               zuav = ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / zbu
-               zvav = ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / zbv
-               ! add the trends to the general trends
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zuav
-               va(ji,jj,jk) = va(ji,jj,jk) + zvav
+               ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )
+               va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )
             END DO
          END DO
@@ -432,15 +416,4 @@
    END SUBROUTINE dyn_ldf_iso
 
-# else
-   !!----------------------------------------------------------------------
-   !!   Dummy module                           NO rotation of mixing tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE dyn_ldf_iso( kt )               ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'dyn_ldf_iso: You should not have seen this print! error?', kt
-   END SUBROUTINE dyn_ldf_iso
-#endif
-
    !!======================================================================
 END MODULE dynldf_iso
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90	(revision 5891)
+++ 	(revision )
@@ -1,100 +1,0 @@
-MODULE dynldf_lap
-   !!======================================================================
-   !!                       ***  MODULE  dynldf_lap  ***
-   !! Ocean dynamics:  lateral viscosity trend
-   !!======================================================================
-   !! History :  OPA  ! 1990-09 (G. Madec) Original code
-   !!            4.0  ! 1991-11 (G. Madec)
-   !!            6.0  ! 1996-01 (G. Madec) statement function for e3 and ahm
-   !!   NEMO     1.0  ! 2002-06 (G. Madec)  F90: Free form and module
-   !!             -   ! 2004-08 (C. Talandier) New trends organization
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dyn_ldf_lap  : update the momentum trend with the lateral diffusion
-   !!                  using an iso-level harmonic operator
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE ldfdyn_oce      ! ocean dynamics: lateral physics
-   USE zdf_oce         ! ocean vertical physics
-   !
-   USE in_out_manager  ! I/O manager
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC dyn_ldf_lap  ! called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldfdyn_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dyn_ldf_lap( kt )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE dyn_ldf_lap  ***
-      !!                       
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The before horizontal momentum diffusion trend is an
-      !!      harmonic operator (laplacian type) which separates the divergent
-      !!      and rotational parts of the flow.
-      !!      Its horizontal components are computed as follow:
-      !!         difu = 1/e1u di[ahmt hdivb] - 1/(e2u*e3u) dj-1[e3f ahmf rotb]
-      !!         difv = 1/e2v dj[ahmt hdivb] + 1/(e1v*e3v) di-1[e3f ahmf rotb]
-      !!      in the rotational part of the diffusion.
-      !!      Add this before trend to the general trend (ua,va):
-      !!            (ua,va) = (ua,va) + (diffu,diffv)
-      !!
-      !! ** Action : - Update (ua,va) with the iso-level harmonic mixing trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk             ! dummy loop indices
-      REAL(wp) ::   zua, zva, ze2u, ze1v   ! local scalars
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_lap')
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator'
-         IF(lwp) WRITE(numout,*) '~~~~~~~ '
-      ENDIF
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ze2u = rotb (ji,jj,jk) * fsahmf(ji,jj,jk) * fse3f(ji,jj,jk)
-               ze1v = hdivb(ji,jj,jk) * fsahmt(ji,jj,jk)
-               ! horizontal diffusive trends
-               zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)*fse3f(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
-                     + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v                   ) / e1u(ji,jj)
-
-               zva = + ( ze2u - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk)*fse3f(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
-                     + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v                   ) / e2v(ji,jj)
-
-               ! add it to the general momentum trends
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
-               va(ji,jj,jk) = va(ji,jj,jk) + zva
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_lap')
-      !
-   END SUBROUTINE dyn_ldf_lap
-
-   !!======================================================================
-END MODULE dynldf_lap
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90	(revision 5901)
@@ -0,0 +1,169 @@
+MODULE dynldf_lap_blp
+   !!======================================================================
+   !!                   ***  MODULE  dynldf_lap_blp  ***
+   !! Ocean dynamics:  lateral viscosity trend (laplacian and bilaplacian)
+   !!======================================================================
+   !! History :  OPA  ! 1990-09 (G. Madec) Original code
+   !!            4.0  ! 1991-11 (G. Madec)
+   !!            6.0  ! 1996-01 (G. Madec) statement function for e3 and ahm
+   !!   NEMO     1.0  ! 2002-06 (G. Madec)  F90: Free form and module
+   !!             -   ! 2004-08 (C. Talandier) New trends organization
+   !!            3.7  ! 2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification,
+   !!                 !                                  add velocity dependent coefficient and optional read in file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_ldf_lap   : update the momentum trend with the lateral viscosity using an iso-level   laplacian operator
+   !!   dyn_ldf_blp   : update the momentum trend with the lateral viscosity using an iso-level bilaplacian operator
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
+   USE ldfslp         ! iso-neutral slopes 
+   USE zdf_oce        ! ocean vertical physics
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dyn_ldf_lap  ! called by dynldf.F90
+   PUBLIC dyn_ldf_blp  ! called by dynldf.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_ldf_lap( kt, pub, pvb, pua, pva, kpass )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dyn_ldf_lap  ***
+      !!                       
+      !! ** Purpose :   Compute the before horizontal momentum diffusive 
+      !!      trend and add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The Laplacian operator apply on horizontal velocity is 
+      !!      writen as :   grad_h( ahmt div_h(U )) - curl_h( ahmf curl_z(U) ) 
+      !!
+      !! ** Action : - pua, pva increased by the harmonic operator applied on pub, pvb.
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity  [m/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! velocity trend   [m/s2]
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zsign        ! local scalars
+      REAL(wp) ::   zua, zva     ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zcur, zdiv
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass
+         WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dyn_ldf_lap')
+      !
+      CALL wrk_alloc( jpi, jpj, zcur, zdiv ) 
+      !
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign
+      ELSE                    ;   zsign = -1._wp      !  (eddy viscosity coef. >0)
+      ENDIF
+      !
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         DO jj = 2, jpj
+            DO ji = fs_2, jpi   ! vector opt.
+               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1)
+!!gm open question here : fse3f  at before or now ?    probably now...
+!!gm note that ahmf has already been multiplied by fmask
+               zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * fse3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &
+                  &     * (  e2v(ji  ,jj-1) * pvb(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk)  &
+                  &        - e1u(ji-1,jj  ) * pub(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk)  ) 
+               !                                      ! ahm * div        (computed from 2 to jpi/jpj)
+               zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / fse3t_b(ji,jj,jk) * tmask(ji,jj,jk)                           &
+                  &     * (  e2u(ji,jj)*fse3u_b(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*fse3u_b(ji-1,jj,jk) * pub(ji-1,jj,jk)  &
+                  &        + e1v(ji,jj)*fse3v_b(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*fse3v_b(ji,jj-1,jk) * pvb(ji,jj-1,jk)  )
+            END DO  
+         END DO  
+         !
+         DO jj = 2, jpjm1                             ! - curl( curl) + grad( div )
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * (                                                   &
+                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) /  ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
+                  &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     )
+                  !
+               pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * (                                                   &
+                  &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) /  ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
+                  &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     )
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      CALL wrk_dealloc( jpi, jpj, zcur, zdiv ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_lap')
+      !
+   END SUBROUTINE dyn_ldf_lap
+
+
+   SUBROUTINE dyn_ldf_blp( kt, pub, pvb, pua, pva )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dyn_ldf_blp  ***
+      !!                    
+      !! ** Purpose :   Compute the before lateral momentum viscous trend 
+      !!              and add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The lateral viscous trends is provided by a bilaplacian
+      !!      operator applied to before field (forward in time).
+      !!      It is computed by two successive calls to dyn_ldf_lap routine
+      !!
+      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! momentum trend
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zulap, zvlap   ! laplacian at u- and v-point
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_blp')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zulap, zvlap ) 
+      !
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+      !
+      zulap(:,:,:) = 0._wp
+      zvlap(:,:,:) = 0._wp
+      !
+      CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 )   ! rotated laplacian applied to ptb (output in zlap)
+      !
+      CALL lbc_lnk( zulap(:,:,:) , 'U', -1. )             ! Lateral boundary conditions
+      CALL lbc_lnk( zvlap(:,:,:) , 'V', -1. )
+      !
+      CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 )   ! rotated laplacian applied to zlap (output in pta)
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zulap, zvlap ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_blp')
+      !
+   END SUBROUTINE dyn_ldf_blp
+
+   !!======================================================================
+END MODULE dynldf_lap_blp
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90	(revision 5891)
+++ 	(revision )
@@ -1,597 +1,0 @@
-MODULE dynnept
-   !!======================================================================
-   !!                       ***  MODULE  dynnept  ***
-   !! Ocean dynamics: Neptune effect as proposed by Greg Holloway,
-   !!                 recoded version of simplest case (u*, v* only)
-   !!======================================================================
-   !! History :  1.0  !  2007-06  (Michael Dunphy)  Modular form: - new namelist parameters
-   !!                                                             - horizontal diffusion for Neptune
-   !!                                                             - vertical diffusion for gm in momentum eqns
-   !!                                                             - option to use Neptune in Coriolis eqn
-   !!                    2011-08  (Jeff Blundell, NOCS) Simplified form for temporally invariant u*, v*
-   !!                                               Horizontal and vertical diffusivity formulations removed
-   !!                                               Dynamic allocation of storage added
-   !!                                               Option of ramping Neptune vel. down
-   !!                                               to zero added in shallow depths added
-   !!----------------------------------------------------------------------
-   !! dynnept_alloc        :
-   !! dyn_nept_init        :
-   !! dyn_nept_div_cur_init:
-   !! dyn_nept_cor         :
-   !! dyn_nept_vel         :
-   !! dyn_nept_smooth_vel  :
-   !!----------------------------------------------------------------------
-   USE oce              ! ocean dynamics and tracers
-   USE dom_oce          ! ocean space and time domain
-   USE in_out_manager   ! I/O manager
-   USE lib_mpp          ! distributed memory computing
-   USE prtctl           ! Print control
-   USE phycst
-   USE lbclnk
-   USE wrk_nemo        ! Memory Allocation
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC dyn_nept_init      ! routine called by nemogcm.F90
-   PUBLIC dyn_nept_cor       ! routine called by step.F90
-   !! dynnept_alloc()         is called only by dyn_nept_init, within this module
-   !! dyn_nept_div_cur_init   is called only by dyn_nept_init, within this module
-   !! dyn_nept_vel            is called only by dyn_nept_cor,  within this module
-
-   !! * Shared module variables
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)    :: zunep, zvnep  ! Neptune u and v
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: zhdivnep      ! hor. div for Neptune vel.
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: zmrotnep      ! curl for Neptune vel.
-
-
-   !! * Namelist namdyn_nept variables
-   LOGICAL, PUBLIC  ::  ln_neptsimp          ! yes/no simplified neptune
-
-   LOGICAL          ::  ln_smooth_neptvel    ! yes/no smooth zunep, zvnep
-   REAL(wp)         ::  rn_tslse             ! value of lengthscale L at the equator
-   REAL(wp)         ::  rn_tslsp             ! value of lengthscale L at the pole
-!! Specify whether to ramp down the Neptune velocity in shallow
-!! water, and the depth range controlling such ramping down
-   LOGICAL          ::  ln_neptramp          ! ramp down Neptune velocity in shallow water
-   REAL(wp)         ::  rn_htrmin            ! min. depth of transition range
-   REAL(wp)         ::  rn_htrmax            ! max. depth of transition range
-
-   !! * Module variables
-
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , implemented by Bedford Institute of Oceanography
-   !!----------------------------------------------------------------------
-
-   !! $Id$
- CONTAINS
-
-   INTEGER FUNCTION dynnept_alloc()
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE dynnept_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( zunep(jpi,jpj) , zvnep(jpi,jpj) ,     &
-         &      zhdivnep(jpi,jpj,jpk) , zmrotnep(jpi,jpj,jpk) , STAT=dynnept_alloc )
-         !
-      IF( dynnept_alloc /= 0 )   CALL ctl_warn('dynnept_alloc: array allocate failed.')
-   END FUNCTION dynnept_alloc
-
-
-   SUBROUTINE dyn_nept_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_nept_init  ***
-      !!
-      !! ** Purpose :   Read namelist parameters, initialise arrays
-      !!                and compute the arrays zunep and zvnep
-      !!
-      !! ** Method  :   zunep =
-      !!                zvnep =
-      !!
-      !! ** History :  1.0  !   07-05  (Zeliang Wang)   Original code for zunep, zvnep
-      !!               1.1  !   07-06  (Michael Dunphy) namelist and  initialisation
-      !!               2.0  ! 2011-07  (Jeff Blundell, NOCS)
-      !!                    ! Simplified form for temporally invariant u*, v*
-      !!                    ! Horizontal and vertical diffusivity formulations removed
-      !!                    ! Includes optional tapering-off in shallow depths
-      !!----------------------------------------------------------------------
-      USE iom
-      !!
-      INTEGER  ::   ji, jj, jk    ! dummy loop indices
-      REAL(wp) :: unemin,unemax,vnemin,vnemax   ! extrema of (u*, v*) fields
-      REAL(wp) :: zhdivmin,zhdivmax             ! extrema of horizontal divergence of (u*, v*) fields
-      REAL(wp) :: zmrotmin,zmrotmax             ! extrema of the curl of the (u*, v*) fields
-      REAL(wp) :: ustar,vstar                   ! (u*, v*) before tapering in shallow water
-      REAL(wp) :: hramp                         ! depth over which Neptune vel. is ramped down
-      !
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n      
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: znmask
-      !!
-      NAMELIST/namdyn_nept/ ln_neptsimp, ln_smooth_neptvel, rn_tslse, rn_tslsp,      &
-                            ln_neptramp, rn_htrmin, rn_htrmax
-      INTEGER  ::   ios
-      !!----------------------------------------------------------------------
-      ! Define the (simplified) Neptune parameters
-      ! ==========================================
-
-      REWIND( numnam_ref )              ! Namelist namdyn_nept in reference namelist : Simplified Neptune
-      READ  ( numnam_ref, namdyn_nept, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_nept in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namdyn_nept in reference namelist : Simplified Neptune
-      READ  ( numnam_cfg, namdyn_nept, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_nept in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namdyn_nept )
-
-      IF(lwp) THEN                      ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dyn_nept_init : Simplified Neptune module'
-         WRITE(numout,*) '~~~~~~~~~~~~~'
-         WRITE(numout,*) ' -->   Reading namelist namdyn_nept parameters:'
-         WRITE(numout,*) '       ln_neptsimp          = ', ln_neptsimp
-         WRITE(numout,*)
-         IF( ln_neptsimp ) THEN
-            WRITE(numout,*) '       ln_smooth_neptvel    = ', ln_smooth_neptvel
-            WRITE(numout,*) '       rn_tslse             = ', rn_tslse
-            WRITE(numout,*) '       rn_tslsp             = ', rn_tslsp
-            WRITE(numout,*)
-            WRITE(numout,*) '       ln_neptramp          = ', ln_neptramp
-            WRITE(numout,*) '       rn_htrmin            = ', rn_htrmin
-            WRITE(numout,*) '       rn_htrmax            = ', rn_htrmax
-            WRITE(numout,*)
-         ENDIF
-      ENDIF
-      !
-      IF( .NOT. ln_neptsimp ) RETURN
-      !                                 ! Dynamically allocate local work arrays
-      CALL wrk_alloc( jpi, jpj     , zht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n  ) 
-      CALL wrk_alloc( jpi, jpj, jpk, znmask                                          ) 
-
-      IF( ln_smooth_neptvel ) THEN
-         IF(lwp) WRITE(numout,*) ' -->   neptune velocities will be smoothed'
-      ELSE
-         IF(lwp) WRITE(numout,*) ' -->   neptune velocities will not be smoothed'
-      ENDIF
-
-      IF( ln_neptramp ) THEN
-          IF(lwp) WRITE(numout,*) ' -->   ln_neptramp enabled, ramp down Neptune'
-          IF(lwp) WRITE(numout,*) ' -->   velocity components in shallow water'
-      ELSE
-          IF(lwp) WRITE(numout,*) ' -->   ln_neptramp disabled'
-      ENDIF
-
-
-!!    Perform dynamic allocation of shared module variables
-      IF( dynnept_alloc() /= 0 )   CALL ctl_warn('dynnept_alloc: array allocate failed.')
-
-      IF( .not. ln_rstart ) THEN      ! If restarting, these arrays are read from the restart file
-         zhdivnep(:,:,:) = 0.0_wp
-         zmrotnep(:,:,:) = 0.0_wp
-      END IF
-
-      ! Computation of nmask: same as fmask, but fmask cannot be used
-      ! because it is modified after it is computed in dom_msk
-      ! (this can be optimised to save memory, such as merge into next loop)
-      DO jk = 1, jpk
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector loop
-               znmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
-                   &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
-            END DO
-         END DO
-      END DO
-
-      CALL lbc_lnk( znmask, 'F', 1.0_wp )
-
-
-      ! now compute zunep, zvnep (renamed from earlier versions)
-
-      zunep(:,:) = 0.0_wp
-      zvnep(:,:) = 0.0_wp
-
-      htn(:,:) = 0.0_wp            ! ocean depth at F-point
-      DO jk = 1, jpk
-         htn(:,:) = htn(:,:) + fse3f(:,:,jk) * znmask(:,:,jk)
-      END DO
-
-      IF( ln_smooth_neptvel ) THEN
-         CALL dyn_nept_smooth_vel( htn, zht, .TRUE. )
-      !! overwrites zht with a smoothed version of htn
-      ELSE
-         zht(:,:) = htn(:,:)
-      !! use unsmoothed version of htn
-      ENDIF
-      CALL lbc_lnk( zht, 'F', 1.0_wp )
-
-      !! Compute tsp, a stream function for the Neptune velocity,
-      !! with the usual geophysical sign convention
-      !! Then zunep = -latitudinal derivative "-(1/H)*d(tsp)/dy"
-      !!      zvnep = longitudinal derivative " (1/H)*d(tsp)/dx"
-
-      tsp(:,:)    = 0.0_wp
-      tscale(:,:) = 0.0_wp
-
-      tscale(:,:) = rn_tslsp + (rn_tslse - rn_tslsp) *   &
-                   ( 0.5_wp + 0.5_wp * COS( 2.0_wp * rad * gphif(:,:) )  )
-      tsp   (:,:) = -2.0_wp * omega * SIN( rad * gphif(:,:) ) * tscale(:,:) * tscale(:,:) * zht(:,:)
-
-
-      IF( ln_smooth_neptvel ) THEN
-         CALL dyn_nept_smooth_vel( hu, hu_n, .TRUE. )
-      !! overwrites hu_n with a smoothed version of hu
-      ELSE
-         hu_n(:,:) = hu(:,:)
-      !! use unsmoothed version of hu
-      ENDIF
-      CALL lbc_lnk( hu_n, 'U', 1.0_wp )
-      hu_n(:,:) = hu_n(:,:) * umask(:,:,1)
-
-      WHERE( hu_n(:,:) == 0.0_wp )
-         hur_n(:,:) = 0.0_wp
-      ELSEWHERE
-         hur_n(:,:) = 1.0_wp / hu_n(:,:)
-      END WHERE
-
-
-      IF( ln_smooth_neptvel ) THEN
-         CALL dyn_nept_smooth_vel( hv, hv_n, .TRUE. )
-      !! overwrites hv_n with a smoothed version of hv
-      ELSE
-         hv_n(:,:) = hv(:,:)
-      !! use unsmoothed version of hv
-      ENDIF
-      CALL lbc_lnk( hv_n, 'V', 1.0_wp )
-      hv_n(:,:) = hv_n(:,:) * vmask(:,:,1)
-
-      WHERE( hv_n == 0.0_wp )
-         hvr_n(:,:) = 0.0_wp
-      ELSEWHERE
-         hvr_n(:,:) = 1.0_wp / hv_n(:,:)
-      END WHERE
-
-
-      unemin =  1.0e35
-      unemax = -1.0e35
-      vnemin =  1.0e35
-      vnemax = -1.0e35
-      hramp = rn_htrmax - rn_htrmin
-      DO jj = 2, jpj-1
-         DO ji = 2, jpi-1
-            if ( umask(ji,jj,1) /= 0.0_wp ) then
-               ustar =-1.0_wp/e2u(ji,jj) * hur_n(ji,jj) * ( tsp(ji,jj)-tsp(ji,jj-1) ) * umask(ji,jj,1)
-               if ( ln_neptramp ) then
-!!                Apply ramp down to velocity component
-                  if ( hu_n(ji,jj) <= rn_htrmin ) then
-                    zunep(ji,jj) = 0.0_wp
-                   else if ( hu_n(ji,jj) >= rn_htrmax ) then
-                    zunep(ji,jj) = ustar
-                   else if ( hramp > 0.0_wp ) then
-                    zunep(ji,jj) = ( hu_n(ji,jj) - rn_htrmin) * ustar/hramp
-                  endif
-                else
-                 zunep(ji,jj) = ustar
-               endif 
-             else
-              zunep(ji,jj) = 0.0_wp
-            endif
-            if ( vmask(ji,jj,1) /= 0.0_wp ) then
-               vstar = 1.0_wp/e1v(ji,jj) * hvr_n(ji,jj) * ( tsp(ji,jj)-tsp(ji-1,jj) ) * vmask(ji,jj,1)
-               if ( ln_neptramp ) then
-!!                Apply ramp down to velocity component
-                  if ( hv_n(ji,jj) <= rn_htrmin ) then
-                    zvnep(ji,jj) = 0.0_wp
-                   else if ( hv_n(ji,jj) >= rn_htrmax ) then
-                    zvnep(ji,jj) = vstar
-                   else if ( hramp > 0.0_wp ) then
-                    zvnep(ji,jj) = ( hv_n(ji,jj) - rn_htrmin) * vstar/hramp
-                  endif
-                else
-                  zvnep(ji,jj) = vstar
-               endif
-             else
-              zvnep(ji,jj) = 0.0_wp
-            endif
-            unemin = min( unemin, zunep(ji,jj) )
-            unemax = max( unemax, zunep(ji,jj) )
-            vnemin = min( vnemin, zvnep(ji,jj) )
-            vnemax = max( vnemax, zvnep(ji,jj) )
-         END DO
-      END DO
-      CALL lbc_lnk( zunep, 'U', -1.0_wp )
-      CALL lbc_lnk( zvnep, 'V', -1.0_wp )
-      WRITE(numout,*) '      zunep: min, max       = ', unemin,unemax
-      WRITE(numout,*) '      zvnep: min, max       = ', vnemin,vnemax
-      WRITE(numout,*)
-
-      !!  Compute, once and for all, the horizontal divergence (zhdivnep)
-      !!  and the curl (zmrotnep) of the Neptune velocity field (zunep, zvnep)
-      CALL dyn_nept_div_cur_init
-
-      !! Check the ranges of the computed divergence & vorticity
-      zhdivmin =  1.0e35
-      zhdivmax = -1.0e35
-      zmrotmin =  1.0e35
-      zmrotmax = -1.0e35
-      hramp = rn_htrmax - rn_htrmin
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         DO jj = 2, jpj-1
-            DO ji = 2, jpi-1
-               zhdivmin = min( zhdivmin, zhdivnep(ji,jj,jk) )
-               zhdivmax = max( zhdivmax, zhdivnep(ji,jj,jk) )
-               zmrotmin = min( zmrotmin, zmrotnep(ji,jj,jk) )
-               zmrotmax = max( zmrotmax, zmrotnep(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
-      WRITE(numout,*) '   zhdivnep: min, max       = ', zhdivmin,zhdivmax
-      WRITE(numout,*) '   zmrotnep: min, max       = ', zmrotmin,zmrotmax
-      WRITE(numout,*)
-
-!!    Deallocate temporary workspace arrays, which are all local to
-!!    this routine, except where passed as arguments to other routines
-      CALL wrk_dealloc( jpi, jpj     , zht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n  ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, znmask                                          ) 
-      !
-   END SUBROUTINE dyn_nept_init
-
-
-   SUBROUTINE dyn_nept_div_cur_init
-      !!----------------------------------------------------------------------
-      !!             ***  ROUTINE dyn_nept_div_cur_init  ***
-      !!
-      !! ** Purpose :   compute the horizontal divergence and the relative
-      !!                vorticity of the time-invariant u* and v* Neptune
-      !!                effect velocities (called zunep, zvnep)
-      !!
-      !! ** Method  : - Divergence:
-      !!      - compute the divergence given by :
-      !!         zhdivnep = 1/(e1t*e2t*e3t) ( di[e2u*e3u zunep] + dj[e1v*e3v zvnep] )
-      !!      - compute the curl in tensorial formalism:
-      !!         zmrotnep = 1/(e1f*e2f) ( di[e2v zvnep] - dj[e1u zunep] )
-      !!      Note: Coastal boundary condition: lateral friction set through
-      !!      the value of fmask along the coast (see dommsk.F90) and shlat
-      !!      (namelist parameter)
-      !!
-      !! ** Action  : - compute zhdivnep, the hor. divergence of (u*, v*)
-      !!              - compute zmrotnep, the rel. vorticity  of (u*, v*)
-      !!
-      !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code
-      !!            4.0  ! 1991-11  (G. Madec)
-      !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions
-      !!            7.0  ! 1996-01  (G. Madec)  s-coordinates
-      !!            8.0  ! 1997-06  (G. Madec)  lateral boundary cond., lbc
-      !!            8.1  ! 1997-08  (J.M. Molines)  Open boundaries
-      !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
-      !!  NEMO      1.0  ! 2002-09  (G. Madec, E. Durand)  Free form, F90
-      !!             -   ! 2005-01  (J. Chanut) Unstructured open boundaries
-      !!             -   ! 2003-08  (G. Madec)  merged of cur and div, free form, F90
-      !!             -   ! 2005-01  (J. Chanut, A. Sellar) unstructured open boundaries
-      !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
-      !!                 ! 2011-06  (Jeff Blundell, NOCS) Adapt code from divcur.F90
-      !!                 !           to compute Neptune effect fields only
-      !!----------------------------------------------------------------------
-      !
-      INTEGER  ::   ji, jj, jk          ! dummy loop indices
-      !!----------------------------------------------------------------------
-      !    
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'dyn_nept_div_cur_init :'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~'
-      IF(lwp) WRITE(numout,*) 'horizontal velocity divergence and'
-      IF(lwp) WRITE(numout,*) 'relative vorticity of Neptune flow'
-#if defined key_noslip_accurate
-   !!----------------------------------------------------------------------
-   !!   'key_noslip_accurate'                     2nd order centered scheme
-   !!                                                4th order at the coast
-   !!----------------------------------------------------------------------
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'WARNING: key_noslip_accurate option'
-      IF(lwp) WRITE(numout,*) 'not implemented in simplified Neptune'
-      CALL ctl_warn( ' noslip_accurate option not implemented' )
-#endif
-
-   !!----------------------------------------------------------------------
-   !!   Default option                           2nd order centered schemes
-   !!----------------------------------------------------------------------
-
-      ! Apply the div and curl operators to the depth-dependent velocity
-      ! field produced by multiplying (zunep, zvnep) by (umask, vmask), exactly
-      ! equivalent to the equivalent calculation in the unsimplified code
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !                                             ! --------
-         ! Horizontal divergence                       !   div
-         !                                             ! --------
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zhdivnep(ji,jj,jk) =   &
-               &   (  e2u(ji  ,jj  )*fse3u(ji  ,jj  ,jk) * zunep(ji  ,jj  ) * umask(ji  ,jj  ,jk)    &
-               &    - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk) * zunep(ji-1,jj  ) * umask(ji-1,jj  ,jk)    &
-               &    + e1v(ji  ,jj  )*fse3v(ji  ,jj  ,jk) * zvnep(ji  ,jj  ) * vmask(ji  ,jj  ,jk)    &
-               &    - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * zvnep(ji  ,jj-1) * vmask(ji  ,jj-1,jk) )  &
-               &  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-
-         IF( .NOT. AGRIF_Root() ) THEN
-            IF ((nbondi ==  1).OR.(nbondi == 2))  zhdivnep(nlci-1 , :     ,jk) = 0.0_wp   ! east
-            IF ((nbondi == -1).OR.(nbondi == 2))  zhdivnep(2      , :     ,jk) = 0.0_wp   ! west
-            IF ((nbondj ==  1).OR.(nbondj == 2))  zhdivnep(:      ,nlcj-1 ,jk) = 0.0_wp   ! north
-            IF ((nbondj == -1).OR.(nbondj == 2))  zhdivnep(:      ,2      ,jk) = 0.0_wp   ! south
-         ENDIF
-
-         !                                             ! --------
-         ! relative vorticity                          !   rot
-         !                                             ! --------
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zmrotnep(ji,jj,jk) =   &
-                  &       (  e2v(ji+1,jj  ) * zvnep(ji+1,jj  ) * vmask(ji+1,jj  ,jk)     &
-                  &        - e2v(ji  ,jj  ) * zvnep(ji  ,jj  ) * vmask(ji  ,jj  ,jk)     &
-                  &        - e1u(ji  ,jj+1) * zunep(ji  ,jj+1) * umask(ji  ,jj+1,jk)     &
-                  &        + e1u(ji  ,jj  ) * zunep(ji  ,jj  ) * umask(ji  ,jj  ,jk)  )  &
-                  &       * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) )
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      ! 4. Lateral boundary conditions on zhdivnep and zmrotnep
-      ! ----------------------------------=======-----=======
-      CALL lbc_lnk( zhdivnep, 'T', 1. )   ;   CALL lbc_lnk( zmrotnep , 'F', 1. )     ! lateral boundary cond. (no sign change)
-      !
-   END SUBROUTINE dyn_nept_div_cur_init
-
-
-   SUBROUTINE dyn_nept_cor( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_nept_cor  ***
-      !!
-      !! ** Purpose :  Add or subtract the Neptune velocity from the now velocities
-      !!
-      !! ** Method  :  First call : kt not equal to lastkt -> subtract zunep, zvnep
-      !!               Second call: kt     equal to lastkt -> add zunep, zvnep
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
-      !!
-      INTEGER, SAVE :: lastkt             ! store previous kt
-      DATA lastkt/-1/                     ! initialise previous kt
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_neptsimp ) THEN
-         !
-         IF( lastkt /= kt ) THEN          ! 1st call for this kt: subtract the Neptune velocities zunep, zvnep from un, vn
-            CALL dyn_nept_vel( -1 )      ! -1 = subtract
-            !
-         ELSE                              ! 2nd call for this kt: add the Neptune velocities zunep, zvnep to un, vn
-            CALL dyn_nept_vel(  1 )      !  1 = add
-            !
-         ENDIF
-         !
-         lastkt = kt     ! Store kt
-         !
-      ENDIF
-      !
-   END SUBROUTINE dyn_nept_cor
-
-
-   SUBROUTINE dyn_nept_vel( ksign )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_nept_vel  ***
-      !!
-      !! ** Purpose :  Add or subtract the Neptune velocity from the now
-      !!               velocities based on ksign
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   ksign    ! 1 or -1 to add or subtract neptune velocities
-      !!
-      INTEGER :: jk                       ! dummy loop index
-      !!----------------------------------------------------------------------
-      !
-      ! Adjust the current velocity un, vn by adding or subtracting the
-      ! Neptune velocities zunep, zvnep, as determined by argument ksign
-      DO jk=1, jpk
-         un(:,:,jk) = un(:,:,jk) + ksign * zunep(:,:) * umask(:,:,jk)
-         vn(:,:,jk) = vn(:,:,jk) + ksign * zvnep(:,:) * vmask(:,:,jk)
-      END DO
-      !
-   END SUBROUTINE dyn_nept_vel
-
-
-   SUBROUTINE dyn_nept_smooth_vel( htold, htnew, ld_option )
-
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_nept_smooth_vel  ***
-      !!
-      !! ** Purpose :  Compute smoothed topography field.
-      !!
-      !! ** Action : - Updates the array htnew (output) with a smoothed
-      !!               version of the (input) array htold. Form of smoothing
-      !!               algorithm is controlled by the (logical) argument ld_option.
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )  ::  htold      ! temporary 2D workspace
-      LOGICAL                     , INTENT(in   )  ::  ld_option  ! temporary 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)  ::  htnew      ! temporary 2D workspace
-      !
-      INTEGER                           ::  ji, jj  ! dummy loop indices
-      INTEGER , POINTER, DIMENSION(:,:) ::  nb, iwork
-      REAL(wp), POINTER, DIMENSION(:,:) ::  work    ! temporary 2D workspace
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi, jpj, nb, iwork ) 
-      CALL wrk_alloc( jpi, jpj, work      ) 
-      !
-      iwork(:,:) = 0
-
-      !! iwork is a mask of gridpoints: iwork = 1 => ocean, iwork = 0 => land
-      WHERE( htold(:,:) > 0 )
-         iwork(:,:) = 1
-         htnew(:,:) = htold(:,:)
-      ELSEWHERE
-         iwork(:,:) = 0
-         htnew(:,:) = 0.0_wp
-      END WHERE
-      !! htnew contains valid ocean depths from htold, or zero
-
-      !! set work to a smoothed/averaged version of htnew; choice controlled by ld_option
-      !! nb is set to the sum of the weights of the valid values used in work
-      IF( ld_option ) THEN
-
-         !! Apply scale-selective smoothing in determining work from htnew
-         DO jj=2,jpj-1
-            DO ji=2,jpi-1
-               work(ji,jj) = 4.0*htnew( ji , jj ) +                        &
-                           & 2.0*htnew(ji+1, jj ) + 2.0*htnew(ji-1, jj ) + &
-                           & 2.0*htnew( ji ,jj+1) + 2.0*htnew( ji ,jj-1) + &
-                           &     htnew(ji+1,jj+1) +     htnew(ji+1,jj-1) + &
-                           &     htnew(ji-1,jj+1) +     htnew(ji-1,jj-1)
-
-               nb(ji,jj)   = 4 * iwork( ji , jj ) +                        &
-                           & 2 * iwork(ji+1, jj ) + 2 * iwork(ji-1, jj ) + &
-                           & 2 * iwork( ji ,jj+1) + 2 * iwork( ji ,jj-1) + &
-                           &     iwork(ji+1,jj+1) +     iwork(ji+1,jj-1) + &
-                           &     iwork(ji-1,jj+1) +     iwork(ji-1,jj-1)
-            END DO
-         END DO
-
-      ELSE
-
-         !! Apply simple 9-point averaging in determining work from htnew
-         DO jj=2,jpj-1
-            DO ji=2,jpi-1
-               work(ji,jj) =  htnew( ji , jj ) +                    &
-                           &  htnew(ji+1, jj ) + htnew(ji-1, jj ) + &
-                           &  htnew( ji ,jj+1) + htnew( ji ,jj-1) + &
-                           &  htnew(ji+1,jj+1) + htnew(ji+1,jj-1) + &
-                           &  htnew(ji-1,jj+1) + htnew(ji-1,jj-1)
-
-               nb(ji,jj) =    iwork( ji , jj ) +                    &
-                           &  iwork(ji+1, jj ) + iwork(ji-1, jj ) + &
-                           &  iwork( ji ,jj+1) + iwork( ji ,jj-1) + &
-                           &  iwork(ji+1,jj+1) + iwork(ji+1,jj-1) + &
-                           &  iwork(ji-1,jj+1) + iwork(ji-1,jj-1)
-            END DO
-         END DO
-
-      ENDIF
-
-      !! write averaged value of work into htnew,
-      !! if average is valid and point is unmasked
-      WHERE( (htold(:,:) /= 0.0_wp ) .AND. ( nb(:,:) /= 0 ) )
-         htnew(:,:) = work(:,:)/real(nb(:,:))
-      ELSEWHERE
-         htnew(:,:) = 0.0_wp
-      END WHERE
-
-      !!    Deallocate temporary workspace arrays, all local to this routine
-      CALL wrk_dealloc( jpi, jpj, nb, iwork ) 
-      CALL wrk_dealloc( jpi, jpj, work      ) 
-      !
-   END SUBROUTINE dyn_nept_smooth_vel
-
-END MODULE dynnept
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 5901)
@@ -266,6 +266,18 @@
                ! Add volume filter correction: compatibility with tracer advection scheme
                ! => time filter + conservation correction (only at the first level)
-               fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) &
-                              &                                          -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1)
+               IF ( nn_isf == 0) THEN   ! if no ice shelf melting
+                  fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) &
+                                 &                                          -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1)
+               ELSE                     ! if ice shelf melting
+                  DO jj = 1,jpj
+                     DO ji = 1,jpi
+                        jk = mikt(ji,jj)
+                        fse3t_b(ji,jj,jk) = fse3t_b(ji,jj,jk) - atfp * rdt * r1_rau0                       &
+                                          &                          * ( (emp_b(ji,jj)    - emp(ji,jj)   ) &
+                                          &                            - (rnf_b(ji,jj)    - rnf(ji,jj)   ) &
+                                          &                            + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) ) * tmask(ji,jj,jk)
+                     END DO
+                  END DO
+               END IF
             ENDIF
             !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 5901)
@@ -77,7 +77,4 @@
       !!             Note that as all external forcing a time averaging over a two rdt
       !!             period is used to prevent the divergence of odd and even time step.
-      !!
-      !! N.B. : When key_esopa is used all the scheme are tested, regardless 
-      !!        of the physical meaning of the results. 
       !!----------------------------------------------------------------------
       !
@@ -121,7 +118,7 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   spgu(ji,jj) = spgu(ji,jj) + zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    &
-                     &                      + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) /e1u(ji,jj)
+                     &                      + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
                   spgv(ji,jj) = spgv(ji,jj) + zg_2 * (  ssh_ib (ji,jj+1) - ssh_ib (ji,jj)    &
-                     &                      + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) /e2v(ji,jj)
+                     &                      + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
                END DO
             END DO
@@ -135,6 +132,6 @@
             DO jj = 2, jpjm1                         ! add tide potential forcing
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj)
-                  spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj)
+                  spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
+                  spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
                END DO 
             END DO
@@ -149,6 +146,6 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj)
-                  spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj)
+                  spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
+                  spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
                END DO
             END DO
@@ -176,14 +173,4 @@
       CASE (  2 )   ;   CALL dyn_spg_flt( kt, kindic )      ! filtered
       !                                                    
-      CASE ( -1 )                                ! esopa: test all possibility with control print
-                        CALL dyn_spg_exp( kt )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, &
-         &                            tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                        CALL dyn_spg_ts ( kt )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, &
-         &                           tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                        CALL dyn_spg_flt( kt, kindic )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, &
-         &                            tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       END SELECT
       !                    
@@ -248,19 +235,15 @@
       IF(lk_dynspg_flt)   ioptio = ioptio + 1
       !
-      IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ( ioptio == 0 .AND. .NOT. lk_c1d ) )   &
+      IF(  ioptio > 1  .OR. ( ioptio == 0 .AND. .NOT. lk_c1d ) )   &
            &   CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' )
       IF( ( lk_dynspg_ts .OR. lk_dynspg_exp ) .AND. ln_isfcav )   &
            &   CALL ctl_stop( ' dynspg_ts and dynspg_exp not tested with ice shelf cavity ' )
       !
-      IF( lk_esopa     )   nspg = -1
       IF( lk_dynspg_exp)   nspg =  0
       IF( lk_dynspg_ts )   nspg =  1
       IF( lk_dynspg_flt)   nspg =  2
       !
-      IF( lk_esopa     )   nspg = -1
-      !
       IF(lwp) THEN
          WRITE(numout,*)
-         IF( nspg == -1 )   WRITE(numout,*) '     ESOPA test All scheme used'
          IF( nspg ==  0 )   WRITE(numout,*) '     explicit free surface'
          IF( nspg ==  1 )   WRITE(numout,*) '     free surface with time splitting scheme'
@@ -268,17 +251,9 @@
       ENDIF
 
-#if defined key_dynspg_flt || defined key_esopa
+#if defined key_dynspg_flt
       CALL solver_init( nit000 )   ! Elliptic solver initialisation
 #endif
-
-      !                        ! Control of timestep choice
-      IF( lk_dynspg_ts .OR. lk_dynspg_exp ) THEN
-         IF( nn_cla == 1 )   CALL ctl_stop( 'Crossland advection not implemented for this free surface formulation' )
-      ENDIF
-
       !			       ! Control of hydrostatic pressure choice
-      IF( lk_dynspg_ts .AND. ln_dynhpg_imp ) THEN
-         CALL ctl_stop( 'Semi-implicit hpg not compatible with time splitting' )
-      ENDIF
+      IF( lk_dynspg_ts .AND. ln_dynhpg_imp )   CALL ctl_stop( 'Semi-implicit hpg not compatible with time splitting' )
       !
       IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_init')
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 5901)
@@ -7,5 +7,5 @@
    !!            3.2  !  2009-06  (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module
    !!----------------------------------------------------------------------
-#if defined key_dynspg_exp   ||   defined key_esopa
+#if defined key_dynspg_exp
    !!----------------------------------------------------------------------
    !!   'key_dynspg_exp'                              explicit free surface
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90	(revision 5901)
@@ -14,6 +14,7 @@
    !!            3.2  !  2009-03  (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module
    !!            3.7  !  2014-04  (F. Roquet, G. Madec)  add some trends diag
-   !!----------------------------------------------------------------------
-#if defined key_dynspg_flt   ||   defined key_esopa  
+   !!             -   !  2014-12  (G. Madec) remove cross-land advection (cla)
+   !!----------------------------------------------------------------------
+#if defined key_dynspg_flt  
    !!----------------------------------------------------------------------
    !!   'key_dynspg_flt'                              filtered free surface
@@ -36,5 +37,4 @@
    USE bdydyn          ! ocean open boundary condition on dynamics
    USE bdyvol          ! ocean open boundary condition (bdy_vol routine)
-   USE cla             ! cross land advection
    USE trd_oce         ! trends: ocean variables
    USE trddyn          ! trend manager: dynamics
@@ -206,5 +206,4 @@
       CALL Agrif_dyn( kt )    ! Update velocities on each coarse/fine interfaces 
 #endif
-      IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_dynspg( kt )      ! Cross Land Advection (update (ua,va))
 
       ! compute the next vertically averaged velocity (effect of the additional force not included)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90	(revision 5901)
@@ -17,20 +17,19 @@
    
    !                                                       !!! Surface pressure gradient logicals
-#if   defined key_dynspg_exp  ||  defined key_esopa
+#if   defined key_dynspg_exp
    LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_exp = .TRUE.   !: Explicit free surface flag
 #else
    LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_exp = .FALSE.  !: Explicit free surface flag
 #endif
-#if   defined key_dynspg_ts   ||  defined key_esopa
+#if   defined key_dynspg_ts
    LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_ts  = .TRUE.   !: Free surface with time splitting flag
 #else
    LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_ts  = .FALSE.  !: Free surface with time splitting flag
 #endif
-#if   defined key_dynspg_flt  ||  defined key_esopa
+#if   defined key_dynspg_flt
    LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_flt = .TRUE.   !: Filtered free surface cst volume flag
 #else
    LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_flt = .FALSE.  !: Filtered free surface cst volume flag
 #endif
-
   !                                                                         !!! Time splitting scheme (key_dynspg_ts) 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshn_e, ssha_e   ! sea surface heigth (now, after)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 5901)
@@ -12,5 +12,5 @@
    !!             3.6  ! 2013-11  (A. Coward) Update for z-tilde compatibility
    !!---------------------------------------------------------------------
-#if defined key_dynspg_ts   ||   defined key_esopa
+#if defined key_dynspg_ts
    !!----------------------------------------------------------------------
    !!   'key_dynspg_ts'         split explicit free surface
@@ -98,6 +98,6 @@
       ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) )
 
-      IF( ln_dynvor_een .or. ln_dynvor_een_old ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 
-                                                    &      ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) )
+      IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 
+         &                          ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) )
 
       dyn_spg_ts_alloc = MAXVAL(ierr(:))
@@ -107,4 +107,5 @@
       !
    END FUNCTION dyn_spg_ts_alloc
+
 
    SUBROUTINE dyn_spg_ts( kt )
@@ -219,18 +220,30 @@
       !
       IF ( kt == nit000 .OR. lk_vvl ) THEN
-         IF ( ln_dynvor_een_old ) THEN
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                    &
-                        &          ht(ji  ,jj  ) + ht(ji+1,jj  )   ) / 4._wp  
-                  IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zwz(ji,jj)
-               END DO
-            END DO
+         IF ( ln_dynvor_een ) THEN              !==  EEN scheme  ==!
+            SELECT CASE( nn_een_e3f )              !* ff/e3 at F-point
+            CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                    &
+                        &             ht(ji  ,jj  ) + ht(ji+1,jj  )   ) / 4._wp  
+                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj)
+                  END DO
+               END DO
+            CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                     &
+                        &             ht(ji  ,jj  ) + ht(ji+1,jj  )   )                   &
+                        &       / ( MAX( 1._wp, tmask(ji  ,jj+1, 1) + tmask(ji+1,jj+1, 1) +    &
+                        &                       tmask(ji  ,jj  , 1) + tmask(ji+1,jj  , 1) ) )
+                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj)
+                  END DO
+               END DO
+            END SELECT
             CALL lbc_lnk( zwz, 'F', 1._wp )
-            zwz(:,:) = ff(:,:) * zwz(:,:)
-
+            !
             ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
             DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
+               DO ji = 2, jpi
                   ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
                   ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
@@ -239,30 +252,12 @@
                END DO
             END DO
-         ELSE IF ( ln_dynvor_een ) THEN
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                     &
-                        &          ht(ji  ,jj  ) + ht(ji+1,jj  )   )                   &
-                        &      / ( MAX( 1.0_wp, tmask(ji  ,jj+1, 1) + tmask(ji+1,jj+1, 1) +    &
-                        &                       tmask(ji  ,jj  , 1) + tmask(ji+1,jj  , 1) ) )
-                  IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zwz(ji,jj)
-               END DO
-            END DO
-            CALL lbc_lnk( zwz, 'F', 1._wp )
-            zwz(:,:) = ff(:,:) * zwz(:,:)
-
-            ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
-                  ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
-                  ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1)
-                  ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  )
-               END DO
-            END DO
-         ELSE
+            !
+         ELSE                                !== all other schemes (ENE, ENS, MIX)
             zwz(:,:) = 0._wp
-            zhf(:,:) = 0.
+            zhf(:,:) = 0._wp
             IF ( .not. ln_sco ) THEN
+
+!!gm  agree the JC comment  : this should be done in a much clear way
+
 ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case
 !     Set it to zero for the time being 
@@ -276,5 +271,5 @@
 
             DO jj = 1, jpjm1
-               zhf(:,jj) = zhf(:,jj)*(1._wp- umask(:,jj,1) * umask(:,jj+1,1))
+               zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1))
             END DO
 
@@ -297,5 +292,5 @@
       ! If forward start at previous time step, and centered integration, 
       ! then update averaging weights:
-      IF ((.NOT.ln_bt_fw).AND.((neuler==0).AND.(kt==nit000+1))) THEN
+      IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN
          ll_fw_start=.FALSE.
          CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2)
@@ -338,8 +333,8 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)
-               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
-               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj)
-               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj)
+               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
+               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj)
+               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
                ! energy conserving formulation for planetary vorticity term
                zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
@@ -352,7 +347,7 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
-                 &            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
+                 &            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
                zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
-                 &            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+                 &            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
                zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
                zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
@@ -360,15 +355,15 @@
          END DO
          !
-      ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old ) THEN  ! enstrophy and energy conserving scheme
+      ELSEIF ( ln_dynvor_een ) THEN  ! enstrophy and energy conserving scheme
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_trd(ji,jj) = + z1_12 / e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
-                &                                      + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
-                &                                      + ftse(ji,jj  ) * zwy(ji  ,jj-1) &
-                &                                      + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
-               zv_trd(ji,jj) = - z1_12 / e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &
-                &                                      + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
-                &                                      + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &
-                &                                      + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
+               zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
+                &                                         + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
+                &                                         + ftse(ji,jj  ) * zwy(ji  ,jj-1) &
+                &                                         + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
+               zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &
+                &                                         + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
+                &                                         + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &
+                &                                         + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
             END DO
          END DO
@@ -381,6 +376,6 @@
          DO jj = 2, jpjm1 
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) / e1u(ji,jj)
-               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) / e2v(ji,jj)
+               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj)
+               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj)
             END DO
          END DO
@@ -431,6 +426,6 @@
             DO jj = 2, jpjm1              
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_spg =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) /e1u(ji,jj)
-                  zv_spg =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) /e2v(ji,jj)
+                  zu_spg =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj)
+                  zv_spg =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj)
                   zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
                   zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
@@ -441,7 +436,7 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zu_spg =  grav * z1_2 * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)    &
-                      &                    + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) /e1u(ji,jj)
+                      &                    + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
                   zv_spg =  grav * z1_2 * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)    &
-                      &                    + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) /e2v(ji,jj)
+                      &                    + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
                   zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
                   zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
@@ -454,8 +449,8 @@
       !                                         ! Surface net water flux and rivers
       IF (ln_bt_fw) THEN
-         zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) )
+         zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )
       ELSE
          zssh_frc(:,:) = zraur * z1_2 * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)   &
-                &                        + rdivisf * ( fwfisf(:,:) + fwfisf_b(:,:) )       )
+                &                        + fwfisf(:,:) + fwfisf_b(:,:)                     )
       ENDIF
 #if defined key_asminc
@@ -465,6 +460,6 @@
       ENDIF
 #endif
-      !                                   !* Fill boundary data arrays with AGRIF
-      !                                   ! -------------------------------------
+      !                                   !* Fill boundary data arrays for AGRIF
+      !                                   ! ------------------------------------
 #if defined key_agrif
          IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt )
@@ -549,10 +544,10 @@
             DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points
                DO ji = 2, fs_jpim1   ! Vector opt.
-                  zwx(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e12u(ji,jj)     &
-                     &              * ( e12t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
-                     &              +   e12t(ji+1,jj) * zsshp2_e(ji+1,jj) )
-                  zwy(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e12v(ji,jj)     &
-                     &              * ( e12t(ji,jj  ) * zsshp2_e(ji,jj  )  &
-                     &              +   e12t(ji,jj+1) * zsshp2_e(ji,jj+1) )
+                  zwx(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj)     &
+                     &              * ( e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
+                     &              +   e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) )
+                  zwy(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj)     &
+                     &              * ( e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  &
+                     &              +   e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) )
                END DO
             END DO
@@ -602,6 +597,6 @@
          ! Sum over sub-time-steps to compute advective velocities
          za2 = wgtbtp2(jn)
-         zu_sum  (:,:) = zu_sum  (:,:) + za2 * zwx  (:,:) / e2u  (:,:)
-         zv_sum  (:,:) = zv_sum  (:,:) + za2 * zwy  (:,:) / e1v  (:,:)
+         zu_sum(:,:) = zu_sum(:,:) + za2 * zwx(:,:) * r1_e2u(:,:)
+         zv_sum(:,:) = zv_sum(:,:) + za2 * zwy(:,:) * r1_e1v(:,:)
          !
          ! Set next sea level:
@@ -609,5 +604,5 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zhdiv(ji,jj) = (   zwx(ji,jj) - zwx(ji-1,jj)   &
-                  &             + zwy(ji,jj) - zwy(ji,jj-1)   ) * r1_e12t(ji,jj)
+                  &             + zwy(ji,jj) - zwy(ji,jj-1)   ) * r1_e1e2t(ji,jj)
             END DO
          END DO
@@ -627,10 +622,10 @@
             DO jj = 2, jpjm1
                DO ji = 2, jpim1      ! NO Vector Opt.
-                  zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e12u(ji,jj)  &
-                     &              * ( e12t(ji  ,jj  ) * ssha_e(ji  ,jj  ) &
-                     &              +   e12t(ji+1,jj  ) * ssha_e(ji+1,jj  ) )
-                  zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e12v(ji,jj)  &
-                     &              * ( e12t(ji  ,jj  ) * ssha_e(ji  ,jj  ) &
-                     &              +   e12t(ji  ,jj+1) * ssha_e(ji  ,jj+1) )
+                  zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj)  &
+                     &              * ( e1e2t(ji  ,jj  ) * ssha_e(ji  ,jj  ) &
+                     &              +   e1e2t(ji+1,jj  ) * ssha_e(ji+1,jj  ) )
+                  zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj)  &
+                     &              * ( e1e2t(ji  ,jj  ) * ssha_e(ji  ,jj  ) &
+                     &              +   e1e2t(ji  ,jj+1) * ssha_e(ji  ,jj+1) )
                END DO
             END DO
@@ -666,10 +661,10 @@
             DO jj = 2, jpjm1                            
                DO ji = 2, jpim1
-                  zx1 = z1_2 * umask(ji  ,jj,1) *  r1_e12u(ji  ,jj)    &
-                     &      * ( e12t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    &
-                     &      +   e12t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) )
-                  zy1 = z1_2 * vmask(ji  ,jj,1) *  r1_e12v(ji  ,jj  )  &
-                     &       * ( e12t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  &
-                     &       +   e12t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) )
+                  zx1 = z1_2 * umask(ji  ,jj,1) *  r1_e1e2u(ji  ,jj)    &
+                     &      * ( e1e2t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    &
+                     &      +   e1e2t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) )
+                  zy1 = z1_2 * vmask(ji  ,jj,1) *  r1_e1e2v(ji  ,jj  )  &
+                     &       * ( e1e2t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  &
+                     &       +   e1e2t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) )
                   zhust_e(ji,jj) = hu_0(ji,jj) + zx1 
                   zhvst_e(ji,jj) = hv_0(ji,jj) + zy1
@@ -688,8 +683,8 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zy1 = ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)
-                  zy2 = ( zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
-                  zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) / e2v(ji,jj)
-                  zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+                  zy1 = ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj)
+                  zy2 = ( zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
+                  zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj)
+                  zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
                   zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
                   zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
@@ -701,7 +696,7 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
-                   &             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
+                   &             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
                   zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
-                   &             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+                   &             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
                   zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
                   zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
@@ -709,15 +704,15 @@
             END DO
             !
-         ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old ) THEN !==  energy and enstrophy conserving scheme  ==!
+         ELSEIF ( ln_dynvor_een ) THEN !==  energy and enstrophy conserving scheme  ==!
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_trd(ji,jj) = + z1_12 / e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
-                     &                                    + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
-                     &                                    + ftse(ji,jj  ) * zwy(ji  ,jj-1) & 
-                     &                                    + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
-                  zv_trd(ji,jj) = - z1_12 / e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 
-                     &                                    + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
-                     &                                    + ftnw(ji,jj  ) * zwx(ji-1,jj  ) & 
-                     &                                    + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
+                  zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
+                     &                                       + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
+                     &                                       + ftse(ji,jj  ) * zwy(ji  ,jj-1) & 
+                     &                                       + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
+                  zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 
+                     &                                       + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
+                     &                                       + ftnw(ji,jj  ) * zwx(ji-1,jj  ) & 
+                     &                                       + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
                END DO
             END DO
@@ -729,6 +724,6 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj)
-                  zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj)
+                  zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
+                  zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
                   zu_trd(ji,jj) = zu_trd(ji,jj) + zu_spg
                   zv_trd(ji,jj) = zv_trd(ji,jj) + zv_spg
@@ -745,6 +740,6 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ! Add surface pressure gradient
-               zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) / e1u(ji,jj)
-               zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) / e2v(ji,jj)
+               zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
+               zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
                zwx(ji,jj) = zu_spg
                zwy(ji,jj) = zv_spg
@@ -850,10 +845,10 @@
          DO jj = 1, jpjm1
             DO ji = 1, jpim1      ! NO Vector Opt.
-               zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e12u(ji,jj) &
-                  &              * ( e12t(ji  ,jj) * ssha(ji  ,jj)    &
-                  &              +   e12t(ji+1,jj) * ssha(ji+1,jj) )
-               zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e12v(ji,jj) &
-                  &              * ( e12t(ji,jj  ) * ssha(ji,jj  )    &
-                  &              +   e12t(ji,jj+1) * ssha(ji,jj+1) )
+               zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj) &
+                  &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)    &
+                  &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) )
+               zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj) &
+                  &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )    &
+                  &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) )
             END DO
          END DO
@@ -900,6 +895,5 @@
 #if defined key_agrif
       ! Save time integrated fluxes during child grid integration
-      ! (used to update coarse grid transports)
-      ! Useless with 2nd order momentum schemes
+      ! (used to update coarse grid transports at next time step)
       !
       IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN
@@ -1094,7 +1088,7 @@
          DO jj = 1, jpj
             DO ji =1, jpi
-               zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj))
-               zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj))
-               zcu(ji,jj) = sqrt(grav*ht_0(ji,jj)*(zxr2 + zyr2) )
+               zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj)
+               zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj)
+               zcu(ji,jj) = SQRT( grav * ht_0(ji,jj) * (zxr2 + zyr2) )
             END DO
          END DO
@@ -1102,12 +1096,12 @@
          DO jj = 1, jpj
             DO ji =1, jpi
-               zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj))
-               zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj))
-               zcu(ji,jj) = sqrt(grav*ht(ji,jj)*(zxr2 + zyr2) )
-            END DO
-         END DO
-      ENDIF
-
-      zcmax = MAXVAL(zcu(:,:))
+               zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj)
+               zyr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj)
+               zcu(ji,jj) = SQRT( grav * ht(ji,jj) * (zxr2 + zyr2) )
+            END DO
+         END DO
+      ENDIF
+
+      zcmax = MAXVAL( zcu(:,:) )
       IF( lk_mpp )   CALL mpp_max( zcmax )
 
@@ -1115,5 +1109,5 @@
       IF (ln_bt_nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax)
       
-      rdtbt = rdt / FLOAT(nn_baro)
+      rdtbt = rdt / REAL( nn_baro , wp )
       zcmax = zcmax * rdtbt
 							! Print results
@@ -1195,5 +1189,2 @@
    !!======================================================================
 END MODULE dynspg_ts
-
-
-
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 5901)
@@ -16,4 +16,5 @@
    !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!            3.7  ! 2014-04  (G. Madec) trend simplification: suppress jpdyn_trd_dat vorticity 
+   !!             -   ! 2014-06  (G. Madec) suppression of velocity curl from in-core memory
    !!----------------------------------------------------------------------
 
@@ -22,5 +23,4 @@
    !!       vor_ens  : enstrophy conserving scheme       (ln_dynvor_ens=T)
    !!       vor_ene  : energy conserving scheme          (ln_dynvor_ene=T)
-   !!       vor_mix  : mixed enstrophy/energy conserving (ln_dynvor_mix=T)
    !!       vor_een  : energy and enstrophy conserving   (ln_dynvor_een=T)
    !!   dyn_vor_init : set and control of the different vorticity option
@@ -32,4 +32,5 @@
    USE trd_oce        ! trends: ocean variables
    USE trddyn         ! trend manager: dynamics
+   !
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE prtctl         ! Print control
@@ -44,23 +45,38 @@
 
    PUBLIC   dyn_vor        ! routine called by step.F90
-   PUBLIC   dyn_vor_init   ! routine called by opa.F90
+   PUBLIC   dyn_vor_init   ! routine called by nemogcm.F90
 
    !                                   !!* Namelist namdyn_vor: vorticity term
-   LOGICAL, PUBLIC ::   ln_dynvor_ene   !: energy conserving scheme
-   LOGICAL, PUBLIC ::   ln_dynvor_ens   !: enstrophy conserving scheme
-   LOGICAL, PUBLIC ::   ln_dynvor_mix   !: mixed scheme
-   LOGICAL, PUBLIC ::   ln_dynvor_een   !: energy and enstrophy conserving scheme
-   LOGICAL, PUBLIC ::   ln_dynvor_een_old !: energy and enstrophy conserving scheme (original formulation)
-
-   INTEGER ::   nvor = 0   ! type of vorticity trend used
-   INTEGER ::   ncor = 1   ! coriolis
-   INTEGER ::   nrvm = 2   ! =2 relative vorticity ; =3 metric term
-   INTEGER ::   ntot = 4   ! =4 total vorticity (relative + planetary) ; =5 coriolis + metric term
-
+   LOGICAL, PUBLIC ::   ln_dynvor_ene   !: energy conserving scheme    (ENE)
+   LOGICAL, PUBLIC ::   ln_dynvor_ens   !: enstrophy conserving scheme (ENS)
+   LOGICAL, PUBLIC ::   ln_dynvor_mix   !: mixed scheme                (MIX)
+   LOGICAL, PUBLIC ::   ln_dynvor_een   !: energy and enstrophy conserving scheme (EEN)
+   INTEGER, PUBLIC ::      nn_een_e3f      !: e3f=masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+   LOGICAL, PUBLIC ::   ln_dynvor_msk   !: vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes)
+
+   INTEGER ::   nvor_scheme        ! choice of the type of advection scheme
+   !                               ! associated indices:
+   INTEGER, PUBLIC, PARAMETER ::   np_ENE = 1   ! ENE scheme
+   INTEGER, PUBLIC, PARAMETER ::   np_ENS = 2   ! ENS scheme
+   INTEGER, PUBLIC, PARAMETER ::   np_MIX = 3   ! MIX scheme
+   INTEGER, PUBLIC, PARAMETER ::   np_EEN = 4   ! EEN scheme
+
+   INTEGER ::   ncor, nrvm, ntot   ! choice of calculated vorticity 
+   !                               ! associated indices:
+   INTEGER, PARAMETER ::   np_COR = 1         ! Coriolis (planetary)
+   INTEGER, PARAMETER ::   np_RVO = 2         ! relative vorticity
+   INTEGER, PARAMETER ::   np_MET = 3         ! metric term
+   INTEGER, PARAMETER ::   np_CRV = 4         ! relative + planetary (total vorticity)
+   INTEGER, PARAMETER ::   np_CME = 5         ! Coriolis + metric term
+   
+   REAL(wp) ::   r1_4  = 0.250_wp         ! =1/4
+   REAL(wp) ::   r1_8  = 0.125_wp         ! =1/8
+   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! 1/12
+   
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -87,26 +103,11 @@
       IF( l_trddyn )   CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )
       !
-      !                                          ! vorticity term 
-      SELECT CASE ( nvor )                       ! compute the vorticity trend and add it to the general trend
-      !
-      CASE ( -1 )                                      ! esopa: test all possibility with control print
-         CALL vor_ene( kt, ntot, ua, va )
-         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor0 - Ua: ', mask1=umask, &
-            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-         CALL vor_ens( kt, ntot, ua, va )
-         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor1 - Ua: ', mask1=umask, &
-            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-         CALL vor_mix( kt )
-         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor2 - Ua: ', mask1=umask, &
-            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-         CALL vor_een( kt, ntot, ua, va )
-         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor3 - Ua: ', mask1=umask, &
-            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-         !
-      CASE ( 0 )                                       ! energy conserving scheme
-         IF( l_trddyn )   THEN
-            ztrdu(:,:,:) = ua(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_ene( kt, nrvm, ua, va )                ! relative vorticity or metric trend
+      SELECT CASE ( nvor_scheme )               !==  vorticity trend added to the general trend  ==!
+      !
+      CASE ( np_ENE )                                 !* energy conserving scheme
+         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ene( kt, nrvm, ua, va )                      ! relative vorticity or metric trend
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
@@ -114,17 +115,17 @@
             ztrdu(:,:,:) = ua(:,:,:)
             ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_ene( kt, ncor, ua, va )                ! planetary vorticity trend
+            CALL vor_ene( kt, ncor, ua, va )                      ! planetary vorticity trend
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
          ELSE
-            CALL vor_ene( kt, ntot, ua, va )                ! total vorticity
-         ENDIF
-         !
-      CASE ( 1 )                                       ! enstrophy conserving scheme
-         IF( l_trddyn )   THEN    
-            ztrdu(:,:,:) = ua(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_ens( kt, nrvm, ua, va )                ! relative vorticity or metric trend
+            CALL vor_ene( kt, ntot, ua, va )                ! total vorticity trend
+         ENDIF
+         !
+      CASE ( np_ENS )                                 !* enstrophy conserving scheme
+         IF( l_trddyn ) THEN                                ! trend diagnostics: splitthe trend in two    
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ens( kt, nrvm, ua, va )                      ! relative vorticity or metric trend
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
@@ -132,17 +133,17 @@
             ztrdu(:,:,:) = ua(:,:,:)
             ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_ens( kt, ncor, ua, va )                ! planetary vorticity trend
+            CALL vor_ens( kt, ncor, ua, va )                      ! planetary vorticity trend
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
          ELSE
-            CALL vor_ens( kt, ntot, ua, va )                ! total vorticity
-         ENDIF
-         !
-      CASE ( 2 )                                       ! mixed ene-ens scheme
-         IF( l_trddyn )   THEN
-            ztrdu(:,:,:) = ua(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_ens( kt, nrvm, ua, va )                ! relative vorticity or metric trend (ens)
+            CALL vor_ens( kt, ntot, ua, va )                ! total vorticity trend
+         ENDIF
+         !
+      CASE ( np_MIX )                                 !* mixed ene-ens scheme
+         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ens( kt, nrvm, ua, va )                      ! relative vorticity or metric trend (ens)
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
@@ -150,17 +151,18 @@
             ztrdu(:,:,:) = ua(:,:,:)
             ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_ene( kt, ncor, ua, va )                ! planetary vorticity trend (ene)
+            CALL vor_ene( kt, ncor, ua, va )                      ! planetary vorticity trend (ene)
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
          ELSE
-            CALL vor_mix( kt )                               ! total vorticity (mix=ens-ene)
-         ENDIF
-         !
-      CASE ( 3 )                                       ! energy and enstrophy conserving scheme
-         IF( l_trddyn )   THEN
-            ztrdu(:,:,:) = ua(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_een( kt, nrvm, ua, va )                ! relative vorticity or metric trend
+            CALL vor_ens( kt, nrvm, ua, va )                ! relative vorticity or metric trend (ens)
+            CALL vor_ene( kt, ncor, ua, va )                ! planetary vorticity trend (ene)
+        ENDIF
+         !
+      CASE ( np_EEN )                                 !* energy and enstrophy conserving scheme
+         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_een( kt, nrvm, ua, va )                      ! relative vorticity or metric trend
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
@@ -168,10 +170,10 @@
             ztrdu(:,:,:) = ua(:,:,:)
             ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_een( kt, ncor, ua, va )                ! planetary vorticity trend
+            CALL vor_een( kt, ncor, ua, va )                      ! planetary vorticity trend
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
          ELSE
-            CALL vor_een( kt, ntot, ua, va )                ! total vorticity
+            CALL vor_een( kt, ntot, ua, va )                ! total vorticity trend
          ENDIF
          !
@@ -197,15 +199,11 @@
       !!
       !! ** Method  :   Trend evaluated using now fields (centered in time) 
-      !!      and the Sadourny (1975) flux form formulation : conserves the
-      !!      horizontal kinetic energy.
-      !!      The trend of the vorticity term is given by:
-      !!       * s-coordinate (ln_sco=T), the e3. are inside the derivatives:
-      !!          voru = 1/e1u  mj-1[ (rotn+f)/e3f  mi(e1v*e3v vn) ]
-      !!          vorv = 1/e2v  mi-1[ (rotn+f)/e3f  mj(e2u*e3u un) ]
-      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
-      !!          voru = 1/e1u  mj-1[ (rotn+f)  mi(e1v vn) ]
-      !!          vorv = 1/e2v  mi-1[ (rotn+f)  mj(e2u un) ]
-      !!      Add this trend to the general momentum trend (ua,va):
-      !!          (ua,va) = (ua,va) + ( voru , vorv )
+      !!       and the Sadourny (1975) flux form formulation : conserves the
+      !!       horizontal kinetic energy.
+      !!         The general trend of momentum is increased due to the vorticity 
+      !!       term which is given by:
+      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v vn) ]
+      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f  mj(e2u*e3u un) ]
+      !!       where rvor is the relative vorticity
       !!
       !! ** Action : - Update (ua,va) with the now vorticity term trend
@@ -213,5 +211,4 @@
       !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
       !!----------------------------------------------------------------------
-      !
       INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index
       INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ;
@@ -220,7 +217,7 @@
       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
       !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zx1, zy1, zfact2, zx2, zy2   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, zwy, zwz   ! 2D workspace
       !!----------------------------------------------------------------------
       !
@@ -234,37 +231,55 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
       ENDIF
-
-      zfact2 = 0.5 * 0.5      ! Local constant initialization
-
-!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz )
+      !
       !                                                ! ===============
       DO jk = 1, jpkm1                                 ! Horizontal slab
          !                                             ! ===============
          !
-         ! Potential vorticity and horizontal fluxes
-         ! -----------------------------------------
-         SELECT CASE( kvor )      ! vorticity considered
-         CASE ( 1 )   ;   zwz(:,:) =                  ff(:,:)      ! planetary vorticity (Coriolis)
-         CASE ( 2 )   ;   zwz(:,:) =   rotn(:,:,jk)                ! relative  vorticity
-         CASE ( 3 )                                                ! metric term
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            zwz(:,:) = ff(:,:) 
+         CASE ( np_RVO )                           !* relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                     &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_MET )                           !* metric term
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
                   zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
                        &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )
-               END DO
-            END DO
-         CASE ( 4 )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) )    ! total (relative + planetary vorticity)
-         CASE ( 5 )                                                ! total (coriolis + metric)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ( ff (ji,jj)                                                                       &
-                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
-                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                               &
-                       &       )
-               END DO
-            END DO
+                       &     * 0.5 * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                     &                      - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
+                     &                   * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff(ji,jj)                                                                        &
+                       &     + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &     * 0.5 * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
          END SELECT
+         !
+         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
 
          IF( ln_sco ) THEN
@@ -276,7 +291,5 @@
             zwy(:,:) = e1v(:,:) * vn(:,:,jk)
          ENDIF
-
-         ! Compute and add the vorticity term trend
-         ! ----------------------------------------
+         !                                   !==  compute and add the vorticity term trend  =!
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -285,6 +298,6 @@
                zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1)
                zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1)
-               pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 / e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-               pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 / e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
+               pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+               pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
             END DO  
          END DO  
@@ -299,123 +312,4 @@
 
 
-   SUBROUTINE vor_mix( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE vor_mix  ***
-      !!
-      !! ** Purpose :   Compute the now total vorticity trend and add it to
-      !!      the general trend of the momentum equation.
-      !!
-      !! ** Method  :   Trend evaluated using now fields (centered in time)
-      !!      Mixte formulation : conserves the potential enstrophy of a hori-
-      !!      zontally non-divergent flow for (rotzu x uh), the relative vor-
-      !!      ticity term and the horizontal kinetic energy for (f x uh), the
-      !!      coriolis term. the now trend of the vorticity term is given by:
-      !!       * s-coordinate (ln_sco=T), the e3. are inside the derivatives:
-      !!          voru = 1/e1u  mj-1(rotn/e3f) mj-1[ mi(e1v*e3v vn) ]
-      !!              +1/e1u  mj-1[ f/e3f          mi(e1v*e3v vn) ]
-      !!          vorv = 1/e2v  mi-1(rotn/e3f) mi-1[ mj(e2u*e3u un) ]
-      !!              +1/e2v  mi-1[ f/e3f          mj(e2u*e3u un) ]
-      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
-      !!          voru = 1/e1u  mj-1(rotn) mj-1[ mi(e1v vn) ]
-      !!              +1/e1u  mj-1[ f          mi(e1v vn) ]
-      !!          vorv = 1/e2v  mi-1(rotn) mi-1[ mj(e2u un) ]
-      !!              +1/e2v  mi-1[ f          mj(e2u un) ]
-      !!      Add this now trend to the general momentum trend (ua,va):
-      !!          (ua,va) = (ua,va) + ( voru , vorv )
-      !!
-      !! ** Action : - Update (ua,va) arrays with the now vorticity term trend
-      !!
-      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
-      !!----------------------------------------------------------------------
-      !
-      INTEGER, INTENT(in) ::   kt   ! ocean timestep index
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zfact1, zua, zcua, zx1, zy1   ! local scalars
-      REAL(wp) ::   zfact2, zva, zcva, zx2, zy2   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('vor_mix')
-      !
-      CALL wrk_alloc( jpi, jpj, zwx, zwy, zwz, zww ) 
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn:vor_mix : vorticity term: mixed energy/enstrophy conserving scheme'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-
-      zfact1 = 0.5 * 0.25      ! Local constant initialization
-      zfact2 = 0.5 * 0.5
-
-!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, zww )
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !
-         ! Relative and planetary potential vorticity and horizontal fluxes
-         ! ----------------------------------------------------------------
-         IF( ln_sco ) THEN        
-            IF( ln_dynadv_vec ) THEN
-               zww(:,:) = rotn(:,:,jk) / fse3f(:,:,jk)
-            ELSE                       
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     zww(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
-                        &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                        &       * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) * fse3f(ji,jj,jk) )
-                  END DO
-               END DO
-            ENDIF
-            zwz(:,:) = ff  (:,:)    / fse3f(:,:,jk)
-            zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
-            zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
-         ELSE
-            IF( ln_dynadv_vec ) THEN
-               zww(:,:) = rotn(:,:,jk)
-            ELSE                       
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     zww(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
-                        &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                        &       * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) )
-                  END DO
-               END DO
-            ENDIF
-            zwz(:,:) = ff (:,:)
-            zwx(:,:) = e2u(:,:) * un(:,:,jk)
-            zwy(:,:) = e1v(:,:) * vn(:,:,jk)
-         ENDIF
-
-         ! Compute and add the vorticity term trend
-         ! ----------------------------------------
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)
-               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
-               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj)
-               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
-               ! enstrophy conserving formulation for relative vorticity term
-               zua = zfact1 * ( zww(ji  ,jj-1) + zww(ji,jj) ) * ( zy1 + zy2 )
-               zva =-zfact1 * ( zww(ji-1,jj  ) + zww(ji,jj) ) * ( zx1 + zx2 )
-               ! energy conserving formulation for planetary vorticity term
-               zcua = zfact2 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-               zcva =-zfact2 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
-               ! mixed vorticity trend added to the momentum trends
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zcua + zua
-               va(ji,jj,jk) = va(ji,jj,jk) + zcva + zva
-            END DO  
-         END DO  
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-      CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz, zww ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('vor_mix')
-      !
-   END SUBROUTINE vor_mix
-
-
    SUBROUTINE vor_ens( kt, kvor, pua, pva )
       !!----------------------------------------------------------------------
@@ -429,10 +323,6 @@
       !!      potential enstrophy of a horizontally non-divergent flow. the
       !!      trend of the vorticity term is given by:
-      !!       * s-coordinate (ln_sco=T), the e3. are inside the derivative:
-      !!          voru = 1/e1u  mj-1[ (rotn+f)/e3f ]  mj-1[ mi(e1v*e3v vn) ]
-      !!          vorv = 1/e2v  mi-1[ (rotn+f)/e3f ]  mi-1[ mj(e2u*e3u un) ]
-      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
-      !!          voru = 1/e1u  mj-1[ rotn+f ]  mj-1[ mi(e1v vn) ]
-      !!          vorv = 1/e2v  mi-1[ rotn+f ]  mi-1[ mj(e2u un) ]
+      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f ]  mj-1[ mi(e1v*e3v vn) ]
+      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f ]  mi-1[ mj(e2u*e3u un) ]
       !!      Add this trend to the general momentum trend (ua,va):
       !!          (ua,va) = (ua,va) + ( voru , vorv )
@@ -442,5 +332,4 @@
       !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
       !!----------------------------------------------------------------------
-      !
       INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index
       INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ;
@@ -449,7 +338,7 @@
       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
       !
-      INTEGER  ::   ji, jj, jk           ! dummy loop indices
-      REAL(wp) ::   zfact1, zuav, zvau   ! temporary scalars
-      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zuav, zvau   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, zwy, zwz, zww   ! 2D workspace
       !!----------------------------------------------------------------------
       !
@@ -463,63 +352,70 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
       ENDIF
-
-      zfact1 = 0.5 * 0.25      ! Local constant initialization
-
-!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz )
       !                                                ! ===============
       DO jk = 1, jpkm1                                 ! Horizontal slab
          !                                             ! ===============
          !
-         ! Potential vorticity and horizontal fluxes
-         ! -----------------------------------------
-         SELECT CASE( kvor )      ! vorticity considered
-         CASE ( 1 )   ;   zwz(:,:) =                  ff(:,:)      ! planetary vorticity (Coriolis)
-         CASE ( 2 )   ;   zwz(:,:) =   rotn(:,:,jk)                ! relative  vorticity
-         CASE ( 3 )                                                ! metric term
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            zwz(:,:) = ff(:,:) 
+         CASE ( np_RVO )                           !* relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                     &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_MET )                           !* metric term
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
                   zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
                        &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )
-               END DO
-            END DO
-         CASE ( 4 )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) )    ! total (relative + planetary vorticity)
-         CASE ( 5 )                                                ! total (coriolis + metric)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ( ff (ji,jj)                                                                       &
-                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
-                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                &
-                       &       )
-               END DO
-            END DO
+                       &     * 0.5 * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                     &                      - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
+                     &                   * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff(ji,jj)                                                                       &
+                       &     + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &     * 0.5 * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
          END SELECT
          !
-         IF( ln_sco ) THEN
-            DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop 
-               DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking
-                  zwz(ji,jj) = zwz(ji,jj) / fse3f(ji,jj,jk)
-                  zwx(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk)
-                  zwy(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk)
-               END DO
-            END DO
+         IF( ln_dynvor_msk ) THEN           !==  mask/unmask vorticity ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         IF( ln_sco ) THEN                   !==  horizontal fluxes  ==!
+            zwz(:,:) = zwz(:,:) / fse3f(:,:,jk)
+            zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
          ELSE
-            DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop 
-               DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking
-                  zwx(ji,jj) = e2u(ji,jj) * un(ji,jj,jk)
-                  zwy(ji,jj) = e1v(ji,jj) * vn(ji,jj,jk)
-               END DO
-            END DO
-         ENDIF
-         !
-         ! Compute and add the vorticity term trend
-         ! ----------------------------------------
+            zwx(:,:) = e2u(:,:) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * vn(:,:,jk)
+         ENDIF
+         !                                   !==  compute and add the vorticity term trend  =!
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zuav = zfact1 / e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   &
-                  &                         + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) )
-               zvau =-zfact1 / e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   &
-                  &                         + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) )
+               zuav = r1_8 * r1_e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   &
+                  &                       + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) )
+               zvau =-r1_8 * r1_e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   &
+                  &                       + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) )
                pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
                pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
@@ -553,32 +449,22 @@
       !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36
       !!----------------------------------------------------------------------
-      !
       INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index
-      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ;
-      !                                                           ! =nrvm (relative vorticity or metric)
+      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; =nrvm (relative or metric)
       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend
       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
-      !!
-      INTEGER  ::   ji, jj, jk                                    ! dummy loop indices
-      INTEGER  ::   ierr                                          ! local integer
-      REAL(wp) ::   zfac12, zua, zva                              ! local scalars
-      REAL(wp) ::   zmsk, ze3                                     ! local scalars
-      !                                                           !  3D workspace 
-      REAL(wp), POINTER    , DIMENSION(:,:  )         :: zwx, zwy, zwz
-      REAL(wp), POINTER    , DIMENSION(:,:  )         :: ztnw, ztne, ztsw, ztse
-#if defined key_vvl
-      REAL(wp), POINTER    , DIMENSION(:,:,:)         :: ze3f     !  3D workspace (lk_vvl=T)
-#else
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE   :: ze3f     ! lk_vvl=F, ze3f=1/e3f saved one for all
-#endif
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ierr         ! local integer
+      REAL(wp) ::   zua, zva     ! local scalars
+      REAL(wp) ::   zmsk, ze3    ! local scalars
+      !
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zwx, zwy, zwz, z1_e3f
+      REAL(wp), POINTER, DIMENSION(:,:)   :: ztnw, ztne, ztsw, ztse
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('vor_een')
       !
-      CALL wrk_alloc( jpi, jpj,      zwx , zwy , zwz        ) 
-      CALL wrk_alloc( jpi, jpj,      ztnw, ztne, ztsw, ztse ) 
-#if defined key_vvl
-      CALL wrk_alloc( jpi, jpj, jpk, ze3f                   )
-#endif
+      CALL wrk_alloc( jpi,jpj,   zwx , zwy , zwz , z1_e3f ) 
+      CALL wrk_alloc( jpi,jpj,   ztnw, ztne, ztsw, ztse   ) 
       !
       IF( kt == nit000 ) THEN
@@ -586,90 +472,97 @@
          IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme'
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-#if ! defined key_vvl
-         IF( .NOT.ALLOCATED(ze3f) ) THEN
-            ALLOCATE( ze3f(jpi,jpj,jpk) , STAT=ierr )
-            IF( lk_mpp    )   CALL mpp_sum ( ierr )
-            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dyn:vor_een : unable to allocate arrays' )
-         ENDIF
-         ze3f(:,:,:) = 0._wp
-#endif
       ENDIF
-
-      IF( kt == nit000 .OR. lk_vvl ) THEN      ! reciprocal of e3 at F-point (masked averaging of e3t over ocean points)
-
-         IF( ln_dynvor_een_old ) THEN ! original formulation
-            DO jk = 1, jpk
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
-                        &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) )
-                     IF( ze3 /= 0._wp )   ze3f(ji,jj,jk) = 4.0_wp / ze3
-                  END DO
-               END DO
-            END DO
-         ELSE ! new formulation from NEMO 3.6
-            DO jk = 1, jpk
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
-                        &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) )
-                     zmsk = (                   tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   &
-                        &                     + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk) )
-                     IF( ze3 /= 0._wp )   ze3f(ji,jj,jk) = zmsk / ze3
-                  END DO
-               END DO
-            END DO
-         ENDIF
-
-         CALL lbc_lnk( ze3f, 'F', 1. )
-      ENDIF
-
-      zfac12 = 1._wp / 12._wp    ! Local constant initialization
-
-      
-!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse )
+      !
       !                                                ! ===============
       DO jk = 1, jpkm1                                 ! Horizontal slab
          !                                             ! ===============
-         
-         ! Potential vorticity and horizontal fluxes
-         ! -----------------------------------------
-         SELECT CASE( kvor )      ! vorticity considered
-         CASE ( 1 )                                                ! planetary vorticity (Coriolis)
-            zwz(:,:) = ff(:,:)      * ze3f(:,:,jk)
-         CASE ( 2 )                                                ! relative  vorticity
-            zwz(:,:) = rotn(:,:,jk) * ze3f(:,:,jk)
-         CASE ( 3 )                                                ! metric term
+         !
+         SELECT CASE( nn_een_e3f )           ! == reciprocal of e3 at F-point
+         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
+                     &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) )
+                  IF( ze3 /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4.0_wp / ze3
+                  ELSE                      ;   z1_e3f(ji,jj) = 0.0_wp
+                  ENDIF
+               END DO
+            END DO
+         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
+                     &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) )
+                  zmsk = (                   tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   &
+                     &                     + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk) )
+                  IF( ze3 /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = zmsk / ze3
+                  ELSE                      ;   z1_e3f(ji,jj) = 0.0_wp
+                  ENDIF
+               END DO
+            END DO
+         END SELECT
+         !
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff(ji,jj) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_RVO )                           !* relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                     &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
+                     &       * r1_e1e2f(ji,jj) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_MET )                           !* metric term
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
                   zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
                        &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk)
-               END DO
-            END DO
-            CALL lbc_lnk( zwz, 'F', 1. )
-        CASE ( 4 )                                                ! total (relative + planetary vorticity)
-            zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk)
-         CASE ( 5 )                                                ! total (coriolis + metric)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ( ff (ji,jj)                                                                       &
-                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
-                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                &
-                       &       ) * ze3f(ji,jj,jk)
-               END DO
-            END DO
-            CALL lbc_lnk( zwz, 'F', 1. )
+                       &     * 0.5 * r1_e1e2f(ji,jj) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                     &                         - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
+                     &                      * r1_e1e2f(ji,jj)    ) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  ff(ji,jj)                                                                        &
+                       &        + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &            - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &        * 0.5 * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
          END SELECT
-
+         !
+         CALL lbc_lnk( zwz, 'F', 1. )
+         !
+         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         !                                   !==  horizontal fluxes  ==!
          zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
          zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
 
-         ! Compute and add the vorticity term trend
-         ! ----------------------------------------
+         !                                   !==  compute and add the vorticity term trend  =!
          jj = 2
          ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0
-         DO ji = 2, jpi   
+         DO ji = 2, jpi          ! split in 2 parts due to vector opt.
                ztne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
                ztnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
@@ -687,8 +580,8 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zua = + zfac12 / e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
-                  &                           + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
-               zva = - zfac12 / e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
-                  &                           + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
+               zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
+                  &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
+               zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
+                  &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
                pua(ji,jj,jk) = pua(ji,jj,jk) + zua
                pva(ji,jj,jk) = pva(ji,jj,jk) + zva
@@ -698,9 +591,7 @@
       END DO                                           !   End of slab
       !                                                ! ===============
-      CALL wrk_dealloc( jpi, jpj,      zwx , zwy , zwz        ) 
-      CALL wrk_dealloc( jpi, jpj,      ztnw, ztne, ztsw, ztse ) 
-#if defined key_vvl
-      CALL wrk_dealloc( jpi, jpj, jpk, ze3f                   )
-#endif
+      !
+      CALL wrk_dealloc( jpi,jpj,   zwx , zwy , zwz , z1_e3f ) 
+      CALL wrk_dealloc( jpi,jpj,   ztnw, ztne, ztsw, ztse   ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('vor_een')
@@ -720,5 +611,5 @@
       INTEGER ::   ios             ! Local integer output status for namelist read
       !!
-      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een, ln_dynvor_een_old
+      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een, nn_een_e3f, ln_dynvor_msk
       !!----------------------------------------------------------------------
 
@@ -737,13 +628,17 @@
          WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '        Namelist namdyn_vor : choice of the vorticity term scheme'
-         WRITE(numout,*) '           energy    conserving scheme                ln_dynvor_ene = ', ln_dynvor_ene
-         WRITE(numout,*) '           enstrophy conserving scheme                ln_dynvor_ens = ', ln_dynvor_ens
-         WRITE(numout,*) '           mixed enstrophy/energy conserving scheme   ln_dynvor_mix = ', ln_dynvor_mix
-         WRITE(numout,*) '           enstrophy and energy conserving scheme     ln_dynvor_een = ', ln_dynvor_een
-         WRITE(numout,*) '           enstrophy and energy conserving scheme (old) ln_dynvor_een_old= ', ln_dynvor_een_old
+         WRITE(numout,*) '           energy    conserving scheme                    ln_dynvor_ene = ', ln_dynvor_ene
+         WRITE(numout,*) '           enstrophy conserving scheme                    ln_dynvor_ens = ', ln_dynvor_ens
+         WRITE(numout,*) '           mixed enstrophy/energy conserving scheme       ln_dynvor_mix = ', ln_dynvor_mix
+         WRITE(numout,*) '           enstrophy and energy conserving scheme         ln_dynvor_een = ', ln_dynvor_een
+         WRITE(numout,*) '              e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_een_e3f = ', nn_een_e3f
+         WRITE(numout,*) '           masked (=1) or unmasked(=0) vorticity          ln_dynvor_msk = ', ln_dynvor_msk
       ENDIF
 
+!!gm  this should be removed when choosing a unique strategy for fmask at the coast
       ! If energy, enstrophy or mixed advection of momentum in vector form change the value for masks
       ! at angles with three ocean points and one land point
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '           namlbc: change fmask value in the angles (T)   ln_vorlat = ', ln_vorlat
       IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN
          DO jk = 1, jpk
@@ -759,42 +654,32 @@
           !
       ENDIF
-
-      ioptio = 0                     ! Control of vorticity scheme options
-      IF( ln_dynvor_ene )   ioptio = ioptio + 1
-      IF( ln_dynvor_ens )   ioptio = ioptio + 1
-      IF( ln_dynvor_mix )   ioptio = ioptio + 1
-      IF( ln_dynvor_een )   ioptio = ioptio + 1
-      IF( ln_dynvor_een_old )   ioptio = ioptio + 1
-      IF( lk_esopa      )   ioptio =          1
-
+!!gm end
+
+      ioptio = 0                     ! type of scheme for vorticity (set nvor_scheme)
+      IF( ln_dynvor_ene ) THEN   ;   ioptio = ioptio + 1   ;    nvor_scheme = np_ENE   ;   ENDIF
+      IF( ln_dynvor_ens ) THEN   ;   ioptio = ioptio + 1   ;    nvor_scheme = np_ENS   ;   ENDIF
+      IF( ln_dynvor_mix ) THEN   ;   ioptio = ioptio + 1   ;    nvor_scheme = np_MIX   ;   ENDIF
+      IF( ln_dynvor_een ) THEN   ;   ioptio = ioptio + 1   ;    nvor_scheme = np_EEN   ;   ENDIF
+      !
       IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' )
-
-      !                              ! Set nvor (type of scheme for vorticity)
-      IF( ln_dynvor_ene )   nvor =  0
-      IF( ln_dynvor_ens )   nvor =  1
-      IF( ln_dynvor_mix )   nvor =  2
-      IF( ln_dynvor_een .or. ln_dynvor_een_old )   nvor =  3
-      IF( lk_esopa      )   nvor = -1
-      
-      !                              ! Set ncor, nrvm, ntot (type of vorticity)
-      IF(lwp) WRITE(numout,*)
-      ncor = 1
+      !                      
+      IF(lwp) WRITE(numout,*)        ! type of calculated vorticity (set ncor, nrvm, ntot)
+      ncor = np_COR
       IF( ln_dynadv_vec ) THEN     
          IF(lwp) WRITE(numout,*) '         Vector form advection : vorticity = Coriolis + relative vorticity'
-         nrvm = 2
-         ntot = 4
+         nrvm = np_RVO        ! relative vorticity
+         ntot = np_CRV        ! relative + planetary vorticity
       ELSE                        
          IF(lwp) WRITE(numout,*) '         Flux form advection   : vorticity = Coriolis + metric term'
-         nrvm = 3
-         ntot = 5
+         nrvm = np_MET        ! metric term
+         ntot = np_CME        ! Coriolis + metric term
       ENDIF
       
       IF(lwp) THEN                   ! Print the choice
          WRITE(numout,*)
-         IF( nvor ==  0 )   WRITE(numout,*) '         vorticity scheme : energy conserving scheme'
-         IF( nvor ==  1 )   WRITE(numout,*) '         vorticity scheme : enstrophy conserving scheme'
-         IF( nvor ==  2 )   WRITE(numout,*) '         vorticity scheme : mixed enstrophy/energy conserving scheme'
-         IF( nvor ==  3 )   WRITE(numout,*) '         vorticity scheme : energy and enstrophy conserving scheme'
-         IF( nvor == -1 )   WRITE(numout,*) '         esopa test: use all lateral physics options'
+         IF( nvor_scheme ==  np_ENE )   WRITE(numout,*) '         vorticity scheme ==>> energy conserving scheme'
+         IF( nvor_scheme ==  np_ENS )   WRITE(numout,*) '         vorticity scheme ==>> enstrophy conserving scheme'
+         IF( nvor_scheme ==  np_MIX )   WRITE(numout,*) '         vorticity scheme ==>> mixed enstrophy/energy conserving scheme'
+         IF( nvor_scheme ==  np_EEN )   WRITE(numout,*) '         vorticity scheme ==>> energy and enstrophy conserving scheme'
       ENDIF
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 5901)
@@ -49,6 +49,6 @@
       !!
       !! ** Method  :   The now vertical advection of momentum is given by:
-      !!         w dz(u) = ua + 1/(e1u*e2u*e3u) mk+1[ mi(e1t*e2t*wn) dk(un) ]
-      !!         w dz(v) = va + 1/(e1v*e2v*e3v) mk+1[ mj(e1t*e2t*wn) dk(vn) ]
+      !!         w dz(u) = ua + 1/(e1e2u*e3u) mk+1[ mi(e1e2t*wn) dk(un) ]
+      !!         w dz(v) = va + 1/(e1e2v*e3v) mk+1[ mj(e1e2t*wn) dk(vn) ]
       !!      Add this trend to the general trend (ua,va):
       !!         (ua,va) = (ua,va) + w dz(u,v)
@@ -85,5 +85,5 @@
          DO jj = 2, jpj                   ! vertical fluxes 
             DO ji = fs_2, jpi             ! vector opt.
-               zww(ji,jj) = 0.25_wp * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk)
+               zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
             END DO
          END DO
@@ -121,6 +121,6 @@
             DO ji = fs_2, fs_jpim1       ! vector opt.
                !                         ! vertical momentum advective trends
-               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
-               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )
+               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )
                !                         ! add the trends to the general momentum trends
                ua(ji,jj,jk) = ua(ji,jj,jk) + zua
@@ -146,4 +146,5 @@
       !
    END SUBROUTINE dyn_zad
+
 
    SUBROUTINE dyn_zad_zts ( kt )
@@ -182,6 +183,6 @@
       IF( nn_timing == 1 )  CALL timing_start('dyn_zad_zts')
       !
-      CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw, zww ) 
-      CALL wrk_alloc( jpi,jpj,jpk,3, zus, zvs ) 
+      CALL wrk_alloc( jpi,jpj,jpk,     zwuw, zwvw, zww ) 
+      CALL wrk_alloc( jpi,jpj,jpk,3,   zus , zvs ) 
       !
       IF( kt == nit000 ) THEN
@@ -205,12 +206,12 @@
          DO jj = 2, jpj                   
             DO ji = fs_2, jpi             ! vector opt.
-               zww(ji,jj,jk) = 0.25_wp * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk)
+               zww(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
             END DO
          END DO
       END DO
-      !
-      ! Surface and bottom advective fluxes set to zero
-      DO jj = 2, jpjm1        
+
+      DO jj = 2, jpjm1                    ! Surface and bottom advective fluxes set to zero
          DO ji = fs_2, fs_jpim1           ! vector opt.
+ !!gm missing ISF boundary condition
             zwuw(ji,jj, 1 ) = 0._wp
             zwvw(ji,jj, 1 ) = 0._wp
@@ -251,6 +252,6 @@
                DO ji = fs_2, fs_jpim1       ! vector opt.
                   !                         ! vertical momentum advective trends
-                  zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
-                  zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+                  zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )
                   zus(ji,jj,jk,jta) = zus(ji,jj,jk,jtb) + zua * zts
                   zvs(ji,jj,jk,jta) = zvs(ji,jj,jk,jtb) + zva * zts
@@ -283,6 +284,6 @@
          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
-      CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw, zww ) 
-      CALL wrk_dealloc( jpi,jpj,jpk,3, zus, zvs ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,     zwuw, zwvw, zww ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,3,   zus , zvs ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('dyn_zad_zts')
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 5901)
@@ -9,22 +9,21 @@
 
    !!----------------------------------------------------------------------
-   !!   dyn_zdf      : Update the momentum trend with the vertical diffusion
-   !!   dyn_zdf_init : initializations of the vertical diffusion scheme
+   !!   dyn_zdf       : Update the momentum trend with the vertical diffusion
+   !!   dyn_zdf_init  : initializations of the vertical diffusion scheme
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE zdf_oce         ! ocean vertical physics variables
-
-   USE dynzdf_exp      ! vertical diffusion: explicit (dyn_zdf_exp     routine)
-   USE dynzdf_imp      ! vertical diffusion: implicit (dyn_zdf_imp     routine)
-
-   USE ldfdyn_oce      ! ocean dynamics: lateral physics
-   USE trd_oce         ! trends: ocean variables
-   USE trddyn          ! trend manager: dynamics
-   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 oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE zdf_oce        ! ocean vertical physics variables
+   USE dynzdf_exp     ! vertical diffusion: explicit (dyn_zdf_exp     routine)
+   USE dynzdf_imp     ! vertical diffusion: implicit (dyn_zdf_imp     routine)
+   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -61,5 +60,5 @@
       !!---------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_zdf')
+      IF( nn_timing == 1 )   CALL timing_start('dyn_zdf')
       !
       !                                          ! set time step
@@ -79,11 +78,4 @@
       CASE ( 1 )   ;   CALL dyn_zdf_imp( kt, r2dt )      ! implicit scheme
       !
-      CASE ( -1 )                                        ! esopa: test all possibility with control print
-                       CALL dyn_zdf_exp( kt, r2dt )
-                       CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf0 - Ua: ', mask1=umask,               &
-                          &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                       CALL dyn_zdf_imp( kt, r2dt )
-                       CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf1 - Ua: ', mask1=umask,               &
-                          &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       END SELECT
 
@@ -96,7 +88,7 @@
       !                                          ! print mean trends (used for debugging)
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf  - Ua: ', mask1=umask,               &
-            &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_zdf')
+         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+         !
+      IF( nn_timing == 1 )   CALL timing_stop('dyn_zdf')
       !
    END SUBROUTINE dyn_zdf
@@ -114,5 +106,4 @@
       USE zdftke
       USE zdfgls
-      USE zdfkpp
       !!----------------------------------------------------------------------
       !
@@ -123,9 +114,7 @@
       !
       ! Force implicit schemes
-      IF( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp )   nzdf = 1   ! TKE, GLS or KPP physics
-      IF( ln_dynldf_iso                           )   nzdf = 1   ! iso-neutral lateral physics
-      IF( ln_dynldf_hor .AND. ln_sco              )   nzdf = 1   ! horizontal lateral physics in s-coordinate
-      !
-      IF( lk_esopa )    nzdf = -1                   ! Esopa key: All schemes used
+      IF( lk_zdftke .OR. lk_zdfgls   )   nzdf = 1   ! TKE or GLS physics
+      IF( ln_dynldf_iso              )   nzdf = 1   ! iso-neutral lateral physics
+      IF( ln_dynldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate
       !
       IF(lwp) THEN                                  ! Print the choice
@@ -133,5 +122,4 @@
          WRITE(numout,*) 'dyn_zdf_init : vertical dynamics 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'
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 5901)
@@ -209,6 +209,5 @@
       !-----------------------------------------------------------------------
       !
-      !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-      DO jk = 2, jpkm1
+      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -309,6 +308,5 @@
       !-----------------------------------------------------------------------
       !
-      !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-      DO jk = 2, jpkm1        
+      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 5901)
@@ -20,16 +20,10 @@
    USE sbc_oce         ! surface boundary condition: ocean
    USE domvvl          ! Variable volume
-   USE divcur          ! hor. divergence and curl      (div & cur routines)
-   USE restart         ! only for lrst_oce
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
-   USE phycst
-   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
-   USE lib_mpp         ! MPP library
+   USE divhor          ! horizontal divergence
+   USE phycst          ! physical constants
    USE bdy_oce
    USE bdy_par         
    USE bdydyn2d        ! bdy_ssh routine
 #if defined key_agrif
-   USE agrif_opa_update
    USE agrif_opa_interp
 #endif
@@ -37,4 +31,9 @@
    USE asminc          ! Assimilation increment
 #endif
+   USE in_out_manager  ! I/O manager
+   USE restart         ! only for lrst_oce
+   USE prtctl          ! Print control
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE lib_mpp         ! MPP library
    USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing
@@ -67,29 +66,26 @@
       !!      by the time step.
       !!
-      !! ** action  :   ssha    : after sea surface height
+      !! ** action  :   ssha, after sea surface height
       !!
       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
       !!----------------------------------------------------------------------
-      !
-      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zhdiv
-      INTEGER, INTENT(in) ::   kt                      ! time step
+      INTEGER, INTENT(in) ::   kt   ! time step
       ! 
-      INTEGER             ::   jk                      ! dummy loop indice
-      REAL(wp)            ::   z2dt, z1_rau0           ! local scalars
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ssh_nxt')
-      !
-      CALL wrk_alloc( jpi, jpj, zhdiv ) 
+      INTEGER  ::   jk            ! dummy loop indice
+      REAL(wp) ::   z2dt, zcoef   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhdiv   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('ssh_nxt')
+      !
+      CALL wrk_alloc( jpi,jpj,   zhdiv ) 
       !
       IF( kt == nit000 ) THEN
-         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'ssh_nxt : after sea surface height'
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
-         !
-      ENDIF
-      !
-      CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity
+      ENDIF
+      !
+      CALL div_hor( kt )                              ! Horizontal divergence
       !
       z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
@@ -107,29 +103,27 @@
       ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations.
       ! 
-      z1_rau0 = 0.5_wp * r1_rau0
-      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:)
+      zcoef = 0.5_wp * r1_rau0
+      ssha(:,:) = (  sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:)
 
 #if ! defined key_dynspg_ts
       ! These lines are not necessary with time splitting since
       ! boundary condition on sea level is set during ts loop
-#if defined key_agrif
+# if defined key_agrif
       CALL agrif_ssh( kt )
-#endif
-#if defined key_bdy
-      IF (lk_bdy) THEN
-         CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary
-         CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries
-      ENDIF
-#endif
+# endif
+# if defined key_bdy
+      IF( lk_bdy ) THEN
+         CALL lbc_lnk( ssha, 'T', 1. )    ! Not sure that's necessary
+         CALL bdy_ssh( ssha )             ! Duplicate sea level across open boundaries
+      ENDIF
+# endif
 #endif
 
 #if defined key_asminc
-      !                                                ! Include the IAU weighted SSH increment
-      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
+      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN     ! Include the IAU weighted SSH increment
          CALL ssh_asm_inc( kt )
          ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:)
       ENDIF
 #endif
-
       !                                           !------------------------------!
       !                                           !           outputs            !
@@ -160,17 +154,15 @@
       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
       !!----------------------------------------------------------------------
-      !
-      INTEGER, INTENT(in) ::   kt           ! time step
+      INTEGER, INTENT(in) ::   kt   ! time step
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   z1_2dt       ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  z3d, zhdiv
-      !
-      INTEGER             ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp)            ::   z1_2dt       ! local scalars
-      !!----------------------------------------------------------------------
-      
-      IF( nn_timing == 1 )  CALL timing_start('wzv')
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('wzv')
       !
       IF( kt == nit000 ) THEN
-         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'wzv : now vertical velocity '
@@ -178,5 +170,4 @@
          !
          wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all)
-         !
       ENDIF
       !                                           !------------------------------!
@@ -194,5 +185,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zhdiv(ji,jj,jk) = r1_e12t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )
+                  zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )
                END DO
             END DO
@@ -217,5 +208,5 @@
 
 #if defined key_bdy
-      IF (lk_bdy) THEN
+      IF( lk_bdy ) THEN
          DO jk = 1, jpkm1
             wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
@@ -225,7 +216,7 @@
       !
       IF( nn_timing == 1 )  CALL timing_stop('wzv')
-
-
+      !
    END SUBROUTINE wzv
+
 
    SUBROUTINE ssh_swp( kt )
@@ -266,14 +257,12 @@
          sshb(:,:) = sshn(:,:)                           ! before <-- now
          sshn(:,:) = ssha(:,:)                           ! now    <-- after  (before already = now)
+         !
       ELSE                                         !** Leap-Frog time-stepping: Asselin filter + swap
          sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) )     ! before <-- now filtered
-         IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) - rnf_b(:,:) + rnf(:,:) ) * ssmask(:,:)
+         IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:)    - emp(:,:)    &
+                                &                                 - rnf_b(:,:)    + rnf(:,:)    &
+                                &                                 + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:)
          sshn(:,:) = ssha(:,:)                           ! now <-- after
       ENDIF
-      !
-      ! Update velocity at AGRIF zoom boundaries
-#if defined key_agrif
-      IF ( .NOT.Agrif_Root() ) CALL Agrif_Update_Dyn( kt )
-#endif
       !
       IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 5901)
@@ -4,5 +4,5 @@
    !! Ocean floats :   trajectory computation using a 4th order Runge-Kutta
    !!======================================================================
-#if   defined key_floats   ||   defined key_esopa
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                     float trajectories
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 5901)
@@ -7,5 +7,5 @@
    !!   NEMO      1.0  ! 2002-11  (G. Madec, A. Bozec)  F90: Free form and module
    !!----------------------------------------------------------------------
-#if   defined key_floats   ||   defined key_esopa
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                        drifting floats
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90	(revision 5901)
@@ -7,5 +7,5 @@
    !!   NEMO     1.0  ! 2002-06  (A. Bozec)  F90, Free form and module
    !!----------------------------------------------------------------------
-#if   defined key_floats   ||   defined key_esopa
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                     float trajectories
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90	(revision 5901)
@@ -4,5 +4,5 @@
    !! Ocean floats :   trajectory computation
    !!======================================================================
-#if   defined key_floats   ||   defined key_esopa
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                     float trajectories
@@ -125,5 +125,5 @@
 
             ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too.
-            zsurfz = e1t(iiloc(jfl),ijloc(jfl)) * e2t(iiloc(jfl),ijloc(jfl))
+            zsurfz =          e1e2t(iiloc(jfl),ijloc(jfl))
             zvol   = zsurfz * fse3t(iiloc(jfl),ijloc(jfl),-ikl(jfl))
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90	(revision 5901)
@@ -4,9 +4,8 @@
    !! Ocean floats :   domain
    !!======================================================================
-   !! History :  OPA          ! 1998-07 (Y.Drillet, CLIPPER)  Original code
-   !!            NEMO_3.3.1   ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): 
-                              ! add Ariane convention, Comsecitc changes
-   !!----------------------------------------------------------------------
-#if   defined key_floats   ||   defined key_esopa
+   !! History :  OPA  ! 1998-07 (Y.Drillet, CLIPPER)  Original code
+   !!  NEMO      3.3  ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): add ARIANE convention + comsecitc changes
+   !!----------------------------------------------------------------------
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                     float trajectories
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90	(revision 5901)
@@ -2,21 +2,15 @@
    !!======================================================================
    !!                       ***  MODULE  florst  ***
-   !!
-   !!
-   !! write floats restart files
-   !!
+   !! Ocean floats : write floats restart files
    !!======================================================================
-   !!  History :
-   !!    8.0  !  99-09  (Y. Drillet)    : Original code
-   !!         !  00-06  (J.-M. Molines) : Profiling floats for CLS 
-   !!    8.5  !  02-10  (A. Bozec)  F90 : Free form and module
-   !!    3.2  !  10-08  (slaw, cbricaud): netcdf outputs and others 
+   !!  History :  OPA  !  1999-09  (Y. Drillet)    : Original code
+   !!              -   !  2000-06  (J.-M. Molines) : Profiling floats for CLS 
+   !!   NEMO      1.0  !  2002-10  (A. Bozec)  F90 : Free form and module
+   !!             3.2  !  2010-08  (slaw, cbricaud): netcdf outputs and others 
    !!----------------------------------------------------------------------
-#if   defined key_floats   ||   defined key_esopa
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                     float trajectories
    !!----------------------------------------------------------------------
-
-   !! * Modules used
    USE flo_oce         ! ocean drifting floats
    USE dom_oce         ! ocean space and time domain
@@ -37,7 +31,6 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 5901)
@@ -3,21 +3,16 @@
    !!                       ***  MODULE  flowri  ***
    !!
-   !! write floats trajectory in ascii                    ln_flo_ascii = T
-   !!                      or in netcdf ( IOM or IOSPSL ) ln_flo_ascii = F           
-   !! 
-   !!
+   !! Ocean floats: write floats trajectory in ascii                    ln_flo_ascii = T
+   !!                                    or in netcdf ( IOM or IOSPSL ) ln_flo_ascii = F           
    !!======================================================================
-   !!  History :
-   !!    8.0  !  99-09  (Y. Drillet)    : Original code
-   !!         !  00-06  (J.-M. Molines) : Profiling floats for CLS 
-   !!    8.5  !  02-10  (A. Bozec)  F90 : Free form and module
-   !!    3.2  !  10-08  (slaw, cbricaud): netcdf outputs and others 
-   !!----------------------------------------------------------------------
-#if   defined key_floats   ||   defined key_esopa
+   !!  History :  OPA  !  1999-09  (Y. Drillet)    : Original code
+   !!              -   !  2000-06  (J.-M. Molines) : Profiling floats for CLS 
+   !!   NEMO      1.0  !  2002-10  (A. Bozec)  F90 : Free form and module
+   !!             3.2  !  2010-08  (slaw, cbricaud): netcdf outputs and others 
+   !!----------------------------------------------------------------------
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                     float trajectories
    !!----------------------------------------------------------------------
-
-   !! * Modules used
    USE flo_oce         ! ocean drifting floats
    USE oce             ! ocean dynamics and tracers
@@ -30,5 +25,4 @@
    USE iom             ! I/O library
 
-
    IMPLICIT NONE
    PRIVATE
@@ -51,7 +45,6 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90	(revision 5901)
@@ -191,5 +191,5 @@
 
          nbergs_end        = icb_utl_count()
-         zgrdd_berg_mass   = SUM( berg_mass (:,:)*e1e2t(:,:)*tmask_i(:,:) )
+         zgrdd_berg_mass   = SUM( berg_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )
          zgrdd_bits_mass   = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90	(revision 5901)
@@ -156,5 +156,5 @@
          ! use tmask rather than tmask_i when dealing with icebergs
          IF( tmask(ii,ij,1) /= 0._wp ) THEN    ! Add melting to the grid and field diagnostics
-            z1_e1e2    = 1._wp / e1e2t(ii,ij) * this%mass_scaling
+            z1_e1e2    = r1_e1e2t(ii,ij) * this%mass_scaling
             z1_dt_e1e2 = z1_dt * z1_e1e2
             zmelt    = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt   ! kg/s
@@ -195,5 +195,5 @@
             !
          ELSE                            ! Diagnose mass distribution on grid
-            z1_e1e2 = 1._wp / e1e2t(ii,ij) * this%mass_scaling
+            z1_e1e2 = r1_e1e2t(ii,ij) * this%mass_scaling
             CALL icb_dia_size( ii, ij, zWn, zLn, zAbits,   &
             &                  this%mass_scaling, zMnew, znMbits, z1_e1e2)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 5901)
@@ -129,8 +129,8 @@
          !
          IF( ln_cfmeta ) THEN   ! Add additional grid metadata
-            CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej))
-            CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej))
-            CALL iom_set_domain_attr("grid_V", area = e12v(nldi:nlei, nldj:nlej))
-            CALL iom_set_domain_attr("grid_W", area = e12t(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej))
             CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
             CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
@@ -903,12 +903,8 @@
                IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs
             ELSEIF( PRESENT(pv_r2d) ) THEN
-!CDIR COLLAPSE
                IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
-!CDIR COLLAPSE
                IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
             ELSEIF( PRESENT(pv_r3d) ) THEN
-!CDIR COLLAPSE
                IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
-!CDIR COLLAPSE
                IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
             ENDIF
@@ -1219,6 +1215,8 @@
       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op
       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_offset
-      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
-      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       &
+    &     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr  &
+    &                    ( cdid, freq_op=freq_op, freq_offset=freq_offset )
       CALL xios_solve_inheritance()
    END SUBROUTINE iom_set_field_attr
@@ -1696,4 +1694,5 @@
             END DO
 
+            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
             IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname )
             IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname )
@@ -1743,4 +1742,6 @@
       ENDIF
       
+!$AGRIF_DO_NOT_TREAT      
+! Should be fixed in the conv
       IF( llfull ) THEN 
          clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
@@ -1753,4 +1754,5 @@
          WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run
       ENDIF
+!$AGRIF_END_DO_NOT_TREAT      
 
    END FUNCTION iom_sdate
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 5901)
@@ -9,4 +9,6 @@
    !!            3.3  !  2010-04  (M. Leclair, G. Madec)  modified LF-RA
    !!            - -  !  2010-10  (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D)
+   !!            3.7  !  2014-01  (G. Madec) suppression of curl and hdiv from the restart
+   !!             -   !  2014-12  (G. Madec) remove KPP scheme
    !!----------------------------------------------------------------------
 
@@ -18,10 +20,11 @@
    USE oce             ! ocean dynamics and tracers 
    USE dom_oce         ! ocean space and time domain
+   USE sbc_ice         ! only lk_lim3 
    USE phycst          ! physical constants
+   USE eosbn2          ! equation of state            (eos bn2 routine)
+   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
+   !
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
-   USE eosbn2          ! equation of state            (eos bn2 routine)
-   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
-   USE divcur          ! hor. divergence and curl      (div & cur routines)
 
    IMPLICIT NONE
@@ -130,6 +133,4 @@
                      CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) )
                      CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) )
-                     CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb      )
-                     CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     )
                      CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      )
                      !
@@ -138,11 +139,6 @@
                      CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem) )
                      CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) )
-                     CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn      )
-                     CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn     )
                      CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      )
                      CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      )
-#if defined key_zdfkpp
-                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       )
-#endif
       IF( kt == nitrst ) THEN
          CALL iom_close( numrow )     ! close the restart file (only at last time step)
@@ -197,4 +193,5 @@
    END SUBROUTINE rst_read_open
 
+
    SUBROUTINE rst_read
       !!---------------------------------------------------------------------- 
@@ -227,6 +224,4 @@
          CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) )
          CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) )
-         CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    )
-         CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   )
          CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    )
       ELSE
@@ -239,10 +234,4 @@
       CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) )
       CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
-      IF( iom_varid( numror, 'rotn', ldstop = .FALSE. ) > 0 ) THEN
-         CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    )
-         CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   )
-      ELSE
-         CALL div_cur( 0 )                              ! Horizontal divergence & Relative vorticity
-      ENDIF
       IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN
          CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density
@@ -250,11 +239,4 @@
          CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )   
       ENDIF
-#if defined key_zdfkpp
-      IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN
-         CALL iom_get( numror, jpdom_autoglo, 'rhd'    , rhd     )   ! now    in situ density anomaly
-      ELSE
-         CALL eos( tsn, rhd, fsdept_n(:,:,:) )   ! compute rhd
-      ENDIF
-#endif
       !
       IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
@@ -262,8 +244,6 @@
          ub   (:,:,:)   = un   (:,:,:)
          vb   (:,:,:)   = vn   (:,:,:)
-         rotb (:,:,:)   = rotn (:,:,:)
-         hdivb(:,:,:)   = hdivn(:,:,:)
          sshb (:,:)     = sshn (:,:)
-
+         !
          IF( lk_vvl ) THEN
             DO jk = 1, jpk
@@ -271,5 +251,5 @@
             END DO
          ENDIF
-
+         !
       ENDIF
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90	(revision 5891)
+++ 	(revision )
@@ -1,732 +1,0 @@
-MODULE cla
-   !!======================================================================
-   !!                    ***  MODULE  cla  ***
-   !! Cross Land Advection : specific update of the horizontal divergence,
-   !!                        tracer trends and after velocity
-   !!
-   !!                 ---   Specific to ORCA_R2   ---
-   !!
-   !!======================================================================
-   !! History :  1.0  ! 2002-11 (A. Bozec)  Original code
-   !!            3.2  ! 2009-07 (G. Madec)  merge cla, cla_div, tra_cla, cla_dynspg
-   !!                 !                     and correct a mpp bug reported by A.R. Porter
-   !!----------------------------------------------------------------------
-   !!   cla_div           : update of horizontal divergence at cla straits
-   !!   tra_cla           : update of tracers at cla straits
-   !!   cla_dynspg        : update of after horizontal velocities at cla straits
-   !!   cla_init          : initialisation - control check
-   !!   cla_bab_el_mandeb : cross land advection for Bab-el-mandeb strait
-   !!   cla_gibraltar     : cross land advection for Gibraltar strait
-   !!   cla_hormuz        : cross land advection for Hormuz strait
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers
-   USE dom_oce        ! ocean space and time domain
-   USE sbc_oce        ! surface boundary condition: ocean
-   USE dynspg_oce     ! ocean dynamics: surface pressure gradient variables
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! distributed memory computing library
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp        ! MPP library
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   cla_init     ! routine called by opa.F90
-   PUBLIC   cla_div      ! routine called by divcur.F90
-   PUBLIC   cla_traadv   ! routine called by traadv.F90
-   PUBLIC   cla_dynspg   ! routine called by dynspg_flt.F90
-
-   INTEGER  ::   nbab, ngib, nhor   ! presence or not of required grid-point on local domain
-   !                                ! for Bab-el-Mandeb, Gibraltar, and Hormuz straits
-   
-   !                                           !   fixed part  !  time evolving    !!! profile of hdiv for some straits
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_139_101, hdiv_139_101_kt    ! Gibraltar     (i,j)=(172,101)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_139_102                     ! Gibraltar     (i,j)=(139,102)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_141_102, hdiv_141_102_kt    ! Gibraltar     (i,j)=(141,102)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_161_88 , hdiv_161_88_kt     ! Bab-el-Mandeb (i,j)=(161,88)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_161_87                      ! Bab-el-Mandeb (i,j)=(161,87)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_160_89 , hdiv_160_89_kt     ! Bab-el-Mandeb (i,j)=(160,89)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_172_94                      ! Hormuz        (i,j)=(172, 94)
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   t_171_94_hor, s_171_94_hor       ! Temperature, salinity in Hormuz strait
-   
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE cla_div( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE div_cla  ***
-      !!
-      !! ** Purpose :   update the horizontal divergence of the velocity field
-      !!              at some straits ( Gibraltar, Bab el Mandeb and Hormuz ).
-      !!
-      !! ** Method  : - first time-step: initialisation of cla
-      !!              - all   time-step: using imposed transport at each strait, 
-      !!              the now horizontal divergence is updated
-      !!
-      !! ** Action  :   phdivn   updted now horizontal divergence at cla straits
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!----------------------------------------------------------------------
-      !     
-      IF( kt == nit000 ) THEN
-         !
-         CALL cla_init                                        ! control check 
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'div_cla : cross land advection on hdiv '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~'
-         !
-         IF( nbab == 1 )   CALL cla_bab_el_mandeb('ini')    ! Bab el Mandeb ( Red Sea - Indian ocean )
-         IF( ngib == 1 )   CALL cla_gibraltar    ('ini')    ! Gibraltar strait (Med Sea - Atlantic ocean)
-         IF( nhor == 1 )   CALL cla_hormuz       ('ini')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
-         !
-      ENDIF                           
-      !
-      IF( nbab == 1    )   CALL cla_bab_el_mandeb('div')    ! Bab el Mandeb ( Red Sea - Indian ocean )
-      IF( ngib == 1    )   CALL cla_gibraltar    ('div')    ! Gibraltar strait (Med Sea - Atlantic ocean)
-      IF( nhor == 1    )   CALL cla_hormuz       ('div')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
-      !
-!!gm  lbc useless here, no?
-!!gm      CALL lbc_lnk( hdivn, 'T', 1. )                    ! Lateral boundary conditions on hdivn
-      !
-   END SUBROUTINE cla_div
-   
-   
-   SUBROUTINE cla_traadv( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE tra_cla  ***
-      !!                   
-      !! ** Purpose :   Update the now trend due to the advection of tracers
-      !!      and add it to the general trend of passive tracer equations
-      !!      at some straits ( Bab el Mandeb, Gibraltar, Hormuz ).
-      !!
-      !! ** Method  :   using both imposed transport at each strait and T & S
-      !!              budget, the now tracer trends is updated
-      !!
-      !! ** Action  :   (ta,sa)   updated now tracer trends at cla straits
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 ) THEN 
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_cla : cross land advection on tracers '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~'
-      ENDIF
-      !
-      IF( nbab == 1    )   CALL cla_bab_el_mandeb('tra')      ! Bab el Mandeb strait
-      IF( ngib == 1    )   CALL cla_gibraltar    ('tra')      ! Gibraltar strait
-      IF( nhor == 1    )   CALL cla_hormuz       ('tra')      ! Hormuz Strait ( Persian Gulf)
-      !
-   END SUBROUTINE cla_traadv
-
-   
-   SUBROUTINE cla_dynspg( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE cla_dynspg  ***
-      !!                   
-      !! ** Purpose :   Update the after velocity at some straits 
-      !!              (Bab el Mandeb, Gibraltar, Hormuz).
-      !!
-      !! ** Method  :   required to compute the filtered surface pressure gradient 
-      !!
-      !! ** Action  :   (ua,va)   after velocity at the cla straits
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 ) THEN 
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'cla_dynspg : cross land advection on (ua,va) '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-      ENDIF
-      !
-      IF( nbab == 1    )   CALL cla_bab_el_mandeb('spg')      ! Bab el Mandeb strait
-      IF( ngib == 1    )   CALL cla_gibraltar    ('spg')      ! Gibraltar strait
-      IF( nhor == 1    )   CALL cla_hormuz       ('spg')      ! Hormuz Strait ( Persian Gulf)
-      !
-!!gm lbc is needed here, not?
-!!gm      CALL lbc_lnk( hdivn, 'U', -1. )   ;   CALL lbc_lnk( hdivn, 'V', -1. )      ! Lateral boundary conditions 
-      !
-   END SUBROUTINE cla_dynspg
-
-
-   SUBROUTINE cla_init
-      !! -------------------------------------------------------------------
-      !!                   ***  ROUTINE cla_init  ***
-      !!           
-      !! ** Purpose :   control check for mpp computation  
-      !!
-      !! ** Method  : - All the strait grid-points must be inside one of the 
-      !!              local domain interior for the cla advection to work
-      !!              properly in mpp (i.e. inside (2:jpim1,2:jpjm1) ).
-      !!              Define the corresponding indicators (nbab, ngib, nhor)
-      !!              - The profiles of cross-land fluxes are currently hard
-      !!              coded for L31 levels. Stop if jpk/=31
-      !!
-      !! ** Action  :   nbab, ngib, nhor   strait inside the local domain or not
-      !!---------------------------------------------------------------------
-      REAL(wp) ::   ztemp   ! local scalar
-      INTEGER  ::   ierr    ! local integer
-      !!---------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'cla_init : cross land advection initialisation '
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
-      !
-      !                           ! Allocate arrays for this module
-      ALLOCATE( hdiv_139_101(jpk) , hdiv_139_101_kt(jpk) ,     &    ! Gibraltar
-         &      hdiv_139_102(jpk) ,                            &
-         &      hdiv_141_102(jpk) , hdiv_141_102_kt(jpk) ,     &
-         &      hdiv_161_88 (jpk) , hdiv_161_88_kt (jpk) ,     &    ! Bab-el-Mandeb
-         &      hdiv_161_87 (jpk) ,                            &                     
-         &      hdiv_160_89 (jpk) , hdiv_160_89_kt (jpk) ,     &     ! Hormuz
-         &      hdiv_172_94 (jpk) ,                            &
-         &      t_171_94_hor(jpk) , s_171_94_hor   (jpk) , STAT=ierr )
-      IF( lk_mpp    )   CALL mpp_sum( ierr )
-      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'cla_init: unable to allocate arrays' )
-      !
-      IF( .NOT.lk_dynspg_flt )   CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' )
-      !
-      IF( lk_vvl             )   CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' )
-      !
-      IF( jpk /= 31          )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' )
-      !
-      !                                        _|_______|_______|_
-      !                                     89  |       |///////|  
-      !                                        _|_______|_______|_
-      ! ------------------------ !          88  |///////|       | 
-      !   Bab el Mandeb strait   !             _|_______|_______|_
-      ! ------------------------ !          87  |///////|       | 
-      !                                        _|_______|_______|_
-      !                                         |  160  |  161  |  
-      !
-      ! The 6 Bab el Mandeb grid-points must be inside one of the interior of the
-      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
-      nbab = 0
-      IF(  ( 1 <= mj0( 88) .AND. mj1( 89) <= jpj ) .AND.    &  !* (161,89), (161,88) and (161,88) on the local pocessor
-         & ( 1 <= mi0(160) .AND. mi1(161) <= jpi )       )    nbab = 1 
-      !
-      ! test if there is no local domain that includes all required grid-points
-      ztemp = REAL( nbab )
-      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
-      IF( ztemp == 0 ) THEN                     ! Only 2 points in each direction, this should never be a problem
-         CALL ctl_stop( ' cross land advection at Bab-el_Mandeb does not work with your processor cutting: change it' )
-      ENDIF
-      !                                        ___________________________
-      ! ------------------------ !         102  |       |///////|       |
-      !     Gibraltar strait     !             _|_______|_______|_______|_
-      ! ------------------------ !         101  |       |///////|       |
-      !                                        _|_______|_______|_______|_ 
-      !                                         |  139  |  140  |  141  |
-      !
-      ! The 6 Gibraltar grid-points must be inside one of the interior of the
-      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
-      ngib = 0
-      IF(  ( 2 <= mj0(101) .AND. mj1(102) <= jpjm1 ) .AND.    &  !* (139:141,101:102) on the local pocessor
-         & ( 2 <= mi0(139) .AND. mi1(141) <= jpim1 )       )    ngib = 1 
-      !
-      ! test if there is no local domain that includes all required grid-points
-      ztemp = REAL( ngib )
-      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
-      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
-           CALL ctl_stop( ' cross land advection at Gibraltar does not work with your processor cutting: change it' )
-      ENDIF
-      !                                        _______________
-      ! ------------------------ !          94  |/////|     | 
-      !       Hormuz strait      !             _|_____|_____|_
-      ! ------------------------ !                171   172     
-      !           
-      ! The 2 Hormuz grid-points must be inside one of the interior of the
-      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
-      nhor = 0
-      IF(    2 <= mj0( 94) .AND. mj1( 94) <= jpjm1  .AND.  & 
-         &   2 <= mi0(171) .AND. mi1(172) <= jpim1         )   nhor = 1 
-      !
-      ! test if there is no local domain that includes all required grid-points
-      ztemp = REAL( nhor )
-      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
-      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
-           CALL ctl_stop( ' cross land advection at Hormuz does not work with your processor cutting: change it' )
-      ENDIF
-      !
-   END SUBROUTINE cla_init
-
-
-   SUBROUTINE cla_bab_el_mandeb( cd_td )
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE cla_bab_el_mandeb  ***
-      !!       
-      !! ** Purpose :   update the now horizontal divergence, the tracer tendancy
-      !!              and the after velocity in vicinity of Bab el Mandeb ( Red Sea - Indian ocean).
-      !!
-      !! ** Method  :   compute the exchanges at each side of the strait :
-      !!
-      !!       surf. zio_flow
-      !! (+ balance of emp) /\  |\\\\\\\\\\\|
-      !!                    ||  |\\\\\\\\\\\|  
-      !!    deep zio_flow   ||  |\\\\\\\\\\\|  
-      !!            |  ||   ||  |\\\\\\\\\\\|  
-      !!        89  |  ||   ||  |\\\\\\\\\\\|  
-      !!            |__\/_v_||__|____________ 
-      !!            !\\\\\\\\\\\|          surf. zio_flow
-      !!            |\\\\\\\\\\\|<===    (+ balance of emp)
-      !!            |\\\\\\\\\\\u
-      !!        88  |\\\\\\\\\\\|<---      deep  zrecirc (upper+deep at 2 different levels)
-      !!            |___________|__________   
-      !!            !\\\\\\\\\\\|         
-      !!            |\\\\\\\\\\\| ---\     deep  zrecirc (upper+deep) 
-      !!        87  !\\\\\\\\\\\u ===/   + deep  zio_flow   (all at the same level)
-      !!            !\\\\\\\\\\\|  
-      !!            !___________|__________ 
-      !!                160         161
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
-      !                                         ! ='tra' update the tracers
-      !                                         ! ='spg' update after velocity
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zemp_red     ! temporary scalar
-      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
-      !!---------------------------------------------------------------------
-      !
-      SELECT CASE( cd_td ) 
-      !                     ! ---------------- !
-      CASE( 'ini' )         !  initialisation  ! 
-         !                  ! ---------------- ! 
-         !                                   
-         zio_flow    = 0.4e6                       ! imposed in/out flow
-         zrecirc_upp = 0.2e6                       ! imposed upper recirculation water
-         zrecirc_bot = 0.5e6                       ! imposed bottom  recirculation water
-
-         hdiv_161_88(:) = 0.e0                     ! (161,88) Gulf of Aden side, north point
-         hdiv_161_87(:) = 0.e0                     ! (161,87) Gulf of Aden side, south point
-         hdiv_160_89(:) = 0.e0                     ! (160,89) Red sea side
-
-         DO jj = mj0(88), mj1(88)              !** profile of hdiv at (161,88)   (Gulf of Aden side, north point)
-            DO ji = mi0(161), mi1(161)         !------------------------------
-               DO jk = 1, 8                        ! surface in/out flow   (Ind -> Red)   (div >0)
-                  hdiv_161_88(jk) = + zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                   ! recirculation water   (Ind -> Red)   (div >0)
-               hdiv_161_88(20) =                 + zrecirc_upp   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,20) )
-               hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
-            END DO
-         END DO
-         !
-         DO jj = mj0(87), mj1(87)              !** profile of hdiv at (161,88)   (Gulf of Aden side, south point)
-            DO ji = mi0(161), mi1(161)         !------------------------------
-               !                                   ! deep out flow + recirculation   (Red -> Ind)   (div <0)
-               hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
-            END DO
-         END DO
-         !
-         DO jj = mj0(89), mj1(89)              !** profile of hdiv at (161,88)   (Red sea side)
-            DO ji = mi0(160), mi1(160)         !------------------------------
-               DO jk = 1, 8                        ! surface inflow    (Ind -> Red)   (div <0)
-                  hdiv_160_89(jk) = - zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                   ! deep    outflow   (Red -> Ind)   (div >0)
-               hdiv_160_89(16)    = + zio_flow / (      e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,16) )
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
-         !                  ! ---------=====-- ! 
-         !                                     !** emp on the Red Sea   (div >0) 
-         zemp_red = 0.e0                       !---------------------
-         DO jj = mj0(87), mj1(96)                  ! sum over the Red sea
-            DO ji = mi0(148), mi1(160) 
-               zemp_red = zemp_red + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_sum( zemp_red )   ! sum with other processors value
-         zemp_red = zemp_red * 1.e-3               ! convert in m3
-         !
-         !                                     !** Correct hdivn (including emp adjustment)
-         !                                     !-------------------------------------------
-         DO jj = mj0(88), mj1(88)                  !* profile of hdiv at (161,88)   (Gulf of Aden side, north point)
-            DO ji = mi0(161), mi1(161) 
-               hdiv_161_88_kt(:) = hdiv_161_88(:)
-               DO jk = 1, 8                              ! increase the inflow from the Indian   (div >0) 
-                  hdiv_161_88_kt(jk) = hdiv_161_88(jk) + zemp_red / (8. * e2u(ji,jj) * fse3u(ji,jj,jk) )
-               END DO
-               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_88_kt(:)
-            END DO
-         END DO
-         DO jj = mj0(87), mj1(87)                  !* profile of divergence at (161,87)   (Gulf of Aden side, south point)
-            DO ji = mi0(161), mi1(161) 
-               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_87(:)
-            END DO
-         END DO
-         DO jj = mj0(89), mj1(89)                  !* profile of divergence at (160,89)   (Red sea side)
-            DO ji = mi0(160), mi1(160) 
-               hdiv_160_89_kt(:) = hdiv_160_89(:)
-               DO jk = 1, 18                              ! increase the inflow from the Indian   (div <0) 
-                  hdiv_160_89_kt(jk) = hdiv_160_89(jk) - zemp_red / (10. * e1v(ji,jj) * fse3v(ji,jj,jk) )
-               END DO
-               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_160_89_kt(:)
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
-         !                  ! --------=======- !
-         !
-         DO jj = mj0(88), mj1(88)              !** (161,88)   (Gulf of Aden side, north point)
-            DO ji = mi0(161), mi1(161) 
-               DO jk = 1, jpkm1                         ! surf inflow + reciculation (from Gulf of Aden)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_tem)
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_sal)
-               END DO
-            END DO
-         END DO
-         DO jj = mj0(87), mj1(87)              !** (161,87)   (Gulf of Aden side, south point)
-            DO ji = mi0(161), mi1(161) 
-               jk =  21                                 ! deep outflow + recirulation (combined flux)
-               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + hdiv_161_88(20) * tsn(ji  ,jj+1,20,jp_tem)   &  ! upper recirculation from Gulf of Aden
-                  &                        + hdiv_161_88(21) * tsn(ji  ,jj+1,21,jp_tem)   &  ! deep  recirculation from Gulf of Aden
-                  &                        + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_tem)      ! deep inflow from Red sea
-               tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + hdiv_161_88(20) * tsn(ji  ,jj+1,20,jp_sal)   &
-                  &                        + hdiv_161_88(21) * tsn(ji  ,jj+1,21,jp_sal)   &
-                  &                        + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_sal)   
-            END DO
-         END DO
-         DO jj = mj0(89), mj1(89)              !** (161,88)   (Red sea side)
-            DO ji = mi0(160), mi1(160)
-               DO jk = 1, 14                            ! surface inflow (from Gulf of Aden)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_tem)
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_sal)
-               END DO
-               !                                  ! deep    outflow (from Red sea)
-               tsa(ji,jj,16,jp_tem) = tsa(ji,jj,16,jp_tem) - hdiv_160_89(16) * tsn(ji,jj,16,jp_tem)
-               tsa(ji,jj,16,jp_sal) = tsa(ji,jj,16,jp_sal) - hdiv_160_89(16) * tsn(ji,jj,16,jp_sal)
-            END DO
-         END DO
-         !
-         !                  ! ---------------- !
-      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
-         !                  ! --------=======- !
-         ! at this stage, (ua,va) are the after velocity, not the tendancy
-         ! compute the velocity from the divergence at T-point
-         !
-         DO jj = mj0(88), mj1(88)              !** (160,88)   (Gulf of Aden side, north point)
-            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point) 
-               ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
-                  &                              * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         DO jj = mj0(87), mj1(87)              !** (160,87)   (Gulf of Aden side, south point)
-            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point) 
-               ua(ji,jj,:) = - hdiv_161_87(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
-                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         DO jj = mj0(88), mj1(88)              !** profile of divergence at (160,89)   (Red sea side)
-            DO ji = mi0(160), mi1(160)                   ! 88, not 89 as it is a V-point)
-               va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1t(ji,jj+1) * e2t(ji,jj+1) * fse3t(ji,jj+1,:) )   &
-                  &                              * e1v(ji,jj) * fse3v(ji,jj,:)
-            END DO
-         END DO
-      END SELECT
-      !
-   END SUBROUTINE cla_bab_el_mandeb
-   
-
-   SUBROUTINE cla_gibraltar( cd_td )
-      !! -------------------------------------------------------------------
-      !!                 ***  ROUTINE cla_gibraltar  ***
-      !!        
-      !! ** Purpose :   update the now horizontal divergence, the tracer 
-      !!              tendancyand the after velocity in vicinity of Gibraltar 
-      !!              strait ( Persian Gulf - Indian ocean ).
-      !!
-      !! ** Method :
-      !!                     _______________________            
-      !!      deep  zio_flow /====|///////|====> surf. zio_flow
-      !!    + deep  zrecirc  \----|///////|     (+balance of emp)
-      !! 102                      u///////u
-      !!      mid.  recicul    <--|///////|<==== deep  zio_flow
-      !!                     _____|_______|_____  
-      !!      surf. zio_flow ====>|///////|       
-      !!    (+balance of emp)     |///////|
-      !! 101                      u///////|             
-      !!      mid.  recicul    -->|///////|               Caution: zrecirc split into 
-      !!      deep  zrecirc  ---->|///////|                  upper & bottom recirculation
-      !!                   _______|_______|_______ 
-      !!                     139     140     141  
-      !!
-      !!---------------------------------------------------------------------
-      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
-      !                                         ! ='tra' update the tracers
-      !                                         ! ='spg' update after velocity
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zemp_med     ! temporary scalar
-      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
-      !!---------------------------------------------------------------------
-      !
-      SELECT CASE( cd_td ) 
-      !                     ! ---------------- !
-      CASE( 'ini' )         !  initialisation  ! 
-         !                  ! ---------------- ! 
-         !                                     !** initialization of the velocity
-         hdiv_139_101(:) = 0.e0                     !  139,101 (Atlantic side, south point)
-         hdiv_139_102(:) = 0.e0                     !  139,102 (Atlantic side, north point)
-         hdiv_141_102(:) = 0.e0                     !  141,102 (Med sea  side)
-            
-         !                                     !** imposed transport
-         zio_flow    = 0.8e6                        ! inflow surface  water
-         zrecirc_mid = 0.7e6                        ! middle recirculation water
-         zrecirc_upp = 2.5e6                        ! upper  recirculation water
-         zrecirc_bot = 3.5e6                        ! bottom recirculation water
-         !
-         DO jj = mj0(101), mj1(101)            !** profile of hdiv at 139,101 (Atlantic side, south point)
-            DO ji = mi0(139), mi1(139)         !-----------------------------
-               DO jk = 1, 14                        ! surface in/out flow (Atl -> Med)   (div >0)
-                  hdiv_139_101(jk) = + zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               DO jk = 15, 20                       ! middle  reciculation (Atl 101 -> Atl 102)   (div >0)   
-                  hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                    ! upper reciculation (Atl 101 -> Atl 101)   (div >0)
-               hdiv_139_101(21) =               + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               !
-               !                                    ! upper & bottom reciculation (Atl 101 -> Atl 101 & 102)   (div >0)
-               hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)            !** profile of hdiv at 139,102 (Atlantic side, north point)
-            DO ji = mi0(139), mi1(139)         !-----------------------------
-               DO jk = 15, 20                       ! middle reciculation (Atl 101 -> Atl 102)   (div <0)                
-                  hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                    ! outflow of Mediterranean sea + deep recirculation   (div <0) 
-               hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)            !** velocity profile at 141,102  (Med sea side)
-            DO ji = mi0(141), mi1(141)         !------------------------------
-               DO  jk = 1, 14                       ! surface inflow in the Med     (div <0)
-                  hdiv_141_102(jk) = - zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                    ! deep    outflow toward the Atlantic    (div >0) 
-               hdiv_141_102(21)    = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
-         !                  ! ---------=====-- ! 
-         !                                     !** emp on the Mediterranean Sea  (div >0) 
-         zemp_med = 0.e0                       !-------------------------------
-         DO jj = mj0(96), mj1(110)                  ! sum over the Med sea
-            DO ji = mi0(141),mi1(181)
-               zemp_med = zemp_med + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
-            END DO
-         END DO
-         DO jj = mj0(96), mj1(96)                   ! minus 2 points in Red Sea 
-            DO ji = mi0(148),mi1(148)
-               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
-            END DO
-            DO ji = mi0(149),mi1(149)
-               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_sum( zemp_med )    ! sum with other processors value
-         zemp_med = zemp_med * 1.e-3                ! convert in m3
-         !
-         !                                     !** Correct hdivn (including emp adjustment)
-         !                                     !-------------------------------------------
-         DO jj = mj0(101), mj1(101)                 !* 139,101 (Atlantic side, south point)
-            DO ji = mi0(139), mi1(139) 
-               hdiv_139_101_kt(:) = hdiv_139_101(:)      
-               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div >0) 
-                  hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_139_101_kt(:)
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)                 !* 139,102 (Atlantic side, north point)
-            DO ji = mi0(139), mi1(139) 
-               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_139_102(:)
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)
-            DO ji = mi0(141), mi1(141) 
-               hdiv_141_102(:) = hdiv_141_102(:)
-               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div <0)
-                  hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_141_102_kt(:)
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
-         !                  ! --------=======- !
-         !
-         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)   (div >0)
-            DO ji = mi0(139), mi1(139) 
-               DO jk = 1, jpkm1                         ! surf inflow + mid. & bottom reciculation (from Atlantic)	
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_tem)
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_sal)
-               END DO
-            END DO
-         END DO
-         !
-         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)   (div <0)
-            DO ji = mi0(139), mi1(139) 
-               DO jk = 15, 20                            ! middle  reciculation (Atl 101 -> Atl 102)   (div <0)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_tem)  ! middle Atlantic recirculation
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_sal)
-               END DO
-               !                                         ! upper & bottom Atl. reciculation (Atl 101 -> Atl 102) - (div <0)
-               !                                         ! deep Med flow                    (Med 102 -> Atl 102) - (div <0)
-               tsa(ji,jj,22,jp_tem) = tsa(ji,jj,22,jp_tem) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_tem)   &  ! deep Med flow  
-                  &                        + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_tem)   &  ! upper  Atlantic recirculation  
-                  &                        + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_tem)      ! bottom Atlantic recirculation  
-               tsa(ji,jj,22,jp_sal) = tsa(ji,jj,22,jp_sal) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_sal)   &
-                  &                        + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_sal)   &
-                  &                        + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_sal) 
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)   (div <0)
-            DO ji = mi0(141), mi1(141) 
-               DO jk = 1, 14                             ! surface flow from Atlantic to Med sea
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_tem)
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_sal)
-               END DO
-               !                                         ! deeper flow from Med sea to Atlantic
-               tsa(ji,jj,21,jp_tem) = tsa(ji,jj,21,jp_tem) - hdiv_141_102(21) * tsn(ji,jj,21,jp_tem)
-               tsa(ji,jj,21,jp_sal) = tsa(ji,jj,21,jp_sal) - hdiv_141_102(21) * tsn(ji,jj,21,jp_sal)
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
-         !                  ! --------=======- !
-         ! at this stage, (ua,va) are the after velocity, not the tendancy
-         ! compute the velocity from the divergence at T-point
-         !
-         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)
-            DO ji = mi0(139), mi1(139)                    ! div >0 => ua >0, same sign
-               ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
-                  &                             * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)
-            DO ji = mi0(139), mi1(139)                    ! div <0 => ua <0, same sign
-               ua(ji,jj,:) = hdiv_139_102(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
-                  &                          * e2u(ji,jj) * fse3u(ji,jj,:)   
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)            !** 140,102 (Med side) (140 not 141 as it is a U-point)
-            DO ji = mi0(140), mi1(140)                    ! div >0 => ua <0, opposite sign
-               ua(ji,jj,:) = - hdiv_141_102(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
-                  &                            * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-   END SUBROUTINE cla_gibraltar
-
-
-   SUBROUTINE cla_hormuz( cd_td )
-      !! -------------------------------------------------------------------
-      !!                   ***  ROUTINE div_hormuz  ***
-      !!              
-      !! ** Purpose :   update the now horizontal divergence, the tracer 
-      !!              tendancyand the after velocity in vicinity of Hormuz 
-      !!              strait ( Persian Gulf - Indian ocean ).
-      !!
-      !! ** Method  :   Hormuz strait
-      !!            ______________   
-      !!            |/////|<==      surface inflow
-      !!        94  |/////|     
-      !!            |/////|==>      deep    outflow
-      !!            |_____|_______
-      !!              171    172     
-      !!---------------------------------------------------------------------
-      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='ini' initialisation
-      !!                                        ! ='div' update the divergence
-      !!                                        ! ='tra' update the tracers
-      !!                                        ! ='spg' update after velocity
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zio_flow     ! temporary scalar
-      !!---------------------------------------------------------------------
-      !
-      SELECT CASE( cd_td ) 
-      !                     ! ---------------- !
-      CASE( 'ini' )         !  initialisation  ! 
-         !                  ! ---------------- ! 
-         !                                     !** profile of horizontal divergence due to cross-land advection
-         zio_flow  = 1.e6                          ! imposed in/out flow
-         !
-         hdiv_172_94(:) = 0.e0         
-         !
-         DO jj = mj0(94), mj1(94)                  ! in/out flow at (i,j) = (172,94)
-            DO ji = mi0(172), mi1(172) 
-               DO jk = 1, 8                            ! surface inflow  (Indian ocean to Persian Gulf) (div<0)
-                  hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               DO jk = 16, 18                          ! deep    outflow (Persian Gulf to Indian ocean) (div>0)
-                  hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
-         !                                     !** T & S profile in the Hormuz strait (use in deep outflow)
-         !      Temperature       and         Salinity
-         t_171_94_hor(:)  = 0.e0   ;   s_171_94_hor(:)  = 0.e0
-         t_171_94_hor(16) = 18.4   ;   s_171_94_hor(16) = 36.27
-         t_171_94_hor(17) = 17.8   ;   s_171_94_hor(17) = 36.4
-         t_171_94_hor(18) = 16.    ;   s_171_94_hor(18) = 36.27
-         !
-         !                  ! ---------------- !
-      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
-         !                  ! ---------=====-- ! 
-         !                                   
-         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
-            DO ji = mi0(172), mi1(172) 
-               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_172_94(:)
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
-         !                  ! --------=======- !
-         !                          
-         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
-            DO ji = mi0(172), mi1(172) 
-               DO jk = 1, 8                          ! surface inflow   (Indian ocean to Persian Gulf) (div<0)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_tem) 
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_sal) 
-               END DO
-               DO jk = 16, 18                        ! deep outflow     (Persian Gulf to Indian ocean) (div>0)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * t_171_94_hor(jk)
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * s_171_94_hor(jk)
-               END DO
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
-         !                  ! --------=======- !
-         ! No barotropic flow through Hormuz strait
-         ! at this stage, (ua,va) are the after velocity, not the tendancy
-         ! compute the velocity from the divergence at T-point
-         DO jj = mj0(94), mj1(94)              !** 171,94 (Indian ocean side) (171 not 172 as it is the western U-point)
-            DO ji = mi0(171), mi1(171)                ! div >0 => ua >0, opposite sign
-               ua(ji,jj,:) = - hdiv_172_94(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
-                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-   END SUBROUTINE cla_hormuz
-   
-   !!======================================================================
-END MODULE cla
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 5901)
@@ -298,4 +298,12 @@
       ENDIF
 
+#if defined key_agrif
+      IF (Agrif_Root()) THEN
+         CALL Agrif_MPI_Init(mpi_comm_opa)
+      ELSE
+         CALL Agrif_MPI_set_grid_comm(mpi_comm_opa)
+      ENDIF
+#endif
+
       CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
       CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
@@ -3736,9 +3744,9 @@
       LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
       INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number
-      !!
+      !
       CHARACTER(len=80) ::   clfile
       INTEGER           ::   iost
       !!----------------------------------------------------------------------
-
+      !
       ! adapt filename
       ! ----------------
@@ -3753,5 +3761,5 @@
       knum=get_unit()
 #endif
-
+      !
       iost=0
       IF( cdacce(1:6) == 'DIRECT' )  THEN
@@ -3786,7 +3794,8 @@
          STOP 'ctl_opn bad opening'
       ENDIF
-
+      !
    END SUBROUTINE ctl_opn
 
+
    SUBROUTINE ctl_nam ( kios, cdnam, ldwp )
       !!----------------------------------------------------------------------
@@ -3797,26 +3806,25 @@
       !! ** Method  :   Fortan open
       !!----------------------------------------------------------------------
-      INTEGER          , INTENT(inout) ::   kios      ! IO status after reading the namelist
-      CHARACTER(len=*) , INTENT(in   ) ::   cdnam     ! group name of namelist for which error occurs
-      CHARACTER(len=4)                 ::   clios     ! string to convert iostat in character for print
-      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
-      !!----------------------------------------------------------------------
-
-      ! 
-      ! ----------------
-      WRITE (clios, '(I4.0)') kios
+      INTEGER         , INTENT(inout) ::   kios    ! IO status after reading the namelist
+      CHARACTER(len=*), INTENT(in   ) ::   cdnam   ! group name of namelist for which error occurs
+      CHARACTER(len=4)                ::   clios   ! string to convert iostat in character for print
+      LOGICAL         , INTENT(in   ) ::   ldwp    ! boolean term for print
+      !!----------------------------------------------------------------------
+      !
+      WRITE (clios, '(I4.0)')   kios
       IF( kios < 0 ) THEN         
-         CALL ctl_warn( 'W A R N I N G:  end of record or file while reading namelist ' &
- &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
-      ENDIF
-
+         CALL ctl_warn( 'end of record or file while reading namelist '   &
+            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
+      ENDIF
+      !
       IF( kios > 0 ) THEN
-         CALL ctl_stop( 'E R R O R :   misspelled variable in namelist ' &
- &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
+         CALL ctl_stop( 'misspelled variable in namelist '   &
+            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
       ENDIF
       kios = 0
       RETURN
-      
+      !
    END SUBROUTINE ctl_nam
+
 
    INTEGER FUNCTION get_unit()
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90	(revision 5901)
@@ -0,0 +1,209 @@
+MODULE ldfc1d_c2d
+   !!======================================================================
+   !!                    ***  MODULE  ldfc1d_c2d  ***
+   !! Ocean physics:  profile and horizontal shape of lateral eddy coefficients 
+   !!=====================================================================
+   !! History :  3.7  ! 2013-12  (G. Madec)  restructuration/simplification of aht/aeiv specification,
+   !!                 !                      add velocity dependent coefficient and optional read in file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ldf_c1d       : ah reduced by 1/4 on the vertical (tanh profile, inflection at 300m) 
+   !!   ldf_c2d       : ah = F(e1,e2) (laplacian or = F(e1^3,e2^3) (bilaplacian)
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ldf_c1d   ! called by ldftra and ldfdyn modules
+   PUBLIC   ldf_c2d   ! called by ldftra and ldfdyn modules
+
+ 
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id: $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ldf_c1d( cd_type, prat, pahs1, pahs2, pah1, pah2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_c1d  ***
+      !!              
+      !! ** Purpose :   1D eddy diffusivity/viscosity coefficients
+      !!
+      !! ** Method  :   1D eddy diffusivity coefficients F( depth )
+      !!                Reduction by prat from surface to bottom 
+      !!                hyperbolic tangent profile with inflection point 
+      !!                at zh=500m and a width of zw=200m
+      !!
+      !!   cd_type = TRA      pah1, pah2 defined at U- and V-points
+      !!             DYN      pah1, pah2 defined at T- and F-points
+      !!----------------------------------------------------------------------
+      CHARACTER(len=2)                , INTENT(in   ) ::   cd_type        ! DYNamique or TRAcers
+      REAL(wp)                        , INTENT(in   ) ::   prat           ! ratio surface/deep values           [-]
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) ::   pahs1, pahs2   ! surface value of eddy coefficient   [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pah1 , pah2    ! eddy coefficient                    [m2/s]
+      !
+      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   zh, zc, zdep1   ! local scalars
+      REAL(wp) ::   zw    , zdep2   !   -      -
+      !!----------------------------------------------------------------------
+
+      ! initialization of the profile
+      zh =  500._wp              ! depth    of the inflection point [m]
+      zw =  1._wp / 200._wp      ! width^-1     -        -      -   [1/m]
+      !                          ! associated coefficient           [-]
+      zc = ( 1._wp - prat ) / ( 1._wp + TANH( zh * zw) )
+      !
+      !
+      SELECT CASE( cd_type )        ! point of calculation
+      !
+      CASE( 'DYN' )                     ! T- and F-points
+         DO jk = 1, jpk                      ! pah1 at T-point
+            pah1(:,:,jk) = pahs1(:,:) * (  prat + zc * ( 1._wp + TANH( - ( fsdept(:,:,jk) - zh ) * zw) )  ) * tmask(:,:,jk)
+         END DO
+         DO jk = 1, jpk                      ! pah2 at F-point (zdep2 is an approximation in zps-coord.)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  zdep2 = (  fsdept(ji,jj+1,jk) + fsdept(ji+1,jj+1,jk)   &
+                     &     + fsdept(ji,jj  ,jk) + fsdept(ji+1,jj  ,jk)  ) * 0.25_wp
+                  pah2(ji,jj,jk) = pahs2(ji,jj) * (  prat + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  ) * fmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pah2, 'F', 1. )   ! Lateral boundary conditions
+         !
+      CASE( 'TRA' )                     ! U- and V-points (zdep1 & 2 are an approximation in zps-coord.)
+         DO jk = 1, jpk
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  zdep1 = (  fsdept(ji,jj,jk) + fsdept(ji+1,jj,jk)  ) * 0.5_wp
+                  zdep2 = (  fsdept(ji,jj,jk) + fsdept(ji,jj+1,jk)  ) * 0.5_wp
+                  pah1(ji,jj,jk) = pahs1(ji,jj) * (  prat + zc * ( 1._wp + TANH( - ( zdep1 - zh ) * zw) )  ) * umask(ji,jj,jk)
+                  pah2(ji,jj,jk) = pahs2(ji,jj) * (  prat + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pah1, 'U', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( pah2, 'V', 1. )   
+         !
+      END SELECT
+      !
+   END SUBROUTINE ldf_c1d
+
+
+   SUBROUTINE ldf_c2d( cd_type, cd_op, pah0, pah1, pah2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_c2d  ***
+      !!              
+      !! ** Purpose :   2D eddy diffusivity/viscosity coefficients
+      !!
+      !! ** Method  :   2D eddy diffusivity coefficients F( e1 , e2 )
+      !!       laplacian   operator :   ah proportional to the scale factor      [m2/s]
+      !!       bilaplacian operator :   ah proportional to the (scale factor)^3  [m4/s]
+      !!       In both cases, pah0 is the maximum value reached by the coefficient 
+      !!       at the Equator in case of e1=ra*rad= ~111km, not over the whole domain.
+      !!
+      !!   cd_type = TRA      pah1, pah2 defined at U- and V-points
+      !!             DYN      pah1, pah2 defined at T- and F-points
+      !!----------------------------------------------------------------------
+      CHARACTER(len=3)                , INTENT(in   ) ::   cd_type      ! DYNamique or TRAcers
+      CHARACTER(len=3)                , INTENT(in   ) ::   cd_op        ! operator: LAPlacian BiLaPlacian
+      REAL(wp)                        , INTENT(in   ) ::   pah0         ! eddy coefficient   [m2/s or m4/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pah1, pah2   ! eddy coefficient   [m2/s or m4/s]
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   za00, zd_max, zemax1, zemax2   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      zd_max = ra * rad       ! = 1 degree at the equator in meters
+      !
+      IF(lwp) THEN
+         WRITE(numout,*) 'ldf_c2d :     aht = rn_aht0 *  max(e1,e2)/e_equator     (  laplacian) '
+         WRITE(numout,*) '~~~~~~~       or  = rn_bht0 * [max(e1,e2)/e_equator]**3 (bilaplacian)'
+         WRITE(numout,*)
+      ENDIF
+      !
+      SELECT CASE( cd_type )        !==  surface values  ==!  (depending on DYN/TRA)
+      !
+      CASE( 'DYN' )                     ! T- and F-points
+         IF( cd_op == 'LAP' ) THEN            ! laplacian operator
+            IF(lwp) WRITE(numout,*) '              momentum laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)'
+            za00 = pah0 / zd_max
+            DO jj = 1, jpj 
+               DO ji = 1, jpi 
+                  zemax1 = MAX( e1t(ji,jj), e2t(ji,jj) ) * tmask(ji,jj,1)
+                  zemax2 = MAX( e1f(ji,jj), e2f(ji,jj) ) * fmask(ji,jj,1)
+                  pah1(ji,jj,1) = za00 * zemax1
+                  pah2(ji,jj,1) = za00 * zemax2
+               END DO
+            END DO
+         ELSEIF( cd_op == 'BLP' ) THEN     ! bilaplacian operator
+            IF(lwp) WRITE(numout,*) '              momentum bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3'
+            za00 = pah0 / ( zd_max * zd_max * zd_max )
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zemax1 = MAX( e1t(ji,jj), e2t(ji,jj) ) * tmask(ji,jj,1)
+                  zemax2 = MAX( e1f(ji,jj), e2f(ji,jj) ) * fmask(ji,jj,1)
+                  pah1(ji,jj,1) = za00 * zemax1 * zemax1 * zemax1 
+                  pah2(ji,jj,1) = za00 * zemax2 * zemax2 * zemax2 
+               END DO
+            END DO
+         ELSE                                ! NO diffusion/viscosity
+            CALL ctl_stop( 'ldf_c2d: ', cd_op, ' case. Unknown lateral operator ' )
+         ENDIF
+         !                                !  deeper values  (LAP and BLP cases)
+         DO jk = 2, jpk
+            pah1(:,:,jk) = pah1(:,:,1) * tmask(:,:,jk) 
+            pah2(:,:,jk) = pah2(:,:,1) * fmask(:,:,jk) 
+         END DO
+         !
+      CASE( 'TRA' )                     ! U- and V-points (approximation in zps-coord.)
+         IF( cd_op == 'LAP' ) THEN            ! laplacian operator
+            IF(lwp) WRITE(numout,*) '              tracer laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)'
+            za00 = pah0 / zd_max
+            DO jj = 1, jpj 
+               DO ji = 1, jpi 
+                  zemax1 = MAX( e1u(ji,jj), e2u(ji,jj) ) * umask(ji,jj,1)
+                  zemax2 = MAX( e1v(ji,jj), e2v(ji,jj) ) * vmask(ji,jj,1)
+                  pah1(ji,jj,1) = za00 * zemax1
+                  pah2(ji,jj,1) = za00 * zemax2
+               END DO
+            END DO
+         ELSEIF( cd_op == 'BLP' ) THEN      ! bilaplacian operator (NB: square root of the coeff)
+            IF(lwp) WRITE(numout,*) '              tracer bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3'
+            za00 = pah0 / ( zd_max * zd_max * zd_max )
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zemax1 = MAX( e1u(ji,jj), e2u(ji,jj) ) * umask(ji,jj,1) 
+                  zemax2 = MAX( e1v(ji,jj), e2v(ji,jj) ) * vmask(ji,jj,1) 
+                  pah1(ji,jj,1) = za00 * zemax1 * zemax1 * zemax1 
+                  pah2(ji,jj,1) = za00 * zemax2 * zemax2 * zemax2 
+               END DO
+            END DO
+         ELSE                                ! NO diffusion/viscosity
+            CALL ctl_stop( 'ldf_c2d: ', cd_op, ' case. Unknown lateral operator ' )
+         ENDIF
+         !                                !  deeper values  (LAP and BLP cases)
+         DO jk = 2, jpk
+            pah1(:,:,jk) = pah1(:,:,1) * umask(:,:,jk) 
+            pah2(:,:,jk) = pah2(:,:,1) * vmask(:,:,jk) 
+         END DO
+         !
+      END SELECT
+      !
+   END SUBROUTINE ldf_c2d
+
+   !!======================================================================
+END MODULE ldfc1d_c2d
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 5901)
@@ -6,19 +6,20 @@
    !! History :  OPA  ! 1997-07  (G. Madec)  multi dimensional coefficients
    !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   ldf_dyn_init : initialization, namelist read, and parameters control
-   !!   ldf_dyn_c3d   : 3D eddy viscosity coefficient initialization
-   !!   ldf_dyn_c2d   : 2D eddy viscosity coefficient initialization
-   !!   ldf_dyn_c1d   : 1D eddy viscosity coefficient initialization
+   !!            3.7  ! 2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification,
+   !!                 !                                  add velocity dependent coefficient and optional read in file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ldf_dyn_init  : initialization, namelist read, and parameters control
+   !!   ldf_dyn       : update lateral eddy viscosity coefficients at each time step 
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers   
    USE dom_oce         ! ocean space and time domain 
-   USE ldfdyn_oce      ! ocean dynamics lateral physics
    USE phycst          ! physical constants
-   USE ldfslp          ! ???
-   USE ioipsl
+   USE ldfc1d_c2d      ! lateral diffusion: 1D and 2D cases
+   !
    USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module for ehanced bottom friction file
+   USE timing          ! Timing
    USE lib_mpp         ! distribued memory computing library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
@@ -28,14 +29,31 @@
    PRIVATE
 
-   PUBLIC   ldf_dyn_init   ! called by opa.F90
-
-  INTERFACE ldf_zpf
-     MODULE PROCEDURE ldf_zpf_1d, ldf_zpf_1d_3d, ldf_zpf_3d
-  END INTERFACE
+   PUBLIC   ldf_dyn_init   ! called by nemogcm.F90
+   PUBLIC   ldf_dyn        ! called by step.F90
+
+   !                                                !!* Namelist namdyn_ldf : lateral mixing on momentum *
+   LOGICAL , PUBLIC ::   ln_dynldf_lap   !: laplacian operator
+   LOGICAL , PUBLIC ::   ln_dynldf_blp   !: bilaplacian operator
+   LOGICAL , PUBLIC ::   ln_dynldf_lev   !: iso-level direction
+   LOGICAL , PUBLIC ::   ln_dynldf_hor   !: horizontal (geopotential) direction
+   LOGICAL , PUBLIC ::   ln_dynldf_iso   !: iso-neutral direction
+   INTEGER , PUBLIC ::   nn_ahm_ijk_t    !: choice of time & space variations of the lateral eddy viscosity coef.
+   REAL(wp), PUBLIC ::   rn_ahm_0        !: lateral laplacian eddy viscosity            [m2/s]
+   REAL(wp), PUBLIC ::   rn_ahm_b        !: lateral laplacian background eddy viscosity [m2/s]
+   REAL(wp), PUBLIC ::   rn_bhm_0        !: lateral bilaplacian eddy viscosity          [m4/s]
+
+   LOGICAL , PUBLIC ::   l_ldfdyn_time   !: flag for time variation of the lateral eddy viscosity coef.
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahmt, ahmf   !: eddy diffusivity coef. at U- and V-points   [m2/s or m4/s]
+
+   REAL(wp) ::   r1_12   = 1._wp / 12._wp    ! =1/12
+   REAL(wp) ::   r1_4    = 0.25_wp           ! =1/4
+   REAL(wp) ::   r1_288  = 1._wp / 288._wp   ! =1/( 12^2 * 2 )
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -49,29 +67,27 @@
       !! ** Purpose :   set the horizontal ocean dynamics physics
       !!
-      !! ** Method  :  
-      !!      -  default option : ahm = constant coef. = rn_ahm_0 (namelist)
-      !!      - 'key_dynldf_c1d': ahm = F(depth)                     see ldf_dyn_c1d.h90
-      !!      - 'key_dynldf_c2d': ahm = F(latitude,longitude)        see ldf_dyn_c2d.h90
-      !!      - 'key_dynldf_c3d': ahm = F(latitude,longitude,depth)  see ldf_dyn_c3d.h90
-      !!
-      !!      N.B. User defined include files.  By default, 3d and 2d coef.
-      !!      are set to a constant value given in the namelist and the 1d
-      !!      coefficients are initialized to a hyperbolic tangent vertical
-      !!      profile.
-      !!
-      !! Reference :   Madec, G. and M. Imbard, 1996: Climate Dynamics, 12, 381-388.
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio         ! ???
-      INTEGER ::   ios            ! Local : output status for namelist read
-      LOGICAL ::   ll_print = .FALSE.    ! Logical flag for printing viscosity coef.
-      !! 
-      NAMELIST/namdyn_ldf/ ln_dynldf_lap  , ln_dynldf_bilap,                  &
-         &                 ln_dynldf_level, ln_dynldf_hor  , ln_dynldf_iso,   &
-         &                 rn_ahm_0_lap   , rn_ahmb_0      , rn_ahm_0_blp ,   &
-         &                 rn_cmsmag_1    , rn_cmsmag_2    , rn_cmsh,         &
-         &                 rn_ahm_m_lap   , rn_ahm_m_blp
-
-   !!----------------------------------------------------------------------
-
+      !! ** Method  :   the eddy viscosity coef. specification depends on:
+      !!              - the operator:
+      !!             ln_dynldf_lap = T     laplacian operator
+      !!             ln_dynldf_blp = T   bilaplacian operator
+      !!              - the parameter nn_ahm_ijk_t:
+      !!    nn_ahm_ijk_t  =  0 => = constant
+      !!                  = 10 => = F(z) :     = constant with a reduction of 1/4 with depth 
+      !!                  =-20 => = F(i,j)     = shape read in 'eddy_viscosity.nc' file
+      !!                  = 20    = F(i,j)     = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case)
+      !!                  =-30 => = F(i,j,k)   = shape read in 'eddy_viscosity.nc'  file
+      !!                  = 30    = F(i,j,k)   = 2D (case 20) + decrease with depth (case 10)
+      !!                  = 31    = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator
+      !!                                                           or |u|e^3/12 bilaplacian operator )
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk                ! dummy loop indices
+      INTEGER  ::   ierr, inum, ios   ! local integer
+      REAL(wp) ::   zah0              ! local scalar
+      !
+      NAMELIST/namdyn_ldf/ ln_dynldf_lap, ln_dynldf_blp,                  &
+         &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso,   &
+         &                 nn_ahm_ijk_t , rn_ahm_0, rn_ahm_b, rn_bhm_0
+      !!----------------------------------------------------------------------
+      !
       REWIND( numnam_ref )              ! Namelist namdyn_ldf in reference namelist : Lateral physics
       READ  ( numnam_ref, namdyn_ldf, IOSTAT = ios, ERR = 901)
@@ -88,210 +104,191 @@
          WRITE(numout,*) '~~~~~~~'
          WRITE(numout,*) '   Namelist namdyn_ldf : set lateral mixing parameters'
-         WRITE(numout,*) '      laplacian operator                      ln_dynldf_lap   = ', ln_dynldf_lap
-         WRITE(numout,*) '      bilaplacian operator                    ln_dynldf_bilap = ', ln_dynldf_bilap
-         WRITE(numout,*) '      iso-level                               ln_dynldf_level = ', ln_dynldf_level
-         WRITE(numout,*) '      horizontal (geopotential)               ln_dynldf_hor   = ', ln_dynldf_hor
-         WRITE(numout,*) '      iso-neutral                             ln_dynldf_iso   = ', ln_dynldf_iso
-         WRITE(numout,*) '      horizontal laplacian eddy viscosity     rn_ahm_0_lap    = ', rn_ahm_0_lap
-         WRITE(numout,*) '      background viscosity                    rn_ahmb_0       = ', rn_ahmb_0
-         WRITE(numout,*) '      horizontal bilaplacian eddy viscosity   rn_ahm_0_blp    = ', rn_ahm_0_blp
-         WRITE(numout,*) '      upper limit for laplacian eddy visc     rn_ahm_m_lap    = ', rn_ahm_m_lap
-         WRITE(numout,*) '      upper limit for bilap eddy viscosity    rn_ahm_m_blp    = ', rn_ahm_m_blp
-
-      ENDIF
-
-      ahm0     = rn_ahm_0_lap              ! OLD namelist variables defined from DOCTOR namelist variables
-      ahmb0    = rn_ahmb_0
-      ahm0_blp = rn_ahm_0_blp
-
-      ! ... check of lateral diffusive operator on tracers
-      !           ==> will be done in trazdf module
-
-      ! ... Space variation of eddy coefficients
-      ioptio = 0
-#if defined key_dynldf_c3d
-      IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( latitude, longitude, depth)'
-      ioptio = ioptio+1
-#endif
-#if defined key_dynldf_c2d
-      IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( latitude, longitude)'
-      ioptio = ioptio+1
-#endif
-#if defined key_dynldf_c1d
-      IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( depth )'
-      ioptio = ioptio+1
-      IF( ln_sco ) CALL ctl_stop( 'key_dynldf_c1d cannot be used in s-coordinate (ln_sco)' )
-#endif
-      IF( ioptio == 0 ) THEN
-          IF(lwp) WRITE(numout,*) '   momentum mixing coef. = constant  (default option)'
-        ELSEIF( ioptio > 1 ) THEN
-           CALL ctl_stop( 'use only one of the following keys: key_dynldf_c3d, key_dynldf_c2d, key_dynldf_c1d' )
-      ENDIF
-
-
-      IF( ln_dynldf_bilap ) THEN
-         IF(lwp) WRITE(numout,*) '   biharmonic momentum diffusion'
-         IF( .NOT. ln_dynldf_lap ) ahm0 = ahm0_blp   ! Allow spatially varying coefs, which use ahm0 as input
-         IF( ahm0_blp > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' )
-      ELSE
-         IF(lwp) WRITE(numout,*) '   harmonic momentum diff. (default)'
-         IF( ahm0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be positive' )
-      ENDIF
-
-
-      ! Lateral eddy viscosity
-      ! ======================
-#if defined key_dynldf_c3d
-      CALL ldf_dyn_c3d( ll_print )   ! ahm = 3D coef. = F( longitude, latitude, depth )
-#elif defined key_dynldf_c2d
-      CALL ldf_dyn_c2d( ll_print )   ! ahm = 1D coef. = F( longitude, latitude )
-#elif defined key_dynldf_c1d
-      CALL ldf_dyn_c1d( ll_print )   ! ahm = 1D coef. = F( depth )
-#else
-                                     ! Constant coefficients
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'inildf: constant eddy viscosity coef. '
-      IF(lwp) WRITE(numout,*) '~~~~~~'
-      IF(lwp) WRITE(numout,*) '        ahm1 = ahm2 = ahm0 =  ',ahm0
-#endif
-     nkahm_smag = 0
-#if defined key_dynldf_smag
-     nkahm_smag = 1
-#endif
-
+         !
+         WRITE(numout,*) '      type :'
+         WRITE(numout,*) '         laplacian operator                   ln_dynldf_lap = ', ln_dynldf_lap
+         WRITE(numout,*) '         bilaplacian operator                 ln_dynldf_blp = ', ln_dynldf_blp
+         !
+         WRITE(numout,*) '      direction of action :'
+         WRITE(numout,*) '         iso-level                            ln_dynldf_lev = ', ln_dynldf_lev
+         WRITE(numout,*) '         horizontal (geopotential)            ln_dynldf_hor = ', ln_dynldf_hor
+         WRITE(numout,*) '         iso-neutral                          ln_dynldf_iso = ', ln_dynldf_iso
+         !
+         WRITE(numout,*) '      coefficients :'
+         WRITE(numout,*) '         type of time-space variation         nn_ahm_ijk_t  = ', nn_ahm_ijk_t
+         WRITE(numout,*) '         lateral laplacian eddy viscosity     rn_ahm_0_lap  = ', rn_ahm_0, ' m2/s'
+         WRITE(numout,*) '         background viscosity (iso case)      rn_ahm_b      = ', rn_ahm_b, ' m2/s'
+         WRITE(numout,*) '         lateral bilaplacian eddy viscosity   rn_ahm_0_blp  = ', rn_bhm_0, ' m4/s'
+      ENDIF
+
+      !                                ! Parameter control
+      IF( .NOT.ln_dynldf_lap .AND. .NOT.ln_dynldf_blp ) THEN
+         IF(lwp) WRITE(numout,*) '   No viscous operator selected. ahmt and ahmf are not allocated'
+         l_ldfdyn_time = .FALSE.
+         RETURN
+      ENDIF
+      !
+      IF( ln_dynldf_blp .AND. ln_dynldf_iso ) THEN     ! iso-neutral bilaplacian not implemented
+         CALL ctl_stop( 'dyn_ldf_init: iso-neutral bilaplacian not coded yet' ) 
+      ENDIF
+
+      ! ... Space/Time variation of eddy coefficients
+      !                                               ! allocate the ahm arrays
+      ALLOCATE( ahmt(jpi,jpj,jpk) , ahmf(jpi,jpj,jpk) , STAT=ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays')
+      !
+      ahmt(:,:,jpk) = 0._wp                           ! last level always 0  
+      ahmf(:,:,jpk) = 0._wp
+      !
+      !                                               ! value of eddy mixing coef.
+      IF    ( ln_dynldf_lap ) THEN   ;   zah0 =      rn_ahm_0         !   laplacian operator
+      ELSEIF( ln_dynldf_blp ) THEN   ;   zah0 = ABS( rn_bhm_0 )       ! bilaplacian operator
+      ELSE                                                                  ! NO viscous  operator
+         CALL ctl_warn( 'ldf_dyn_init: No lateral viscous operator used ' )
+      ENDIF
+      !
+      l_ldfdyn_time = .FALSE.                         ! no time variation except in case defined below
+      !
+      IF( ln_dynldf_lap .OR. ln_dynldf_blp ) THEN     ! only if a lateral diffusion operator is used
+         !
+         SELECT CASE(  nn_ahm_ijk_t  )                ! Specification of space time variations of ahmt, ahmf
+         !
+         CASE(   0  )      !==  constant  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = constant '
+            ahmt(:,:,:) = zah0 * tmask(:,:,:)
+            ahmf(:,:,:) = zah0 * fmask(:,:,:)
+            !
+         CASE(  10  )      !==  fixed profile  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( depth )'
+            ahmt(:,:,1) = zah0 * tmask(:,:,1)                      ! constant surface value
+            ahmf(:,:,1) = zah0 * fmask(:,:,1)
+            CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf )
+            !
+         CASE ( -20 )      !== fixed horizontal shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F(i,j) read in eddy_viscosity.nc file'
+            CALL iom_open( 'eddy_viscosity_2D.nc', inum )
+            CALL iom_get ( inum, jpdom_data, 'ahmt_2d', ahmt(:,:,1) )
+            CALL iom_get ( inum, jpdom_data, 'ahmf_2d', ahmf(:,:,1) )
+            CALL iom_close( inum )
+!!gm Question : info for LAP or BLP case  to take into account the SQRT in the bilaplacian case ???
+!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ????
+!!              better:  check that the max is <=1  i.e. it is a shape from 0 to 1, not a coef that has physical dimension
+            DO jk = 2, jpkm1
+               ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk)
+               ahmf(:,:,jk) = ahmf(:,:,1) * fmask(:,:,jk)
+            END DO
+            !
+         CASE(  20  )      !== fixed horizontal shape  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap. or blp. case)'
+            IF( ln_dynldf_lap )   CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor
+            IF( ln_dynldf_blp )   CALL ldf_c2d( 'DYN', 'BLP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor^3
+            !
+         CASE( -30  )      !== fixed 3D shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file'
+            CALL iom_open( 'eddy_viscosity_3D.nc', inum )
+            CALL iom_get ( inum, jpdom_data, 'ahmt_3d', ahmt )
+            CALL iom_get ( inum, jpdom_data, 'ahmf_3d', ahmf )
+            CALL iom_close( inum )
+!!gm Question : info for LAP or BLP case  to take into account the SQRT in the bilaplacian case ????
+!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ????
+            DO jk = 1, jpkm1
+               ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk)
+               ahmf(:,:,jk) = ahmf(:,:,jk) * fmask(:,:,jk)
+            END DO
+            !
+         CASE(  30  )       !==  fixed 3D shape  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth )'
+            IF( ln_dynldf_lap )   CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor
+            IF( ln_dynldf_blp )   CALL ldf_c2d( 'DYN', 'BLP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor
+            !                                                    ! reduction with depth
+            CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf )
+            !
+         CASE(  31  )       !==  time varying 3D field  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth , time )'
+            IF(lwp) WRITE(numout,*) '                                proportional to the velocity : |u|e/12 or |u|e^3/12'
+            !
+            l_ldfdyn_time = .TRUE.     ! will be calculated by call to ldf_dyn routine in step.F90
+            !
+         CASE DEFAULT
+            CALL ctl_stop('ldf_dyn_init: wrong choice for nn_ahm_ijk_t, the type of space-time variation of ahm')
+         END SELECT
+         !
+         IF( ln_dynldf_blp .AND. .NOT. l_ldfdyn_time ) THEN       ! bilapcian and no time variation:
+            ahmt(:,:,:) = SQRT( ahmt(:,:,:) )                     ! take the square root of the coefficient
+            ahmf(:,:,:) = SQRT( ahmf(:,:,:) )
+         ENDIF
+         !
+      ENDIF
       !
    END SUBROUTINE ldf_dyn_init
 
-#if defined key_dynldf_c3d
-#   include "ldfdyn_c3d.h90"
-#elif defined key_dynldf_c2d
-#   include "ldfdyn_c2d.h90"
-#elif defined key_dynldf_c1d
-#   include "ldfdyn_c1d.h90"
-#endif
-
-
-   SUBROUTINE ldf_zpf_1d( ld_print, pdam, pwam, pbot, pdep, pah )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_zpf  ***
-      !!                   
-      !! ** Purpose :   vertical adimensional profile for eddy coefficient
-      !!
-      !! ** Method  :   1D eddy viscosity coefficients ( depth )
-      !!----------------------------------------------------------------------
-      LOGICAL , INTENT(in   )                 ::   ld_print   ! If true, output arrays on numout
-      REAL(wp), INTENT(in   )                 ::   pdam       ! depth of the inflection point
-      REAL(wp), INTENT(in   )                 ::   pwam       ! width of inflection
-      REAL(wp), INTENT(in   )                 ::   pbot       ! bottom value (0<pbot<= 1)
-      REAL(wp), INTENT(in   ), DIMENSION(jpk) ::   pdep       ! depth of the gridpoint (T, U, V, F)
-      REAL(wp), INTENT(inout), DIMENSION(jpk) ::   pah        ! adimensional vertical profile
-      !!
-      INTEGER  ::   jk           ! dummy loop indices
-      REAL(wp) ::   zm00, zm01, zmhb, zmhs       ! temporary scalars
-      !!----------------------------------------------------------------------
-
-      zm00 = TANH( ( pdam - gdept_1d(1    ) ) / pwam )
-      zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam )
-      zmhs = zm00 / zm01
-      zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01
-
-      DO jk = 1, jpk
-         pah(jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam )  )
-      END DO
-
-      IF(lwp .AND. ld_print ) THEN      ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm profile : '
-         WRITE(numout,*)
-         WRITE(numout,'("  jk      ahm       ","  depth t-level " )')
-         DO jk = 1, jpk
-            WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(jk), pdep(jk)
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE ldf_zpf_1d
-
-
-   SUBROUTINE ldf_zpf_1d_3d( ld_print, pdam, pwam, pbot, pdep, pah )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_zpf  ***
-      !!
-      !! ** Purpose :   vertical adimensional profile for eddy coefficient
-      !!
-      !! ** Method  :   1D eddy viscosity coefficients ( depth )
-      !!----------------------------------------------------------------------
-      LOGICAL , INTENT(in   )                         ::   ld_print   ! If true, output arrays on numout
-      REAL(wp), INTENT(in   )                         ::   pdam       ! depth of the inflection point
-      REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection
-      REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1)
-      REAL(wp), INTENT(in   ), DIMENSION          (:) ::   pdep       ! depth of the gridpoint (T, U, V, F)
-      REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile
-      !!
-      INTEGER  ::   jk           ! dummy loop indices
-      REAL(wp) ::   zm00, zm01, zmhb, zmhs, zcf  ! temporary scalars
-      !!----------------------------------------------------------------------
-
-      zm00 = TANH( ( pdam - gdept_1d(1    ) ) / pwam )
-      zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam )
-      zmhs = zm00 / zm01
-      zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01
-
-      DO jk = 1, jpk
-         zcf = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam )  )
-         pah(:,:,jk) = zcf
-      END DO
-
-      IF(lwp .AND. ld_print ) THEN      ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm profile : '
-         WRITE(numout,*)
-         WRITE(numout,'("  jk      ahm       ","  depth t-level " )')
-         DO jk = 1, jpk
-            WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(jk)
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE ldf_zpf_1d_3d
-
-
-   SUBROUTINE ldf_zpf_3d( ld_print, pdam, pwam, pbot, pdep, pah )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_zpf  ***
-      !!
-      !! ** Purpose :   vertical adimensional profile for eddy coefficient
-      !!
-      !! ** Method  :   3D for partial step or s-coordinate
-      !!----------------------------------------------------------------------
-      LOGICAL , INTENT(in   )                         ::   ld_print   ! If true, output arrays on numout
-      REAL(wp), INTENT(in   )                         ::   pdam       ! depth of the inflection point
-      REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection
-      REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1)
-      REAL(wp), INTENT(in   ), DIMENSION      (:,:,:) ::   pdep       ! dep of the gridpoint (T, U, V, F)
-      REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile
-      !!
-      INTEGER  ::   jk           ! dummy loop indices
-      REAL(wp) ::   zm00, zm01, zmhb, zmhs       ! temporary scalars
-      !!----------------------------------------------------------------------
-
-      zm00 = TANH( ( pdam - gdept_1d(1    ) ) / pwam )   
-      zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam )
-      zmhs = zm00 / zm01
-      zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01
-
-      DO jk = 1, jpk
-         pah(:,:,jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(:,:,jk) ) / pwam )  )
-      END DO
-
-      IF(lwp .AND. ld_print ) THEN      ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm profile : '
-         WRITE(numout,*)
-         WRITE(numout,'("  jk      ahm       ","  depth t-level " )')
-         DO jk = 1, jpk
-            WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(1,1,jk)
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE ldf_zpf_3d
+
+   SUBROUTINE ldf_dyn( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_dyn  ***
+      !! 
+      !! ** Purpose :   update at kt the momentum lateral mixing coeff. (ahmt and ahmf)
+      !!
+      !! ** Method  :   time varying eddy viscosity coefficients:
+      !!
+      !!    nn_ahm_ijk_t = 31    ahmt, ahmf = F(i,j,k,t) = F(local velocity) 
+      !!                         ( |u|e /12  or  |u|e^3/12 for laplacian or bilaplacian operator )
+      !!                BLP case : sqrt of the eddy coef, since bilaplacian is en re-entrant laplacian
+      !!
+      !! ** action  :    ahmt, ahmf   update at each time step
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time step index
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zu2pv2_ij_p1, zu2pv2_ij, zu2pv2_ij_m1, zetmax, zefmax   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_dyn')
+      !
+      SELECT CASE(  nn_ahm_ijk_t  )       !== Eddy vicosity coefficients ==!
+      !
+      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity )
+         !
+         IF( ln_dynldf_lap   ) THEN          !   laplacian operator : |u| e /12 = |u/144| e
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk)
+                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
+                     zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk)
+                     zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) )
+                     zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) )
+                     ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zetmax * tmask(ji,jj,jk)      ! 288= 12*12 * 2
+                     ahmf(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zefmax * fmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ELSEIF( ln_dynldf_blp ) THEN      ! bilaplacian operator : sqrt( |u| e^3 /12 ) = sqrt( |u/144| e ) * e
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk)
+                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
+                     zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk)
+                     zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) )
+                     zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) )
+                     ahmt(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zetmax  ) * zetmax * tmask(ji,jj,jk)
+                     ahmf(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zefmax  ) * zefmax * fmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+         CALL lbc_lnk( ahmt, 'T', 1. )   ;   CALL lbc_lnk( ahmf, 'F', 1. )
+         !
+      END SELECT
+      !
+      CALL iom_put( "ahmt_2d", ahmt(:,:,1) )   ! surface u-eddy diffusivity coeff.
+      CALL iom_put( "ahmf_2d", ahmf(:,:,1) )   ! surface v-eddy diffusivity coeff.
+      CALL iom_put( "ahmt_3d", ahmt(:,:,:) )   ! 3D      u-eddy diffusivity coeff.
+      CALL iom_put( "ahmf_3d", ahmf(:,:,:) )   ! 3D      v-eddy diffusivity coeff.
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_dyn')
+      !
+   END SUBROUTINE ldf_dyn
 
    !!======================================================================
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90	(revision 5891)
+++ 	(revision )
@@ -1,124 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                     ***  ldfdyn_c1d.h90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_dyn_c1d( ld_print )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_dyn_c1d  ***
-      !!                   
-      !! ** Purpose :   initializations of the horizontal ocean physics
-      !!
-      !! ** Method  :   1D eddy viscosity coefficients ( depth )
-      !!      ahm3, ahm4 never used
-      !!      harmonic   operator : ahm1 defined at T-level
-      !!      biharmonic operator : ahm2 defined at T-level
-      !!      isopycnal or geopotential harmonic operator
-      !!                                      : ahm1 defined at T-level
-      !!                                      : ahm2 defined at w-level
-      !!
-      !!----------------------------------------------------------------------
-      LOGICAL, INTENT(in) :: ld_print   ! If true, output arrays on numout
-      !
-      INTEGER  ::   jk   ! dummy loop indice
-      REAL(wp) ::   zdam,  zwam,  zm00,  zm01,  zmhf,  zmhs
-      REAL(wp) ::   zdam2, zwam2, zm200, zm201, zmh2f, zmh2s
-      REAL(wp) ::   zahmf, zahms
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'inildf: 1D eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~  --'
-
-      ! Set ahm1 for laplacian     (always at t-level)
-      ! =============
-      ! (USER: modify ahm1 following your desiderata)
-
-      ! initialization of the profile
-      ! ahms, ahmf: surface and bottom values
-      zahms = ahm0
-      zahmf = ahm0/4.
-      ! zdam, zwam: depth of the inflection pt and width of inflection
-      zdam  = -300.
-      zwam  =  300.
-      ! computation coefficients
-      zm00 = TANH( (0-zdam)/zwam )
-      zm01 = TANH( (-fsdept(1,1,jpk)-zdam)/zwam )
-      zmhf = (zahms-zahmf)/(zm00-zm01)
-      zmhs = zahms-zmhf * zm00
-
-      ! Set ahm2 for bilaplacian   (always at t-level)
-      ! =============
-      ! (USER: modify ahm2 following your desiderata)
-
-      ! initialization of the profile
-      ! ahms, ahmf: surface and bottom values
-      zahm2s = ahm0_blp
-      zahm2f = ahm0_blp/4.
-      ! zdam, zwam: depth of the inflection pt and width of inflection
-      zdam2  = -300.
-      zwam2  =  300.
-      ! computation coefficients
-      zm200 = TANH( (0-zdam2)/zwam2 )
-      zm201 = TANH( (-fsdept(1,1,jpk)-zdam2)/zwam2 )
-      zmh2f = (zahm2s-zahm2f)/(zm200-zm201)
-      zmh2s = zahm2s-zmh2f * zm00
-
-
-      ! set ahm1 and ahm2 at T-level
-      DO jk = 1, jpk
-         ahm1(jk) = zmhs  + zmhf  * TANH( (-fsdept(1,1,jk)-zdam ) / zwam  )
-         ahm2(jk) = zmh2s + zmh2f * TANH( (-fsdept(1,1,jk)-zdam2) / zwam2 )
-      END DO
-
-      ! Control print
-      IF(lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm profile (laplacian): '
-         WRITE(numout,*)
-         WRITE(numout,9100)
-         DO jk = 1, jpk
-            WRITE(numout,9110) jk, ahm1(jk), fsdept(1,1,jk)
-         END DO
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm profile (bilaplacian): '
-         WRITE(numout,*)
-         WRITE(numout,9100)
-         DO jk = 1, jpk
-            WRITE(numout,9110) jk, ahm2(jk), fsdept(1,1,jk)
-         END DO
-      ENDIF
- 9100 FORMAT('  jk      ahm       ','  depth t-level ' )
- 9110 FORMAT(i6,2f12.4,3x,2f12.4)
-
-
-      ! Set ahm3=ahm4   (always defined at w-level)
-      ! =============
-
-      ! define ahm3 from the same vertical profile used for ahm4
-      ! (always defined at w-level)
-      ! (USER: modify ahm1 following your desiderata)
-
-      DO jk = 1, jpk
-         ahm3(jk) = zmhs + zmhf * TANH( (-fsdepw(1,1,jk)-zdam) / zwam )
-         ahm4(jk) = ahm3(jk)
-      END DO
-
-      ! Control print
-      IF(lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm3=ahm4 profile : '
-         WRITE(numout,*)
-         WRITE(numout,9120)
-         DO jk = 1, jpk
-            WRITE(numout,9110) jk, ahm3(jk), fsdepw(1,1,jk)
-         END DO
-      ENDIF
- 9120 FORMAT('  jk      ahm       ','  depth w-level ' )
-      !
-   END SUBROUTINE ldf_dyn_c1d
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90	(revision 5891)
+++ 	(revision )
@@ -1,523 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                      ***  ldfdyn_c2d.h90  ***
-   !!----------------------------------------------------------------------
-   !!   ldf_dyn_c2d  : set the lateral viscosity coefficients
-   !!   ldf_dyn_c2d_orca : specific case for orca r2 and r4
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_dyn_c2d( ld_print )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE ldf_dyn_c2d  ***
-      !!                  
-      !! ** Purpose :   initializations of the horizontal ocean physics
-      !!
-      !! ** Method :
-      !!      2D eddy viscosity coefficients ( longitude, latitude )
-      !!
-      !!       harmonic operator   : ahm1 is defined at t-point
-      !!                             ahm2 is defined at f-point
-      !!           + isopycnal     : ahm3 is defined at u-point
-      !!           or geopotential   ahm4 is defined at v-point
-      !!           iso-model level : ahm3, ahm4 not used
-      !!
-      !!       biharmonic operator : ahm3 is defined at u-point
-      !!                             ahm4 is defined at v-point
-      !!                           : ahm1, ahm2 not used
-      !!
-      !!----------------------------------------------------------------------
-      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout
-      !
-      INTEGER  ::   ji, jj
-      REAL(wp) ::   za00, zd_max, zetmax, zeumax, zefmax, zevmax
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'ldf_dyn_c2d : 2d lateral eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-
-      ! harmonic operator (ahm1, ahm2) : ( T- and F- points) (used for laplacian operators
-      ! ===============================                       whatever its orientation is)
-      IF( ln_dynldf_lap ) THEN
-         ! define ahm1 and ahm2 at the right grid point position
-         ! (USER: modify ahm1 and ahm2 following your desiderata)
-
-         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
-         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
-
-         IF(lwp) WRITE(numout,*) '              laplacian operator: ahm proportional to e1'
-         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
-
-         za00 = ahm0 / zd_max
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zetmax = MAX( e1t(ji,jj), e2t(ji,jj) )
-               zefmax = MAX( e1f(ji,jj), e2f(ji,jj) )
-               ahm1(ji,jj) = za00 * zetmax
-               ahm2(ji,jj) = za00 * zefmax
-            END DO
-         END DO
-
-         IF( ln_dynldf_iso ) THEN
-            IF(lwp) WRITE(numout,*) '              Caution, as implemented now, the isopycnal part of momentum'
-            IF(lwp) WRITE(numout,*) '                 mixing use aht0 as eddy viscosity coefficient. Thus, it is'
-            IF(lwp) WRITE(numout,*) '                 uniform and you must be sure that your ahm is greater than'
-            IF(lwp) WRITE(numout,*) '                 aht0 everywhere in the model domain.'
-         ENDIF
-
-         ! Special case for ORCA R1, R2 and R4 configurations (overwrite the value of ahm1 ahm2)
-         ! ==============================================
-         IF( cp_cfg == "orca" .AND. ( jp_cfg == 2 .OR. jp_cfg == 4 ) )   CALL ldf_dyn_c2d_orca( ld_print )
-         IF( cp_cfg == "orca" .AND.   jp_cfg == 1)                       CALL ldf_dyn_c2d_orca_R1( ld_print )
-
-         ! Control print
-         IF( lwp .AND. ld_print ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: 2D ahm1 array'
-            CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: 2D ahm2 array'
-            CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         ENDIF
-      ENDIF
-
-      ! biharmonic operator (ahm3, ahm4) : at U- and V-points (used for bilaplacian operator
-      ! =================================                      whatever its orientation is)
-      IF( ln_dynldf_bilap ) THEN
-         ! (USER: modify ahm3 and ahm4 following your desiderata)
-         ! Here: ahm is proportional to the cube of the maximum of the gridspacing
-         !       in the to horizontal direction
-
-         zd_max = MAX( MAXVAL( e1u(:,:) ), MAXVAL( e2u(:,:) ) )
-         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
-
-         IF(lwp) WRITE(numout,*) '              bi-laplacian operator: ahm proportional to e1**3 '
-         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
-
-         za00 = ahm0_blp / ( zd_max * zd_max * zd_max )
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zeumax = MAX( e1u(ji,jj), e2u(ji,jj) )
-               zevmax = MAX( e1v(ji,jj), e2v(ji,jj) )
-               ahm3(ji,jj) = za00 * zeumax * zeumax * zeumax
-               ahm4(ji,jj) = za00 * zevmax * zevmax * zevmax
-            END DO
-         END DO
-
-         ! Control print
-         IF( lwp .AND. ld_print ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahm3 array'
-            CALL prihre(ahm3,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahm4 array'
-            CALL prihre(ahm4,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         ENDIF
-      ENDIF
-      !
-   END SUBROUTINE ldf_dyn_c2d
-
-
-   SUBROUTINE ldf_dyn_c2d_orca( ld_print )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE ldf_dyn_c2d  ***
-      !!
-      !!                   **** W A R N I N G ****
-      !!
-      !!                ORCA R2 and R4 configurations
-      !!                  
-      !!                   **** W A R N I N G ****
-      !!                  
-      !! ** Purpose :   initializations of the lateral viscosity for orca R2
-      !!
-      !! ** Method  :   blah blah blah...
-      !!
-      !!----------------------------------------------------------------------
-      USE ldftra_oce, ONLY:   aht0
-      USE iom
-      !
-      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
-      !
-      INTEGER  ::   ji, jj, jn   ! dummy loop indices
-      INTEGER  ::   inum, iim, ijm            ! local integers
-      INTEGER  ::   ifreq, il1, il2, ij, ii
-      INTEGER  ::   ijpt0,ijpt1, ierror
-      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk
-      CHARACTER (len=15) ::   clexp
-      INTEGER,     POINTER, DIMENSION(:,:)  :: icof
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d  ! temporary array to read ahmcoef file
-      !!----------------------------------------------------------------------
-      !                                
-      CALL wrk_alloc( jpi   , jpj   , icof  )
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~  --'
-      IF(lwp) WRITE(numout,*) '        orca ocean configuration'
-
-      IF( cp_cfg == "orca" .AND. cp_cfz == "antarctic" ) THEN
-!
-! 1.2 Modify ahm
-! --------------
-         IF(lwp)WRITE(numout,*) ' inildf: Antarctic ocean'
-         IF(lwp)WRITE(numout,*) '         no tropics, no reduction of ahm'
-         IF(lwp)WRITE(numout,*) '         north boundary increase'
-
-         ahm1(:,:) = ahm0
-         ahm2(:,:) = ahm0
-
-         ijpt0=max(1,min(49 -njmpp+1,jpj))
-         ijpt1=max(0,min(49-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*2.
-            ahm1(:,jj)=ahm0*2.
-         END DO
-         ijpt0=max(1,min(48 -njmpp+1,jpj))
-         ijpt1=max(0,min(48-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.9
-            ahm1(:,jj)=ahm0*1.75
-         END DO
-         ijpt0=max(1,min(47 -njmpp+1,jpj))
-         ijpt1=max(0,min(47-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.5
-            ahm1(:,jj)=ahm0*1.25
-         END DO
-         ijpt0=max(1,min(46 -njmpp+1,jpj))
-         ijpt1=max(0,min(46-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.1
-         END DO
-
-      ELSE IF( cp_cfg == "orca" .AND. cp_cfz == "arctic" ) THEN
-! 1.2 Modify ahm 
-! --------------
-         IF(lwp)WRITE(numout,*) ' inildf: Arctic ocean'
-         IF(lwp)WRITE(numout,*) '         no tropics, no reduction of ahm'
-         IF(lwp)WRITE(numout,*) '         south and west boundary increase'
-
-
-         ahm1(:,:) = ahm0
-         ahm2(:,:) = ahm0
-
-         ijpt0=max(1,min(98-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(98-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*2.
-            ahm1(:,jj)=ahm0*2.
-         END DO
-         ijpt0=max(1,min(99-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(99-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.9
-            ahm1(:,jj)=ahm0*1.75
-         END DO
-         ijpt0=max(1,min(100-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(100-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.5
-            ahm1(:,jj)=ahm0*1.25
-         END DO
-         ijpt0=max(1,min(101-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(101-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.1
-         END DO
-      ELSE
-         ! Read 2d integer array to specify western boundary increase in the
-         ! ===================== equatorial strip (20N-20S) defined at t-points
-         !
-         ALLOCATE( ztemp2d(jpi,jpj) )
-         ztemp2d(:,:) = 0.
-         CALL iom_open ( 'ahmcoef.nc', inum )
-         CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d)
-         icof(:,:)  = NINT(ztemp2d(:,:))
-         CALL iom_close( inum )
-         DEALLOCATE(ztemp2d)
-
-         ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator)
-         ! =================
-         ! define ahm1 and ahm2 at the right grid point position
-         ! (USER: modify ahm1 and ahm2 following your desiderata)
-
-
-         ! Decrease ahm to zahmeq m2/s in the tropics
-         ! (from 90 to 20 degre: ahm = constant
-         ! from 20 to  2.5 degre: ahm = decrease in (1-cos)/2
-         ! from  2.5 to  0 degre: ahm = constant
-         ! symmetric in the south hemisphere)
-
-         zahmeq = aht0
-
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( ABS( gphif(ji,jj) ) >= 20. ) THEN
-                  ahm2(ji,jj) =  ahm0
-               ELSEIF( ABS( gphif(ji,jj) ) <= 2.5 ) THEN
-                  ahm2(ji,jj) =  zahmeq
-               ELSE
-                  ahm2(ji,jj) = zahmeq + (ahm0-zahmeq)/2.   &
-                     * ( 1. - COS( rad * ( ABS(gphif(ji,jj))-2.5 ) * 180. / 17.5 ) )
-               ENDIF
-               IF( ABS( gphit(ji,jj) ) >= 20. ) THEN
-                  ahm1(ji,jj) =  ahm0
-               ELSEIF( ABS( gphit(ji,jj) ) <= 2.5 ) THEN
-                  ahm1(ji,jj) =  zahmeq
-               ELSE
-                  ahm1(ji,jj) = zahmeq + (ahm0-zahmeq)/2.   &
-                     * ( 1. - COS( rad * ( ABS(gphit(ji,jj))-2.5 ) * 180. / 17.5 ) )
-               ENDIF
-            END DO
-         END DO
-
-         ! increase along western boundaries of equatorial strip
-         ! t-point
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zcoft = FLOAT( icof(ji,jj) ) / 100.
-               ahm1(ji,jj) = zcoft * ahm0 + (1.-zcoft) * ahm1(ji,jj) 
-            END DO
-         END DO
-         ! f-point
-         icof(:,:) = icof(:,:) * tmask(:,:,1)
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1   ! NO vector opt.
-               zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)
-               IF( zmsk == 0. ) THEN
-                  zcoff = 1.
-               ELSE
-                  zcoff = FLOAT( icof(ji,jj+1) + icof(ji+1,jj+1) + icof(ji,jj) + icof(ji,jj+1) )   &
-                     / (zmsk * 100.)
-               ENDIF
-               ahm2(ji,jj) = zcoff * ahm0 + (1.-zcoff) * ahm2(ji,jj)
-            END DO
-         END DO
-      ENDIF
-      
-      ! Lateral boundary conditions on ( ahm1, ahm2 )
-      !                                ==============
-      CALL lbc_lnk( ahm1, 'T', 1. )   ! T-point, unchanged sign
-      CALL lbc_lnk( ahm2, 'F', 1. )   ! F-point, unchanged sign
-
-      ! Control print
-      IF( lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: 2D ahm1 array'
-         CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: 2D ahm2 array'
-         CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi   , jpj   , icof  )
-      !
-   END SUBROUTINE ldf_dyn_c2d_orca
-
-
-   SUBROUTINE ldf_dyn_c2d_orca_R1( ld_print )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE ldf_dyn_c2d  ***
-      !!
-      !!                   **** W A R N I N G ****
-      !!
-      !!                ORCA R1 configuration
-      !!                  
-      !!                   **** W A R N I N G ****
-      !!                  
-      !! ** Purpose :   initializations of the lateral viscosity for orca R1
-      !!
-      !! ** Method  :   blah blah blah...
-      !!
-      !!----------------------------------------------------------------------
-      USE ldftra_oce, ONLY:   aht0
-      USE iom
-      !
-      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
-      !
-      INTEGER ::   ji, jj, jn      ! dummy loop indices
-      INTEGER ::   inum            ! temporary logical unit
-      INTEGER ::   iim, ijm
-      INTEGER ::   ifreq, il1, il2, ij, ii
-      INTEGER ::   ijpt0,ijpt1, ierror
-      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk, zam20s
-      CHARACTER (len=15) ::   clexp
-      INTEGER,     POINTER, DIMENSION(:,:)  :: icof
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d  ! temporary array to read ahmcoef file
-      !!----------------------------------------------------------------------
-      !                                
-      CALL wrk_alloc( jpi   , jpj   , icof  )
-      !                                
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~  --'
-      IF(lwp) WRITE(numout,*) '        orca_r1 configuration'
-
-      IF( cp_cfg == "orca" .AND. cp_cfz == "antarctic" ) THEN
-!
-! 1.2 Modify ahm
-! --------------
-         IF(lwp)WRITE(numout,*) ' inildf: Antarctic ocean'
-         IF(lwp)WRITE(numout,*) '         no tropics, no reduction of ahm'
-         IF(lwp)WRITE(numout,*) '         north boundary increase'
-
-         ahm1(:,:) = ahm0
-         ahm2(:,:) = ahm0
-
-         ijpt0=max(1,min(49 -njmpp+1,jpj))
-         ijpt1=max(0,min(49-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*2.
-            ahm1(:,jj)=ahm0*2.
-         END DO
-         ijpt0=max(1,min(48 -njmpp+1,jpj))
-         ijpt1=max(0,min(48-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.9
-            ahm1(:,jj)=ahm0*1.75
-         END DO
-         ijpt0=max(1,min(47 -njmpp+1,jpj))
-         ijpt1=max(0,min(47-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.5
-            ahm1(:,jj)=ahm0*1.25
-         END DO
-         ijpt0=max(1,min(46 -njmpp+1,jpj))
-         ijpt1=max(0,min(46-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.1
-         END DO
-
-      ELSE IF( cp_cfg == "orca" .AND. cp_cfz == "arctic" ) THEN
-! 1.2 Modify ahm 
-! --------------
-         IF(lwp)WRITE(numout,*) ' inildf: Arctic ocean'
-         IF(lwp)WRITE(numout,*) '         no tropics, no reduction of ahm'
-         IF(lwp)WRITE(numout,*) '         south and west boundary increase'
-
-
-         ahm1(:,:) = ahm0
-         ahm2(:,:) = ahm0
-
-         ijpt0=max(1,min(98-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(98-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*2.
-            ahm1(:,jj)=ahm0*2.
-         END DO
-         ijpt0=max(1,min(99-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(99-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.9
-            ahm1(:,jj)=ahm0*1.75
-         END DO
-         ijpt0=max(1,min(100-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(100-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.5
-            ahm1(:,jj)=ahm0*1.25
-         END DO
-         ijpt0=max(1,min(101-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(101-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.1
-         END DO
-      ELSE
-         
-         ! Read 2d integer array to specify western boundary increase in the
-         ! ===================== equatorial strip (20N-20S) defined at t-points
-         ALLOCATE( ztemp2d(jpi,jpj) )
-         ztemp2d(:,:) = 0.
-         CALL iom_open ( 'ahmcoef.nc', inum )
-         CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d)
-         icof(:,:)  = NINT(ztemp2d(:,:))
-         CALL iom_close( inum )
-         DEALLOCATE(ztemp2d)
-
-         ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator)
-         ! =================
-         ! define ahm1 and ahm2 at the right grid point position
-         ! (USER: modify ahm1 and ahm2 following your desiderata)
-
-
-         ! Decrease ahm to zahmeq m2/s in the tropics
-         ! (from 90   to 20   degrees: ahm = scaled by local metrics
-         !  from 20   to  2.5 degrees: ahm = decrease in (1-cos)/2
-         !  from  2.5 to  0   degrees: ahm = constant
-         ! symmetric in the south hemisphere)
-
-         zahmeq = aht0
-         zam20s = ahm0*COS( rad * 20. )
-
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( ABS( gphif(ji,jj) ) >= 20. ) THEN
-                  !              leave as set in ldf_dyn_c2d
-               ELSEIF( ABS( gphif(ji,jj) ) <= 2.5 ) THEN
-                  ahm2(ji,jj) =  zahmeq
-               ELSE
-                  ahm2(ji,jj) =  zahmeq + (zam20s-zahmeq)/2.   &
-                     * ( 1. - COS( rad * ( ABS(gphif(ji,jj))-2.5 ) * 180. / 17.5 ) )
-               ENDIF
-               IF( ABS( gphit(ji,jj) ) >= 20. ) THEN
-                  !             leave as set in ldf_dyn_c2d
-               ELSEIF( ABS( gphit(ji,jj) ) <= 2.5 ) THEN
-                  ahm1(ji,jj) =  zahmeq
-               ELSE
-                  ahm1(ji,jj) =  zahmeq + (zam20s-zahmeq)/2.   &
-                     * ( 1. - COS( rad * ( ABS(gphit(ji,jj))-2.5 ) * 180. / 17.5 ) )
-               ENDIF
-            END DO
-         END DO
-
-         ! increase along western boundaries of equatorial strip
-         ! t-point
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               IF( ABS( gphit(ji,jj) ) < 20. ) THEN
-                  zcoft = FLOAT( icof(ji,jj) ) / 100.
-                  ahm1(ji,jj) = zcoft * ahm0 + (1.-zcoft) * ahm1(ji,jj) 
-               ENDIF
-            END DO
-         END DO
-         ! f-point
-         icof(:,:) = icof(:,:) * tmask(:,:,1)
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               IF( ABS( gphif(ji,jj) ) < 20. ) THEN
-                  zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)
-                  IF( zmsk == 0. ) THEN
-                     zcoff = 1.
-                  ELSE
-                     zcoff = FLOAT( icof(ji,jj+1) + icof(ji+1,jj+1) + icof(ji,jj) + icof(ji,jj+1) )   &
-                        / (zmsk * 100.)
-                  ENDIF
-                  ahm2(ji,jj) = zcoff * ahm0 + (1.-zcoff) * ahm2(ji,jj)
-               ENDIF
-            END DO
-         END DO
-      ENDIF
-      
-      ! Lateral boundary conditions on ( ahm1, ahm2 )
-      !                                ==============
-      CALL lbc_lnk( ahm1, 'T', 1. )   ! T-point, unchanged sign
-      CALL lbc_lnk( ahm2, 'F', 1. )   ! F-point, unchanged sign
-
-      ! Control print
-      IF( lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: 2D ahm1 array'
-         CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: 2D ahm2 array'
-         CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi   , jpj   , icof  )
-      !
-   END SUBROUTINE ldf_dyn_c2d_orca_R1
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90	(revision 5891)
+++ 	(revision )
@@ -1,433 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                        ***  ldfdyn_c3d.h90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   'key_dynldf_c3d'             3D lateral eddy viscosity coefficients
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_dyn_c3d( ld_print )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_dyn_c3d  ***
-      !!                   
-      !! ** Purpose :   initializations of the horizontal ocean physics
-      !!
-      !! ** Method  :   3D eddy viscosity coef. ( longitude, latitude, depth )
-      !!       laplacian operator   : ahm1, ahm2 defined at T- and F-points
-      !!                              ahm2, ahm4 never used
-      !!       bilaplacian operator : ahm1, ahm2 never used
-      !!                           :  ahm3, ahm4 defined at U- and V-points
-      !!       ??? explanation of the default is missing
-      !!----------------------------------------------------------------------
-      USE ldftra_oce, ONLY :   aht0
-      USE iom
-      !!
-      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zr = 0.2     ! maximum of the reduction factor at the bottom ocean ( 0 < zr < 1 )
-      REAL(wp) ::   zh = 500.    ! depth of at which start the reduction ( > dept(1) )
-      REAL(wp) ::   zd_max       ! maximum grid spacing over the global domain
-      REAL(wp) ::   za00, zc, zd, zetmax, zefmax, zeumax, zevmax   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:) :: zcoef   
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpk, zcoef )
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'ldf_dyn_c3d : 3D lateral eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-
-      
-      ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operators
-      ! =================                       whatever its orientation is)
-      IF( ln_dynldf_lap ) THEN
-         ! define ahm1 and ahm2 at the right grid point position
-         ! (USER: modify ahm1 and ahm2 following your desiderata)
-
-         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
-         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
-
-         IF(lwp) WRITE(numout,*) '              laplacian operator: ahm proportional to e1'
-         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
-
-         za00 = ahm0 / zd_max
-
-         IF( ln_dynldf_iso ) THEN
-            IF(lwp) WRITE(numout,*) '              Caution, as implemented now, the isopycnal part of momentum'
-            IF(lwp) WRITE(numout,*) '                 mixing use aht0 as eddy viscosity coefficient. Thus, it is'
-            IF(lwp) WRITE(numout,*) '                 uniform and you must be sure that your ahm is greater than'
-            IF(lwp) WRITE(numout,*) '                 aht0 everywhere in the model domain.'
-         ENDIF
-
-         CALL ldf_zpf( .TRUE. , 1000., 500., 0.25, fsdept(:,:,:), ahm1 )   ! vertical profile
-         CALL ldf_zpf( .TRUE. , 1000., 500., 0.25, fsdept(:,:,:), ahm2 )   ! vertical profile
-         DO jk = 1,jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zetmax = MAX( e1t(ji,jj), e2t(ji,jj) )
-                  zefmax = MAX( e1f(ji,jj), e2f(ji,jj) )
-                  ahm1(ji,jj,jk) = za00 * zetmax * ahm1(ji,jj,jk)
-                  ahm2(ji,jj,jk) = za00 * zefmax * ahm2(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-
-         ! Special case for ORCA R1, R2 and R4 configurations (overwrite the value of ahm1 ahm2)
-         ! ==============================================
-         IF( cp_cfg == "orca" .AND. ( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) ) THEN 
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '              ORCA R1, R2 or R4: overwrite the previous definition of ahm'
-            IF(lwp) WRITE(numout,*) '              ================='
-            CALL ldf_dyn_c3d_orca( ld_print )
-         ENDIF
-
-      ENDIF
-      
-      ! Control print
-      IF(lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '         3D ahm1 array (k=1)'
-         CALL prihre( ahm1(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) '         3D ahm2 array (k=1)'
-         CALL prihre( ahm2(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
-      ENDIF
-
-
-      ! ahm3 and ahm4 at U- and V-points (used for bilaplacian operator
-      ! ================================  whatever its orientation is)
-      ! (USER: modify ahm3 and ahm4 following your desiderata)
-      ! Here: ahm is proportional to the cube of the maximum of the gridspacing
-      !       in the to horizontal direction
-
-      IF( ln_dynldf_bilap ) THEN
-
-         zd_max = MAX( MAXVAL( e1u(:,:) ), MAXVAL( e2u(:,:) ) )
-         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
-
-         IF(lwp) WRITE(numout,*) '              bi-laplacian operator: ahm proportional to e1**3 '
-         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
-
-         za00 = ahm0_blp / ( zd_max * zd_max * zd_max )
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zeumax = MAX( e1u(ji,jj), e2u(ji,jj) )
-               zevmax = MAX( e1v(ji,jj), e2v(ji,jj) )
-               ahm3(ji,jj,1) = za00 * zeumax * zeumax * zeumax
-               ahm4(ji,jj,1) = za00 * zevmax * zevmax * zevmax
-            END DO
-         END DO
-
-         zh = MAX( zh, fsdept(1,1,1) )   ! at least the first reach ahm0
-         IF( ln_zco ) THEN               ! z-coordinate, same profile everywhere
-            IF(lwp) WRITE(numout,'(36x," ahm ", 7x)')
-            DO jk = 1, jpk
-               IF( fsdept(1,1,jk) <= zh ) THEN
-                  zcoef(jk) = 1.e0
-               ELSE
-                  zcoef(jk) = 1.e0 + ( zr - 1.e0 )   &
-                     &               * (  1. - EXP( ( fsdept(1,1,jk   ) - zh ) / zh )  )   &
-                     &               / (  1. - EXP( ( fsdept(1,1,jpkm1) - zh ) / zh )  )
-               ENDIF
-               ahm3(:,:,jk) = ahm3(:,:,1) * zcoef(jk)
-               ahm4(:,:,jk) = ahm4(:,:,1) * zcoef(jk)
-               IF(lwp) WRITE(numout,'(34x,E7.2,8x,i3)') zcoef(jk) * ahm0, jk
-            END DO
-         ELSE                            ! partial steps or s-ccordinate
-            zc = MAXVAL( fsdept(:,:,jpkm1) )
-            IF( lk_mpp )   CALL mpp_max( zc )   ! max over the global domain
-
-            zc = 1. / (  1. - EXP( ( zc - zh ) / zh )  )
-            DO jk = 2, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     IF( fsdept(ji,jj,jk) <= zh ) THEN
-                        ahm3(ji,jj,jk) = ahm3(ji,jj,1)
-                        ahm4(ji,jj,jk) = ahm4(ji,jj,1)
-                     ELSE
-                        zd = 1.e0 + ( zr - 1.e0 ) * (  1. - EXP( ( fsdept(ji,jj,jk) - zh ) / zh )  ) * zc
-                        ahm3(ji,jj,jk) = ahm3(ji,jj,1) * zd
-                        ahm4(ji,jj,jk) = ahm4(ji,jj,1) * zd
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-            ahm3(:,:,jpk) = ahm3(:,:,jpkm1)
-            ahm4(:,:,jpk) = ahm4(:,:,jpkm1)
-            IF(lwp) WRITE(numout,'(36x," ahm ", 7x)')
-            DO jk = 1, jpk
-               IF(lwp) WRITE(numout,'(30x,E10.2,8x,i3)') ahm3(1,1,jk), jk
-            END DO
-         ENDIF
-
-         ! Control print
-         IF( lwp .AND. ld_print ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahm3 array at level 1'
-            CALL prihre(ahm3(:,:,1  ),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahm4 array at level 1'
-            CALL prihre(ahm4(:,:,jpk),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         ENDIF
-      ENDIF
-      !
-      CALL wrk_dealloc( jpk, zcoef )
-      !
-   END SUBROUTINE ldf_dyn_c3d
-
-
-   SUBROUTINE ldf_dyn_c3d_orca( ld_print )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_dyn_c3d  ***
-      !!                   
-      !! ** Purpose :   ORCA R1, R2 and R4 only
-      !!
-      !! ** Method  :   blah blah blah ....
-      !!----------------------------------------------------------------------
-      USE ldftra_oce, ONLY:   aht0
-      USE iom
-      !!
-      LOGICAL, INTENT(in) ::   ld_print   ! If true, output arrays on numout
-      !!
-      INTEGER ::   ji, jj, jk, jn      ! dummy loop indices
-      INTEGER ::   ii0, ii1, ij0, ij1  ! local integers
-      INTEGER ::   inum, iim, ijm      ! 
-      INTEGER ::   ifreq, il1, il2, ij, ii
-      REAL(wp) ::   zahmeq, zcoff, zcoft, zmsk   ! local scalars
-      REAL(wp) ::   zemax , zemin, zeref, zahmm
-      CHARACTER (len=15) ::   clexp
-      INTEGER , POINTER, DIMENSION(:,:)  :: icof
-      REAL(wp), POINTER, DIMENSION(:  )  :: zcoef   
-      REAL(wp), POINTER, DIMENSION(:,:)  :: zahm0
-      !
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ztemp2d  ! temporary array to read ahmcoef file
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi   , jpj   , icof  )
-      CALL wrk_alloc( jpk   ,         zcoef )
-      CALL wrk_alloc( jpi   , jpj   , zahm0 )
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'ldfdyn_c3d_orca : 3D eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
-      IF(lwp) WRITE(numout,*) '        orca R1, R2 or R4 configuration: reduced in the surface Eq. strip '
-
-      ! Read 2d integer array to specify western boundary increase in the
-      ! ===================== equatorial strip (20N-20S) defined at t-points
-      ALLOCATE( ztemp2d(jpi,jpj) )
-      ztemp2d(:,:) = 0.
-      CALL iom_open ( 'ahmcoef.nc', inum )
-      CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d)
-      icof(:,:)  = NINT(ztemp2d(:,:))
-      CALL iom_close( inum )
-      DEALLOCATE(ztemp2d)
-
-      ! Set ahm1 and ahm2
-      ! =================
-      
-      ! define ahm1 and ahm2 at the right grid point position
-      ! (USER: modify ahm1 and ahm2 following your desiderata)
-      ! biharmonic : ahm1 (ahm2) defined at u- (v-) point
-      ! harmonic   : ahm1 (ahm2) defined at t- (f-) point
-      
-      ! first level : as for 2D coefficients
-      
-      ! Decrease ahm to zahmeq m2/s in the tropics
-      ! (from 90 to 20 degre: ahm = constant
-      ! from 20 to  2.5 degre: ahm = decrease in (1-cos)/2
-      ! from  2.5 to  0 degre: ahm = constant
-      ! symmetric in the south hemisphere)
-      
-      IF( jp_cfg == 4 )   THEN
-         zahmeq = 5.0 * aht0
-         zahmm  = min( 160000.0, ahm0)
-         zemax = MAXVAL ( e1t(:,:) * e2t(:,:), tmask(:,:,1) .GE. 0.5 )
-         zemin = MINVAL ( e1t(:,:) * e2t(:,:), tmask(:,:,1) .GE. 0.5 )
-         zeref = MAXVAL ( e1t(:,:) * e2t(:,:),   &
-             &   tmask(:,:,1) .GE. 0.5 .AND. ABS(gphit(:,:)) .GT. 50. )
- 
-         DO jj = 1, jpj
-           DO ji = 1, jpi
-              zmsk = e1t(ji,jj) * e2t(ji,jj)
-              IF( abs(gphit(ji,jj)) .LE. 15 ) THEN 
-                 zahm0(ji,jj) = ahm0
-              ELSE 
-                 IF( zmsk .GE. zeref ) THEN 
-                    zahm0(ji,jj) = ahm0
-                 ELSE 
-                    zahm0(ji,jj) = zahmm + (ahm0-zahmm)*(1.0 -   &
-                        &          cos((rpi*0.5*(zmsk-zemin)/(zeref-zemin))))
-                 ENDIF 
-              ENDIF 
-           END DO 
-         END DO 
-      ENDIF
-
-      IF( jp_cfg == 2 )   THEN
-         zahmeq     = aht0
-         zahmm      = ahm0
-         zahm0(:,:) = ahm0
-      ENDIF
-
-      IF( jp_cfg == 1 )   THEN
-         zahmeq     = aht0  ! reduced to aht0 on equator; set to ahm0 if no tropical reduction is required
-         zahmm      = ahm0
-         zahm0(:,:) = ahm0
-      ENDIF
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ABS(gphif(ji,jj)) >= 20.) THEN
-               ahm2(ji,jj,1) =  zahm0(ji,jj)
-            ELSEIF( ABS(gphif(ji,jj)) <= 2.5) THEN
-               ahm2(ji,jj,1) =  zahmeq
-            ELSE
-               ahm2(ji,jj,1) = zahmeq + (zahm0(ji,jj)-zahmeq)/2.   &
-                  &            *(1.-COS( rad*(ABS(gphif(ji,jj))-2.5)*180./17.5 ) )
-            ENDIF
-            IF( ABS(gphit(ji,jj)) >= 20.) THEN
-               ahm1(ji,jj,1) =  zahm0(ji,jj)
-            ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN
-               ahm1(ji,jj,1) =  zahmeq
-            ELSE
-               ahm1(ji,jj,1) = zahmeq + (zahm0(ji,jj)-zahmeq)/2.   &
-                  &            *(1.-COS( rad*(ABS(gphit(ji,jj))-2.5)*180./17.5 ) )
-            ENDIF
-         END DO
-      END DO
-      
-      ! increase along western boundaries of equatorial strip
-      ! t-point
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            zcoft = float( icof(ji,jj) ) / 100.
-            ahm1(ji,jj,1) = zcoft * zahm0(ji,jj) + (1.-zcoft) * ahm1(ji,jj,1)
-         END DO
-      END DO
-      ! f-point
-      icof(:,:) = icof(:,:) * tmask(:,:,1)
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1   ! NO vector opt.
-            zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)
-            IF( zmsk == 0. ) THEN
-               zcoff = 1.
-            ELSE
-               zcoff = FLOAT( icof(ji,jj+1) + icof(ji+1,jj+1) + icof(ji,jj) + icof(ji,jj+1) )   &
-                     / (zmsk * 100.)
-            ENDIF
-            ahm2(ji,jj,1) = zcoff * zahm0(ji,jj) + (1.-zcoff) * ahm2(ji,jj,1)
-         END DO
-      END DO
-
-      ! other level: re-increase the coef in the deep ocean
-      !==================================================================
-      ! Prior to v3.3, zcoeff was hardwired according to k-index jk.
-      !
-      ! From v3.3 onwards this has been generalised to a function of 
-      ! depth so that it can be used with any number of levels.
-      !
-      ! The function has been chosen to match the original values (shown
-      ! in the following comments) when using the standard 31 ORCA levels.  
-      !     DO jk = 1, 21
-      !        zcoef(jk) = 1._wp
-      !     END DO
-      !     zcoef(22) = 2._wp
-      !     zcoef(23) = 3._wp
-      !     zcoef(24) = 5._wp
-      !     zcoef(25) = 7._wp
-      !     zcoef(26) = 9._wp
-      !     DO jk = 27, jpk
-      !        zcoef(jk) = 10._wp
-      !     END DO
-      !==================================================================
-
-       IF(lwp) THEN
-          WRITE(numout,*)
-          WRITE(numout,*) '         1D zcoef array '
-          WRITE(numout,*) '         ~~~~~~~~~~~~~~ '
-          WRITE(numout,*)
-          WRITE(numout,*) '    jk        zcoef '
-       ENDIF
-
-      DO jk=1, jpk
-         zcoef(jk) = 1.0_wp + NINT(9.0_wp*(gdept_1d(jk)-800.0_wp)/(3000.0_wp-800.0_wp))
-         zcoef(jk) = MIN(10.0_wp, MAX(1.0_wp, zcoef(jk)))
-         IF(lwp) WRITE(numout,'(4x,i3,6x,f7.3)') jk,zcoef(jk)
-      END DO
-
-      DO jk = 2, jpk
-         ahm1(:,:,jk) = MIN( zahm0(:,:), zcoef(jk) * ahm1(:,:,1) )
-         ahm2(:,:,jk) = MIN( zahm0(:,:), zcoef(jk) * ahm2(:,:,1) )
-      END DO
-
-      IF( jp_cfg == 4 )   THEN         ! Limit AHM in Gibraltar strait
-         ij0 = 50   ;   ij1 = 53
-         ii0 = 69   ;   ii1 = 71
-         DO jk = 1, jpk
-            ahm1(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) = MIN( zahmm, ahm1(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) ) 
-            ahm2(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) = MIN( zahmm, ahm2(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) )
-         END DO
-      ENDIF
-      CALL lbc_lnk( ahm1, 'T', 1. )   ! Lateral boundary conditions (unchanged sign)
-      CALL lbc_lnk( ahm2, 'F', 1. )
-
-
-      IF(lwp) THEN                    ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '         3D ahm1 array (k=1)'
-         CALL prihre( ahm1(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) '         3D ahm2 array (k=1)'
-         CALL prihre( ahm2(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) '         3D ahm2 array (k=jpk)'
-         CALL prihre( ahm2(:,:,jpk), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
-      ENDIF
-
-
-      ! Set ahm3 and ahm4
-      ! =================
-
-      ! define ahm3 and ahm4 at the right grid point position
-      ! initialization to a constant value
-      !     (USER: modify ahm3 and ahm4 following your desiderata)
-      !     harmonic isopycnal or geopotential:
-      !                          ahm3 (ahm4) defined at u- (v-) point
-      DO jk = 1, jpk
-         DO jj = 2, jpj
-            DO ji = 2, jpi
-               ahm3(ji,jj,jk) = 0.5 * ( ahm2(ji,jj,jk) + ahm2(ji  ,jj-1,jk) )
-               ahm4(ji,jj,jk) = 0.5 * ( ahm2(ji,jj,jk) + ahm2(ji-1,jj  ,jk) )
-            END DO
-         END DO
-      END DO
-      ahm3 ( :, 1, :) = ahm3 ( :, 2, :)
-      ahm4 ( :, 1, :) = ahm4 ( :, 2, :)
-      
-      CALL lbc_lnk( ahm3, 'U', 1. )    ! Lateral boundary conditions (unchanged sign)
-      CALL lbc_lnk( ahm4, 'V', 1. )
-
-      ! Control print
-
-      IF( lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm3 array level 1'
-         CALL prihre(ahm3(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm4 array level 1'
-         CALL prihre(ahm4(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi   , jpj   , icof  )
-      CALL wrk_dealloc( jpk   ,         zcoef )
-      CALL wrk_dealloc( jpi   , jpj   , zahm0 )
-      !
-   END SUBROUTINE ldf_dyn_c3d_orca
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90	(revision 5891)
+++ 	(revision )
@@ -1,68 +1,0 @@
-MODULE ldfdyn_oce
-   !!======================================================================
-   !!                  ***  MODULE  ldfdyn_oce  ***
-   !! Ocean physics:  lateral momentum mixing coefficient defined in memory 
-   !!======================================================================
-   !! History :  1.0  ! 2002-11  (G. Madec)  F90: Free form and module
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE in_out_manager ! I/O manager
-   USE lib_mpp         ! MPP library
-
-   IMPLICIT NONE
-   PUBLIC
-
-   !                                       !!* Namelist namdyn_ldf : lateral mixing *
-   LOGICAL , PUBLIC ::   ln_dynldf_lap      !: laplacian operator
-   LOGICAL , PUBLIC ::   ln_dynldf_bilap    !: bilaplacian operator
-   LOGICAL , PUBLIC ::   ln_dynldf_level    !: iso-level direction
-   LOGICAL , PUBLIC ::   ln_dynldf_hor      !: horizontal (geopotential) direction
-   LOGICAL , PUBLIC ::   ln_dynldf_iso      !: iso-neutral direction
-   REAL(wp), PUBLIC ::   rn_ahm_0_lap       !: lateral laplacian eddy viscosity (m2/s)
-   REAL(wp), PUBLIC ::   rn_ahmb_0          !: lateral laplacian background eddy viscosity (m2/s)
-   REAL(wp), PUBLIC ::   rn_ahm_0_blp       !: lateral bilaplacian eddy viscosity (m4/s)
-   REAL(wp), PUBLIC ::   ahm0, ahmb0, ahm0_blp         !: OLD namelist names
-   REAL(wp), PUBLIC ::   rn_cmsmag_1        !: constant in laplacian Smagorinsky viscosity
-   REAL(wp), PUBLIC ::   rn_cmsmag_2        !: constant in bilaplacian Smagorinsky viscosity
-   REAL(wp), PUBLIC ::   rn_cmsh            !: 1 or 0 , if 0 -use only shear for Smagorinsky viscosity
-   REAL(wp), PUBLIC ::   rn_ahm_m_blp       !: upper limit for bilap  abs(ahm) < min( dx^4/128rdt, rn_ahm_m_blp)
-   REAL(wp), PUBLIC ::   rn_ahm_m_lap       !: upper limit for lap  ahm < min(dx^2/16rdt, rn_ahm_m_lap)
-
-   INTEGER , PUBLIC ::   nkahm_smag      =  0          !: 
-
-   !                                                                                  !!! eddy coeff. at U-,V-,W-pts [m2/s]
-#if defined key_dynldf_c3d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahm1, ahm2, ahm3, ahm4   !: ** 3D coefficients **
-#elif defined key_dynldf_c2d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahm1, ahm2, ahm3, ahm4   !: ** 2D coefficients **
-#elif defined key_dynldf_c1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   ahm1, ahm2, ahm3, ahm4   !: ** 2D coefficients **
-#else
-   REAL(wp), PUBLIC                                      ::   ahm1, ahm2, ahm3, ahm4   !: ** 0D coefficients **
-#endif
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION ldfdyn_oce_alloc()
-      !!----------------------------------------------------------------------
-      !!                 ***  FUNCTION ldfdyn_oce_alloc  ***
-      !!----------------------------------------------------------------------
-      ldfdyn_oce_alloc = 0
-#if defined key_dynldf_c3d
-      ALLOCATE( ahm1(jpi,jpj,jpk) , ahm2(jpi,jpj,jpk) , ahm3(jpi,jpj,jpk) , ahm4(jpi,jpj,jpk) , STAT=ldfdyn_oce_alloc )
-#elif defined key_dynldf_c2d
-      ALLOCATE( ahm1(jpi,jpj    ) , ahm2(jpi,jpj    ) , ahm3(jpi,jpj    ) , ahm4(jpi,jpj    ) , STAT=ldfdyn_oce_alloc )
-#elif defined key_dynldf_c1d
-      ALLOCATE( ahm1(        jpk) , ahm2(        jpk) , ahm3(        jpk) , ahm4(        jpk) , STAT=ldfdyn_oce_alloc )
-#endif
-      IF( ldfdyn_oce_alloc /= 0 )   CALL ctl_warn('ldfdyn_oce_alloc: failed to allocate arrays')
-      !
-   END FUNCTION ldfdyn_oce_alloc
-
-   !!======================================================================
-END MODULE ldfdyn_oce
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90	(revision 5891)
+++ 	(revision )
@@ -1,301 +1,0 @@
-MODULE ldfdyn_smag
-   !!======================================================================
-   !!                     ***  MODULE  ldftrasmag  ***
-   !! Ocean physics:  variable eddy induced velocity coefficients
-   !!======================================================================
-#if   defined key_dynldf_smag   &&   defined key_dynldf_c3d
-   !!----------------------------------------------------------------------
-   !!   'key_dynldf_smag'      and           smagorinsky  diffusivity
-   !!   'key_dynldf_c3d'                    3D tracer lateral  mixing coef.
-   !!----------------------------------------------------------------------
-   !!   ldf_eiv      : compute the eddy induced velocity coefficients
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE sbcrnf          ! river runoffs
-   USE ldfdyn_oce      ! ocean tracer   lateral physics
-   USE phycst          ! physical constants
-   USE ldfslp          ! iso-neutral slopes
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE iom
-   USE wrk_nemo
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC ldf_dyn_smag               ! routine called by step.F90
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-
-
-
-
-   !!----------------------------------------------------------------------
-   !!                        ***  ldfdyn_smag.F90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   'key_dynldf_smag'             3D lateral eddy viscosity coefficients
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_dyn_smag( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_dyn_smag  ***
-      !!                   
-      !! ** Purpose :   initializations of the horizontal ocean physics
-      !!
-      !! ** Method  :   3D eddy viscosity coef. 
-      !!    M.Griffies, R.Hallberg AMS, 2000
-      !! for laplacian:
-      !!   Asmag=(C/pi)^2*dx*dy sqrt(D^2), C=3-4
-      !! for bilaplacian:
-      !!   Bsmag=Asmag*dx*dy/8
-      !!   D^2=(du/dx-dv/dy)^2+(dv/dx+du/dy)^2 for Cartesian coordinates
-      !!  in general case du/dx ==> e2 d(u/e2)/dx;  du/dy ==> e1 d(u/e1)/dy; 
-      !!                  dv/dx ==> e2 d(v/e2)/dx;  dv/dy ==> e1 d(v/e1)/dy
-      !!
-      !!       laplacian operator   : ahm1, ahm2 defined at T- and F-points
-      !!                              ahm3, ahm4 never used
-      !!       bilaplacian operator : ahm1, ahm2 never used
-      !!                           :  ahm3, ahm4 defined at U- and V-points
-      !!       explanation of the default is missingi
-      !!  last modified : Maria Luneva, September 2011
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      !! ahm0 here is a background viscosity
-
-      !! * Arguments
-
-      !! * local variables
-
-      INTEGER              :: kt                   ! timestep
-
-      INTEGER  ::   ji, jj, jk                     ! dummy loop indices
-      REAL (wp):: zdeltat,zdeltaf,zdeltau,zdeltav  ! temporary scalars
-      REAL (wp), POINTER, DIMENSION (:,:) ::   zux, zuy , zvx ,zvy, zue1, zue2, zve1, zve2 
-      REAL (wp)::  zcmsmag_1, zcmsmag_2 , zcmsh
-
-
-      !!----------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi,jpj,zux,zuy,zvx,zvy )
-      CALL wrk_alloc( jpi,jpj,zue1,zue2,zve1,zve2 )
-
-
-      IF(  kt == nit000 ) THEN
-
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'ldf_dyn_smag : 3D lateral eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-     
-      ENDIF
-      
-      zcmsmag_1 = rn_cmsmag_1
-      zcmsmag_2 = rn_cmsmag_2
-      zcmsh     = rn_cmsh
-
-   
-
-
-      ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operators
-      ! =================                       whatever its orientation is)
-      IF( ln_dynldf_lap ) THEN
-         ! define ahm1 and ahm2 at the right grid point position
-         ! (USER: modify ahm1 and ahm2 following your desiderata)
-         
-         DO jk=1,jpk
-           zue2(:,:)=un(:,:,jk)/e2u(:,:)
-           zve1(:,:)=vn(:,:,jk)/e1v(:,:)
-           zue1(:,:)=un(:,:,jk)/e1u(:,:)
-           zve2(:,:)=vn(:,:,jk)/e2v(:,:)
-
- 
-           DO jj=2,jpj
-            DO ji=2,jpi
-            zux(ji,jj)=(zue2(ji,jj)-zue2(ji-1,jj))/e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) * zcmsh
-            zvy(ji,jj)=(zve1(ji,jj)-zve1(ji,jj-1))/e2t(ji,jj)*e1t(ji,jj)*tmask(ji,jj,jk) * zcmsh
-            ENDDO
-           ENDDO
-
-           DO jj=1,jpjm1
-            DO ji=1,jpim1
-            zuy(ji,jj)=(zue1(ji,jj+1)-zue1(ji,jj))/e2f(ji,jj)*e1f(ji,jj)*fmask(ji,jj,jk)
-            zvx(ji,jj)=(zve2(ji+1,jj)-zve2(ji,jj))/e1f(ji,jj)*e2f(ji,jj)*fmask(ji,jj,jk)
-            ENDDO
-           ENDDO
-             
-          DO jj=2,jpjm1
-           DO ji=2,jpim1
-
-            zdeltat=2._wp /(e1t(ji,jj)**(-2)+e2t(ji,jj)**(-2))
-            zdeltaf=2._wp /(e1f(ji,jj)**(-2)+e2f(ji,jj)**(-2))   
-            ahm1(ji,jj,jk)=(zcmsmag_1/rpi)**2*zdeltat*                                         &
-                            sqrt( (zux(ji,jj)-zvy(ji,jj))**2+                                    &
-                     0.0625_wp*(zuy(ji,jj)+zuy(ji,jj-1)+zuy(ji-1,jj)+zuy(ji-1,jj-1)+             &
-                            zvx(ji,jj)+zvx(ji,jj-1)+zvx(ji-1,jj)+zvx(ji-1,jj-1))**2)
-
-            ahm2(ji,jj,jk)=(zcmsmag_1/rpi)**2*zdeltaf*                                         &
-                            sqrt( (zuy(ji,jj)+zvx(ji,jj))**2+                                    &
-                     0.0625_wp*(zux(ji,jj)+zux(ji,jj+1)+zux(ji+1,jj)+zux(ji+1,jj+1)-             &
-                             zvy(ji,jj)-zvy(ji,jj+1)-zvy(ji+1,jj)-zvy(ji+1,jj+1))**2)
-
-            ahm1(ji,jj,jk)=MAX(ahm1(ji,jj,jk),rn_ahm_0_lap)
-            ahm2(ji,jj,jk)=MAX(ahm2(ji,jj,jk),rn_ahm_0_lap)
-
-! stability criteria or upper limit set from namelist
-            ahm1(ji,jj,jk)=MIN(ahm1(ji,jj,jk),zdeltat / (16_wp*rdt),rn_ahm_m_lap)
-            ahm2(ji,jj,jk)=MIN(ahm2(ji,jj,jk),zdeltaf / (16_wp*rdt),rn_ahm_m_lap)
-
-            ENDDO
-           ENDDO
-
-         ENDDO ! jpk
-            ahm1(:,:,jpk) = ahm1(:,:,jpkm1)
-            ahm2(:,:,jpk) = ahm2(:,:,jpkm1)
-            IF(lwp.and.kt==nit000) WRITE(numout,'(36x," ahm ", 7x)')
-            DO jk = 1, jpk
-
-               IF(lwp.and.kt==nit000) WRITE(numout,'(30x,E10.2,8x,i3)') ahm1(jpi/2,jpj/2,jk), jk
-            END DO
-      CALL lbc_lnk( ahm1, 'T', 1. )   ! Lateral boundary conditions on ( ahtt )
-      CALL lbc_lnk( ahm2, 'F', 1. )   ! Lateral boundary conditions on ( ahtt )
-
-      ENDIF    ! ln_dynldf_lap
-      
-
-
-      ! ahm3 and ahm4 at U- and V-points (used for bilaplacian operator
-      ! ================================  whatever its orientation is)
-      ! Here: ahm is proportional to the cube of the maximum of the grid spacing
-      !       in the to horizontal direction
-
-      IF( ln_dynldf_bilap ) THEN
-         DO jk=1,jpk
-           zue2(:,:) = un(:,:,jk)/e2u(:,:)
-           zve1(:,:) = vn(:,:,jk)/e1v(:,:)
-           zue1(:,:) = un(:,:,jk)/e1u(:,:)
-           zve2(:,:) = vn(:,:,jk)/e2v(:,:)
-
-
-           DO jj=2,jpj
-            DO ji=2,jpi
-            zux(ji,jj) = (zue2(ji,jj)-zue2(ji-1,jj))/e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
-            zvy(ji,jj) = (zve1(ji,jj)-zve1(ji,jj-1))/e2t(ji,jj)*e1t(ji,jj)*tmask(ji,jj,jk)
-            ENDDO
-           ENDDO
-
-           DO jj=1,jpjm1
-            DO ji=1,jpim1
-            zuy(ji,jj) = (zue1(ji,jj+1)-zue1(ji,jj))/e2f(ji,jj)*e1f(ji,jj)*fmask(ji,jj,jk)
-            zvx(ji,jj) = (zve2(ji+1,jj)-zve2(ji,jj))/e1f(ji,jj)*e2f(ji,jj)*fmask(ji,jj,jk)
-            ENDDO
-           ENDDO
-
-
-          DO jj=2,jpjm1
-           DO ji=2,jpim1
-            zdeltau = 2._wp/(e1u(ji,jj)**(-2)+e2u(ji,jj)**(-2))
-            zdeltav = 2._wp/(e1v(ji,jj)**(-2)+e2v(ji,jj)**(-2))
-
-            ahm3(ji,jj,jk) = -(zcmsmag_2/rpi)**2/8.0_wp*zdeltau**2*                          &
-
-                         sqrt(0.25_wp*(zux(ji,jj)+zux(ji+1,jj)-zvy(ji,jj)-zvy(ji+1,jj))**2+    &
-                              0.25_wp*(zuy(ji,jj)+zuy(ji,jj-1)+zvx(ji,jj)+zvx(ji,jj-1))**2)
-
-            ahm4(ji,jj,jk) = -(zcmsmag_2/rpi)**2/8.0_wp*zdeltav**2*                           &
-
-                         sqrt(0.25_wp*(zux(ji,jj)+zux(ji,jj+1)-zvy(ji,jj)-zvy(ji,jj+1))**2+    &
-                              0.25_wp*(zuy(ji,jj)+zuy(ji-1,jj)+zvx(ji-1,jj)+zvx(ji,jj))**2)
-
-            ahm3(ji,jj,jk) = MIN (rn_ahm_0_blp , ahm3(ji,jj,jk) )
-            ahm4(ji,jj,jk) = MIN (rn_ahm_0_blp , ahm4(ji,jj,jk) ) 
-
-! stability criteria or upper limit set in namelist
-
-            ahm3(ji,jj,jk) = MAX( ahm3(ji,jj,jk),-zdeltau**2/( 128._wp*rdt ),rn_ahm_m_blp )
-            ahm4(ji,jj,jk) = MAX( ahm4(ji,jj,jk),-zdeltav**2/( 128._wp*rdt ),rn_ahm_m_blp )
-            
-
-            ENDDO
-           ENDDO
-
-         ENDDO
-            ahm3(:,:,jpk) = ahm3(:,:,jpkm1)
-            ahm4(:,:,jpk) = ahm4(:,:,jpkm1)
-
-      DO jk = 1, jpk
-      IF(  kt == nit000 ) THEN
-
-               IF(lwp) WRITE(numout,'(30x,E10.2,8x,i3)') ahm3(jpi/2,jpj/2,jk), jk
-      ENDIF   
-      END DO
-      CALL lbc_lnk( ahm3, 'U', 1. )   ! Lateral boundary conditions
-      CALL lbc_lnk( ahm4, 'V', 1. )
-   ENDIF
-
-      CALL wrk_dealloc( jpi,jpj,zux,zuy,zvx,zvy )
-      CALL wrk_dealloc( jpi,jpj,zue1,zue2,zve1,zve2 )
-   !    zumax = MAXVAL( ABS( ahm3(:,:,:) ) )                ! slower than the following loop on NEC SX5
-      zdeltat = 0._wp
-   If(ln_dynldf_lap)THEN
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zdeltat = MAX(zdeltat,ABS(ahm1(ji,jj,jk)),ABS(ahm2(ji,jj,jk)) )
-          END DO
-        END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_max( zdeltat )                 ! max over the global domain
-      !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,'dynlap:  abs(ahm) max: ', zdeltat
-    ENDIF
-    If(ln_dynldf_bilap)THEN
-     zdeltat = 0._wp
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zdeltat = MAX(zdeltat,ABS(ahm3(ji,jj,jk)),ABS(ahm3(ji,jj,jk)) )
-          END DO
-        END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_max( zdeltat )                 ! max over the global domain
-      !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,'dyn_bilap abs(ahm) max: ', zdeltat
-      !
-   ENDIF
-      !
-
-END SUBROUTINE ldf_dyn_smag
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Dummy module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE ldf_dyn_smag( kt )       ! Empty routine
-      WRITE(*,*) 'ldf_dyn_smag: You should not have seen this print! error? check keys ldf:c3d+smag', kt
-   END SUBROUTINE ldf_dyn_smag
-#endif
-
-   END MODULE ldfdyn_smag
-
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90	(revision 5891)
+++ 	(revision )
@@ -1,40 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                    ***  ldfdyn_substitute.h90  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute fsahm., the lateral eddy viscosity coeff. 
-   !!      with a constant, or 1D, or 2D or 3D array, using CPP macro.
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-   !!
-   !! fsahmt, fsahmf - used for laplaian operator only
-   !! fsahmu, fsahmv - used for bilaplacian operator only
-   !!
-#if defined key_dynldf_c3d
-!   ' key_dynldf_c3d' :                  3D coefficient
-#    define   fsahmt(i,j,k)    ahm1(i,j,k)
-#    define   fsahmf(i,j,k)    ahm2(i,j,k)
-#    define   fsahmu(i,j,k)    ahm3(i,j,k)
-#    define   fsahmv(i,j,k)    ahm4(i,j,k)
-#elif defined key_dynldf_c2d
-!   ' key_dynldf_c2d' :                 2D coefficient
-#  define   fsahmt(i,j,k)    ahm1(i,j)
-#  define   fsahmf(i,j,k)    ahm2(i,j)
-#  define   fsahmu(i,j,k)    ahm3(i,j)
-#  define   fsahmv(i,j,k)    ahm4(i,j)
-#elif defined key_dynldf_c1d
-!   'key_dynldf_c1d' :                  1D coefficient
-#  define   fsahmt(i,j,k)    ahm1(k)
-#  define   fsahmf(i,j,k)    ahm1(k)
-#  define   fsahmu(i,j,k)    ahm2(k)
-#  define   fsahmv(i,j,k)    ahm2(k)
-#else
-!   default option :               Constant coefficient
-#  define   fsahmt(i,j,k)   ahm0
-#  define   fsahmf(i,j,k)   ahm0
-#  define   fsahmu(i,j,k)   ahm0_blp
-#  define   fsahmv(i,j,k)   ahm0_blp
-#endif
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90	(revision 5891)
+++ 	(revision )
@@ -1,224 +1,0 @@
-MODULE ldfeiv
-   !!======================================================================
-   !!                     ***  MODULE  ldfeiv  ***
-   !! Ocean physics:  variable eddy induced velocity coefficients
-   !!======================================================================
-   !! History :  OPA  ! 1999-03  (G. Madec, A. Jouzeau)  Original code
-   !!   NEMO     1.0  ! 2002-06  (G. Madec)  Free form, F90
-   !!----------------------------------------------------------------------
-#if   defined key_traldf_eiv   &&   defined key_traldf_c2d
-   !!----------------------------------------------------------------------
-   !!   'key_traldf_eiv'      and                     eddy induced velocity
-   !!   'key_traldf_c2d'                    2D tracer lateral  mixing coef.
-   !!----------------------------------------------------------------------
-   !!   ldf_eiv      : compute the eddy induced velocity coefficients
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE sbcrnf          ! river runoffs
-   USE ldftra_oce      ! ocean tracer   lateral physics
-   USE phycst          ! physical constants
-   USE ldfslp          ! iso-neutral slopes
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE iom             ! I/O library
-   USE wrk_nemo        ! work arrays
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   ldf_eiv    ! routine called by step.F90
-   
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE ldf_eiv( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_eiv  ***
-      !!
-      !! ** Purpose :   Compute the eddy induced velocity coefficient from the
-      !!              growth rate of baroclinic instability.
-      !!
-      !! ** Method :
-      !!
-      !! ** Action : - uslp , vslp  : i- and j-slopes of neutral surfaces at u- & v-points
-      !!             - wslpi, wslpj : i- and j-slopes of neutral surfaces at w-points. 
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zfw, ze3w, zn2, zf20, zaht, zaht_min      ! temporary scalars
-      REAL(wp), DIMENSION(:,:), POINTER ::   zn, zah, zhw, zross   ! 2D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ldf_eiv')
-      !
-      CALL wrk_alloc( jpi,jpj, zn, zah, zhw, zross )
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'ldf_eiv : eddy induced velocity coefficients'
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-      ENDIF
-      
-      ! 0. Local initialization
-      ! -----------------------
-      zn   (:,:) = 0._wp
-      zhw  (:,:) = 5._wp
-      zah  (:,:) = 0._wp
-      zross(:,:) = 0._wp
-
-
-      ! 1. Compute lateral diffusive coefficient 
-      ! ----------------------------------------
-      IF( ln_traldf_grif ) THEN
-         DO jk = 1, jpk
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  ! Take the max of N^2 and zero then take the vertical sum 
-                  ! of the square root of the resulting N^2 ( required to compute 
-                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
-                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
-                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
-                  ! Compute elements required for the inverse time scale of baroclinic
-                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
-                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
-                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
-                  zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w
-                  zhw(ji,jj) = zhw(ji,jj) + ze3w
-               END DO
-            END DO
-         END DO
-      ELSE
-         DO jk = 1, jpk
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  ! Take the max of N^2 and zero then take the vertical sum 
-                  ! of the square root of the resulting N^2 ( required to compute 
-                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
-                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
-                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
-                  ! Compute elements required for the inverse time scale of baroclinic
-                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
-                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
-                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
-                  zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
-                     &                            + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w
-                  zhw(ji,jj) = zhw(ji,jj) + ze3w
-               END DO
-            END DO
-         END DO
-      END IF
-
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 )
-            ! Rossby radius at w-point taken < 40km and  > 2km
-            zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 )
-            ! Compute aeiw by multiplying Ro^2 and T^-1
-            aeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * ssmask(ji,jj)
-         END DO
-      END DO
-
-      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK 
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! Take the minimum between aeiw and 1000 m2/s over shelves (depth shallower than 650 m)
-               IF( mbkt(ji,jj) <= 20 )   aeiw(ji,jj) = MIN( aeiw(ji,jj), 1000. )
-            END DO
-         END DO
-      ENDIF
-
-      ! Decrease the coefficient in the tropics (20N-20S) 
-      zf20 = 2._wp * omega * sin( rad * 20._wp )
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            aeiw(ji,jj) = MIN( 1., ABS( ff(ji,jj) / zf20 ) ) * aeiw(ji,jj)
-         END DO
-      END DO
-
-      ! ORCA R05: Take the minimum between aeiw  and aeiv0
-      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               aeiw(ji,jj) = MIN( aeiw(ji,jj), aeiv0 )
-            END DO
-         END DO
-      ENDIF
-      CALL lbc_lnk( aeiw, 'W', 1. )      ! lateral boundary condition on aeiw 
-
-
-      ! Average the diffusive coefficient at u- v- points 
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            aeiu(ji,jj) = 0.5_wp * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )
-            aeiv(ji,jj) = 0.5_wp * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )
-         END DO 
-      END DO 
-      CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )      ! lateral boundary condition
-
-
-      IF(ln_ctl) THEN
-         CALL prt_ctl(tab2d_1=aeiu, clinfo1=' eiv  - u: ', ovlap=1)
-         CALL prt_ctl(tab2d_1=aeiv, clinfo1=' eiv  - v: ', ovlap=1)
-      ENDIF
-
-      ! ORCA R05: add a space variation on aht (=aeiv except at the equator and river mouth)
-      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN
-         zf20     = 2._wp * omega * SIN( rad * 20._wp )
-         zaht_min = 100._wp                           ! minimum value for aht
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zaht      = ( 1._wp -  MIN( 1._wp , ABS( ff(ji,jj) / zf20 ) ) ) * ( aht0 - zaht_min )  &
-                  &      + aht0 * rnfmsk(ji,jj)                          ! enhanced near river mouths
-               ahtu(ji,jj) = MAX( MAX( zaht_min, aeiu(ji,jj) ) + zaht, aht0 )
-               ahtv(ji,jj) = MAX( MAX( zaht_min, aeiv(ji,jj) ) + zaht, aht0 )
-               ahtw(ji,jj) = MAX( MAX( zaht_min, aeiw(ji,jj) ) + zaht, aht0 )
-            END DO
-         END DO
-         IF(ln_ctl) THEN
-            CALL prt_ctl(tab2d_1=ahtu, clinfo1=' aht  - u: ', ovlap=1)
-            CALL prt_ctl(tab2d_1=ahtv, clinfo1=' aht  - v: ', ovlap=1)
-            CALL prt_ctl(tab2d_1=ahtw, clinfo1=' aht  - w: ', ovlap=1)
-         ENDIF
-      ENDIF
-
-      IF( aeiv0 == 0._wp ) THEN
-         aeiu(:,:) = 0._wp
-         aeiv(:,:) = 0._wp
-         aeiw(:,:) = 0._wp
-      ENDIF
-
-      CALL iom_put( "aht2d"    , ahtw )   ! lateral eddy diffusivity
-      CALL iom_put( "aht2d_eiv", aeiw )   ! EIV lateral eddy diffusivity
-      !  
-      CALL wrk_dealloc( jpi,jpj, zn, zah, zhw, zross )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ldf_eiv')
-      !
-   END SUBROUTINE ldf_eiv
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Dummy module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE ldf_eiv( kt )       ! Empty routine
-      INTEGER :: kt
-      WRITE(*,*) 'ldf_eiv: You should not have seen this print! error?', kt
-   END SUBROUTINE ldf_eiv
-#endif
-
-   !!======================================================================
-END MODULE ldfeiv
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90	(revision 5891)
+++ 	(revision )
@@ -1,39 +1,0 @@
-#if defined key_traldf_eiv   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!                   ***  ldfeiv_substitute.h90  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute fsaei. the eddy induced velocity coeff.
-   !!      with a constant or 1D or 2D or 3D array, using CPP macro.
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-#  if defined key_traldf_c3d
-!   'traldf_c3d' :                           eiv: 3D coefficient
-#    define   fsaeiu(i,j,k)   aeiu(i,j,k)
-#    define   fsaeiv(i,j,k)   aeiv(i,j,k)
-#    define   fsaeiw(i,j,k)   aeiw(i,j,k)
-#  elif defined key_traldf_c2d
-!   'traldf_c2d' :                           eiv: 2D coefficient
-#    define   fsaeiu(i,j,k)   aeiu(i,j)
-#    define   fsaeiv(i,j,k)   aeiv(i,j)
-#    define   fsaeiw(i,j,k)   aeiw(i,j)
-#  elif defined key_traldf_c1d
-!   'traldf_c1d' :                           eiv: 1D coefficient
-#    define   fsaeiu(i,j,k)   aeiu(k)
-#    define   fsaeiv(i,j,k)   aeiv(k)
-#    define   fsaeiw(i,j,k)   aeiw(k)
-#  else
-!   Default option :                          eiv: Constant coefficient
-#    define   fsaeiu(i,j,k)   aeiv0
-#    define   fsaeiv(i,j,k)   aeiv0
-#    define   fsaeiw(i,j,k)   aeiv0
-#  endif
-#else
-!   Default option :                         eiv: dummy variables
-#    define   fsaeiu(i,j,k)   aeiv0
-#    define   fsaeiv(i,j,k)   aeiv0
-#    define   fsaeiw(i,j,k)   aeiv0
-#endif
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 5901)
@@ -11,11 +11,10 @@
    !!            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
+   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  add limiter on triad slopes
    !!----------------------------------------------------------------------
-#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_triad : calculates the triads of isoneutral slopes (Griffies operator)
    !!   ldf_slp_mxl   : calculates the slopes at the base of the mixed layer (Madec operator)
    !!   ldf_slp_init  : initialization of the slopes computation
@@ -23,6 +22,5 @@
    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 ldfdyn         ! lateral diffusion: eddy viscosity coef.
    USE phycst         ! physical constants
    USE zdfmxl         ! mixed layer depth
@@ -30,29 +28,42 @@
    !
    USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl         ! Print control
+   USE lib_mpp        ! distribued memory computing library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    USE wrk_nemo       ! work arrays
    USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   ldf_slp        ! routine called by step.F90
-   PUBLIC   ldf_slp_grif   ! routine called by step.F90
-   PUBLIC   ldf_slp_init   ! routine called by opa.F90
-
-   LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     !: slopes flag
-   !                                                                             !! Madec operator
-   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator
+   PUBLIC   ldf_slp         ! routine called by step.F90
+   PUBLIC   ldf_slp_triad   ! routine called by step.F90
+   PUBLIC   ldf_slp_init    ! routine called by nemogcm.F90
+
+   LOGICAL , PUBLIC ::   l_ldfslp = .FALSE.     !: slopes flag
+
+   LOGICAL , PUBLIC ::   ln_traldf_iso   = .TRUE.       !: iso-neutral direction
+   LOGICAL , PUBLIC ::   ln_traldf_triad = .FALSE.      !: griffies triad scheme
+
+   LOGICAL , PUBLIC ::   ln_triad_iso    = .FALSE.      !: pure horizontal mixing in ML
+   LOGICAL , PUBLIC ::   ln_botmix_triad = .FALSE.      !: mixing on bottom
+   REAL(wp), PUBLIC ::   rn_sw_triad     = 1._wp        !: =1 switching triads ; =0 all four triads used 
+   REAL(wp), PUBLIC ::   rn_slpmax       = 0.01_wp      !: slope limit
+
+   LOGICAL , PUBLIC ::   l_grad_zps = .FALSE.           !: special treatment for Horz Tgradients w partial steps (triad operator)
+   
+   !                                                     !! Classic operator (Madec)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   uslp, wslpi          !: i_slope at U- and W-points
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   vslp, wslpj          !: j-slope at V- and W-points
-   !                                                                !! Griffies operator
+   !                                                     !! triad operator (Griffies)
    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
+   !                                                     !! both operators
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   ah_wslp2             !: ah * slope^2 at w-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   akz                  !: stabilizing vertical diffusivity
+   
+   !                                                     !! 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
@@ -63,9 +74,7 @@
    !! * 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)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -105,13 +114,11 @@
       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) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw, z1_slpmax ! 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) ::   zdepv, zdepu         !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwz, zww
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdzr
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zhmlpu, zhmlpv
       !!----------------------------------------------------------------------
       !
@@ -119,349 +126,225 @@
       !
       CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv )
-      CALL wrk_alloc( jpi,jpj, zhmlpu, zhmlpv )
-
-      IF ( ln_traldf_iso .OR. ln_dynldf_iso ) THEN 
-     
-         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(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) )
-                  zgrv(ji,jj,jk) = vmask(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
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
-                  zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)
-               END DO
-            END DO
-         ENDIF
-         IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-               IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 
-               IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj)
-               END DO
-            END DO
-         ENDIF
-         !
-         !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
-         ! interior value
-         DO jk = 2, jpkm1
-            !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
-            !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0
-            !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1
-            !                                !          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(:,:,jk+1) )
-         END DO
-         ! surface initialisation 
-         zdzr(:,:,1) = 0._wp 
-         IF ( ln_isfcav ) THEN
-            ! if isf need to overwrite the interior value at at the first ocean point
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp
-               END DO
-            END DO
-         END IF
-         !
-         !                          !==   Slopes just below the mixed layer   ==!
-         CALL ldf_slp_mxl( 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 )
-         !
-         IF ( ln_isfcav ) THEN
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj  ),                   5._wp)
-                  IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji+1,jj  ),                   5._wp)
-                  IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj  ), hmlpt(ji+1,jj  ), 5._wp)
-                  IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj  ),                   5._wp)
-                  IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj+1),                   5._wp)
-                  IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj  ), hmlpt(ji  ,jj+1), 5._wp)
-               ENDDO
-            ENDDO
-         ELSE
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zhmlpu(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji+1,jj  ), 5._wp)
-                  zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji  ,jj+1), 5._wp)
-               ENDDO
-            ENDDO
-         END IF
-         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(ji,jj)
-                  zav = zgrv(ji,jj,jk) / e2v(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)
-                  zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau )  )
-                  zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(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) )
-                  ! thickness of water column between surface and level k at u/v point
-                  zdepu = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji+1,jj  ,jk) )                              &
-                                   - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj  ) ) - fse3u(ji,jj,miku(ji,jj)) )
-                  zdepv = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji  ,jj+1,jk) )                              &
-                                   - 2 * MAX( risfdep(ji,jj), risfdep(ji  ,jj+1) ) - fse3v(ji,jj,mikv(ji,jj)) )
-                  !
-                  zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps )                                          &
-                     &                 + zfi  * uslpml(ji,jj) * zdepu / zhmlpu(ji,jj)
-                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * wumask(ji,jj,jk)
-                  zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps )                                          &
-                     &                 + zfj  * vslpml(ji,jj) * zdepv / zhmlpv(ji,jj) 
-                  zww(ji,jj,jk) = zww(ji,jj,jk) * wvmask(ji,jj,jk)
-                  
-                 
+
+      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
+      z1_slpmax = 1._wp / rn_slpmax
+      !
+      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(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) )
+               zgrv(ji,jj,jk) = vmask(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
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
+               zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
+      DO jk = 2, jpkm1
+         !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
+         !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0
+         !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1
+         !                                !          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(:,:,jk+1) )
+      END DO
+      !
+      !                          !==   Slopes just below the mixed layer   ==!
+      CALL ldf_slp_mxl( 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) * r1_e1u(ji,jj)
+               zav = zgrv(ji,jj,jk) * r1_e2v(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)
+               zbu = MIN(  zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau )  )
+               zbv = MIN(  zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/fse3v(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 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) )   &
+                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk)
+               zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                              &
+                  &                   + zfj  * vslpml(ji,jj)                                                     &
+                  &                          * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) )   &
+                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(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)
+!               !                                         ! 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 lbc_lnk( zwz, 'U', -1. )   ;   CALL 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(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(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(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(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(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   &
-                     &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp   &
-                     &                            *   umask(ji,jj,jk-1)
-                  vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   &
-                     &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp   &
-                     &                            *   vmask(ji,jj,jk-1)
-               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. ) * wmask(ji,jj,jk)
-                  !                                  !* Slopes at w point
-                  !                                        ! i- & j-gradient of density at w-points
-                  zci = MAX(  umask(ji-1,jj,jk  ) + umask(ji,jj,jk  )           &
-                     &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj)
-                  zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           &
-                     &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) *  e2t(ji,jj)
-                  zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           &
-                     &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci
-                  zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           &
-                     &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj
-                  !                                        ! 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/fse3w(ji,jj,jk)* ABS( zai )  )
-                  zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(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 = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj), 10._wp )
-                  zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) &
-                     &            + zck * wslpiml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
-                  zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) &
-                     &            + zck * wslpjml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zwz, 'U', -1. )   ;   CALL 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(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(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(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(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(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   &
+                  &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp
+               vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   &
+                  &                            * ( vmask(ji  ,jj,jk) + vmask(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(ji-1,jj,jk  ) + umask(ji,jj,jk  )           &
+                  &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj)
+               zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           &
+                  &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) * e2t(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 (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 (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/fse3w(ji,jj,jk)* ABS( zai )  )
+               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(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 = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp )
+               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask(ji,jj,jk)
+               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk)
 
 !!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)
+!               !                                         ! 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 lbc_lnk( zwz, 'T', -1. )   ;    CALL 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(ji,jj,jk) * z1_16
-                  wslpi(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(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(ji,jj,jk) * z1_16
-                  wslpi(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(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(ji,jj,jk) + umask(ji-1,jj,jk) )   &
-                     &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25
-                  wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * wmask(ji,jj,jk)
-                  wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * wmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-         ! III.  Specific grid points
-         ! ===========================
-         !
-         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
-
-
-         ! IV. Lateral boundary conditions
-         ! ===============================
-         CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
-         CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )
-
-
-         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
-         !
-
-      ELSEIF ( lk_vvl ) THEN 
- 
-         IF(lwp) THEN 
-            WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 
-         ENDIF 
-
-         ! geopotential diffusion in s-coordinates on tracers and/or momentum 
-         ! The slopes of s-surfaces are computed at each time step due to vvl 
-         ! 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 ) 
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1   ! vector opt. 
-               uslp(ji,jj,1) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,1) - fsdept_b(ji ,jj ,1) )  * umask(ji,jj,1) 
-               vslp(ji,jj,1) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,1) - fsdept_b(ji ,jj ,1) )  * vmask(ji,jj,1) 
-               wslpi(ji,jj,1) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,1) - fsdepw_b(ji-1,jj,1) ) * tmask(ji,jj,1) * 0.5 
-               wslpj(ji,jj,1) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,1) - fsdepw_b(ji,jj-1,1) ) * tmask(ji,jj,1) * 0.5 
-            END DO 
-         END DO 
-
-         DO jk = 2, jpk 
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt. 
-                  uslp(ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 
-                  vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
-                  wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) &
-                    &                              * wmask(ji,jj,jk) * 0.5 
-                  wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) &
-                    &                              * wmask(ji,jj,jk) * 0.5 
-               END DO 
-            END DO 
-         END DO 
-
-         ! Lateral boundary conditions on the slopes 
-         CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
-         CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. ) 
-  
-         if( kt == nit000 ) then 
-            IF(lwp) WRITE(numout,*) ' max slop: u',SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  & 
-               &                             ' wi', sqrt(MAXVAL(wslpi)), ' wj', sqrt(MAXVAL(wslpj)) 
-         endif 
-  
-         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 
-
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL 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 = wmask(ji,jj,jk) * z1_16
+               wslpi(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(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 = wmask(ji,jj,jk) * z1_16
+               wslpi(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(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 in vicinity of topography
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   &
+                  &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25
+               wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck
+               wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck
+            END DO
+         END DO
+      END DO
+
+      ! IV. Lateral boundary conditions
+      ! ===============================
+      CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
+      CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )
+
+
+      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 )
-      CALL wrk_dealloc( jpi,jpj,     zhmlpu, zhmlpv)
       !
       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp')
@@ -470,10 +353,10 @@
 
 
-   SUBROUTINE ldf_slp_grif ( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE ldf_slp_grif  ***
+   SUBROUTINE ldf_slp_triad ( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp_triad  ***
       !!
       !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope
-      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_grif=T)
+      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_triad=T)
       !!      at W-points using the Griffies quarter-cells.
       !!
@@ -490,16 +373,20 @@
       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) ::   zdit, zdis, zdkt, zbu, zbti, zisw
+      REAL(wp) ::   zdjt, zdjs, zdks, zbv, zbtj, zjsw
       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, ze3_e1, ze3_e2
       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')
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_triad')
       !
       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  )
@@ -519,8 +406,8 @@
                   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 = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) / e1u(ji,jj)
-                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * 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 )
+                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) * r1_e1u(ji,jj)
+                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * zdjs ) * r1_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
@@ -533,6 +420,6 @@
                   zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature
                   zdis = gtsu(ji,jj,jp_sal)   ;   zdjs = gtsv(ji,jj,jp_sal)      ! i- & j-gradient of Salinity
-                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,iku,jp_tem) * zdit + rab_b(ji+ip,jj   ,iku,jp_sal) * zdis ) / e1u(ji,jj)
-                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji   ,jj+jp,ikv,jp_sal) * zdjs ) / e2v(ji,jj)
+                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,iku,jp_tem) * zdit + rab_b(ji+ip,jj   ,iku,jp_sal) * zdis ) * r1_e1u(ji,jj)
+                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji   ,jj+jp,ikv,jp_sal) * zdjs ) * r1_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 )
@@ -554,6 +441,6 @@
                      zdks = 0._wp
                   ENDIF
-                  zdzrho_raw = ( - rab_b(ji,jj,jk,jp_tem) * zdkt + rab_b(ji,jj,jk,jp_sal) * zdks ) / fse3w(ji,jj,jk+kp)
-                  zdzrho(ji,jj,jk,kp) = - MIN( - repsln, zdzrho_raw )    ! force zdzrho >= repsln
+                  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
@@ -588,20 +475,22 @@
                   !
                   jk = nmln(ji+ip,jj) + 1
-                  IF( jk .GT. mbkt(ji+ip,jj) ) THEN  !ML reaches bottom
-                    zti_mlb(ji+ip,jj   ,1-ip,kp) = 0.0_wp
-                  ELSE
-                    ! 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)      &
-                       &      - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj)  ) * umask(ji,jj,jk)
-                    zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
+                  IF( jk > mbkt(ji+ip,jj) ) THEN   ! ML reaches bottom
+                     zti_mlb(ji+ip,jj   ,1-ip,kp) = 0.0_wp
+                  ELSE                             
+                     ! 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)      &
+                        &          - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk)
+                     ze3_e1    =  fse3w(ji+ip,jj,jk-kp) * r1_e1u(ji,jj) 
+                     zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1  , ABS( zti_g_raw ) ), zti_g_raw )
                   ENDIF
                   !
                   jk = nmln(ji,jj+jp) + 1
                   IF( jk .GT. mbkt(ji,jj+jp) ) THEN  !ML reaches bottom
-                    ztj_mlb(ji   ,jj+jp,1-jp,kp) = 0.0_wp
+                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = 0.0_wp
                   ELSE
-                    ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      &
-                       &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk)
-                    ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+                     ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      &
+                        &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk)
+                     ze3_e2    =  fse3w(ji,jj+jp,jk-kp) / e2v(ji,jj)
+                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2  , ABS( ztj_g_raw ) ), ztj_g_raw )
                   ENDIF
                END DO
@@ -632,12 +521,16 @@
                      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 * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj)
-                     ztj_coord = znot_thru_surface * ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj)                  ! unmasked
+                     zti_coord = znot_thru_surface * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj)
+                     ztj_coord = znot_thru_surface * ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(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 )
+                     ! additional limit required in bilaplacian case
+                     ze3_e1    = fse3w(ji+ip,jj   ,jk+kp) * r1_e1u(ji,jj)
+                     ze3_e2    = fse3w(ji   ,jj+jp,jk+kp) * r1_e2v(ji,jj)
+                     ! NB: hard coded factor 5 (can be a namelist parameter...)
+                     zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw )
+                     ztj_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2, ABS( ztj_g_raw ) ), ztj_g_raw )
                      !
                      ! Below  ML use limited zti_g as is & mask
@@ -668,24 +561,27 @@
                      !
                      IF( ln_triad_iso ) THEN
-                        zti_raw = zti_lim**2 / zti_raw
-                        ztj_raw = ztj_lim**2 / ztj_raw
+                        zti_raw = zti_lim*zti_lim / zti_raw
+                        ztj_raw = ztj_lim*ztj_lim / 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
+                        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
+                     !                                      ! switching triad scheme 
+                     zisw = (rn_sw_triad - 1._wp ) + rn_sw_triad    &
+                        &            * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - ip ) * SIGN( 1._wp , zdxrho(ji+ip,jj,jk,1-ip) )  )
+                     zjsw = (rn_sw_triad - 1._wp ) + rn_sw_triad    &
+                        &            * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - jp ) * SIGN( 1._wp , zdyrho(ji,jj+jp,jk,1-jp) )  )
+                     !
+                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim * zisw
+                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim * zjsw
+                     !
+                     zbu  = e1e2u(ji   ,jj   ) * fse3u(ji   ,jj   ,jk   )
+                     zbv  = e1e2v(ji   ,jj   ) * fse3v(ji   ,jj   ,jk   )
+                     zbti = e1e2t(ji+ip,jj   ) * fse3w(ji+ip,jj   ,jk+kp)
+                     zbtj = e1e2t(ji   ,jj+jp) * fse3w(ji   ,jj+jp,jk+kp)
+                     !
+                     wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim      ! masked
+                     wslp2(ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim*ztj_g_lim
                   END DO
                END DO
@@ -699,10 +595,11 @@
       !
       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
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_triad')
+      !
+   END SUBROUTINE ldf_slp_triad
 
 
@@ -730,5 +627,5 @@
       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) ::   zeps, zm1_g, zm1_2g, z1_slpmax ! local scalars
       REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
       REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
@@ -741,4 +638,5 @@
       zm1_g  = -1.0_wp / grav
       zm1_2g = -0.5_wp / grav
+      z1_slpmax = 1._wp / rn_slpmax
       !
       uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp
@@ -752,8 +650,6 @@
             DO ji = 1, jpi
                ik = nmln(ji,jj) - 1
-               IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN
-                  omlmask(ji,jj,jk) = 1._wp
-               ELSE
-                  omlmask(ji,jj,jk) = 0._wp
+               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp
+               ELSE                  ;   omlmask(ji,jj,jk) = 0._wp
                ENDIF
             END DO
@@ -777,15 +673,15 @@
             !
             !                        !- vertical density gradient for u- and v-slopes (from dzr at T-point)
-            iku = MIN(  MAX( miku(ji,jj)+1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1)
-            ikv = MIN(  MAX( mikv(ji,jj)+1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1  )   !
+            iku = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1)
+            ikv = MIN(  MAX( 1, nmln(ji,jj) , nmln(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(ji,jj)
-            zav = p_grv(ji,jj,ikv) / e2v(ji,jj)
+            zau = p_gru(ji,jj,iku) * r1_e1u(ji,jj)
+            zav = p_grv(ji,jj,ikv) * r1_e2v(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/fse3u(ji,jj,iku)* ABS( zau )  )
-            zbv = MIN(  zbv , -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav )  )
+            zbu = MIN(  zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau )  )
+            zbv = MIN(  zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav )  )
             !                        !- Slope at u- & v-points (uslpml, vslpml)
             uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku)
@@ -812,6 +708,6 @@
             zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj )  )
             !                        !- i- & j-slope at w-points (wslpiml, wslpjml)
-            wslpiml(ji,jj) = zai / ( zbi - zeps ) * wmask (ji,jj,ik)
-            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * wmask (ji,jj,ik)
+            wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik)
+            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik)
          END DO
       END DO
@@ -831,6 +727,5 @@
       !! ** 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)
+      !! ** Method  :   
       !!----------------------------------------------------------------------
       INTEGER ::   ji, jj, jk   ! dummy loop indices
@@ -845,15 +740,21 @@
          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' )
-         !
+      !
+      ALLOCATE( ah_wslp2(jpi,jpj,jpk) , akz(jpi,jpj,jpk) , STAT=ierr )
+      IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate ah_slp2 or akz' )
+      !
+      IF( ln_traldf_triad ) THEN        ! Griffies operator : triad of slopes
+         IF(lwp) WRITE(numout,*) '              Griffies (triad) operator initialisation'
+         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) ,     &
+            &      triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1) ,     &
+            &      wslp2   (jpi,jpj,jpk)                                         , 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(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) ,                &
-            &   omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj)   , vslpml(jpi,jpj)    , wslpiml(jpi,jpj)   , wslpjml(jpi,jpj) , STAT=ierr )
+         IF(lwp) WRITE(numout,*) '              Madec operator initialisation'
+         ALLOCATE( omlmask(jpi,jpj,jpk) ,                                                                        &
+            &      uslp(jpi,jpj,jpk) , uslpml(jpi,jpj) , wslpi(jpi,jpj,jpk) , wslpiml(jpi,jpj) ,     &
+            &      vslp(jpi,jpj,jpk) , vslpml(jpi,jpj) , wslpj(jpi,jpj,jpk) , wslpjml(jpi,jpj) , STAT=ierr )
          IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' )
 
@@ -865,26 +766,27 @@
          wslpj(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp
 
-         IF(ln_sco .AND.  (ln_traldf_hor .OR. ln_dynldf_hor )) 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 )
-            DO jk = 1, jpk
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)
-                     vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)
-                     wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5
-                     wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5
-                  END DO
-               END DO
-            END DO
-            CALL lbc_lnk( uslp , 'U', -1. )   ;   CALL lbc_lnk( vslp , 'V', -1. )      ! Lateral boundary conditions
-            CALL lbc_lnk( wslpi, 'W', -1. )   ;   CALL lbc_lnk( wslpj, 'W', -1. )
-         ENDIF
+         !!gm I no longer understand this.....
+!!gm         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 )
+!            DO jk = 1, jpk
+!               DO jj = 2, jpjm1
+!                  DO ji = fs_2, fs_jpim1   ! vector opt.
+!                     uslp (ji,jj,jk) = - ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
+!                     vslp (ji,jj,jk) = - ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
+!                     wslpi(ji,jj,jk) = - ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5
+!                     wslpj(ji,jj,jk) = - ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5
+!                  END DO
+!               END DO
+!            END DO
+!            CALL lbc_lnk( uslp , 'U', -1. )   ;   CALL lbc_lnk( vslp , 'V', -1. )      ! Lateral boundary conditions
+!            CALL lbc_lnk( wslpi, 'W', -1. )   ;   CALL lbc_lnk( wslpj, 'W', -1. )
+!!gm         ENDIF
       ENDIF
       !
@@ -892,23 +794,4 @@
       !
    END SUBROUTINE ldf_slp_init
-
-#else
-   !!------------------------------------------------------------------------
-   !!   Dummy module :                 NO Rotation of lateral mixing tensor
-   !!------------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp = .FALSE.    !: slopes flag
-CONTAINS
-   SUBROUTINE ldf_slp( 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
-   SUBROUTINE ldf_slp_grif( 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
-   SUBROUTINE ldf_slp_init              ! Dummy routine
-   END SUBROUTINE ldf_slp_init
-#endif
 
    !!======================================================================
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 5901)
@@ -2,31 +2,81 @@
    !!======================================================================
    !!                       ***  MODULE  ldftra  ***
-   !! Ocean physics:  lateral diffusivity coefficient 
+   !! Ocean physics:  lateral diffusivity coefficients 
    !!=====================================================================
-   !! History :        ! 1997-07  (G. Madec)  from inimix.F split in 2 routines
-   !!   NEMO      1.0  ! 2002-09  (G. Madec)  F90: Free form and module
-   !!             2.0  ! 2005-11  (G. Madec)  
+   !! History :       ! 1997-07  (G. Madec)  from inimix.F split in 2 routines
+   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
+   !!            2.0  ! 2005-11  (G. Madec)  
+   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  restructuration/simplification of aht/aeiv specification,
+   !!                 !                                  add velocity dependent coefficient and optional read in file
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   ldf_tra_init : initialization, namelist read, and parameters control
-   !!   ldf_tra_c3d   : 3D eddy viscosity coefficient initialization
-   !!   ldf_tra_c2d   : 2D eddy viscosity coefficient initialization
-   !!   ldf_tra_c1d   : 1D eddy viscosity coefficient initialization
+   !!   ldf_tra      : update lateral eddy diffusivity coefficients at each time step 
+   !!   ldf_eiv_init : initialization of the eiv coeff. from namelist choices 
+   !!   ldf_eiv      : time evolution of the eiv coefficients (function of the growth rate of baroclinic instability)
+   !!   ldf_eiv_trp  : add to the input ocean transport the contribution of the EIV parametrization
+   !!   ldf_eiv_dia  : diagnose the eddy induced velocity from the eiv streamfunction
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
    USE phycst          ! physical constants
-   USE ldftra_oce      ! ocean tracer   lateral physics
-   USE ldfslp          ! ???
+   USE ldfslp          ! lateral diffusion: slope of iso-neutral surfaces
+   USE ldfc1d_c2d      ! lateral diffusion: 1D & 2D cases 
+   USE diaar5, ONLY:   lk_diaar5
+   !
+   USE trc_oce, ONLY: lk_offline ! offline flag
    USE in_out_manager  ! I/O manager
-   USE ioipsl
+   USE iom             ! I/O module for ehanced bottom friction file
    USE lib_mpp         ! distribued memory computing library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! work arrays
+   USE timing          ! timing
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   ldf_tra_init   ! called by opa.F90
+   PUBLIC   ldf_tra_init   ! called by nemogcm.F90
+   PUBLIC   ldf_tra        ! called by step.F90
+   PUBLIC   ldf_eiv_init   ! called by nemogcm.F90
+   PUBLIC   ldf_eiv        ! called by step.F90
+   PUBLIC   ldf_eiv_trp    ! called by traadv.F90
+   PUBLIC   ldf_eiv_dia    ! called by traldf_iso and traldf_iso_triad.F90
+   
+   !                                   !!* Namelist namtra_ldf : lateral mixing on tracers * 
+   !                                    != Operator type =!
+   LOGICAL , PUBLIC ::   ln_traldf_lap       !: laplacian operator
+   LOGICAL , PUBLIC ::   ln_traldf_blp       !: bilaplacian operator
+   !                                    != Direction of action =!
+   LOGICAL , PUBLIC ::   ln_traldf_lev       !: iso-level direction
+   LOGICAL , PUBLIC ::   ln_traldf_hor       !: horizontal (geopotential) direction
+!  LOGICAL , PUBLIC ::   ln_traldf_iso       !: iso-neutral direction                    (see ldfslp)
+!  LOGICAL , PUBLIC ::   ln_traldf_triad     !: griffies triad scheme                    (see ldfslp)
+   LOGICAL , PUBLIC ::   ln_traldf_msc       !: Method of Stabilizing Correction 
+!  LOGICAL , PUBLIC ::   ln_triad_iso        !: pure horizontal mixing in ML             (see ldfslp)
+!  LOGICAL , PUBLIC ::   ln_botmix_triad     !: mixing on bottom                         (see ldfslp)
+!  REAL(wp), PUBLIC ::   rn_sw_triad         !: =1/0 switching triad / all 4 triads used (see ldfslp)
+!  REAL(wp), PUBLIC ::   rn_slpmax           !: slope limit                              (see ldfslp)
+   !                                    !=  Coefficients =!
+   INTEGER , PUBLIC ::   nn_aht_ijk_t        !: choice of time & space variations of the lateral eddy diffusivity coef.
+   REAL(wp), PUBLIC ::   rn_aht_0            !:   laplacian lateral eddy diffusivity [m2/s]
+   REAL(wp), PUBLIC ::   rn_bht_0            !: bilaplacian lateral eddy diffusivity [m4/s]
+
+   !                                   !!* Namelist namtra_ldfeiv : eddy induced velocity param. *
+   !                                    != Use/diagnose eiv =!
+   LOGICAL , PUBLIC ::   ln_ldfeiv           !: eddy induced velocity flag
+   LOGICAL , PUBLIC ::   ln_ldfeiv_dia       !: diagnose & output eiv streamfunction and velocity (IOM)
+   !                                    != Coefficients =!
+   INTEGER , PUBLIC ::   nn_aei_ijk_t        !: choice of time/space variation of the eiv coeff.
+   REAL(wp), PUBLIC ::   rn_aeiv_0           !: eddy induced velocity coefficient [m2/s]
+   
+   LOGICAL , PUBLIC ::   l_ldftra_time = .FALSE.   !: flag for time variation of the lateral eddy diffusivity coef.
+   LOGICAL , PUBLIC ::   l_ldfeiv_time = .FALSE.   ! flag for time variation of the eiv coef.
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtu, ahtv   !: eddy diffusivity coef. at U- and V-points   [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aeiu, aeiv   !: eddy induced velocity coeff.                [m2/s]
+
+   REAL(wp) ::   r1_4  = 0.25_wp          ! =1/4
+   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! =1/12
 
    !! * Substitutions
@@ -34,5 +84,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -46,45 +96,49 @@
       !! ** Purpose :   initializations of the tracer lateral mixing coeff.
       !!
-      !! ** Method  :   the Eddy diffusivity and eddy induced velocity ceoff.
-      !!      are defined as follows:
-      !!         default option   : constant coef. aht0, aeiv0 (namelist)
-      !!        'key_traldf_c1d': depth dependent coef. defined in 
-      !!                            in ldf_tra_c1d routine
-      !!        'key_traldf_c2d': latitude and longitude dependent coef.
-      !!                            defined in ldf_tra_c2d routine
-      !!        'key_traldf_c3d': latitude, longitude, depth dependent coef.
-      !!                            defined in ldf_tra_c3d routine
-      !!
-      !!      N.B. User defined include files.  By default, 3d and 2d coef.
-      !!      are set to a constant value given in the namelist and the 1d
-      !!      coefficients are initialized to a hyperbolic tangent vertical
-      !!      profile.
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio               ! temporary integer
-      INTEGER ::   ios                  ! temporary integer
-      LOGICAL ::   ll_print = .FALSE.   ! =T print eddy coef. in numout
-      !! 
-      NAMELIST/namtra_ldf/ ln_traldf_lap  , ln_traldf_bilap,                  &
-         &                 ln_traldf_level, ln_traldf_hor  , ln_traldf_iso,   &
-         &                 ln_traldf_grif , ln_traldf_gdia ,                  &
-         &                 ln_triad_iso   , ln_botmix_grif ,                  &
-         &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0,       &
-         &                 rn_slpmax      , rn_chsmag      ,    rn_smsh,      &
-         &                 rn_aht_m
-      !!----------------------------------------------------------------------
-
-      !  Define the lateral tracer physics parameters
-      ! =============================================
-    
-
+      !! ** Method  : * the eddy diffusivity coef. specification depends on:
+      !!
+      !!    ln_traldf_lap = T     laplacian operator
+      !!    ln_traldf_blp = T   bilaplacian operator
+      !!
+      !!    nn_aht_ijk_t  =  0 => = constant
+      !!                  !
+      !!                  = 10 => = F(z) : constant with a reduction of 1/4 with depth 
+      !!                  !
+      !!                  =-20 => = F(i,j)   = shape read in 'eddy_diffusivity.nc' file
+      !!                  = 20    = F(i,j)   = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case)
+      !!                  = 21    = F(i,j,t) = F(growth rate of baroclinic instability)
+      !!                  !
+      !!                  =-30 => = F(i,j,k)   = shape read in 'eddy_diffusivity.nc' file
+      !!                  = 30    = F(i,j,k)   = 2D (case 20) + decrease with depth (case 10)
+      !!                  = 31    = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator
+      !!                                                          or |u|e^3/12 bilaplacian operator )
+      !!              * initialisation of the eddy induced velocity coefficient by a call to ldf_eiv_init 
+      !!            
+      !! ** action  : ahtu, ahtv initialized once for all or l_ldftra_time set to true
+      !!              aeiu, aeiv initialized once for all or l_ldfeiv_time set to true
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk                ! dummy loop indices
+      INTEGER  ::   ierr, inum, ios   ! local integer
+      REAL(wp) ::   zah0              ! local scalar
+      !
+      NAMELIST/namtra_ldf/ ln_traldf_lap, ln_traldf_blp  ,                   &   ! type of operator
+         &                 ln_traldf_lev, ln_traldf_hor  , ln_traldf_triad,  &   ! acting direction of the operator
+         &                 ln_traldf_iso, ln_traldf_msc  ,  rn_slpmax     ,  &   ! option for iso-neutral operator
+         &                 ln_triad_iso , ln_botmix_triad, rn_sw_triad    ,  &   ! option for triad operator
+         &                 rn_aht_0     , rn_bht_0       , nn_aht_ijk_t          ! lateral eddy coefficient
+      !!----------------------------------------------------------------------
+      !
+      !  Choice of lateral tracer physics
+      ! =================================
+      !
       REWIND( numnam_ref )              ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers
       READ  ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp )
-
+      !
       REWIND( numnam_cfg )              ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers
       READ  ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namtra_ldf )
-
+      !
       IF(lwp) THEN                      ! control print
          WRITE(numout,*)
@@ -92,98 +146,625 @@
          WRITE(numout,*) '~~~~~~~~~~~~ '
          WRITE(numout,*) '   Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)'
-         WRITE(numout,*) '      laplacian operator            ln_traldf_lap   = ', ln_traldf_lap
-         WRITE(numout,*) '      bilaplacian operator          ln_traldf_bilap = ', ln_traldf_bilap
-         WRITE(numout,*) '      iso-level                     ln_traldf_level = ', ln_traldf_level
-         WRITE(numout,*) '      horizontal (geopotential)     ln_traldf_hor   = ', ln_traldf_hor
-         WRITE(numout,*) '      iso-neutral                   ln_traldf_iso   = ', ln_traldf_iso
-         WRITE(numout,*) '      iso-neutral (Griffies)        ln_traldf_grif  = ', ln_traldf_grif
-         WRITE(numout,*) '      Griffies strmfn diagnostics   ln_traldf_gdia  = ', ln_traldf_gdia
-         WRITE(numout,*) '      lateral eddy diffusivity      rn_aht_0        = ', rn_aht_0
-         WRITE(numout,*) '      background hor. diffusivity   rn_ahtb_0       = ', rn_ahtb_0
-         WRITE(numout,*) '      eddy induced velocity coef.   rn_aeiv_0       = ', rn_aeiv_0
-         WRITE(numout,*) '      maximum isoppycnal slope      rn_slpmax       = ', rn_slpmax
-         WRITE(numout,*) '      pure lateral mixing in ML     ln_triad_iso    = ', ln_triad_iso
-         WRITE(numout,*) '      lateral mixing on bottom      ln_botmix_grif  = ', ln_botmix_grif
+         !
+         WRITE(numout,*) '      type :'
+         WRITE(numout,*) '         laplacian operator                      ln_traldf_lap   = ', ln_traldf_lap
+         WRITE(numout,*) '         bilaplacian operator                    ln_traldf_blp   = ', ln_traldf_blp
+         !
+         WRITE(numout,*) '      direction of action :'
+         WRITE(numout,*) '         iso-level                               ln_traldf_lev   = ', ln_traldf_lev
+         WRITE(numout,*) '         horizontal (geopotential)               ln_traldf_hor   = ', ln_traldf_hor
+         WRITE(numout,*) '         iso-neutral Madec operator              ln_traldf_iso   = ', ln_traldf_iso
+         WRITE(numout,*) '         iso-neutral triad operator              ln_traldf_triad = ', ln_traldf_triad
+         WRITE(numout,*) '            iso-neutral (Method of Stab. Corr.)  ln_traldf_msc   = ', ln_traldf_msc
+         WRITE(numout,*) '            maximum isoppycnal slope             rn_slpmax       = ', rn_slpmax
+         WRITE(numout,*) '            pure lateral mixing in ML            ln_triad_iso    = ', ln_triad_iso
+         WRITE(numout,*) '            switching triad or not               rn_sw_triad     = ', rn_sw_triad
+         WRITE(numout,*) '            lateral mixing on bottom             ln_botmix_triad = ', ln_botmix_triad
+         !
+         WRITE(numout,*) '      coefficients :'
+         WRITE(numout,*) '         lateral eddy diffusivity   (lap case)   rn_aht_0        = ', rn_aht_0
+         WRITE(numout,*) '         lateral eddy diffusivity (bilap case)   rn_bht_0        = ', rn_bht_0
+         WRITE(numout,*) '         type of time-space variation            nn_aht_ijk_t    = ', nn_aht_ijk_t
+      ENDIF
+      !
+      !                                ! Parameter control
+      !
+      IF( .NOT.ln_traldf_lap .AND. .NOT.ln_traldf_blp ) THEN
+         IF(lwp) WRITE(numout,*) '   No diffusive operator selected. ahtu and ahtv are not allocated'
+         l_ldftra_time = .FALSE.
+         RETURN
+      ENDIF
+      !
+      IF( ln_traldf_blp .AND. ( ln_traldf_iso .OR. ln_traldf_triad) ) THEN     ! iso-neutral bilaplacian need MSC
+         IF( .NOT.ln_traldf_msc )   CALL ctl_stop( 'tra_ldf_init: iso-neutral bilaplacian requires ln_traldf_msc=.true.' )
+      ENDIF
+      !
+      !  Space/time variation of eddy coefficients 
+      ! ===========================================
+      !                                               ! allocate the aht arrays
+      ALLOCATE( ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , STAT=ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays')
+      !
+      ahtu(:,:,jpk) = 0._wp                           ! last level always 0  
+      ahtv(:,:,jpk) = 0._wp
+      !
+      !                                               ! value of eddy mixing coef.
+      IF    ( ln_traldf_lap ) THEN   ;   zah0 =      rn_aht_0        !   laplacian operator
+      ELSEIF( ln_traldf_blp ) THEN   ;   zah0 = ABS( rn_bht_0 )      ! bilaplacian operator
+      ENDIF
+      !
+      l_ldftra_time = .FALSE.                         ! no time variation except in case defined below
+      !
+      IF( ln_traldf_lap .OR. ln_traldf_blp ) THEN     ! only if a lateral diffusion operator is used
+         !
+         SELECT CASE(  nn_aht_ijk_t  )                   ! Specification of space time variations of ehtu, ahtv
+         !
+         CASE(   0  )      !==  constant  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant = ', rn_aht_0
+            ahtu(:,:,:) = zah0 * umask(:,:,:)
+            ahtv(:,:,:) = zah0 * vmask(:,:,:)
+            !
+         CASE(  10  )      !==  fixed profile  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )'
+            ahtu(:,:,1) = zah0 * umask(:,:,1)                      ! constant surface value
+            ahtv(:,:,1) = zah0 * vmask(:,:,1)
+            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv )
+            !
+         CASE ( -20 )      !== fixed horizontal shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j) read in eddy_diffusivity.nc file'
+            CALL iom_open( 'eddy_diffusivity_2D.nc', inum )
+            CALL iom_get ( inum, jpdom_data, 'ahtu_2D', ahtu(:,:,1) )
+            CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) )
+            CALL iom_close( inum )
+            DO jk = 2, jpkm1
+               ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk)
+               ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk)
+            END DO
+            !
+         CASE(  20  )      !== fixed horizontal shape  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or blp case)'
+            IF( ln_traldf_lap )   CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor
+            IF( ln_traldf_blp )   CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor
+            !
+         CASE(  21  )      !==  time varying 2D field  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, time )'
+            IF(lwp) WRITE(numout,*) '                              = F( growth rate of baroclinic instability )'
+            IF(lwp) WRITE(numout,*) '                              min value = 0.1 * rn_aht_0'
+            IF(lwp) WRITE(numout,*) '                              max value = rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)'
+            IF(lwp) WRITE(numout,*) '                              increased to rn_aht_0 within 20N-20S'
+            !
+            l_ldftra_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90
+            !
+            IF( ln_traldf_blp ) THEN
+               CALL ctl_stop( 'ldf_tra_init: aht=F(growth rate of baroc. insta.) incompatible with bilaplacian operator' )
+            ENDIF
+            !
+         CASE( -30  )      !== fixed 3D shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j,k) read in eddy_diffusivity.nc file'
+            CALL iom_open( 'eddy_diffusivity_3D.nc', inum )
+            CALL iom_get ( inum, jpdom_data, 'ahtu_3D', ahtu )
+            CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv )
+            CALL iom_close( inum )
+            DO jk = 1, jpkm1
+               ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk)
+               ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk)
+            END DO
+            !
+         CASE(  30  )      !==  fixed 3D shape  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth )'
+            IF( ln_traldf_lap )   CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor
+            IF( ln_traldf_blp )   CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor
+            !                                                    ! reduction with depth
+            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv )
+            !
+         CASE(  31  )      !==  time varying 3D field  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth , time )'
+            IF(lwp) WRITE(numout,*) '                                proportional to the velocity : |u|e/12 or |u|e^3/12'
+            !
+            l_ldftra_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90
+            !
+         CASE DEFAULT
+            CALL ctl_stop('ldf_tra_init: wrong choice for nn_aht_ijk_t, the type of space-time variation of aht')
+         END SELECT
+         !
+         IF( ln_traldf_blp .AND. .NOT. l_ldftra_time ) THEN
+            ahtu(:,:,:) = SQRT( ahtu(:,:,:) )
+            ahtv(:,:,:) = SQRT( ahtv(:,:,:) )
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE ldf_tra_init
+
+
+   SUBROUTINE ldf_tra( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_tra  ***
+      !! 
+      !! ** Purpose :   update at kt the tracer lateral mixing coeff. (aht and aeiv)
+      !!
+      !! ** Method  :   time varying eddy diffusivity coefficients:
+      !!
+      !!    nn_aei_ijk_t = 21    aeiu, aeiv = F(i,j,  t) = F(growth rate of baroclinic instability)
+      !!                                                   with a reduction to 0 in vicinity of the Equator
+      !!    nn_aht_ijk_t = 21    ahtu, ahtv = F(i,j,  t) = F(growth rate of baroclinic instability)
+      !!
+      !!                 = 31    ahtu, ahtv = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator
+      !!                                                                     or |u|e^3/12 bilaplacian operator )
+      !!
+      !! ** action  :   ahtu, ahtv   update at each time step   
+      !!                aeiu, aeiv      -       -     -    -   (if ln_ldfeiv=T) 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time step
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zaht, zaht_min, z1_f20       ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_aei_ijk_t == 21 ) THEN       ! eddy induced velocity coefficients
+         !                                ! =F(growth rate of baroclinic instability)
+         !                                ! max value rn_aeiv_0 ; decreased to 0 within 20N-20S
+         CALL ldf_eiv( kt, rn_aeiv_0, aeiu, aeiv )
+         IF(lwp .AND. kt<=nit000+20 )   WRITE(numout,*) ' kt , ldf_eiv appel', kt
+      ENDIF
+      !
+      SELECT CASE(  nn_aht_ijk_t  )       ! Eddy diffusivity coefficients
+      !
+      CASE(  21  )       !==  time varying 2D field  ==!   = F( growth rate of baroclinic instability )
+         !                                             !   min value rn_aht_0 / 10 
+         !                                             !   max value rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)
+         !                                             !   increase to rn_aht_0 within 20N-20S
+         IF( nn_aei_ijk_t /= 21 ) THEN
+            CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv )
+            IF(lwp .AND. kt<=nit000+20 )   WRITE(numout,*) ' kt , ldf_eiv appel  2', kt
+         ELSE
+            ahtu(:,:,1) = aeiu(:,:,1)
+            ahtv(:,:,1) = aeiv(:,:,1)
+            IF(lwp .AND. kt<=nit000+20 )   WRITE(numout,*) ' kt , ahtu=aeiu', kt
+         ENDIF
+         !
+         z1_f20   = 1._wp / (  2._wp * omega * SIN( rad * 20._wp )  )      ! 1 / ff(20 degrees)   
+         zaht_min = 0.2_wp * rn_aht_0                                      ! minimum value for aht
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zaht = ( 1._wp -  MIN( 1._wp , ABS( ff(ji,jj) * z1_f20 ) ) ) * ( rn_aht_0 - zaht_min )
+               ahtu(ji,jj,1) = (  MAX( zaht_min, ahtu(ji,jj,1) ) + zaht  ) * umask(ji,jj,1)     ! min value zaht_min
+               ahtv(ji,jj,1) = (  MAX( zaht_min, ahtv(ji,jj,1) ) + zaht  ) * vmask(ji,jj,1)     ! increase within 20S-20N
+            END DO
+         END DO
+         DO jk = 2, jpkm1                             ! deeper value = surface value
+            ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk)
+            ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk)
+         END DO
+         !
+      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity )
+         IF( ln_traldf_lap     ) THEN          !   laplacian operator |u| e /12
+            DO jk = 1, jpkm1
+               ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12
+               ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12
+            END DO
+         ELSEIF( ln_traldf_blp ) THEN      ! bilaplacian operator      sqrt( |u| e^3 /12 ) = sqrt( |u| e /12 ) * e
+            DO jk = 1, jpkm1
+               ahtu(:,:,jk) = SQRT(  ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12  ) * e1u(:,:)
+               ahtv(:,:,jk) = SQRT(  ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12  ) * e2v(:,:)
+            END DO
+         ENDIF
+         !
+      END SELECT
+      !
+      IF( .NOT.lk_offline ) THEN
+         CALL iom_put( "ahtu_2d", ahtu(:,:,1) )   ! surface u-eddy diffusivity coeff.
+         CALL iom_put( "ahtv_2d", ahtv(:,:,1) )   ! surface v-eddy diffusivity coeff.
+         CALL iom_put( "ahtu_3d", ahtu(:,:,:) )   ! 3D      u-eddy diffusivity coeff.
+         CALL iom_put( "ahtv_3d", ahtv(:,:,:) )   ! 3D      v-eddy diffusivity coeff.
+         !
+!!gm  : THE IF below is to be checked (comes from Seb)
+         IF( ln_ldfeiv ) THEN
+           CALL iom_put( "aeiu_2d", aeiu(:,:,1) )   ! surface u-EIV coeff.
+           CALL iom_put( "aeiv_2d", aeiv(:,:,1) )   ! surface v-EIV coeff.
+           CALL iom_put( "aeiu_3d", aeiu(:,:,:) )   ! 3D      u-EIV coeff.
+           CALL iom_put( "aeiv_3d", aeiv(:,:,:) )   ! 3D      v-EIV coeff.
+         ENDIF     
+      ENDIF
+      !
+   END SUBROUTINE ldf_tra
+
+
+   SUBROUTINE ldf_eiv_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv_init  ***
+      !!
+      !! ** Purpose :   initialization of the eiv coeff. from namelist choices.
+      !!
+      !! ** Method :
+      !!
+      !! ** Action :   aeiu , aeiv   : EIV coeff. at u- & v-points
+      !!               l_ldfeiv_time : =T if EIV coefficients vary with time
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk                ! dummy loop indices
+      INTEGER  ::   ierr, inum, ios   ! local integer
+      !
+      NAMELIST/namtra_ldfeiv/ ln_ldfeiv   , ln_ldfeiv_dia,   &    ! eddy induced velocity (eiv)
+         &                    nn_aei_ijk_t, rn_aeiv_0             ! eiv  coefficient
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namtra_ldfeiv in reference namelist : eddy induced velocity param.
+      READ  ( numnam_ref, namtra_ldfeiv, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namtra_ldfeiv in configuration namelist : eddy induced velocity param.
+      READ  ( numnam_cfg, namtra_ldfeiv, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in configuration namelist', lwp )
+      IF(lwm)  WRITE ( numond, namtra_ldfeiv )
+
+      IF(lwp) THEN                      ! control print
          WRITE(numout,*)
-      ENDIF
-
-      !                                ! convert DOCTOR namelist names into OLD names
-      aht0  = rn_aht_0
-      ahtb0 = rn_ahtb_0
-      aeiv0 = rn_aeiv_0
-
-      !                                ! Parameter control
-
-      ! ... Check consistency for type and direction :
-      !           ==> will be done in traldf module
-
-      ! ... Space variation of eddy coefficients
-      ioptio = 0
-#if defined key_traldf_c3d
-      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth)'
-      ioptio = ioptio + 1
-#endif
-#if defined key_traldf_c2d
-      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude)'
-      ioptio = ioptio + 1
-#endif
-#if defined key_traldf_c1d
-      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )'
-      ioptio = ioptio + 1
-      IF( .NOT. ln_zco )   CALL ctl_stop( 'key_traldf_c1d can only be used in z-coordinate - full step' )
-#endif
-      IF( ioptio == 0 ) THEN
-          IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant (default option)'
-        ELSEIF( ioptio > 1 ) THEN
-           CALL ctl_stop('          use only one of the following keys:',   &
-             &           ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d' )
-      ENDIF
-
-      IF( ln_traldf_bilap ) THEN
-         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion'
-         IF( aht0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. aht0 must be negative' )
+         WRITE(numout,*) 'ldf_eiv_init : eddy induced velocity parametrization'
+         WRITE(numout,*) '~~~~~~~~~~~~ '
+         WRITE(numout,*) '   Namelist namtra_ldfeiv : '
+         WRITE(numout,*) '      Eddy Induced Velocity (eiv) param.      ln_ldfeiv     = ', ln_ldfeiv
+         WRITE(numout,*) '      eiv streamfunction & velocity diag.     ln_ldfeiv_dia = ', ln_ldfeiv_dia
+         WRITE(numout,*) '      eddy induced velocity coef.             rn_aeiv_0     = ', rn_aeiv_0
+         WRITE(numout,*) '      type of time-space variation            nn_aei_ijk_t  = ', nn_aei_ijk_t
+         WRITE(numout,*)
+      ENDIF
+      !
+      IF( ln_ldfeiv .AND. ln_traldf_blp )   CALL ctl_stop( 'ldf_eiv_init: eddy induced velocity ONLY with laplacian diffusivity' )
+
+      !                                 ! Parameter control
+      l_ldfeiv_time = .FALSE.    
+      !
+      IF( ln_ldfeiv ) THEN                         ! allocate the aei arrays
+         ALLOCATE( aeiu(jpi,jpj,jpk), aeiv(jpi,jpj,jpk), STAT=ierr )
+         IF( ierr /= 0 )   CALL ctl_stop('STOP', 'ldf_eiv: failed to allocate arrays')
+         !
+         SELECT CASE( nn_aei_ijk_t )               ! Specification of space time variations of eaiu, aeiv
+         !
+         CASE(   0  )      !==  constant  ==!
+            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = constant = ', rn_aeiv_0
+            aeiu(:,:,:) = rn_aeiv_0
+            aeiv(:,:,:) = rn_aeiv_0
+            !
+         CASE(  10  )      !==  fixed profile  ==!
+            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = F( depth )'
+            aeiu(:,:,1) = rn_aeiv_0                                ! constant surface value
+            aeiv(:,:,1) = rn_aeiv_0
+            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv )
+            !
+         CASE ( -20 )      !== fixed horizontal shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j) read in eddy_diffusivity_2D.nc file'
+            CALL iom_open ( 'eddy_induced_velocity_2D.nc', inum )
+            CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu(:,:,1) )
+            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) )
+            CALL iom_close( inum )
+            DO jk = 2, jpk
+               aeiu(:,:,jk) = aeiu(:,:,1)
+               aeiv(:,:,jk) = aeiv(:,:,1)
+            END DO
+            !
+         CASE(  20  )      !== fixed horizontal shape  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or bilap case)'
+            CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv )    ! surface value proportional to scale factor
+            !
+         CASE(  21  )       !==  time varying 2D field  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, time )'
+            IF(lwp) WRITE(numout,*) '                              = F( growth rate of baroclinic instability )'
+            !
+            l_ldfeiv_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90
+            !
+         CASE( -30  )      !== fixed 3D shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file'
+            CALL iom_open ( 'eddy_induced_velocity_3D.nc', inum )
+            CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu )
+            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv )
+            CALL iom_close( inum )
+            !
+         CASE(  30  )       !==  fixed 3D shape  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth )'
+            CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv )    ! surface value proportional to scale factor
+            !                                                 ! reduction with depth
+            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv )
+            !
+         CASE DEFAULT
+            CALL ctl_stop('ldf_tra_init: wrong choice for nn_aei_ijk_t, the type of space-time variation of aei')
+         END SELECT
+         !
       ELSE
-         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)'
-         IF( aht0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. aht0 must be positive' )
-      ENDIF
-
-
-      !  Lateral eddy diffusivity and eddy induced velocity coefficients
-      ! ================================================================
-#if defined key_traldf_c3d
-      CALL ldf_tra_c3d( ll_print )      ! aht = 3D coef. = F( longitude, latitude, depth )
-#elif defined key_traldf_c2d
-      CALL ldf_tra_c2d( ll_print )      ! aht = 2D coef. = F( longitude, latitude )
-#elif defined key_traldf_c1d
-      CALL ldf_tra_c1d( ll_print )      ! aht = 1D coef. = F( depth )
-#else
-                                        ! Constant coefficients
-      IF(lwp)WRITE(numout,*)
-      IF(lwp)WRITE(numout,*) '      constant eddy diffusivity coef.   ahtu = ahtv = ahtw = aht0 = ', aht0
-      IF( lk_traldf_eiv ) THEN
-         IF(lwp)WRITE(numout,*) '      constant eddy induced velocity coef.   aeiu = aeiv = aeiw = aeiv0 = ', aeiv0
+          IF(lwp) WRITE(numout,*) '   eddy induced velocity param is NOT used neither diagnosed'
+          ln_ldfeiv_dia = .FALSE.
+      ENDIF
+      !                    
+   END SUBROUTINE ldf_eiv_init
+
+
+   SUBROUTINE ldf_eiv( kt, paei0, paeiu, paeiv )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv  ***
+      !!
+      !! ** Purpose :   Compute the eddy induced velocity coefficient from the
+      !!              growth rate of baroclinic instability.
+      !!
+      !! ** Method  :   coefficient function of the growth rate of baroclinic instability
+      !!
+      !! Reference : Treguier et al. JPO 1997   ; Held and Larichev JAS 1996
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt             ! ocean time-step index
+      REAL(wp)                        , INTENT(inout) ::   paei0          ! max value            [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   paeiu, paeiv   ! eiv coefficient      [m2/s]
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei   ! local scalars
+      REAL(wp), DIMENSION(:,:), POINTER ::   zn, zah, zhw, zross, zaeiw   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('ldf_eiv')
+      !
+      CALL wrk_alloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw )
+      !      
+      zn   (:,:) = 0._wp      ! Local initialization
+      zhw  (:,:) = 5._wp
+      zah  (:,:) = 0._wp
+      zross(:,:) = 0._wp
+      !                       ! Compute lateral diffusive coefficient at T-point
+      IF( ln_traldf_triad ) THEN
+         DO jk = 1, jpk
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  ! Take the max of N^2 and zero then take the vertical sum 
+                  ! of the square root of the resulting N^2 ( required to compute 
+                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
+                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
+                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
+                  ! Compute elements required for the inverse time scale of baroclinic
+                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                  zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w
+                  zhw(ji,jj) = zhw(ji,jj) + ze3w
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jk = 1, jpk
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  ! Take the max of N^2 and zero then take the vertical sum 
+                  ! of the square root of the resulting N^2 ( required to compute 
+                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
+                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
+                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
+                  ! Compute elements required for the inverse time scale of baroclinic
+                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                  zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                     &                            + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w
+                  zhw(ji,jj) = zhw(ji,jj) + ze3w
+               END DO
+            END DO
+         END DO
+      END IF
+
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 )
+            ! Rossby radius at w-point taken < 40km and  > 2km
+            zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 )
+            ! Compute aeiw by multiplying Ro^2 and T^-1
+            zaeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1)
+         END DO
+      END DO
+
+!!gm      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2
+!!gm         DO jj = 2, jpjm1
+!!gm            DO ji = fs_2, fs_jpim1   ! vector opt.
+!!gm               ! Take the minimum between aeiw and 1000 m2/s over shelves (depth shallower than 650 m)
+!!gm               IF( mbkt(ji,jj) <= 20 )   zaeiw(ji,jj) = MIN( zaeiw(ji,jj), 1000. )
+!!gm            END DO
+!!gm         END DO
+!!gm      ENDIF
+
+      !                                         !==  Bound on eiv coeff.  ==!
+      z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  )
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zzaei = MIN( 1._wp, ABS( ff(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)       ! tropical decrease
+            zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0
+         END DO
+      END DO
+      CALL lbc_lnk( zaeiw(:,:), 'W', 1. )       ! lateral boundary condition
+      !               
+      DO jj = 2, jpjm1                          !== aei at u- and v-points  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1)
+            paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1)
+         END DO 
+      END DO 
+      CALL lbc_lnk( paeiu(:,:,1), 'U', 1. )   ;   CALL lbc_lnk( paeiv(:,:,1), 'V', 1. )      ! lateral boundary condition
+
+      DO jk = 2, jpkm1                          !==  deeper values equal the surface one  ==!
+         paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk)
+         paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk)
+      END DO
+      !  
+      CALL wrk_dealloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('ldf_eiv')
+      !
+   END SUBROUTINE ldf_eiv
+
+
+   SUBROUTINE ldf_eiv_trp( kt, kit000, pun, pvn, pwn, cdtype )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv_trp  ***
+      !! 
+      !! ** Purpose :   add to the input ocean transport the contribution of 
+      !!              the eddy induced velocity parametrization.
+      !!
+      !! ** Method  :   The eddy induced transport is computed from a flux stream-
+      !!              function which depends on the slope of iso-neutral surfaces
+      !!              (see ldf_slp). For example, in the i-k plan : 
+      !!                   psi_uw = mk(aeiu) e2u mi(wslpi)   [in m3/s]
+      !!                   Utr_eiv = - dk[psi_uw]
+      !!                   Vtr_eiv = + di[psi_uw]
+      !!                ln_ldfeiv_dia = T : output the associated streamfunction,
+      !!                                    velocity and heat transport (call ldf_eiv_dia)
+      !!
+      !! ** Action  : pun, pvn increased by the eiv transport
+      !!----------------------------------------------------------------------
+      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)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean transport components   [m3/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean transport components   [m3/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv                [m3/s]
+      !!
+      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
+      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars
+      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zpsi_uw, zpsi_vw
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start( 'ldf_eiv_trp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zpsi_uw, zpsi_vw )
+
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ldf_eiv_trp : eddy induced advection on ', cdtype,' :'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   add to velocity fields the eiv component'
+      ENDIF
+
       
-      ENDIF
-#endif
-
-#if defined key_traldf_smag && ! defined key_traldf_c3d
-        CALL ctl_stop( 'key_traldf_smag can only be used with key_traldf_c3d' )
-#endif
-#if defined key_traldf_smag
-        IF(lwp) WRITE(numout,*)' SMAGORINSKY DIFFUSION'
-        IF(lwp .AND. rn_smsh < 1)  WRITE(numout,*)' only  shear is used '
-        IF(lwp.and.ln_traldf_bilap) CALL ctl_stop(' SMAGORINSKY + BILAPLACIAN - UNSTABLE OR NON_CONSERVATIVE' )
-#endif
-
-      !
-   END SUBROUTINE ldf_tra_init
-
-#if defined key_traldf_c3d
-#   include "ldftra_c3d.h90"
-#elif defined key_traldf_c2d
-#   include "ldftra_c2d.h90"
-#elif defined key_traldf_c1d
-#   include "ldftra_c1d.h90"
-#endif
+      zpsi_uw(:,:, 1 ) = 0._wp   ;   zpsi_vw(:,:, 1 ) = 0._wp
+      zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp
+      !
+      DO jk = 2, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zpsi_uw(ji,jj,jk) = - 0.25_wp * e2u(ji,jj) * ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk) )   &
+                  &                                       * ( aeiu (ji,jj,jk-1) + aeiu (ji  ,jj,jk) ) * umask(ji,jj,jk)
+               zpsi_vw(ji,jj,jk) = - 0.25_wp * e1v(ji,jj) * ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk) )   &
+                  &                                       * ( aeiv (ji,jj,jk-1) + aeiv (ji,jj  ,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.               
+               pun(ji,jj,jk) = pun(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) )
+               pvn(ji,jj,jk) = pvn(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) )
+            END DO
+         END DO
+      END DO
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               pwn(ji,jj,jk) = pwn(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   &
+                  &                             + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) )
+            END DO
+         END DO
+      END DO
+      !
+      !                              ! diagnose the eddy induced velocity and associated heat transport
+      IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zpsi_uw, zpsi_vw )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop( 'ldf_eiv_trp')
+      !
+    END SUBROUTINE ldf_eiv_trp
+
+
+   SUBROUTINE ldf_eiv_dia( psi_uw, psi_vw )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv_dia  ***
+      !!
+      !! ** Purpose :   diagnose the eddy induced velocity and its associated
+      !!              vertically integrated heat transport.
+      !!
+      !! ** Method :
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   psi_uw, psi_vw   ! streamfunction   [m3/s]
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) ::   zztmp   ! local scalar
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zw2d   ! 2D workspace
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zw3d   ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'ldf_eiv_dia')
+      !
+      !                                                  !==  eiv stream function: output  ==!
+      CALL lbc_lnk( psi_uw, 'U', -1. )                         ! lateral boundary condition
+      CALL lbc_lnk( psi_vw, 'V', -1. )
+      !
+!!gm      CALL iom_put( "psi_eiv_uw", psi_uw )                 ! output
+!!gm      CALL iom_put( "psi_eiv_vw", psi_vw )
+      !
+      !                                                  !==  eiv velocities: calculate and output  ==!
+      CALL wrk_alloc( jpi,jpj,jpk,   zw3d )
+      !
+      zw3d(:,:,jpk) = 0._wp                                    ! bottom value always 0
+      !
+      DO jk = 1, jpkm1                                         ! e2u e3u u_eiv = -dk[psi_uw]
+         zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * fse3u(:,:,jk) )
+      END DO
+      CALL iom_put( "uoce_eiv", zw3d )
+      !
+      DO jk = 1, jpkm1                                         ! e1v e3v v_eiv = -dk[psi_vw]
+         zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * fse3v(:,:,jk) )
+      END DO
+      CALL iom_put( "voce_eiv", zw3d )
+      !
+      DO jk = 1, jpkm1                                         ! e1 e2 w_eiv = dk[psix] + dk[psix]
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1  ! vector opt.
+               zw3d(ji,jj,jk) = (  psi_vw(ji,jj,jk) - psi_vw(ji  ,jj-1,jk)    &
+                  &              + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj  ,jk)  ) / e1e2t(ji,jj)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zw3d, 'T', 1. )      ! lateral boundary condition
+      CALL iom_put( "woce_eiv", zw3d )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zw3d )
+      !      
+      !
+      IF( lk_diaar5 ) THEN                               !==  eiv heat transport: calculate and output  ==!
+         CALL wrk_alloc( jpi,jpj,   zw2d )
+         !
+         zztmp = 0.5_wp * rau0 * rcp 
+         zw2d(:,:) = 0._wp 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   &
+                     &                              * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) ) 
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zw2d, 'U', -1. )
+         CALL iom_put( "ueiv_heattr", zw2d )                  ! heat transport in i-direction
+         zw2d(:,:) = 0._wp 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   &
+                     &                              * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji,jj+1,jk,jp_tem) ) 
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zw2d, 'V', -1. )
+         CALL iom_put( "veiv_heattr", zw2d )                  !  heat transport in i-direction
+         !
+         CALL wrk_dealloc( jpi,jpj,   zw2d )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'ldf_eiv_dia')      
+      !
+   END SUBROUTINE ldf_eiv_dia
 
    !!======================================================================
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90	(revision 5891)
+++ 	(revision )
@@ -1,129 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                      ***  ldftra_c1d.h90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_tra_c1d( ld_print )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldftra_c1d  ***
-      !!              
-      !! ** Purpose :   1D eddy diffusivity coefficient
-      !!
-      !! ** Method  :   1D eddy diffusivity coefficients ( depth )
-      !!       biharmonic operator    : ahtt = defined at T-level
-      !!                                ahtu,ahtv,ahtw never used
-      !!
-      !!       harmonic operator      : ahtt never used
-      !!          -1-  iso-model level: ahtu = ahtv defined at T-level
-      !!                                ahtw never used
-      !!          -2-  isopycnal or   : ahtu = ahtv defined at T-level
-      !!               geopotential     ahtw defined at w-level
-      !!
-      !!       eddy induced velocity
-      !!         always harmonic      : aeiu = aeiv defined at T-level
-      !!				  aeiw defined at w-level
-      !!----------------------------------------------------------------------
-      LOGICAL, INTENT (in) ::   ld_print   ! If true, print arrays in numout
-      !
-      INTEGER  ::   jk   ! dummy loop indices
-      REAL(wp) ::   zkah, zahr, za00 , za01    ! local scalars
-      REAL(wp) ::   zahf, zahs, zahtf, zahts   !   -      -
-      !!----------------------------------------------------------------------
-
-      IF( lk_traldf_eiv ) THEN 
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' ldf_tra_c1d : 1D eddy diffusivity and eddy induced velocity coefficients'
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   -- ' 
-         IF(lwp) WRITE(numout,*)
-      ELSE
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' inildf : 1D eddy diffusivity coefficient '
-         IF(lwp) WRITE(numout,*) ' ~~~~~~   -- '
-         IF(lwp) WRITE(numout,*)
-      ENDIF
-
-      ! initialization of the profile
-
-      ! ahts, ahtf: surface and bottom values
-      zahts = aht0
-      zahtf = aht0/4. 
-      ! zkah, zahr: depth of the inflection pt and width of inflection
-      zkah =  -300.
-      zahr =   300.
-      ! computation coefficients
-      za00 = TANH( ( -fsdept(1,1,1  ) - zkah ) / zahr )
-      za01 = TANH( ( -fsdept(1,1,jpk) - zkah ) / zahr )
-      zahf = ( zahts-zahtf ) / ( za00 - za01 )
-      zahs = zahts - zahf * za00
-
-      ! biharmonic operator : (T-point)
-      ! ==================== 
-
-      ! set ahtt at T-level
-      DO jk = 1, jpk
-         ahtt(jk) = zahs + zahf * TANH( (-fsdept(1,1,jk)-zkah) / zahr )
-      END DO
-
-      ! control print
-      IF(lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '         aht profile at T-level : '
-         WRITE(numout,*)
-         WRITE(numout,*) ' level    aht          depth t-level '
-         DO jk = 1, jpk
-            WRITE(numout,'(i6,2f12.4)') jk, ahtt(jk), fsdept(1,1,jk)
-         END DO
-      ENDIF
-
-      ! harmonic operator : (U-, V-, W-points)
-      ! ================== 
-
-      ! set ahtu = ahtv at T-level, and ahtw at w-level
-      DO jk = 1, jpk
-         ahtu(jk) = zahs + zahf * TANH( ( -fsdept(1,1,jk) - zkah ) / zahr )
-         ahtv(jk) = ahtu(jk)
-         ahtw(jk) = zahs + zahf * TANH( ( -fsdepw(1,1,jk) - zkah ) / zahr )
-      END DO
-
-      ! control print
-      IF(lwp .AND. ld_print ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '         aht profile at T-level : '
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' level    aht          depth t-level '
-         DO jk = 1, jpk
-            IF(lwp) WRITE(numout,"(i6,2f12.4)") jk, ahtu(jk), fsdept(1,1,jk)
-         END DO
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '         aht profile at W-level : '
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '  jk      aht          depth w-level '
-         DO jk = 1, jpk
-            IF(lwp)WRITE(numout,"(i6,2f12.4)") jk, ahtw(jk), fsdepw(1,1,jk)
-         END DO
-      ENDIF
-
-# if defined key_traldf_eiv
-      ! set aeiu = aeiv and set aeiw (here same profile as on aht)
-      aeiu(:) = ahtu(:)
-      aeiv(:) = aeiu(:)
-      aeiw(:) = ahtw(:)
-      
-      ! Control print
-      IF(lwp .AND. ld_print ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '         aeiv profile at T-level : '
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '  jk      aeiv           depth t-level '
-         DO jk = 1, jpk
-            IF(lwp) WRITE(numout,"(i6,2f12.4)") jk, aeiu(jk), fsdept(1,1,jk)
-         END DO
-      ENDIF
-#endif
-      !
-   END SUBROUTINE ldf_tra_c1d
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90	(revision 5891)
+++ 	(revision )
@@ -1,162 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                      ***  ldftra_c2d.h90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_tra_c2d( ld_print )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldftra_c2d  ***
-      !!              
-      !! ** Purpose :   initializations of horizontally non uniform eddy 
-      !!      diffusivity coefficients
-      !!
-      !! ** Method :
-      !!       biharmonic operator    : ahtt = defined at T-level
-      !!                                ahtu,ahtv,ahtw never used
-      !!       harmonic operator (ahtt never used)
-      !!           iso-model level   : ahtu, ahtv defined at u-, v-points
-      !!         isopycnal         : ahtu, ahtv, ahtw defined at u-, v-, w-pts
-      !!         or geopotential   
-      !!       eddy induced velocity
-      !!           always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts
-      !!----------------------------------------------------------------------
-      LOGICAL, INTENT (in) ::   ld_print   ! If true, print arrays in numout
-      !
-      INTEGER ::   ji, jj   ! dummy loop indices
-      REAL(wp) ::   za00, zd_max, zeumax, zevmax, zetmax
-      !!----------------------------------------------------------------------
-
-      IF( lk_traldf_eiv ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' ldf_tra_c2d : 2D eddy diffusivity and eddy'
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  induced velocity coefficients'
-      ELSE
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' ldf_tra2d : 2D eddy diffusivity coefficient'
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --'
-      ENDIF
-
-      zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
-      IF( lk_mpp ) CALL mpp_max( zd_max )   ! max over the global domain
-
-      ! harmonic operator : (U-, V-, W-points)
-      ! ==================
-      IF( ln_traldf_lap ) THEN
-         !
-         za00 = aht0 / zd_max
-         !
-         DO jj = 1, jpj 
-            DO ji = 1, jpi 
-               zeumax = MAX( e1u(ji,jj), e2u(ji,jj) ) 
-               zevmax = MAX( e1v(ji,jj), e2v(ji,jj) ) 
-               zetmax = MAX( e1t(ji,jj), e2t(ji,jj) )
-               ahtu(ji,jj) = za00 * zeumax ! set ahtu = ahtv at u- and v-points, 
-               ahtv(ji,jj) = za00 * zevmax ! and ahtw at w-point (idem T-point) 
-               ahtw(ji,jj) = za00 * zetmax ! 
-            END DO
-         END DO
-
-         CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( ahtv, 'V', 1. )   ! (no change of sign)
-         CALL lbc_lnk( ahtw, 'W', 1. )
-
-         ! Special case for ORCA R2 and R4 configurations (overwrite the value of ahtu ahtv ahtw)
-         ! ==============================================
-         IF( cp_cfg == "orca" .AND. ( jp_cfg == 2 .OR. jp_cfg == 4 ) )   THEN
-            ahtu(:,:) = aht0              ! set ahtu = ahtv at u- and v-points,
-            ahtv(:,:) = aht0              ! and ahtw at w-point
-            ahtw(:,:) = aht0              ! (here : no space variation)
-            IF(lwp) WRITE(numout,*) '               ORCA R2 or R4 case'
-            IF(lwp) WRITE(numout,*) '               Constant values used for eddy diffusivity coefficients'
-            IF(lwp) WRITE(numout,*) '               Variation lat/lon only for eddy induced velocity coefficients'
-         ENDIF
-
-         ! Control print
-         IF( lwp .AND. ld_print ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahtu array'
-            CALL prihre( ahtu, jpi, jpj, 1, jpi, 1,   &
-               &                         1, jpj, 1, 1.e-3, numout )
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahtv array'
-            CALL prihre( ahtv, jpi, jpj, 1, jpi, 1,   &
-               &                         1, jpj, 1, 1.e-3, numout )
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahtw array'
-            CALL prihre( ahtw, jpi, jpj, 1, jpi, 1,   &
-               &                         1, jpj, 1, 1.e-3, numout )
-         ENDIF
-      ENDIF
-      
-      ! biharmonic operator : (T-point)
-      ! ====================
-      IF( ln_traldf_bilap ) THEN
-         ! (USER: modify ahtt following your desiderata)
-         ! Here: ahm is proportional to the cube of the maximum of the gridspacing
-         !       in the to horizontal direction
-
-         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
-         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
-
-         za00 = aht0 / ( zd_max * zd_max * zd_max )
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zetmax = MAX( e1t(ji,jj), e2t(ji,jj) )
-               ahtt(ji,jj) = za00 * zetmax * zetmax * zetmax      ! set ahtt at T-point
-            END DO
-         END DO
-
-         CALL lbc_lnk( ahtt, 'T', 1. )   ! Lateral boundary conditions on ( ahtt )
-
-         ! Control print
-         IF( lwp .AND. ld_print ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: 2D ahtt array'
-            CALL prihre( ahtt, jpi, jpj, 1, jpi, 1,   &
-               &                         1, jpj, 1, 1.e-3, numout )
-         ENDIF
-      ENDIF
-
-# if defined key_traldf_eiv
-      ! set aeiu = aeiv at u- and v-points, and aeiw at w-point (idem T-point)
-      ! (here no space variation)
-      aeiu(:,:) = aeiv0
-      aeiv(:,:) = aeiv0
-      aeiw(:,:) = aeiv0
-      
-      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN
-         !                                 ! Cancel eiv in Gibraltar strait
-         aeiu( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
-         aeiv( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
-         aeiw( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
-         !                                 ! Cancel eiv in Mediterrannean sea
-         aeiu( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
-         aeiv( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
-         aeiw( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
-      ENDIF
-
-      ! Lateral boundary conditions on ( aeiu, aeiv, aeiw )
-      CALL lbc_lnk( aeiu, 'U', 1. )
-      CALL lbc_lnk( aeiv, 'V', 1. )
-      CALL lbc_lnk( aeiw, 'W', 1. )
-
-      ! Control print
-      IF( lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: aeiu array'
-         CALL prihre(aeiu,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: aeiv array'
-         CALL prihre(aeiv,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: aeiw array'
-         CALL prihre(aeiw,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-      ENDIF
-# endif
-      !
-   END SUBROUTINE ldf_tra_c2d
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90	(revision 5891)
+++ 	(revision )
@@ -1,123 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                        ***  ldftra_c3d.h90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_tra_c3d( ld_print )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE ldftra_c3d  ***
-      !!                
-      !! ** Purpose :
-      !!     initializations of non uniform horizontal eddy diffusivity coef.
-      !!
-      !! ** Method :
-      !!      3D eddy diffusivity coefficients ( longitude, latitude, depth )
-      !!
-      !!       biharmonic operator    : ahtt = defined at T-level
-      !!                                ahtu,ahtv,ahtw never used
-      !!
-      !!       harmonic operator (ahtt never used)
-      !!         iso-model level   : ahtu, ahtv defined at u-, v-points
-      !!         isopycnal         : ahtu, ahtv, ahtw defined at u-, v-, w-pts
-      !!         or geopotential
-      !!
-      !!       eddy induced velocity
-      !!         always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts
-      !!----------------------------------------------------------------------
-      USE ioipsl
-      !
-      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
-      !!----------------------------------------------------------------------
-
-      IF( lk_traldf_eiv ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' ldf_tra_c3d : 3D eddy diffusivity and eddy induced velocity coefficients'
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  '
-         IF(lwp) WRITE(numout,*) '               Coefficients set to constant'
-      ELSE
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' ldf_tra_c3d : 3D eddy diffusivity coefficient'
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   -- '
-         IF(lwp) WRITE(numout,*) '               Coefficients set to constant'
-      ENDIF
-
-
-      ! biharmonic operator   (T-point)
-      ! -------------------
-
-      ahtt(:,:,:) = aht0              ! set ahtt at T-point (here no space variation)
-
-      CALL lbc_lnk( ahtt, 'T', 1. )   ! Lateral boundary conditions on ( ahtt )
-
-      IF(lwp .AND. ld_print ) THEN                    ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtt at k = 1'
-         CALL prihre( ahtt(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-3, numout )
-      ENDIF
-
-
-      ! harmonic operator   (U-, V-, W-points)
-      ! ----------------- 
-
-      ahtu(:,:,:) = aht0              ! set ahtu = ahtv at u- and v-points,
-      ahtv(:,:,:) = aht0              ! and ahtw at w-point
-      ahtw(:,:,:) = aht0              ! (here example: no space variation)
-      
-      CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions
-      CALL lbc_lnk( ahtv, 'V', 1. )
-      CALL lbc_lnk( ahtw, 'W', 1. )
-
-      IF(lwp .AND. ld_print ) THEN                    ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtu at k = 1'
-         CALL prihre( ahtu(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-3, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtv at k = 1'
-         CALL prihre( ahtv(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-3, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtw at k = 1'
-         CALL prihre( ahtw(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-3, numout )
-      ENDIF
-
-# if defined key_traldf_eiv
-      aeiu(:,:,:) = aeiv0            ! set aeiu = aeiv at u- and v-points,
-      aeiv(:,:,:) = aeiv0            ! and aeiw at w-point
-      aeiw(:,:,:) = aeiv0            ! (here example: no space variation)
-
-      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN
-         !                                 ! Cancel eiv in Gibraltar strait
-         aeiu( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
-         aeiv( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
-         aeiw( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
-         !                                 ! Cancel eiv in Mediterrannean sea
-         aeiu( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
-         aeiv( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
-         aeiw( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
-      ENDIF
-
-      CALL lbc_lnk( aeiu, 'U', 1. )   ! Lateral boundary conditions 
-      CALL lbc_lnk( aeiv, 'V', 1. )
-      CALL lbc_lnk( aeiw, 'W', 1. )
-      IF(lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: aeiu at k = 1'
-         CALL prihre(aeiu(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: aeiv at k = 1'
-         CALL prihre(aeiv(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: aeiw at k = 1'
-         CALL prihre(aeiw(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-      ENDIF
-
-# endif
-   END SUBROUTINE ldf_tra_c3d
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 5891)
+++ 	(revision )
@@ -1,124 +1,0 @@
-MODULE ldftra_oce
-   !!=====================================================================
-   !!                      ***  MODULE  ldftra_oce  ***
-   !! Ocean physics :  lateral tracer mixing coefficient defined in memory 
-   !!=====================================================================
-   !! History :  9.0  !  2002-11  (G. Madec)  Original code
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE in_out_manager ! I/O manager
-   USE lib_mpp         ! MPP library
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC ldftra_oce_alloc ! called by nemo_init->nemo_alloc, nemogcm.F90
-
-   !!----------------------------------------------------------------------
-   !! Lateral eddy diffusivity coefficients (tracers)
-   !!----------------------------------------------------------------------
-   !                                     !!* Namelist namtra_ldf : lateral mixing *
-   LOGICAL , PUBLIC ::   ln_traldf_lap    !: laplacian operator
-   LOGICAL , PUBLIC ::   ln_traldf_bilap  !: bilaplacian operator
-   LOGICAL , PUBLIC ::   ln_traldf_level  !: iso-level direction
-   LOGICAL , PUBLIC ::   ln_traldf_hor    !: horizontal (geopotential) direction
-   LOGICAL , PUBLIC ::   ln_traldf_iso    !: iso-neutral direction
-   LOGICAL , PUBLIC ::   ln_traldf_grif   !: griffies skew flux
-   LOGICAL , PUBLIC ::   ln_traldf_gdia   !: griffies skew flux streamfunction diagnostics
-   REAL(wp), PUBLIC ::   rn_aht_0         !: lateral eddy diffusivity (m2/s)
-   REAL(wp), PUBLIC ::   rn_ahtb_0        !: lateral background eddy diffusivity (m2/s)
-   REAL(wp), PUBLIC ::   rn_aeiv_0        !: eddy induced velocity coefficient (m2/s)
-   REAL(wp), PUBLIC ::   rn_slpmax        !: slope limit
-   REAL(wp), PUBLIC ::   rn_chsmag        !:  multiplicative factor in Smagorinsky diffusivity
-   REAL(wp), PUBLIC ::   rn_smsh          !:  Smagorinsky diffusivity: = 0 - use only sheer
-   REAL(wp), PUBLIC ::   rn_aht_m         !:  upper limit or stability criteria for lateral eddy diffusivity (m2/s)
-
-   REAL(wp), PUBLIC ::   aht0, ahtb0, aeiv0         !!: OLD namelist names
-
-   LOGICAL , PUBLIC ::   ln_triad_iso    !: calculate triads twice
-   LOGICAL , PUBLIC ::   ln_botmix_grif  !: mixing on bottom
-   LOGICAL , PUBLIC ::   l_grad_zps      = .FALSE.   !: special treatment for Horz Tgradients w partial steps 
-
-   REAL(wp), PUBLIC ::   rldf                        !: multiplicative factor of diffusive coefficient
-                                                     !: Needed to define the ratio between passive and active tracer diffusion coef. 
-
-#if defined key_traldf_c3d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtt, ahtu, ahtv, ahtw   !: ** 3D coefficients ** at T-,U-,V-,W-points
-#elif defined key_traldf_c2d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahtt, ahtu, ahtv, ahtw   !: ** 2D coefficients ** at T-,U-,V-,W-points
-#elif defined key_traldf_c1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   ahtt, ahtu, ahtv, ahtw   !: ** 1D coefficients ** at T-,U-,V-,W-points
-#else
-   REAL(wp), PUBLIC                                      ::   ahtt, ahtu, ahtv, ahtw   !: ** 0D coefficients ** at T-,U-,V-,W-points
-#endif
-
-#if defined key_traldf_eiv
-   !!----------------------------------------------------------------------
-   !!   'key_traldf_eiv'                              eddy induced velocity
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER               ::   lk_traldf_eiv   = .TRUE.   !: eddy induced velocity flag
-   
-   !                                                                              !!! eddy coefficients at U-, V-, W-points  [m2/s]
-# if defined key_traldf_c3d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aeiu , aeiv , aeiw   !: ** 3D coefficients **
-# elif defined key_traldf_c2d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   aeiu , aeiv , aeiw   !: ** 2D coefficients **
-# elif defined key_traldf_c1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   aeiu , aeiv , aeiw   !: ** 1D coefficients **
-# else
-   REAL(wp), PUBLIC                                      ::   aeiu , aeiv , aeiw   !: ** 0D coefficients **
-# endif
-# if defined key_diaeiv
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   u_eiv, v_eiv, w_eiv   !: eddy induced velocity [m/s]
-# endif
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :                           NO eddy induced velocity
-   !!----------------------------------------------------------------------
-   LOGICAL , PUBLIC, PARAMETER ::   lk_traldf_eiv   = .FALSE.   !: eddy induced velocity flag
-   REAL(wp), PUBLIC            ::   aeiu, aeiv, aeiw            !: eddy induced coef. (not used)
-#endif
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION ldftra_oce_alloc()
-     !!----------------------------------------------------------------------
-      !!                 ***  FUNCTION ldftra_oce_alloc  ***
-     !!----------------------------------------------------------------------
-     INTEGER, DIMENSION(3) :: ierr
-     !!----------------------------------------------------------------------
-     ierr(:) = 0
-
-#if defined key_traldf_c3d
-      ALLOCATE( ahtt(jpi,jpj,jpk) , ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , ahtw(jpi,jpj,jpk) , STAT=ierr(1) )
-#elif defined key_traldf_c2d
-      ALLOCATE( ahtt(jpi,jpj    ) , ahtu(jpi,jpj    ) , ahtv(jpi,jpj    ) , ahtw(jpi,jpj    ) , STAT=ierr(1) )
-#elif defined key_traldf_c1d
-      ALLOCATE( ahtt(        jpk) , ahtu(        jpk) , ahtv(        jpk) , ahtw(        jpk) , STAT=ierr(1) )
-#endif
-      !
-#if defined key_traldf_eiv
-# if defined key_traldf_c3d
-      ALLOCATE( aeiu(jpi,jpj,jpk) , aeiv(jpi,jpj,jpk) , aeiw(jpi,jpj,jpk) , STAT=ierr(2) )
-# elif defined key_traldf_c2d
-      ALLOCATE( aeiu(jpi,jpj    ) , aeiv(jpi,jpj    ) , aeiw(jpi,jpj    ) , STAT=ierr(2) )
-# elif defined key_traldf_c1d
-      ALLOCATE( aeiu(        jpk) , aeiv(        jpk) , aeiw(        jpk) , STAT=ierr(2) )
-# endif
-# if defined key_diaeiv
-      ALLOCATE( u_eiv(jpi,jpj,jpk), v_eiv(jpi,jpj,jpk), w_eiv(jpi,jpj,jpk), STAT=ierr(3))
-# endif
-#endif
-      ldftra_oce_alloc = MAXVAL( ierr )
-      IF( ldftra_oce_alloc /= 0 )   CALL ctl_warn('ldftra_oce_alloc: failed to allocate arrays')
-      !
-   END FUNCTION ldftra_oce_alloc
-
-   !!=====================================================================
-END MODULE ldftra_oce
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90	(revision 5891)
+++ 	(revision )
@@ -1,210 +1,0 @@
-MODULE ldftra_smag
-   !!======================================================================
-   !!                     ***  MODULE  ldftrasmag  ***
-   !! Ocean physics:  variable eddy induced velocity coefficients
-   !!======================================================================
-#if   defined key_traldf_smag   &&   defined key_traldf_c3d
-   !!----------------------------------------------------------------------
-   !!   'key_traldf_smag'      and           smagorinsky  diffusivity
-   !!   'key_traldf_c3d'                    3D tracer lateral  mixing coef.
-   !!----------------------------------------------------------------------
-   !!   ldf_eiv      : compute the eddy induced velocity coefficients
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE sbcrnf          ! river runoffs
-   USE ldftra_oce      ! ocean tracer   lateral physics
-   USE phycst          ! physical constants
-   USE ldfslp          ! iso-neutral slopes
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE iom
-   USE wrk_nemo
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC ldf_tra_smag               ! routine called by step.F90
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
- 
-
-
-
-  !!----------------------------------------------------------------------
-  !!                        ***  ldf_tra_smag.F90  ***
-  !!----------------------------------------------------------------------
-
-
-   SUBROUTINE ldf_tra_smag( kt )
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_tra_smag  ***
-      !!                   
-      !! ** Purpose :   initializations of the horizontal ocean physics
-      !!
-      !! ** Method  :   3D eddy viscosity coef. 
-      !!    M.Griffies, R.Hallberg AMS, 2000
-      !!  for laplacian:
-      !!   Asmag=(C/pi)^2*dx*dy sqrt(D^2), C=1 for tracers, C=3-4 for viscosity
-      !!   D^2= rm_smsh*(du/dx-dv/dy)^2+(dv/dx+du/dy)^2 for Cartesian coordinates
-      !!  IF rm_smsh = 0 , only shear is used, recommended for tidal flows
-      !!  in general case du/dx ==> e2 d(u/e2)/dx;  du/dy ==> e1 d(u/e1)/dy; 
-      !!                  dv/dx ==> e2 d(v/e2)/dx;  dv/dy ==> e1 d(v/e1)/dy
-      !!  for bilaplacian: now this option is deleted as unstable or non-conservative
-      !!   - delta{Bsmag (delta(T)} = -Bsmag* delta{delta(T)} - delta(Bsmag)*delta( T )
-      !!  second term is of arbitrary sign on the edge of fronts and can induce instability 
-      !!   Bsmag=Asmag*dx*dy/8
-      !!  
-      !!       laplacian operator   : ahm1, ahm2 defined at T- and F-points
-      !!                              ahm3, ahm4 never used
-      !!       bilaplacian operator : ahm1, ahm2 never used
-      !!                           :  ahm3, ahm4 defined at U- and V-points
-      !!       ??? explanation of the default is missing
-      !!  last modified : Maria Luneva, October 2012
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE ioipsl
-      REAL ( wp), POINTER , DIMENSION (:,:) :: zux, zvx , zuy , zvy 
-      REAL ( wp), POINTER , DIMENSION (:,:) :: zue1, zue2 , zve1 , zve2 
-      INTEGER, INTENT( in )                 ::   kt                             ! ocean time-step inedx
-      !! * Arguments
-      INTEGER                               :: ji,jj,jk
-
-      REAL (wp)                             ::     zdeltau, zdeltav, zhsmag ,zsmsh    ! temporary scalars
-      
-      CALL wrk_alloc (jpi,jpj,zux, zvx , zuy , zvy )
-      CALL wrk_alloc (jpi,jpj,zue1, zue2 , zve1 , zve2 )
-      !!----------------------------------------------------------------------
-      IF(  kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' ldf_tra_smag : 3D eddy smagorinsky diffusivity '
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  '
-         IF(lwp) WRITE(numout,*) '               Coefficients are computed'
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*)
-      ENDIF
-
-      zhsmag = rn_chsmag
-      zsmsh  = rn_smsh 
-      zux(:,:)=0._wp ; zuy(:,:)=0._wp ; zvx(:,:)=0._wp ; zvy(:,:)=0._wp
-
-      ! -------------------
-      ahtt(:,:,:) = rn_aht_0
-       IF( ln_traldf_bilap ) THEN
-        IF( lwp .AND. kt == nit000) WRITE(numout,* )'ldf_tra_smag :no bilaplacian Smagorinsky diffusivity'
-        IF( lwp .AND. kt == nit000) WRITE(numout,* )'ldf_tra_smag :bilaplacian diffusivity set to constant'  
-       ENDIF
-
-
-
-      ! harmonic operator   (U-, V-, W-points)
-      ! ----------------- 
-
-      ahtu(:,:,:) = rn_aht_0                  ! set ahtu , ahtv at u- and v-points,
-      ahtv(:,:,:) = rn_aht_0                  ! and ahtw at w-point
-      ahtw(:,:,:) = rn_aht_0                  ! (here example: no space variation)
-      
-      IF( ln_traldf_lap ) THEN
-
-         DO jk=1,jpk
-
-           zue2(:,:)=un(:,:,jk)/e2u(:,:)
-           zve1(:,:)=vn(:,:,jk)/e1v(:,:)
-           zue1(:,:)=un(:,:,jk)/e1u(:,:)
-           zve2(:,:)=vn(:,:,jk)/e2v(:,:)
-
-
-           DO jj=2,jpj
-            DO ji=2,jpi
-            zux(ji,jj)=(zue2(ji,jj)-zue2(ji-1,jj))/e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) * zsmsh 
-            zvy(ji,jj)=(zve1(ji,jj)-zve1(ji,jj-1))/e2t(ji,jj)*e1t(ji,jj)*tmask(ji,jj,jk) * zsmsh 
-            ENDDO
-           ENDDO
-
-           DO jj=1,jpjm1
-            DO ji=1,jpim1
-            zuy(ji,jj)=(zue1(ji,jj+1)-zue1(ji,jj))/e2f(ji,jj)*e1f(ji,jj)*fmask(ji,jj,jk)
-            zvx(ji,jj)=(zve2(ji+1,jj)-zve2(ji,jj))/e1f(ji,jj)*e2f(ji,jj)*fmask(ji,jj,jk)
-            ENDDO
-           ENDDO
-
-
-          DO jj=2,jpjm1
-           DO ji=2,jpim1
-           zdeltau=2._wp/( e1u(ji,jj)**(-2)+e2u(ji,jj)**(-2) )
-           zdeltav=2._wp/( e1v(ji,jj)**(-2)+e2v(ji,jj)**(-2) )
-
-           ahtu(ji,jj,jk)=MAX( rn_aht_0 , (zhsmag/rpi)**2*zdeltau*                                &
-                          SQRT(0.25_wp*( zux(ji,jj)+zux(ji+1,jj)-zvy(ji,jj)-zvy(ji+1,jj) )**2+    &
-                               0.25_wp*( zuy(ji,jj)+zuy(ji,jj-1)+zvx(ji,jj)+zvx(ji,jj-1)  )**2) )
-
-           ahtv(ji,jj,jk)=MAX( rn_aht_0 ,  (zhsmag/rpi)**2*zdeltav*                               &
-                          SQRT(0.25_wp*( zux(ji,jj)+zux(ji,jj+1)-zvy(ji,jj)-zvy(ji,jj+1) )**2+    &
-                               0.25_wp*( zuy(ji,jj)+zuy(ji-1,jj)+zvx(ji-1,jj)+zvx(ji,jj)  )**2) )
-
-
-         !!! stability criteria: aht<delta**2/(4*dt)   dt=2*rdt , positiveness require aht<delta**2/(8*dt)
-             ahtu(ji,jj,jk)=MIN(ahtu(ji,jj,jk),zdeltau/(16*rdt) ,rn_aht_m)
-             ahtv(ji,jj,jk)=MIN(ahtv(ji,jj,jk),zdeltav/(16*rdt) ,rn_aht_m)
-         ! so...
-
-
-            ENDDO
-           ENDDO
-         ENDDO
-        ENDIF
-            ahtu(:,:,jpk) = ahtu(:,:,jpkm1)
-            ahtv(:,:,jpk) = ahtv(:,:,jpkm1)
-        CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions
-        CALL lbc_lnk( ahtv, 'V', 1. )
-
-IF(  kt == nit000 ) THEN
-
-      IF(lwp ) THEN                    ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtu at k = 1'
-         CALL prihre( ahtu(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-1, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtv at k = 1'
-         CALL prihre( ahtv(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-1, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtw at k = 1'
-         CALL prihre( ahtw(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-1, numout )
-      ENDIF
-ENDIF
-
-      CALL wrk_dealloc ( jpi,jpj,zux, zvx , zuy , zvy     )
-      CALL wrk_dealloc ( jpi,jpj,zue1, zue2 , zve1 , zve2 )
-
-
-END SUBROUTINE ldf_tra_smag
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Dummy module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE ldf_tra_smag( kt )       ! Empty routine
-      WRITE(*,*) 'ldf_dyn_smag: You should not have seen this print! error? check keys ldf:c3d+smag', kt
-   END SUBROUTINE ldf_tra_smag
-#endif
-
-END MODULE ldftra_smag
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90	(revision 5891)
+++ 	(revision )
@@ -1,36 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                    *** ldftra_substitute.h90  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute fsaht. the eddy diffusivity coeff.
-   !!      with a constant or 1D or 2D or 3D array, using CPP macro.
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-#if defined key_traldf_c3d
-!   'key_traldf_c3d' :                 aht: 3D coefficient
-#       define   fsahtt(i,j,k)   rldf * ahtt(i,j,k)
-#       define   fsahtu(i,j,k)   rldf * ahtu(i,j,k)
-#       define   fsahtv(i,j,k)   rldf * ahtv(i,j,k)
-#       define   fsahtw(i,j,k)   rldf * ahtw(i,j,k)
-#elif defined key_traldf_c2d
-!   'key_traldf_c2d' :                 aht: 2D coefficient
-#       define   fsahtt(i,j,k)   rldf * ahtt(i,j)
-#       define   fsahtu(i,j,k)   rldf * ahtu(i,j)
-#       define   fsahtv(i,j,k)   rldf * ahtv(i,j)
-#       define   fsahtw(i,j,k)   rldf * ahtw(i,j)
-#elif defined key_traldf_c1d
-!   'key_traldf_c1d' :                aht: 1D coefficient
-#       define   fsahtt(i,j,k)   rldf * ahtt(k)
-#       define   fsahtu(i,j,k)   rldf * ahtu(k)
-#       define   fsahtv(i,j,k)   rldf * ahtv(k)
-#       define   fsahtw(i,j,k)   rldf * ahtw(k)
-#else
-!   Default option :             aht: Constant coefficient
-#      define   fsahtt(i,j,k)   rldf * aht0
-#      define   fsahtu(i,j,k)   rldf * aht0
-#      define   fsahtv(i,j,k)   rldf * aht0
-#      define   fsahtw(i,j,k)   rldf * aht0
-#endif
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 5901)
@@ -24,5 +24,5 @@
    USE lib_mpp          ! MPP library
    USE dom_oce, ONLY : &                  ! Domain variables
-      &                    tmask, tmask_i, e1t, e2t, gphit, glamt
+      &                    tmask, tmask_i, e1e2t, gphit, glamt
    USE obs_const, ONLY :   obfillflt      ! Fillvalue
    USE oce      , ONLY :   sshn           ! Model variables
@@ -220,5 +220,5 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-          zdxdy = e1t(ji,jj) * e2t(ji,jj) * zpromsk(ji,jj)
+          zdxdy = e1e2t(ji,jj) * zpromsk(ji,jj)
           zarea = zarea + zdxdy
           zeta1 = zeta1 + mdt(ji,jj) * zdxdy
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 5901)
@@ -4,14 +4,15 @@
    !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT
    !!=====================================================================
-   !! History :   
-   !!   9.0  !  04-06  (R. Redler, NEC Laboratories Europe, Germany) Original code
-   !!   " "  !  04-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision
-   !!   " "  !  04-11  (V. Gayler, MPI M&D) Grid writing
-   !!   " "  !  05-08  (R. Redler, W. Park) frld initialization, paral(2) revision
-   !!   " "  !  05-09  (R. Redler) extended to allow for communication over root only
-   !!   " "  !  06-01  (W. Park) modification of physical part
-   !!   " "  !  06-02  (R. Redler, W. Park) buffer array fix for root exchange
-   !!   3.4  !  11-11  (C. Harris) Changes to allow mutiple category fields
-   !!----------------------------------------------------------------------
+   !! History :  1.0  !  2004-06  (R. Redler, NEC Laboratories Europe, Germany) Original code
+   !!             -   !  2004-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision
+   !!             -   !  2004-11  (V. Gayler, MPI M&D) Grid writing
+   !!            2.0  !  2005-08  (R. Redler, W. Park) frld initialization, paral(2) revision
+   !!             -   !  2005-09  (R. Redler) extended to allow for communication over root only
+   !!             -   !  2006-01  (W. Park) modification of physical part
+   !!             -   !  2006-02  (R. Redler, W. Park) buffer array fix for root exchange
+   !!            3.4  !  2011-11  (C. Harris) Changes to allow mutiple category fields
+   !!            3.6  !  2014-11  (S. Masson) OASIS3-MCT
+   !!----------------------------------------------------------------------
+   
    !!----------------------------------------------------------------------
    !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3-MCT
@@ -20,6 +21,6 @@
    !!   cpl_init     : initialization of coupled mode communication
    !!   cpl_define   : definition of grid and fields
-   !!   cpl_snd     : snd out fields in coupled mode
-   !!   cpl_rcv     : receive fields in coupled mode
+   !!   cpl_snd      : snd out fields in coupled mode
+   !!   cpl_rcv      : receive fields in coupled mode
    !!   cpl_finalize : finalize the coupled mode communication
    !!----------------------------------------------------------------------
@@ -99,6 +100,6 @@
       !! ** Method  :   OASIS3 MPI communication 
       !!--------------------------------------------------------------------
-      CHARACTER(len = *), INTENT(in) ::   cd_modname   ! model name as set in namcouple file
-      INTEGER          , INTENT(out) ::   kl_comm      ! local communicator of the model
+      CHARACTER(len = *), INTENT(in   ) ::   cd_modname   ! model name as set in namcouple file
+      INTEGER           , INTENT(  out) ::   kl_comm      ! local communicator of the model
       !!--------------------------------------------------------------------
 
@@ -163,5 +164,4 @@
          CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld')   ;   RETURN
       ENDIF
-
       !
       ! ... Define the shape for the area that excludes the halo
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 5901)
@@ -195,5 +195,4 @@
 
       DO jj = 2, jpjm1
-!CDIR NOVERRCHK
          DO ji = fs_2, jpi   ! vector opt.
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 5901)
@@ -80,5 +80,4 @@
    INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk                     formulation
    INTEGER , PUBLIC, PARAMETER ::   jp_none    = 7        !: for OPA when doing coupling via SAS module
-   INTEGER , PUBLIC, PARAMETER ::   jp_esopa   = -1       !: esopa test, ALL formulations
    
    !!----------------------------------------------------------------------
@@ -200,7 +199,5 @@
       !!---------------------------------------------------------------------
       zcoef = 0.5 / ( zrhoa * zcdrag ) 
-!CDIR NOVERRCHK
       DO jj = 2, jpjm1
-!CDIR NOVERRCHK
          DO ji = fs_2, fs_jpim1   ! vect. opt.
             ztx = utau(ji-1,jj  ) + utau(ji,jj) 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90	(revision 5901)
@@ -279,7 +279,5 @@
       ! module of wind stress and wind speed at T-point
       zcoef = 1. / ( zrhoa * zcdrag ) 
-!CDIR NOVERRCHK
       DO jj = 2, jpjm1
-!CDIR NOVERRCHK
          DO ji = fs_2, fs_jpim1   ! vect. opt.
             ztx = utau(ji-1,jj  ) + utau(ji,jj) 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 5901)
@@ -62,5 +62,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in)::   kt   ! ocean time step
-      !!
+      !
       INTEGER            ::   ierror  ! local integer 
       INTEGER            ::   ios     ! Local integer output status for namelist read
@@ -71,5 +71,4 @@
       NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc
       !!----------------------------------------------------------------------
-      !
       !
       !                                         ! -------------------- !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 5901)
@@ -243,7 +243,5 @@
       !   momentum fluxes  (utau, vtau )   !
       !------------------------------------!
-!CDIR COLLAPSE
       utau(:,:) = sf(jp_utau)%fnow(:,:,1)
-!CDIR COLLAPSE
       vtau(:,:) = sf(jp_vtau)%fnow(:,:,1)
 
@@ -251,7 +249,5 @@
       !   wind stress module (taum )       !
       !------------------------------------!
-!CDIR NOVERRCHK
       DO jj = 2, jpjm1
-!CDIR NOVERRCHK
          DO ji = fs_2, fs_jpim1   ! vector opt.
             ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
@@ -268,5 +264,4 @@
       !   store the wind speed  (wndm )    !
       !------------------------------------!
-!CDIR COLLAPSE
       wndm(:,:) = sf(jp_wndm)%fnow(:,:,1)
       wndm(:,:) = wndm(:,:) * tmask(:,:,1)
@@ -281,8 +276,5 @@
       !   Other ocean fluxes   !
       !------------------------!
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             !
@@ -375,9 +367,7 @@
       zcprec = rcp /  rday     ! convert prec ( mm/day ==> m/s)  ==> W/m2
 
-!CDIR COLLAPSE
       emp(:,:) = zqla(:,:) / cevap                                        &   ! freshwater flux
          &     - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1)
       !
-!CDIR COLLAPSE
       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                        &   ! Downward Non Solar flux
          &     - zqla(:,:)             * pst(:,:) * zcevap                &   ! remove evap.   heat content at SST in Celcius
@@ -415,4 +405,5 @@
 
 # if defined key_lim2 || defined key_lim3
+
    SUBROUTINE blk_ice_clio_tau
       !!---------------------------------------------------------------------------
@@ -429,15 +420,15 @@
       !
       IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_tau')
-
+      !
       SELECT CASE( cp_ice_msh )
-
+      !
       CASE( 'C' )                          ! C-grid ice dynamics
-
+         !
          zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress
          utau_ice(:,:) = zcoef * utau(:,:)
          vtau_ice(:,:) = zcoef * vtau(:,:)
-
+         !
       CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner)
-
+         !
          zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress
          DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point
@@ -447,19 +438,21 @@
             END DO
          END DO
-
+         !
          CALL lbc_lnk( utau_ice(:,:), 'I', -1. )   ;   CALL lbc_lnk( vtau_ice(:,:), 'I', -1. )   ! I-point
-
+         !
       END SELECT
-
+      !
       IF(ln_ctl) THEN
          CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ')
       ENDIF
-
+      !
       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_tau')
-
+      !
    END SUBROUTINE blk_ice_clio_tau
+   
 #endif
 
 # if defined key_lim2 || defined key_lim3
+
    SUBROUTINE blk_ice_clio_flx(  ptsu , palb_cs, palb_os, palb )
       !!---------------------------------------------------------------------------
@@ -520,8 +513,5 @@
       !--------------------------------------------------------------------------------
 
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1)                ! air temperature in Kelvins 
@@ -573,10 +563,7 @@
 
       !                                     ! ========================== !
-      DO jl = 1, jpl                       !  Loop over ice categories  !
+      DO jl = 1, jpl                        !  Loop over ice categories  !
          !                                  ! ========================== !
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
          DO jj = 1 , jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                !-------------------------------------------!
@@ -636,7 +623,5 @@
       ! ----------------------------------------------------------------------------- !
       !
-!CDIR COLLAPSE
       qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:)      ! Downward Non Solar flux
-!CDIR COLLAPSE
       tprecip(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s]
       !
@@ -644,5 +629,4 @@
       !    Correct the OCEAN non solar flux with the existence of solid precipitation !
       ! ---------------=====--------------------------------------------------------- !
-!CDIR COLLAPSE
       qns(:,:) = qns(:,:)                                                           &   ! update the non-solar heat flux with:
          &     - sprecip(:,:) * lfus                                                  &   ! remove melting solid precip
@@ -782,8 +766,5 @@
       ! Saturated water vapour and vapour pressure
       ! ------------------------------------------
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt
@@ -814,7 +795,5 @@
       zdaycor  = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist )
 
-!CDIR NOVERRCHK
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             !  product of sine (cosine) of latitude and sine (cosine) of solar declination
@@ -837,11 +816,7 @@
 
       ! compute and sum ocean qsr over the daylight (i.e. between sunrise and sunset)
-!CDIR NOVERRCHK   
       DO jt = 1, jp24
          zcoef = FLOAT( jt ) - 0.5
-!CDIR NOVERRCHK     
-!CDIR COLLAPSE
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                zlha = COS(  zlsrise(ji,jj) - zcoef * zdlha(ji,jj)  )                  ! local hour angle
@@ -862,5 +837,4 @@
       ! Taking into account the ellipsity of the earth orbit, the clouds AND masked if sea-ice cover > 0%
       zcoef1 = srgamma * zdaycor / ( 2. * rpi )
-!CDIR COLLAPSE
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -920,8 +894,5 @@
       ! Saturated water vapour and vapour pressure
       ! ------------------------------------------
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi           
             ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt           
@@ -952,7 +923,5 @@
       zdaycor  = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist )
 
-!CDIR NOVERRCHK
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             !  product of sine (cosine) of latitude and sine (cosine) of solar declination
@@ -979,11 +948,7 @@
       DO jl = 1, ijpl      !  loop over ice categories  !
          !                 !----------------------------! 
-!CDIR NOVERRCHK   
          DO jt = 1, jp24   
             zcoef = FLOAT( jt ) - 0.5
-!CDIR NOVERRCHK     
-!CDIR COLLAPSE
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   zlha = COS(  zlsrise(ji,jj) - zcoef * zdlha(ji,jj)  )                  ! local hour angle
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90	(revision 5901)
@@ -251,7 +251,5 @@
          ! for basin budget and cooerence
          !--------------------------------------------------
-!CDIR COLLAPSE
-           emp (:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1)
-!CDIR COLLAPSE
+         emp(:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1)
 
          CALL iom_put( "qlw_oce",   qbw  )                 ! output downward longwave heat over the ocean
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 5901)
@@ -931,7 +931,5 @@
          ! => need to be done only when otx1 was changed
          IF( llnewtx ) THEN
-!CDIR NOVERRCHK
             DO jj = 2, jpjm1
-!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1   ! vect. opt.
                   zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
@@ -961,7 +959,5 @@
          IF( llnewtau ) THEN 
             zcoef = 1. / ( zrhoa * zcdrag ) 
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi 
                   frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 5901)
@@ -131,5 +131,4 @@
          ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)
          ENDIF
-!CDIR COLLAPSE
          DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
             DO ji = 1, jpi
@@ -145,7 +144,5 @@
          !                                                        ! module of wind stress and wind speed at T-point
          zcoef = 1. / ( zrhoa * zcdrag )
-!CDIR NOVERRCHK
          DO jj = 2, jpjm1
-!CDIR NOVERRCHK
             DO ji = fs_2, fs_jpim1   ! vect. opt.
                ztx = utau(ji-1,jj  ) + utau(ji,jj) 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 5901)
@@ -108,5 +108,5 @@
          !
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) -  snwice_fmass(:,:) ) ) / area   ! sum over the global domain
+            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area   ! sum over the global domain
             zcoef = z_fwf * rcp
             emp(:,:) = emp(:,:) - z_fwf              * tmask(:,:,1)
@@ -162,5 +162,5 @@
             zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) )
             !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges) 
-            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
+            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
             !            
             IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 5901)
@@ -67,5 +67,4 @@
    PRIVATE
 
-   !! * Routine accessibility
    PUBLIC cice_sbc_init   ! routine called by sbc_init
    PUBLIC cice_sbc_final  ! routine called by sbc_final
@@ -95,6 +94,9 @@
    !! * Substitutions
 #  include "domzgr_substitute.h90"
-
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO-consortium (2015) 
    !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -154,9 +156,11 @@
    END SUBROUTINE sbc_ice_cice
 
-   SUBROUTINE cice_sbc_init (ksbc)
+
+   SUBROUTINE cice_sbc_init( ksbc )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_init  ***
       !! ** Purpose: Initialise ice related fields for NEMO and coupling
       !!
+      !!---------------------------------------------------------------------
       INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type
       REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2
@@ -289,5 +293,5 @@
 
    
-   SUBROUTINE cice_sbc_in (kt, ksbc)
+   SUBROUTINE cice_sbc_in( kt, ksbc )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_in  ***
@@ -296,5 +300,5 @@
       INTEGER, INTENT(in   ) ::   kt   ! ocean time step
       INTEGER, INTENT(in   ) ::   ksbc ! surface forcing type
-
+      !
       INTEGER  ::   ji, jj, jl                   ! dummy loop indices      
       REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice
@@ -490,21 +494,19 @@
 ! x comp and y comp of sea surface slope (on F points)
 ! T point to F point
-      DO jj=1,jpjm1
-         DO ji=1,jpim1
-            ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  ))/e1u(ji,jj  )   &
-                               + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) & 
-                            *  fmask(ji,jj,1)
-         ENDDO
-      ENDDO
-      CALL nemo2cice(ztmp,ss_tltx,'F', -1. )
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  )) * r1_e1u(ji,jj  )    &
+               &               + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1)  ) * fmask(ji,jj,1)
+         END DO
+      END DO
+      CALL nemo2cice( ztmp,ss_tltx,'F', -1. )
 
 ! T point to F point
-      DO jj=1,jpjm1
-         DO ji=1,jpim1
-            ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj))/e2v(ji  ,jj)   &
-                               + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) &
-                            *  fmask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj)) * r1_e2v(ji  ,jj)    &
+               &               + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj)  ) *  fmask(ji,jj,1)
+         END DO
+      END DO
       CALL nemo2cice(ztmp,ss_tlty,'F', -1. )
 
@@ -517,5 +519,5 @@
 
 
-   SUBROUTINE cice_sbc_out (kt,ksbc)
+   SUBROUTINE cice_sbc_out( kt, ksbc )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_out  ***
@@ -575,5 +577,5 @@
 ! Update taum with modulus of ice-ocean stress 
 ! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here 
-taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1**2. + ztmp2**2.) 
+taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1*ztmp1 + ztmp2*ztmp2) 
 
 ! Freshwater fluxes 
@@ -888,5 +890,4 @@
 #endif
       !!---------------------------------------------------------------------
-
       CHARACTER(len=1), INTENT( in ) ::   &
           cd_type       ! nature of pn grid-point
@@ -908,4 +909,5 @@
 
       INTEGER  ::   ji, jj, jn                      ! dummy loop indices
+      !!---------------------------------------------------------------------
 
 !     A. Ensure all haloes are filled in NEMO field (pn)
@@ -1096,5 +1098,4 @@
    !!   Default option           Dummy module         NO CICE sea-ice model
    !!----------------------------------------------------------------------
-   !! $Id$
 CONTAINS
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 5901)
@@ -18,19 +18,18 @@
    USE eosbn2          ! equation of state
    USE sbc_oce         ! surface boundary condition: ocean fields
+   USE zdfbfr          !
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager library
+   USE fldread         ! read input field at current time step
    USE lbclnk          !
-   USE iom             ! I/O manager library
-   USE in_out_manager  ! I/O manager
    USE wrk_nemo        ! Memory allocation
    USE timing          ! Timing
    USE lib_fortran     ! glob_sum
-   USE zdfbfr
-   USE fldread         ! read input field at current time step
-
-
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   sbc_isf, sbc_isf_div, sbc_isf_alloc  ! routine called in sbcmod and divcur
+   PUBLIC   sbc_isf, sbc_isf_div, sbc_isf_alloc  ! routine called in sbcmod and divhor
 
    ! public in order to be able to output then 
@@ -53,12 +52,5 @@
    REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  risfLeff               !:effective length (Leff) BG03 nn_isf==2
    REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point
-#if defined key_agrif
-   ! AGRIF can not handle these arrays as integers. The reason is a mystery but problems avoided by declaring them as reals
-   REAL(wp),    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base
-                                                                                          !: (first wet level and last level include in the tbl)
-#else
    INTEGER,    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base
-#endif
-
 
    REAL(wp), PUBLIC, SAVE ::   rcpi   = 2000.0_wp     ! phycst ?
@@ -79,26 +71,29 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)
+   !! NEMO/OPA 3.7 , LOCEAN-IPSL (2015)
    !! $Id$
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
  
-  SUBROUTINE sbc_isf(kt)
-    INTEGER, INTENT(in)          ::   kt         ! ocean time step
-    INTEGER                      ::   ji, jj, jk, ijkmin, inum, ierror
-    INTEGER                      ::   ikt, ikb   ! top and bottom level of the isf boundary layer
-    REAL(wp)                     ::   rmin
-    REAL(wp)                     ::   zhk
-    CHARACTER(len=256)           ::   cfisf, cvarzisf, cvarhisf   ! name for isf file
-    CHARACTER(LEN=256)           :: cnameis                     ! name of iceshelf file
-    CHARACTER (LEN=32)           :: cvarLeff                    ! variable name for efficient Length scale
-    INTEGER           ::   ios           ! Local integer output status for namelist read
-      !
+   SUBROUTINE sbc_isf(kt)
       !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_isf  ***
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)          ::   kt         ! ocean time step
+      !
+      INTEGER                      ::   ji, jj, jk, ijkmin, inum, ierror
+      INTEGER                      ::   ikt, ikb   ! top and bottom level of the isf boundary layer
+      REAL(wp)                     ::   rmin
+      REAL(wp)                     ::   zhk
+      REAL(wp)                     ::   zt_frz, zpress
+      CHARACTER(len=256)           ::   cfisf , cvarzisf, cvarhisf   ! name for isf file
+      CHARACTER(LEN=256)           :: cnameis                     ! name of iceshelf file
+      CHARACTER (LEN=32)           :: cvarLeff                    ! variable name for efficient Length scale
+      INTEGER           ::   ios           ! Local integer output status for namelist read
+      !!
       NAMELIST/namsbc_isf/ nn_isfblk, rn_hisf_tbl, ln_divisf, ln_conserve, rn_gammat0, rn_gammas0, nn_gammablk, &
-                         & sn_fwfisf, sn_qisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf
-      !
+         &                 sn_fwfisf, sn_qisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf
+      !!---------------------------------------------------------------------
       !
       !                                         ! ====================== !
@@ -113,5 +108,4 @@
 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist', lwp )
          IF(lwm) WRITE ( numond, namsbc_isf )
-
 
          IF ( lwp ) WRITE(numout,*)
@@ -194,7 +188,6 @@
          END IF
          
+         ! compute bottom level of isf tbl and thickness of tbl below the ice shelf
          rhisf_tbl_0(:,:) = rhisf_tbl(:,:)
-
-         ! compute bottom level of isf tbl and thickness of tbl below the ice shelf
          DO jj = 1,jpj
             DO ji = 1,jpi
@@ -217,5 +210,5 @@
             END DO
          END DO
-         
+         !
       END IF
 
@@ -270,10 +263,19 @@
          END IF
          ! compute tsc due to isf
-         ! WARNING water add at temp = 0C, correction term is added in trasbc, maybe better here but need a 3D variable).
-         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp !
+         ! WARNING water add at temp = 0C, correction term is added, maybe better here but need a 3D variable).
+!         zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04
+         zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress )
+         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - rdivisf * fwfisf(:,:) * zt_frz * r1_rau0 !
          
          ! salt effect already take into account in vertical advection
          risf_tsc(:,:,jp_sal) = (1.0_wp-rdivisf) * fwfisf(:,:) * stbl(:,:) * r1_rau0
-          
+
+         ! output
+         IF( iom_use('qisf'  ) )   CALL iom_put('qisf'  , qisf)
+         IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )
+
+         ! if apply only on the trend and not as a volume flux (rdivisf = 0), fwfisf have to be set to 0 now
+         fwfisf(:,:) = rdivisf * fwfisf(:,:)         
+ 
          ! lbclnk
          CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.)
@@ -295,10 +297,8 @@
          ENDIF
          ! 
-         ! output
-         CALL iom_put('qisf'  , qisf)
-         IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )
       END IF
-  
+      !  
   END SUBROUTINE sbc_isf
+
 
   INTEGER FUNCTION sbc_isf_alloc()
@@ -321,26 +321,26 @@
   END FUNCTION
 
-  SUBROUTINE sbc_isf_bg03(kt)
-   !!==========================================================================
-   !!                 *** SUBROUTINE sbcisf_bg03  ***
-   !! add net heat and fresh water flux from ice shelf melting
-   !! into the adjacent ocean using the parameterisation by
-   !! Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean
-   !!     interaction for climate models", Ocean Modelling 5(2003) 157-170.
-   !!  (hereafter BG)
-   !!==========================================================================
-   !!----------------------------------------------------------------------
-   !!   sbc_isf_bg03      : routine called from sbcmod
-   !!----------------------------------------------------------------------
-   !!
-   !! ** Purpose   :   Add heat and fresh water fluxes due to ice shelf melting
-   !! ** Reference :   Beckmann et Goosse, 2003, Ocean Modelling
-   !!
-   !! History :
-   !!      !  06-02  (C. Wang) Original code
-   !!----------------------------------------------------------------------
-
-    INTEGER, INTENT ( in ) :: kt
-
+
+   SUBROUTINE sbc_isf_bg03(kt)
+      !!==========================================================================
+      !!                 *** SUBROUTINE sbcisf_bg03  ***
+      !! add net heat and fresh water flux from ice shelf melting
+      !! into the adjacent ocean using the parameterisation by
+      !! Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean
+      !!     interaction for climate models", Ocean Modelling 5(2003) 157-170.
+      !!  (hereafter BG)
+      !!==========================================================================
+      !!----------------------------------------------------------------------
+      !!   sbc_isf_bg03      : routine called from sbcmod
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose   :   Add heat and fresh water fluxes due to ice shelf melting
+      !! ** Reference :   Beckmann et Goosse, 2003, Ocean Modelling
+      !!
+      !! History :
+      !!      !  06-02  (C. Wang) Original code
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT ( in ) :: kt
+      !
     INTEGER :: ji, jj, jk, jish  !temporary integer
     INTEGER :: ijkmin
@@ -386,9 +386,11 @@
              qisf(ji,jj) = 0._wp ; fwfisf(ji,jj) = 0._wp
           END IF
-       ENDDO
-    ENDDO
+       END DO
+    END DO
     !
     IF( nn_timing == 1 )  CALL timing_stop('sbc_isf_bg03')
+      !
   END SUBROUTINE sbc_isf_bg03
+
 
    SUBROUTINE sbc_isf_cav( kt )
@@ -439,5 +441,4 @@
       !
       !
-!CDIR COLLAPSE
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -472,9 +473,6 @@
 
                      nit = nit + 1
-                     IF (nit .GE. 100) THEN
-                        !WRITE(numout,*) "sbcisf : too many iteration ... ", zhtflx, zhtflx_b,zgammat, rn_gammat0, rn_tfri2, nn_gammablk, ji,jj
-                        !WRITE(numout,*) "sbcisf : too many iteration ... ", (zhtflx - zhtflx_b)/zhtflx
-                        CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' )
-                     END IF
+                     IF (nit .GE. 100) CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' )
+
 ! save gammat and compute zhtflx_b
                      zgammat2d(ji,jj)=zgammat
@@ -496,5 +494,4 @@
 
 ! More complicated 3 equation thermodynamics as in MITgcm
-!CDIR COLLAPSE
          DO jj = 2, jpj
             DO ji = 2, jpi
@@ -565,6 +562,7 @@
       !
       IF( nn_timing == 1 )  CALL timing_stop('sbc_isf_cav')
-
+      !
    END SUBROUTINE sbc_isf_cav
+
 
    SUBROUTINE sbc_isf_gammats(gt, gs, zqhisf, zqwisf, ji, jj, lit )
@@ -693,6 +691,7 @@
                END IF
       END IF
-
+      !
    END SUBROUTINE
+
 
    SUBROUTINE sbc_isf_tbl( varin, varout, cptin )
@@ -756,5 +755,5 @@
       IF (cptin == 'T') CALL lbc_lnk(varout,'T',1.)
       IF (cptin == 'U' .OR. cptin == 'V') CALL lbc_lnk(varout,'T',-1.)
-
+      !
    END SUBROUTINE sbc_isf_tbl
       
@@ -794,5 +793,5 @@
                ! test on tmask useless ?????
                DO jk = ikt, mbkt(ji,jj)
-!                  IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
+                  IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
                END DO
                rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
@@ -823,5 +822,6 @@
       !
    END SUBROUTINE sbc_isf_div
-                        
+
+
    FUNCTION tinsitu( ptem, psal, ppress ) RESULT( pti )
       !!----------------------------------------------------------------------
@@ -874,5 +874,6 @@
       !
    END FUNCTION tinsitu
-   !
+
+
    FUNCTION fsatg( pfps, pfpt, pfphp )
       !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 5901)
@@ -28,5 +28,4 @@
    USE sbcdcy           ! surface boundary condition: diurnal cycle
    USE sbcssm           ! surface boundary condition: sea-surface mean variables
-   USE sbcapr           ! surface boundary condition: atmospheric pressure
    USE sbcana           ! surface boundary condition: analytical formulation
    USE sbcflx           ! surface boundary condition: flux formulation
@@ -133,5 +132,5 @@
          WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl   = ', ln_mixcpl
          WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis    = ', lk_oasis
-         WRITE(numout,*) '              components of your executable              nn_components = ', nn_components
+         WRITE(numout,*) '              components of your executable            nn_components = ', nn_components
          WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx
          WRITE(numout,*) '           Misc. options of sbc : '
@@ -176,11 +175,11 @@
 
       !                              ! allocate sbc arrays
-      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' )
+      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'sbc_init : unable to allocate sbc_oce arrays' )
 
       !                          ! Checks:
       IF( nn_isf .EQ. 0 ) THEN                      ! variable initialisation if no ice shelf 
-         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
-         fwfisf  (:,:) = 0.0_wp
-         fwfisf_b(:,:) = 0.0_wp
+         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'sbc_init : unable to allocate sbc_isf arrays' )
+         fwfisf  (:,:)   = 0.0_wp ; fwfisf_b  (:,:)   = 0.0_wp
+         risf_tsc(:,:,:) = 0.0_wp ; risf_tsc_b(:,:,:) = 0.0_wp
          rdivisf       = 0.0_wp
       END IF
@@ -224,7 +223,7 @@
          ENDIF
       ELSE
-      IF ( ln_cdgw .OR. ln_sdw  )                                         & 
-         &   CALL ctl_stop('Not Activated Wave Module (ln_wave=F) but     &
-         & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ')
+      IF ( ln_cdgw .OR. ln_sdw  )                                                           & 
+         &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    &
+         &                  'with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ')
       ENDIF 
       !                          ! Choice of the Surface Boudary Condition (set nsbc)
@@ -241,16 +240,9 @@
       IF( nn_components == jp_iam_opa )   &
          &                  THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module
-      IF( lk_esopa        )            nsbc = jp_esopa                                       ! esopa test, ALL formulations
-      !
-      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '           E R R O R in setting the sbc, one and only one namelist/CPP key option '
-         WRITE(numout,*) '                     must be choosen. You choose ', icpt, ' option(s)'
-         WRITE(numout,*) '                     We stop'
-         nstop = nstop + 1
-      ENDIF
+      !
+      IF( icpt /= 1 )    CALL ctl_stop( 'sbc_init: choose ONE and only ONE sbc option' )
+      !
       IF(lwp) THEN
          WRITE(numout,*)
-         IF( nsbc == jp_esopa   )   WRITE(numout,*) '              ESOPA test All surface boundary conditions'
          IF( nsbc == jp_gyre    )   WRITE(numout,*) '              GYRE analytical formulation'
          IF( nsbc == jp_ana     )   WRITE(numout,*) '              analytical formulation'
@@ -267,10 +259,9 @@
       !
       IF( lk_oasis )   CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step
-      !                                                     !                                            (2) the use of nn_fsbc
+      !                                             !                                            (2) the use of nn_fsbc
 
 !     nn_fsbc initialization if OPA-SAS coupling via OASIS
 !     sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
       IF ( nn_components /= jp_iam_nemo ) THEN
-
          IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt)
          IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt)
@@ -344,9 +335,4 @@
       !                                            !        forcing field computation         !
       !                                            ! ---------------------------------------- !
-      !
-      IF ( .NOT. lk_bdy ) then
-         IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc
-      ENDIF
-                                                         ! (caution called before sbc_ssm)
       !
       IF( nn_components /= jp_iam_sas )   CALL sbc_ssm( kt )   ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
@@ -373,11 +359,4 @@
          IF( nn_components == jp_iam_opa ) &
                              CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS
-      CASE( jp_esopa )                                
-                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations
-                             CALL sbc_gyre    ( kt )                    !
-                             CALL sbc_flx     ( kt )                    !
-                             CALL sbc_blk_clio( kt )                    !
-                             CALL sbc_blk_core( kt )                    !
-                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   !
       END SELECT
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 5901)
@@ -31,8 +31,9 @@
    PRIVATE
 
-   PUBLIC   sbc_rnf       ! routine call in sbcmod module
-   PUBLIC   sbc_rnf_div   ! routine called in divcurl module
-   PUBLIC   sbc_rnf_alloc ! routine call in sbcmod module
-   PUBLIC   sbc_rnf_init  ! (PUBLIC for TAM)
+   PUBLIC   sbc_rnf       ! routine called in sbcmod module
+   PUBLIC   sbc_rnf_div   ! routine called in divhor module
+   PUBLIC   sbc_rnf_alloc ! routine called in sbcmod module
+   PUBLIC   sbc_rnf_init  ! routine called in sbcmod module
+   
    !                                                     !!* namsbc_rnf namelist *
    CHARACTER(len=100)         ::   cn_dir          !: Root directory for location of rnf files
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 5901)
@@ -107,5 +107,4 @@
             IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx))
                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
-!CDIR COLLAPSE
                DO jj = 1, jpj
                   DO ji = 1, jpi
@@ -121,5 +120,4 @@
                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
                zerp_bnd = rn_sssr_bnd / rday                          !       -              -    
-!CDIR COLLAPSE
                DO jj = 1, jpj
                   DO ji = 1, jpi                            
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 5901)
@@ -4,19 +4,21 @@
    !! Wave module 
    !!======================================================================
-   !! History :  3.3.1  !   2011-09  (Adani M)  Original code: Drag Coefficient 
-   !!         :  3.4    !   2012-10  (Adani M)                 Stokes Drift 
+   !! History :  3.3  !   2011-09  (Adani M)  Original code: Drag Coefficient 
+   !!         :  3.4  !   2012-10  (Adani M)                 Stokes Drift 
    !!----------------------------------------------------------------------
-   USE iom             ! I/O manager library
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distribued memory computing library
+
+   !!----------------------------------------------------------------------
+   !!   sbc_wave      : read drag coefficient from wave model in netcdf files 
+   !!----------------------------------------------------------------------
+   USE oce            ! 
+   USE sbc_oce	       ! Surface boundary condition: ocean fields
+   USE bdy_oce        !
+   USE domvvl         !
+   !
+   USE iom            ! I/O manager library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
    USE fldread	       ! read input fields
-   USE oce
-   USE sbc_oce	       ! Surface boundary condition: ocean fields
-   USE domvvl
-
-   
-   !!----------------------------------------------------------------------
-   !!   sbc_wave       : read drag coefficient from wave model in netcdf files 
-   !!----------------------------------------------------------------------
+   USE wrk_nemo       !
 
    IMPLICIT NONE
@@ -25,18 +27,21 @@
    PUBLIC   sbc_wave    ! routine called in sbc_blk_core or sbc_blk_mfs
    
-   INTEGER , PARAMETER ::   jpfld  = 3           ! maximum number of files to read for srokes drift
-   INTEGER , PARAMETER ::   jp_usd = 1           ! index of stokes drift  (i-component) (m/s)    at T-point
-   INTEGER , PARAMETER ::   jp_vsd = 2           ! index of stokes drift  (j-component) (m/s)    at T-point
-   INTEGER , PARAMETER ::   jp_wn  = 3           ! index of wave number                 (1/m)    at T-point
+   INTEGER , PARAMETER ::   jpfld  = 3   ! maximum number of files to read for srokes drift
+   INTEGER , PARAMETER ::   jp_usd = 1   ! index of stokes drift  (i-component) (m/s)    at T-point
+   INTEGER , PARAMETER ::   jp_vsd = 2   ! index of stokes drift  (j-component) (m/s)    at T-point
+   INTEGER , PARAMETER ::   jp_wn  = 3   ! index of wave number                 (1/m)    at T-point
+
    TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_cd	  ! structure of input fields (file informations, fields read) Drag Coefficient
    TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_sd	  ! structure of input fields (file informations, fields read) Stokes Drift
-   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:)       :: cdn_wave 
-   REAL(wp),ALLOCATABLE,DIMENSION (:,:)              :: usd2d,vsd2d,uwavenum,vwavenum 
-   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:,:)     :: usd3d,vsd3d,wsd3d 
+
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION (:,:)   :: cdn_wave 
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION (:,:,:) :: usd3d, vsd3d, wsd3d 
+   REAL(wp),         ALLOCATABLE, DIMENSION (:,:)   :: usd2d, vsd2d, uwavenum, vwavenum 
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -56,27 +61,17 @@
       !!              - Compute 3d stokes drift using monochromatic
       !! ** action  :   
-      !!               
       !!---------------------------------------------------------------------
-      USE oce,  ONLY : un,vn,hdivn,rotn
-      USE divcur
-      USE wrk_nemo
-#if defined key_bdy
-      USE bdy_oce, ONLY : bdytmask
-#endif
-      INTEGER, INTENT( in  ) ::  kt       ! ocean time step
-      INTEGER                ::  ierror   ! return error code
-      INTEGER                ::  ifpr, jj,ji,jk 
+      INTEGER, INTENT( in  ) ::   kt       ! ocean time step
+      !
+      INTEGER                ::   ierror   ! return error code
+      INTEGER                ::   ifpr, jj,ji,jk 
       INTEGER                ::   ios     ! Local integer output status for namelist read
-      REAL(wp),DIMENSION(:,:,:),POINTER             ::  udummy,vdummy,hdivdummy,rotdummy
-      REAL                                          ::  z2dt,z1_2dt
       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read
       CHARACTER(len=100)     ::  cn_dir                          ! Root directory for location of drag coefficient files
       TYPE(FLD_N)            ::  sn_cdg, sn_usd, sn_vsd, sn_wn   ! informations about the fields to be read
-      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zusd_t, zvsd_t, ze3hdiv   ! 3D workspace
+      !!
       NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_wn
       !!---------------------------------------------------------------------
-
-      !!----------------------------------------------------------------------
-      !
       !
       !                                         ! -------------------- !
@@ -92,5 +87,4 @@
          IF(lwm) WRITE ( numond, namsbc_wave )
          !
-
          IF ( ln_cdgw ) THEN
             ALLOCATE( sf_cd(1), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg
@@ -102,5 +96,5 @@
             ALLOCATE( cdn_wave(jpi,jpj) )
             cdn_wave(:,:) = 0.0
-        ENDIF
+         ENDIF
          IF ( ln_sdw ) THEN
             slf_i(jp_usd) = sn_usd ; slf_i(jp_vsd) = sn_vsd; slf_i(jp_wn) = sn_wn
@@ -113,80 +107,72 @@
             END DO
             CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' )
-            ALLOCATE( usd2d(jpi,jpj),vsd2d(jpi,jpj),uwavenum(jpi,jpj),vwavenum(jpi,jpj) )
+            ALLOCATE( usd2d(jpi,jpj) , vsd2d(jpi,jpj) , uwavenum(jpi,jpj) , vwavenum(jpi,jpj) )
             ALLOCATE( usd3d(jpi,jpj,jpk),vsd3d(jpi,jpj,jpk),wsd3d(jpi,jpj,jpk) )
-            usd2d(:,:) = 0.0 ;  vsd2d(:,:) = 0.0 ; uwavenum(:,:) = 0.0 ; vwavenum(:,:) = 0.0
-            usd3d(:,:,:) = 0.0 ;vsd3d(:,:,:) = 0.0 ; wsd3d(:,:,:) = 0.0
+            usd3d(:,:,:) = 0._wp   ;   usd2d(:,:) = 0._wp   ;    uwavenum(:,:) = 0._wp
+            vsd3d(:,:,:) = 0._wp   ;   vsd2d(:,:) = 0._wp   ;    vwavenum(:,:) = 0._wp
+            wsd3d(:,:,:) = 0._wp
          ENDIF
       ENDIF
+      !
+      IF ( ln_cdgw ) THEN              !==  Neutral drag coefficient  ==!
+         CALL fld_read( kt, nn_fsbc, sf_cd )      ! read from external forcing
+         cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1)
+      ENDIF
+      !
+      IF ( ln_sdw )  THEN              !==  Computation of the 3d Stokes Drift  ==!
+         !
+         CALL fld_read( kt, nn_fsbc, sf_sd )    !* read drag coefficient from external forcing
          !
          !
-      IF ( ln_cdgw ) THEN
-         CALL fld_read( kt, nn_fsbc, sf_cd )      !* read drag coefficient from external forcing
-         cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1)
-      ENDIF
-      IF ( ln_sdw )  THEN
-          CALL fld_read( kt, nn_fsbc, sf_sd )      !* read drag coefficient from external forcing
-
-         ! Interpolate wavenumber, stokes drift into the grid_V and grid_V
-         !-------------------------------------------------
-
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               uwavenum(ji,jj)=0.5 * ( 2. - umask(ji,jj,1) ) * ( sf_sd(3)%fnow(ji,jj,1) * tmask(ji,jj,1) &
-               &                                + sf_sd(3)%fnow(ji+1,jj,1) * tmask(ji+1,jj,1) )
-
-               vwavenum(ji,jj)=0.5 * ( 2. - vmask(ji,jj,1) ) * ( sf_sd(3)%fnow(ji,jj,1) * tmask(ji,jj,1) &
-               &                                + sf_sd(3)%fnow(ji,jj+1,1) * tmask(ji,jj+1,1) )
-
-               usd2d(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( sf_sd(1)%fnow(ji,jj,1) * tmask(ji,jj,1) &
-               &                                + sf_sd(1)%fnow(ji+1,jj,1) * tmask(ji+1,jj,1) )
-
-               vsd2d(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( sf_sd(2)%fnow(ji,jj,1) * tmask(ji,jj,1) &
-               &                                + sf_sd(2)%fnow(ji,jj+1,1) * tmask(ji,jj+1,1) )
+         CALL wrk_alloc( jpi,jpj,jpk,   zusd_t, zvsd_t, ze3hdiv )
+         !                                      !* distribute it on the vertical
+         DO jk = 1, jpkm1
+            zusd_t(:,:,jk) = sf_sd(jp_usd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * fsdept_n(:,:,jk) )
+            zvsd_t(:,:,jk) = sf_sd(jp_vsd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * fsdept_n(:,:,jk) )
+         END DO
+         !                                      !* interpolate the stokes drift from t-point to u- and v-points
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                   usd3d(ji,jj,jk) = 0.5_wp * ( zusd_t(ji  ,jj,jk) + zusd_t(ji+1,jj,jk) ) * umask(ji,jj,jk)
+                   vsd3d(ji,jj,jk) = 0.5_wp * ( zvsd_t(ji  ,jj,jk) + zvsd_t(ji,jj+1,jk) ) * vmask(ji,jj,jk)
+               END DO
             END DO
          END DO
-
-          !Computation of the 3d Stokes Drift
-          DO jk = 1, jpk
-             DO jj = 1, jpj-1
-                DO ji = 1, jpi-1
-                   usd3d(ji,jj,jk) = usd2d(ji,jj)*exp(2.0*uwavenum(ji,jj)*(-MIN( gdept_0(ji,jj,jk) , gdept_0(ji+1,jj  ,jk))))
-                   vsd3d(ji,jj,jk) = vsd2d(ji,jj)*exp(2.0*vwavenum(ji,jj)*(-MIN( gdept_0(ji,jj,jk) , gdept_0(ji  ,jj+1,jk))))
-                END DO
-             END DO
-             usd3d(jpi,:,jk) = usd2d(jpi,:)*exp( 2.0*uwavenum(jpi,:)*(-gdept_0(jpi,:,jk)) )
-             vsd3d(:,jpj,jk) = vsd2d(:,jpj)*exp( 2.0*vwavenum(:,jpj)*(-gdept_0(:,jpj,jk)) )
-          END DO
-
-          CALL wrk_alloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy)
-          
-          udummy(:,:,:)=un(:,:,:)
-          vdummy(:,:,:)=vn(:,:,:)
-          hdivdummy(:,:,:)=hdivn(:,:,:)
-          rotdummy(:,:,:)=rotn(:,:,:)
-          un(:,:,:)=usd3d(:,:,:)
-          vn(:,:,:)=vsd3d(:,:,:)
-          CALL div_cur(kt)
-      !                                           !------------------------------!
-      !                                           !     Now Vertical Velocity    !
-      !                                           !------------------------------!
-          z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
-
-          z1_2dt = 1.e0 / z2dt
-          DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence
-             ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
-             wsd3d(:,:,jk) = wsd3d(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        &
-                &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    &
-                &                         * tmask(:,:,jk) * z1_2dt
+         CALL lbc_lnk( usd3d(:,:,:), 'U', -1. )
+         CALL lbc_lnk( vsd3d(:,:,:), 'V', -1. )
+         !
+         DO jk = 1, jpkm1                       !* e3t * Horizontal divergence  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ze3hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * fse3u_n(ji  ,jj,jk) * usd3d(ji  ,jj,jk)     &
+                     &                 - e2u(ji-1,jj) * fse3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk)     &
+                     &                 + e1v(ji,jj  ) * fse3v_n(ji,jj  ,jk) * vsd3d(ji,jj  ,jk)     &
+                     &                 - e1v(ji,jj-1) * fse3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk)   ) * r1_e1e2t(ji,jj)
+               END DO  
+            END DO  
+            IF( .NOT. AGRIF_Root() ) THEN
+               IF( nbondi ==  1 .OR. nbondi == 2 )   ze3hdiv(nlci-1,   :  ,jk) = 0._wp      ! east
+               IF( nbondi == -1 .OR. nbondi == 2 )   ze3hdiv(  2   ,   :  ,jk) = 0._wp      ! west
+               IF( nbondj ==  1 .OR. nbondj == 2 )   ze3hdiv(  :   ,nlcj-1,jk) = 0._wp      ! north
+               IF( nbondj == -1 .OR. nbondj == 2 )   ze3hdiv(  :   ,  2   ,jk) = 0._wp      ! south
+            ENDIF
+         END DO
+         CALL lbc_lnk( ze3hdiv, 'T', 1. ) 
+         !
+         DO jk = jpkm1, 1, -1                   !* integrate from the bottom the e3t * hor. divergence
+            wsd3d(:,:,jk) = wsd3d(:,:,jk+1) - ze3hdiv(:,:,jk)
+         END DO
 #if defined key_bdy
-             wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:)
+         IF( lk_bdy ) THEN
+            DO jk = 1, jpkm1
+               wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:)
+            END DO
+         ENDIF
 #endif
-          END DO
-          hdivn(:,:,:)=hdivdummy(:,:,:)
-          rotn(:,:,:)=rotdummy(:,:,:)
-          vn(:,:,:)=vdummy(:,:,:)
-          un(:,:,:)=udummy(:,:,:)
-          CALL wrk_dealloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy)
+         CALL wrk_dealloc( jpi,jpj,jpk,   zusd_t, zvsd_t, ze3hdiv )
+         ! 
       ENDIF
+      !
    END SUBROUTINE sbc_wave
       
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90	(revision 5901)
@@ -89,13 +89,13 @@
          DO ji = 2, jpim1
             zcoef = z2dt * z2dt * grav * bmask(ji,jj)
-            zcoefs = -zcoef * hv(ji  ,jj-1) * e1v(ji  ,jj-1) / e2v(ji  ,jj-1)    ! south coefficient
-            zcoefw = -zcoef * hu(ji-1,jj  ) * e2u(ji-1,jj  ) / e1u(ji-1,jj  )    ! west coefficient
-            zcoefe = -zcoef * hu(ji  ,jj  ) * e2u(ji  ,jj  ) / e1u(ji  ,jj  )    ! east coefficient
-            zcoefn = -zcoef * hv(ji  ,jj  ) * e1v(ji  ,jj  ) / e2v(ji  ,jj  )    ! north coefficient
+            zcoefs = -zcoef * hv(ji  ,jj-1) * e1_e2v(ji  ,jj-1)    ! south coefficient
+            zcoefw = -zcoef * hu(ji-1,jj  ) * e2_e1u(ji-1,jj  )    ! west coefficient
+            zcoefe = -zcoef * hu(ji  ,jj  ) * e2_e1u(ji  ,jj  )    ! east coefficient
+            zcoefn = -zcoef * hv(ji  ,jj  ) * e1_e2v(ji  ,jj  )    ! north coefficient
             gcp(ji,jj,1) = zcoefs
             gcp(ji,jj,2) = zcoefw
             gcp(ji,jj,3) = zcoefe
             gcp(ji,jj,4) = zcoefn
-            gcdmat(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * bmask(ji,jj)    &          ! diagonal coefficient
+            gcdmat(ji,jj) = e1e2t(ji,jj) * bmask(ji,jj)    &          ! diagonal coefficient
                &          - zcoefs -zcoefw -zcoefe -zcoefn
          END DO
@@ -110,26 +110,25 @@
 
             !  south coefficient
-            zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)
+            zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1)
             zcoefs = zcoefs * bdyvmask(ji,jj-1)
             gcp(ji,jj,1) = zcoefs
 
             !  west coefficient
-            zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)
+            zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj)
             zcoefw = zcoefw * bdyumask(ji-1,jj)
             gcp(ji,jj,2) = zcoefw
 
             !  east coefficient
-            zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)
+            zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj)
             zcoefe = zcoefe * bdyumask(ji,jj)
             gcp(ji,jj,3) = zcoefe
 
             !  north coefficient
-            zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)
+            zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj)
             zcoefn = zcoefn * bdyvmask(ji,jj)
             gcp(ji,jj,4) = zcoefn
 
             ! diagonal coefficient
-            gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) &
-                            - zcoefs -zcoefw -zcoefe -zcoefn
+            gcdmat(ji,jj) = e1e2t(ji,jj)*bmask(ji,jj) - zcoefs -zcoefw -zcoefe -zcoefn
          END DO
       END DO
@@ -149,7 +148,7 @@
                !  south coefficient
                IF( ( nbondj == -1 .OR. nbondj == 2 ) .AND. ( jj == 3 ) ) THEN
-                  zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1))
+                  zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1))
                ELSE
-                  zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)
+                  zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1)
                END IF
                gcp(ji,jj,1) = zcoefs
@@ -157,7 +156,7 @@
                !  west coefficient
                IF( ( nbondi == -1 .OR. nbondi == 2 ) .AND. ( ji == 3 )  ) THEN
-                  zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-umask(ji-1,jj,1))
+                  zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj)*(1.-umask(ji-1,jj,1))
                ELSE
-                  zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)
+                  zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj)
                END IF
                gcp(ji,jj,2) = zcoefw
@@ -165,7 +164,7 @@
                !   east coefficient
                IF( ( nbondi == 1 .OR. nbondi == 2 ) .AND. ( ji == nlci-2 ) ) THEN
-                  zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-umask(ji,jj,1))
+                  zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj)*(1.-umask(ji,jj,1))
                ELSE
-                  zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)
+                  zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj)
                END IF
                gcp(ji,jj,3) = zcoefe
@@ -173,13 +172,12 @@
                !   north coefficient
                IF( ( nbondj == 1 .OR. nbondj == 2 ) .AND. ( jj == nlcj-2 ) ) THEN
-                  zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vmask(ji,jj,1))
+                  zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj)*(1.-vmask(ji,jj,1))
                ELSE
-                  zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)
+                  zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj)
                END IF
                gcp(ji,jj,4) = zcoefn
                !
                ! diagonal coefficient
-               gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj)   &
-                  &            - zcoefs -zcoefw -zcoefe -zcoefn
+               gcdmat(ji,jj) = e1e2t(ji,jj)*bmask(ji,jj) - zcoefs -zcoefw -zcoefe -zcoefn
             END DO
          END DO
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 5901)
@@ -11,5 +11,5 @@
    !!            3.2  ! 2009-07  (R. Benshila) suppression of rigid-lid & FETI solver
    !!----------------------------------------------------------------------
-#if defined key_dynspg_flt   ||   defined key_esopa  
+#if defined key_dynspg_flt  
    !!----------------------------------------------------------------------
    !!   'key_dynspg_flt'                              filtered free surface
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 5901)
@@ -6,34 +6,33 @@
    !! History :  2.0  !  2005-11  (G. Madec)  Original code
    !!            3.3  !  2010-09  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!            4.0  !  2011-06  (G. Madec)  Addition of Mixed Layer Eddy parameterisation
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv      : compute ocean tracer advection trend
-   !!   tra_adv_ctl  : control the different options of advection scheme
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE domvvl          ! variable vertical scale factors
-   USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine)
-   USE traadv_tvd      ! 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 traadv_mle      ! ML eddy induced velocity  (tra_adv_mle    routine)
-   USE cla             ! cross land advection      (cla_traadv     routine)
-   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   !!            3.6  !  2011-06  (G. Madec)  Addition of Mixed Layer Eddy parameterisation
+   !!            3.7  !  2014-05  (G. Madec)  Add 2nd/4th order cases for CEN and FCT schemes 
+   !!             -   !  2014-12  (G. Madec) suppression of cross land advection option
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv       : compute ocean tracer advection trend
+   !!   tra_adv_ctl   : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE domvvl         ! variable vertical scale factors
+   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine)
+   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine)
+   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine)
+   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine)
+   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine)
+   USE traadv_mle     ! ML eddy induced velocity  (tra_adv_mle  routine)
+   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
+   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
    !
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O module
-   USE prtctl          ! Print control
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-   USE sbc_oce
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O module
+   USE prtctl         ! Print control
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
    USE diaptr          ! Poleward heat transport 
-
 
    IMPLICIT NONE
@@ -43,22 +42,32 @@
    PUBLIC   tra_adv_init   ! routine called by opa module
 
-   !                              !!* Namelist namtra_adv *
-   LOGICAL ::   ln_traadv_cen2     ! 2nd order centered scheme flag
-   LOGICAL ::   ln_traadv_tvd      ! TVD scheme flag
-   LOGICAL ::   ln_traadv_tvd_zts  ! TVD scheme flag with vertical sub time-stepping
-   LOGICAL ::   ln_traadv_muscl    ! MUSCL scheme flag
-   LOGICAL ::   ln_traadv_muscl2   ! MUSCL2 scheme flag
-   LOGICAL ::   ln_traadv_ubs      ! UBS scheme flag
-   LOGICAL ::   ln_traadv_qck      ! QUICKEST scheme flag
-   LOGICAL ::   ln_traadv_msc_ups  ! use upstream scheme within muscl
-
-
-   INTEGER ::   nadv   ! choice of the type of advection scheme
-
+   !                            !!* Namelist namtra_adv *
+   LOGICAL ::   ln_traadv_cen    ! centered scheme flag
+   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme
+   LOGICAL ::   ln_traadv_fct    ! FCT scheme flag
+   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme
+   INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping
+   LOGICAL ::   ln_traadv_mus    ! MUSCL scheme flag
+   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths
+   LOGICAL ::   ln_traadv_ubs    ! UBS scheme flag
+   INTEGER ::      nn_ubs_v             ! =2/4 : vertical choice of the order of UBS scheme
+   LOGICAL ::   ln_traadv_qck    ! QUICKEST scheme flag
+
+   INTEGER ::              nadv             ! choice of the type of advection scheme
+   !
+   !                                        ! associated indices:
+   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection
+   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme
+   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
+   INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping
+   INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme
+   INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme
+   INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme
+   
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -74,5 +83,4 @@
       !! ** Method  : - Update (ua,va) with the advection term following nadv
       !!----------------------------------------------------------------------
-      !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !
@@ -83,5 +91,6 @@
       IF( nn_timing == 1 )  CALL timing_start('tra_adv')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
+      CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn )
+      !
       !                                          ! set time step
       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
@@ -91,62 +100,48 @@
       ENDIF
       !
-      IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_traadv( kt )       !==  Cross Land Advection  ==! (hor. advection)
-      !
-      !                                               !==  effective transport  ==!
+      !                                         !==  effective transport  ==!
       DO jk = 1, jpkm1
-         zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only
-         zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
-         zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk)
+         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only
+         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
       END DO
       !
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections
          zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
          zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
       ENDIF
       !
-      zun(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
-      zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
-      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
-      !
-      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &
-         &              CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the eiv transport (if necessary)
-      !
-      IF( ln_mle    )   CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the mle transport (if necessary)
-      !
-      CALL iom_put( "uocetr_eff", zun )                                         ! output effective transport      
+      zun(:,:,jpk) = 0._wp                                                      ! no transport trough the bottom
+      zvn(:,:,jpk) = 0._wp
+      zwn(:,:,jpk) = 0._wp
+      !
+      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &
+         &              CALL ldf_eiv_trp( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the eiv transport (if necessary)
+      !
+      IF( ln_mle    )   CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the mle transport (if necessary)
+      !
+      CALL iom_put( "uocetr_eff", zun )                                        ! output effective transport      
       CALL iom_put( "vocetr_eff", zvn )
       CALL iom_put( "wocetr_eff", zwn )
       !
-      IF( ln_diaptr )   CALL dia_ptr( zvn )                                     ! diagnose the effective MSF 
-      !
-   
-      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
-      CASE ( 1 )   ;    CALL tra_adv_cen2   ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered
-      CASE ( 2 )   ;    CALL tra_adv_tvd    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD 
-      CASE ( 3 )   ;    CALL tra_adv_muscl  ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts, ln_traadv_msc_ups )   !  MUSCL 
-      CASE ( 4 )   ;    CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2 
-      CASE ( 5 )   ;    CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS 
-      CASE ( 6 )   ;    CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST 
-      CASE ( 7 )   ;    CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD ZTS
-      !
-      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
-         CALL tra_adv_cen2  ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )          
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_adv_tvd   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts, ln_traadv_msc_ups )          
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_adv_ubs   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_adv_qck   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+!!gm ???
+      IF( ln_diaptr )   CALL dia_ptr( zvn )                                    ! diagnose the effective MSF 
+!!gm ???
+      !
+      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
+      !
+      CASE ( np_CEN )                                    ! Centered scheme : 2nd / 4th order
+         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v )
+      CASE ( np_FCT )                                    ! FCT scheme      : 2nd / 4th order
+         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v )
+      CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting
+         CALL tra_adv_fct_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_fct_zts )
+      CASE ( np_MUS )                                    ! MUSCL
+         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups ) 
+      CASE ( np_UBS )                                    ! UBS
+         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   )
+      CASE ( np_QCK )                                    ! QUICKEST
+         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts                     )
+      !
       END SELECT
       !
@@ -157,5 +152,5 @@
       IF( nn_timing == 1 )  CALL timing_stop( 'tra_adv' )
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zun, zvn, zwn )
       !                                          
    END SUBROUTINE tra_adv
@@ -169,75 +164,108 @@
       !!              tracer advection schemes and set nadv
       !!----------------------------------------------------------------------
-      INTEGER ::   ioptio
-      INTEGER ::   ios                 ! Local integer output status for namelist read
-      !!
-      NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,     &
-         &                 ln_traadv_muscl, ln_traadv_muscl2,  &
-         &                 ln_traadv_ubs  , ln_traadv_qck,     &
-         &                 ln_traadv_msc_ups, ln_traadv_tvd_zts
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namtra_adv in reference namelist : Tracer advection scheme
+      INTEGER ::   ioptio, ios   ! Local integers
+      !
+      NAMELIST/namtra_adv/ ln_traadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN
+         &                 ln_traadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT
+         &                 ln_traadv_mus,                     ln_mus_ups,   &   ! MUSCL
+         &                 ln_traadv_ubs,           nn_ubs_v,               &   ! UBS
+         &                 ln_traadv_qck                                        ! QCK
+      !!----------------------------------------------------------------------
+      !
+      !                                !==  Namelist  ==!
+      !
+      REWIND( numnam_ref )                   ! Namelist namtra_adv in reference namelist : Tracer advection scheme
       READ  ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namtra_adv in configuration namelist : Tracer advection scheme
+      !
+      REWIND( numnam_cfg )                   ! Namelist namtra_adv in configuration namelist : Tracer advection scheme
       READ  ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namtra_adv )
 
-      IF(lwp) THEN                    ! Namelist print
+      IF(lwp) THEN                           ! Namelist print
          WRITE(numout,*)
          WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers'
-         WRITE(numout,*) '      2nd order advection scheme     ln_traadv_cen2    = ', ln_traadv_cen2
-         WRITE(numout,*) '      TVD advection scheme           ln_traadv_tvd     = ', ln_traadv_tvd
-         WRITE(numout,*) '      MUSCL  advection scheme        ln_traadv_muscl   = ', ln_traadv_muscl
-         WRITE(numout,*) '      MUSCL2 advection scheme        ln_traadv_muscl2  = ', ln_traadv_muscl2
-         WRITE(numout,*) '      UBS    advection scheme        ln_traadv_ubs     = ', ln_traadv_ubs
-         WRITE(numout,*) '      QUICKEST advection scheme      ln_traadv_qck     = ', ln_traadv_qck
-         WRITE(numout,*) '      upstream scheme within muscl   ln_traadv_msc_ups = ', ln_traadv_msc_ups
-         WRITE(numout,*) '      TVD advection scheme with zts  ln_traadv_tvd_zts = ', ln_traadv_tvd_zts
-      ENDIF
-
-      ioptio = 0                      ! Parameter control
-      IF( ln_traadv_cen2   )   ioptio = ioptio + 1
-      IF( ln_traadv_tvd    )   ioptio = ioptio + 1
-      IF( ln_traadv_muscl  )   ioptio = ioptio + 1
-      IF( ln_traadv_muscl2 )   ioptio = ioptio + 1
-      IF( ln_traadv_ubs    )   ioptio = ioptio + 1
-      IF( ln_traadv_qck    )   ioptio = ioptio + 1
-      IF( ln_traadv_tvd_zts)   ioptio = ioptio + 1
-      IF( lk_esopa         )   ioptio =          1
-
-      IF( ( ln_traadv_muscl .OR. ln_traadv_muscl2 .OR. ln_traadv_ubs .OR. ln_traadv_qck .OR. ln_traadv_tvd_zts )   &
-         .AND. ln_isfcav )   CALL ctl_stop( 'Only traadv_cen2 and traadv_tvd is compatible with ice shelf cavity')
-
-      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' )
-
-      !                              ! Set nadv
-      IF( ln_traadv_cen2   )   nadv =  1
-      IF( ln_traadv_tvd    )   nadv =  2
-      IF( ln_traadv_muscl  )   nadv =  3
-      IF( ln_traadv_muscl2 )   nadv =  4
-      IF( ln_traadv_ubs    )   nadv =  5
-      IF( ln_traadv_qck    )   nadv =  6
-      IF( ln_traadv_tvd_zts)   nadv =  7
-      IF( lk_esopa         )   nadv = -1
-
-      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*) '      centered scheme                           ln_traadv_cen = ', ln_traadv_cen
+         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v
+         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_traadv_fct = ', ln_traadv_fct
+         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v
+         WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts
+         WRITE(numout,*) '      MUSCL scheme                              ln_traadv_mus = ', ln_traadv_mus
+         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups
+         WRITE(numout,*) '      UBS scheme                                ln_traadv_ubs = ', ln_traadv_ubs
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v
+         WRITE(numout,*) '      QUICKEST scheme                           ln_traadv_qck = ', ln_traadv_qck
+      ENDIF
+
+      ioptio = 0                       !==  Parameter control  ==!
+      IF( ln_traadv_cen )   ioptio = ioptio + 1
+      IF( ln_traadv_fct )   ioptio = ioptio + 1
+      IF( ln_traadv_mus )   ioptio = ioptio + 1
+      IF( ln_traadv_ubs )   ioptio = ioptio + 1
+      IF( ln_traadv_qck )   ioptio = ioptio + 1
+      !
+      IF( ioptio == 0 ) THEN
+         nadv = np_NO_adv
+         CALL ctl_warn( 'tra_adv_init: You are running without tracer advection.' )
+      ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection scheme in namelist namtra_adv' )
+      !
+      IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &          ! Centered
+                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN
+        CALL ctl_stop( 'tra_adv_init: CEN scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_traadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   &          ! FCT
+                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN
+        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_traadv_fct .AND. nn_fct_zts > 0 ) THEN
+         IF( nn_fct_h == 4 ) THEN
+            nn_fct_h = 2
+            CALL ctl_stop( 'tra_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' )
+         ENDIF
+         IF( lk_vvl ) THEN
+            CALL ctl_stop( 'tra_adv_init: vertical sub-timestepping not allow in non-linear free surface' )
+         ENDIF
+         IF( nn_fct_zts == 1 )   CALL ctl_warn( 'tra_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' )
+      ENDIF
+      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS
+        CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_traadv_ubs .AND. nn_ubs_v == 4 ) THEN
+         CALL ctl_warn( 'tra_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
+      ENDIF
+      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities
+         IF(  ln_traadv_cen .AND. nn_cen_v /= 4    .OR.   &                            ! NO 4th order with ISF
+            & ln_traadv_fct .AND. nn_fct_v /= 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' )
+      ENDIF
+      !
+      !                                !==  used advection scheme  ==!  
+      !                                      ! set nadv
+      IF( ln_traadv_cen                      )   nadv = np_CEN
+      IF( ln_traadv_fct                      )   nadv = np_FCT
+      IF( ln_traadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts
+      IF( ln_traadv_mus                      )   nadv = np_MUS
+      IF( ln_traadv_ubs                      )   nadv = np_UBS
+      IF( ln_traadv_qck                      )   nadv = np_QCK
+
+      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 ==  7 )   WRITE(numout,*) '         TVD ZTS   scheme is used'
-         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme'
-      ENDIF
-      !
-      CALL tra_adv_mle_init          ! initialisation of the Mixed Layer Eddy parametrisation (MLE)
+         IF( nadv == np_NO_adv  )   WRITE(numout,*) '         NO T-S advection'
+         IF( nadv == np_CEN     )   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
+            &                                                                        ' Vertical   order: ', nn_cen_v
+         IF( nadv == np_FCT     )   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
+            &                                                                        ' Vertical   order: ', nn_fct_v
+         IF( nadv == np_FCT_zts )   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping'
+         IF( nadv == np_MUS     )   WRITE(numout,*) '         MUSCL    scheme is used'
+         IF( nadv == np_UBS     )   WRITE(numout,*) '         UBS      scheme is used'
+         IF( nadv == np_QCK     )   WRITE(numout,*) '         QUICKEST scheme is used'
+      ENDIF
+      !
+      CALL tra_adv_mle_init            !== initialisation of the Mixed Layer Eddy parametrisation (MLE)  ==!
       !
    END SUBROUTINE tra_adv_init
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90	(revision 5901)
@@ -0,0 +1,210 @@
+MODULE traadv_cen
+   !!======================================================================
+   !!                     ***  MODULE  traadv_cen  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend (2nd/4th order centered)
+   !!======================================================================
+   !! History :  3.7  ! 2014-05  (G. Madec)  original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_cen : update the tracer trend with the advection trends using a centered or scheme (2nd or 4th order)
+   !!                 NB: on the vertical it is actually a 4th order COMPACT scheme which is used
+   !!----------------------------------------------------------------------
+   USE oce, ONLY: tsn  ! now ocean temperature and salinity
+   USE dom_oce         ! ocean space and time domain
+   USE eosbn2          ! equation of state
+   USE traadv_fct      ! acces to routine interp_4th_cpt 
+   USE trd_oce         ! trends: ocean variables
+   USE trdtra          ! trends manager: tracers 
+   USE diaptr          ! poleward transport diagnostics
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! IOM library
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_cen       ! routine called by step.F90
+   
+   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: traadv_cen2.F90 5737 2015-09-13 07:42:41Z gm $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pun, pvn, pwn,     &
+      &                                             ptn, pta, kjpt, kn_cen_h, kn_cen_v ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_cen  ***
+      !!                 
+      !! ** Purpose :   Compute the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations.
+      !!
+      !! ** Method  :   The advection is evaluated by a 2nd or 4th order scheme
+      !!               using now fields (leap-frog scheme). 
+      !!
+      !!       kn_cen_h = 2  ==>> 2nd order centered scheme on the horizontal
+      !!                = 4  ==>> 4th order    -        -       -      -
+      !!
+      !!       kn_cen_v = 2  ==>> 2nd order centered scheme on the vertical
+      !!                = 4  ==>> 4th order COMPACT  scheme     -      -
+      !!
+      !! ** Action :  - update pta  with the now advective tracer trends
+      !!              - send trends to trdtra module for further diagnostcs
+      !!----------------------------------------------------------------------
+      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
+      INTEGER                              , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme)
+      INTEGER                              , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme)
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn             ! now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::   ierr             ! local integer
+      REAL(wp) ::   zC2t_u, zC4t_u   ! local scalars
+      REAL(wp) ::   zC2t_v, zC4t_v   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zwy, zwz, ztu, ztv, ztw
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_cen : centered advection scheme on ', cdtype, ' order h/v =', kn_cen_h,'/', kn_cen_v
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
+      ENDIF
+      !
+      !                          ! surface & bottom values 
+      IF( lk_vvl )   zwz(:,:, 1 ) = 0._wp             ! set to zero one for all
+                     zwz(:,:,jpk) = 0._wp             ! except at the surface in linear free surface
+      !
+      DO jn = 1, kjpt            !==  loop over the tracers  ==!
+         !
+         SELECT CASE( kn_cen_h )          !--  Horizontal fluxes  --!
+         !
+         CASE(  2  )                               ! 2nd order centered
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
+                     zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
+                  END DO
+               END DO
+            END DO
+            !
+         CASE(  4  )                               ! 4th order centered
+            ztu(:,:,jpk) = 0._wp                            ! Bottom value : flux set to zero
+            ztv(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1                                 ! gradient
+               DO jj = 2, jpjm1                                   ! masked derivative
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO jk = 1, jpkm1                                 ! Horizontal advective fluxes
+               DO jj = 2, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! C2 interpolation of T at u- & v-points (x2)
+                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn)
+                     !                                                  ! C4 interpolation of T at u- & v-points (x2)
+                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) )
+                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) )
+                     !                                                  ! C4 fluxes
+                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * zC4t_u
+                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * zC4t_v
+                  END DO
+               END DO
+            END DO         
+            !
+         CASE DEFAULT
+            CALL ctl_stop( 'traadv_fct: wrong value for nn_fct' )
+         END SELECT
+         !
+         !                             !==  Vertical fluxes  ==!
+         !
+         SELECT CASE( kn_cen_v )             !* interior fluxes
+         !
+         CASE(  2  )                               ! 2nd order centered
+            DO jk = 2, jpk
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         CASE(  4  )                               ! 4th order centered
+            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )         ! 4th order compact interpolation of T at w-point
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwz(ji,jj,jk) = pwn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         END SELECT
+         !
+         IF(.NOT.lk_vvl ) THEN               !* top value   (only in linear free surf. as zwz is multiplied by wmask)
+            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                  END DO
+               END DO   
+            ELSE                                   ! no ice-shelf cavities (only ocean surface)
+               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !               
+         DO jk = 1, jpkm1              !--  Divergence of advective fluxes  --!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)    &
+                     &             - (  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)  ) / ( e1e2t(ji,jj) *  fse3t_n(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !                                 ! trend diagnostics
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
+         ENDIF
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen')
+      !
+   END SUBROUTINE tra_adv_cen
+   
+   !!======================================================================
+END MODULE traadv_cen
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 5891)
+++ 	(revision )
@@ -1,368 +1,0 @@
-MODULE traadv_cen2
-   !!======================================================================
-   !!                     ***  MODULE  traadv_cen2  ***
-   !! Ocean  tracers:  horizontal & vertical advective trend
-   !!======================================================================
-   !! History :  OPA  ! 2001-08  (G. Madec, E. Durand) v8.2 trahad+trazad=traadv 
-   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
-   !!             -   ! 2004-08  (C. Talandier) New trends organization
-   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
-   !!            2.0  ! 2006-04  (R. Benshila, G. Madec) Step reorganization
-   !!             -   ! 2006-07  (G. madec)  add ups_orca_set routine
-   !!            3.2  ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection
-   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_cen2 : update the tracer trend with the advection trends using a 2nd order centered scheme
-   !!   ups_orca_set : allow mixed upstream/centered scheme in specific area (set for orca 2 and 4 only)
-   !!----------------------------------------------------------------------
-   USE oce, ONLY: tsn  ! now ocean temperature and salinity
-   USE dom_oce         ! ocean space and time domain
-   USE eosbn2          ! equation of state
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
-   USE closea          ! closed sea
-   USE sbcrnf          ! river runoffs
-   USE in_out_manager  ! I/O manager
-   USE iom             ! IOM library
-   USE diaptr          ! poleward transport diagnostics
-   USE zdf_oce         ! ocean vertical physics
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-   USE phycst
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_cen2   ! routine called by traadv.F90
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits 
-   !                                                             !  and in closed seas (orca 2 and 4 configurations)
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_cen2( kt, kit000, cdtype, pun, pvn, pwn,     &
-      &                                         ptb, ptn, pta, kjpt   ) 
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_cen2  ***
-      !!                 
-      !! ** Purpose :   Compute the now trend due to the advection of tracers
-      !!      and add it to the general trend of passive tracer equations.
-      !!
-      !! ** Method  :   The advection is evaluated by a second order centered
-      !!      scheme using now fields (leap-frog scheme). In specific areas
-      !!      (vicinity of major river mouths, some straits, or where tn is
-      !!      approaching the freezing point) it is mixed with an upstream
-      !!      scheme for stability reasons.
-      !!         Part 0 : compute the upstream / centered flag
-      !!                  (3D array, zind, defined at T-point (0<zind<1))
-      !!         Part I : horizontal advection
-      !!       * centered flux:
-      !!               zcenu = e2u*e3u  un  mi(ptn)
-      !!               zcenv = e1v*e3v  vn  mj(ptn)
-      !!       * upstream flux:
-      !!               zupsu = e2u*e3u  un  (ptb(i) or ptb(i-1) ) [un>0 or <0]
-      !!               zupsv = e1v*e3v  vn  (ptb(j) or ptb(j-1) ) [vn>0 or <0]
-      !!       * mixed upstream / centered horizontal advection scheme
-      !!               zcofi = max(zind(i+1), zind(i))
-      !!               zcofj = max(zind(j+1), zind(j))
-      !!               zwx = zcofi * zupsu + (1-zcofi) * zcenu
-      !!               zwy = zcofj * zupsv + (1-zcofj) * zcenv
-      !!       * horizontal advective trend (divergence of the fluxes)
-      !!               ztra = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }
-      !!       * Add this trend now to the general trend of tracer (ta,sa):
-      !!               pta = pta + ztra
-      !!       * trend diagnostic (l_trdtra=T or l_trctra=T): the trend is
-      !!      saved for diagnostics. The trends saved is expressed as
-      !!      Uh.gradh(T), i.e.  save trend = ztra + ptn divn
-      !!
-      !!         Part II : vertical advection
-      !!      For temperature (idem for salinity) the advective trend is com-
-      !!      puted as follows :
-      !!            ztra = 1/e3t dk+1[ zwz ]
-      !!      where the vertical advective flux, zwz, is given by :
-      !!            zwz = zcofk * zupst + (1-zcofk) * zcent
-      !!      with
-      !!        zupsv = upstream flux = wn * (ptb(k) or ptb(k-1) ) [wn>0 or <0]
-      !!        zcenu = centered flux = wn * mk(tn)
-      !!         The surface boundary condition is :
-      !!      variable volume (lk_vvl = T) : zero advective flux
-      !!      lin. free-surf  (lk_vvl = F) : wn(:,:,1) * ptn(:,:,1)
-      !!         Add this trend now to the general trend of tracer (ta,sa):
-      !!             pta = pta + ztra
-      !!         Trend diagnostic (l_trdtra=T or l_trctra=T): the trend is
-      !!      saved for diagnostics. The trends saved is expressed as :
-      !!             save trend =  w.gradz(T) = ztra - ptn divn.
-      !!
-      !! ** Action :  - update pta  with the now advective tracer trends
-      !!              - save trends if needed
-      !!----------------------------------------------------------------------
-      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,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, ikt   ! dummy loop indices
-      INTEGER  ::   ierr                 ! local integer
-      REAL(wp) ::   zbtr, ztra                            ! local scalars
-      REAL(wp) ::   zfp_ui, zfp_vj, zfp_w, zcofi          !   -      -
-      REAL(wp) ::   zfm_ui, zfm_vj, zfm_w, zcofj, zcofk   !   -      -
-      REAL(wp) ::   zupsut, zcenut, zupst                 !   -      -
-      REAL(wp) ::   zupsvt, zcenvt, zcent, zice           !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:)   :: zfzp, zpres   ! 2D workspace
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zwy     ! 3D     -
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zind    !  -     -
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen2')
-      !
-      CALL wrk_alloc( jpi, jpj, zpres, zfzp )
-      CALL wrk_alloc( jpi, jpj, jpk, zwx, zwy, zwz, zind )
-      !
-
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
-         IF(lwp) WRITE(numout,*)
-         !
-         IF( .NOT. ALLOCATED( upsmsk ) )  THEN
-             ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
-             IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array')
-         ENDIF
-
-         !
-         upsmsk(:,:) = 0._wp                             ! not upstream by default
-         ! 
-         IF( cp_cfg == "orca" )   CALL ups_orca_set      ! set mixed Upstream/centered scheme near some straits
-         !                                               ! and in closed seas (orca2 and orca4 only)
-         IF( jp_cfg == 2 .AND. .NOT. ln_rstart ) THEN    ! Increase the background in the surface layers
-            avmb(1) = 10.  * avmb(1)      ;      avtb(1) = 10.  * avtb(1)
-            avmb(2) = 10.  * avmb(2)      ;      avtb(2) = 10.  * avtb(2)
-            avmb(3) =  5.  * avmb(3)      ;      avtb(3) =  5.  * avtb(3)
-            avmb(4) =  2.5 * avmb(4)      ;      avtb(4) =  2.5 * avtb(4)
-         ENDIF
-      ENDIF
-      !
-      ! Upstream / centered scheme indicator
-      ! ------------------------------------
-!!gm  not strickly exact : the freezing point should be computed at each ocean levels...
-!!gm  not a big deal since cen2 is no more used in global ice-ocean simulations
-!!ch  changes for ice shelf to retain standard behaviour elsewhere, even if not optimal 
-      DO jj = 1, jpj 
-         DO ji = 1, jpi 
-            ikt = mikt(ji,jj) 
-            IF (ikt > 1 ) THEN 
-               zpres(ji,jj) = grav * rau0 * fsdept(ji,jj,ikt) * 1.e-04  
-            ELSE 
-               zpres(ji,jj) = 0.0 
-            ENDIF  
-         END DO 
-      END DO 
-      CALL eos_fzp( tsn(:,:,1,jp_sal), zfzp(:,:), zpres(:,:) )
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !                                        ! below ice covered area (if tn < "freezing"+0.1 )
-               IF( tsn(ji,jj,jk,jp_tem) <= zfzp(ji,jj) + 0.1 ) THEN   ;   zice = 1._wp
-               ELSE                                                   ;   zice = 0._wp
-               ENDIF
-               zind(ji,jj,jk) = MAX (   &
-                  rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows)
-                  upsmsk(ji,jj)               ,      &  ! some of some straits
-                  zice                               &  ! below ice covered area (if tn < "freezing"+0.1 )
-                  &                  ) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      DO jn = 1, kjpt
-         !
-         ! I. Horizontal advection
-         !    ====================
-         !
-         DO jk = 1, jpkm1
-            !                        ! Second order centered tracer flux at u- and v-points
-            DO jj = 1, jpjm1
-               !
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ! upstream indicator
-                  zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
-                  zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
-                  !
-                  ! 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) )
-                  zupsut = zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn)
-                  zupsvt = zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn)
-                  ! centered scheme
-                  zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
-                  zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
-                  ! mixed centered / upstream scheme
-                  zwx(ji,jj,jk) = 0.5 * ( zcofi * zupsut + (1.-zcofi) * zcenut )
-                  zwy(ji,jj,jk) = 0.5 * ( zcofj * zupsvt + (1.-zcofj) * zcenvt )
-               END DO
-            END DO
-         END DO
-
-         ! II. Vertical advection
-         !     ==================
-         !
-         !                                                ! Vertical advective fluxes
-         zwz(:,:,jpk) = 0.e0                                   ! Bottom  value : flux set to zero
-         !                                                     ! Surface value : 
-         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
-         ELSE
-            DO jj = 1, jpj   ! vector opt.
-               DO ji = 1, jpi   ! vector opt.
-                  ikt = mikt(ji,jj)                
-                  zwz(ji,jj,ikt ) = pwn(ji,jj,ikt) * ptn(ji,jj,ikt,jn)   ! linear free surface 
-                  zwz(ji,jj,1:ikt-1) = 0.e0
-               END DO
-            END DO
-         ENDIF
-         !
-         DO jk = 2, jpk              ! Second order centered tracer flux at w-point
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! upstream indicator
-                  zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) ) 
-                  ! mixed centered / upstream scheme
-                  zfp_w = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
-                  zfm_w = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
-                  zupst = zfp_w * ptb(ji,jj,jk,jn) + zfm_w * ptb(ji,jj,jk-1,jn)
-                  ! centered scheme
-                  zcent = pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )
-                  ! mixed centered / upstream scheme
-                  zwz(ji,jj,jk) = 0.5 * ( zcofk * zupst + (1.-zcofk) * zcent )
-               END DO
-            END DO
-         END DO
-
-         ! II. Divergence of advective fluxes
-         ! ----------------------------------
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) *  fse3t(ji,jj,jk) )
-                  ! 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)  )
-                  ! advective trends added to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
-
-         !                                 ! trend diagnostics
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.    &
-            &( cdtype == 'TRC' .AND. l_trdtrc ) )   THEN
-            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )
-            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )
-         END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-         !
-      END DO
-
-      ! ---------------------------  required in restart file to ensure restartability)
-      ! avmb, avtb will be read in zdfini in restart case as they are used in zdftke, kpp etc...
-      IF( lrst_oce .AND. cdtype == 'TRA' ) THEN
-         CALL iom_rstput( kt, nitrst, numrow, 'avmb', avmb )
-         CALL iom_rstput( kt, nitrst, numrow, 'avtb', avtb )
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, zpres, zfzp )
-      CALL wrk_dealloc( jpi, jpj, jpk, zwx, zwy, zwz, zind )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen2')
-      !
-   END SUBROUTINE tra_adv_cen2
-   
-   
-   SUBROUTINE ups_orca_set
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ups_orca_set  ***
-      !!       
-      !! ** Purpose :   add a portion of upstream scheme in area where the
-      !!                centered scheme generates too strong overshoot
-      !!
-      !! ** Method  :   orca (R4 and R2) confiiguration setting. Set upsmsk
-      !!                array to nozero value in some straith. 
-      !!
-      !! ** Action : - upsmsk set to 1 at some strait, 0 elsewhere for orca
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ups_orca_set')
-      !
-      ! mixed upstream/centered scheme near river mouths
-      ! ------------------------------------------------
-      SELECT CASE ( jp_cfg )
-      !                                        ! =======================
-      CASE ( 4 )                               !  ORCA_R4 configuration 
-         !                                     ! =======================
-         !                                          ! Gibraltar Strait
-         ii0 =  70   ;   ii1 =  71
-         ij0 =  52   ;   ij1 =  53   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         !
-         !                                     ! =======================
-      CASE ( 2 )                               !  ORCA_R2 configuration 
-         !                                     ! =======================
-         !                                          ! Gibraltar Strait
-         ij0 = 102   ;   ij1 = 102
-         ii0 = 138   ;   ii1 = 138   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.20
-         ii0 = 139   ;   ii1 = 139   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
-         ii0 = 140   ;   ii1 = 140   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         ij0 = 101   ;   ij1 = 102
-         ii0 = 141   ;   ii1 = 141   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         !                                          ! Bab el Mandeb Strait
-         ij0 =  87   ;   ij1 =  88
-         ii0 = 164   ;   ii1 = 164   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.10
-         ij0 =  88   ;   ij1 =  88
-         ii0 = 163   ;   ii1 = 163   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         ii0 = 162   ;   ii1 = 162   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
-         ii0 = 160   ;   ii1 = 161   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         ij0 =  89   ;   ij1 =  89
-         ii0 = 158   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         ij0 =  90   ;   ij1 =  90
-         ii0 = 160   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         !                                          ! Sound Strait
-         ij0 = 116   ;   ij1 = 116
-         ii0 = 144   ;   ii1 = 144   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         ii0 = 145   ;   ii1 = 147   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         ii0 = 148   ;   ii1 = 148   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         !
-      END SELECT 
-      
-      ! mixed upstream/centered scheme over closed seas
-      ! -----------------------------------------------
-      CALL clo_ups( upsmsk(:,:) )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ups_orca_set')
-      !
-   END SUBROUTINE ups_orca_set
-
-   !!======================================================================
-END MODULE traadv_cen2
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 5891)
+++ 	(revision )
@@ -1,219 +1,0 @@
-MODULE traadv_eiv
-   !!======================================================================
-   !!                    ***  MODULE  traadv_eiv  ***
-   !! Ocean tracers:  advection trend - eddy induced velocity
-   !!======================================================================
-   !! History :  1.0  !  2005-11 (G. Madec)  Original code, from traldf and zdf _iso
-   !!            3.3  !  2010-05 (C. Ethe, G. Madec)  merge TRC-TRA 
-   !!----------------------------------------------------------------------
-#if defined key_traldf_eiv   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_traldf_eiv'                  rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-   !!   tra_ldf_iso : update the tracer trend with the horizontal component
-   !!                 of iso neutral laplacian operator or horizontal 
-   !!                 laplacian operator in s-coordinate
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldfslp          ! iso-neutral slopes
-   USE in_out_manager  ! I/O manager
-   USE iom
-   USE trc_oce         ! share passive tracers/Ocean variables
-# if defined key_diaeiv
-   USE phycst          ! physical constants
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-# endif  
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_eiv   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
-#  include "ldfeiv_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_eiv( kt, kit000, pun, pvn, pwn, cdtype )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_eiv  ***
-      !! 
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The eddy induced advection is computed from the slope
-      !!      of iso-neutral surfaces computed in routine ldf_slp as follows:
-      !!         zu_eiv =  1/(e2u e3u)   dk[ aeiu e2u mi(wslpi) ]
-      !!         zv_eiv =  1/(e1v e3v)   dk[ aeiv e1v mj(wslpj)
-      !!         zw_eiv = -1/(e1t e2t) { di[ aeiu e2u mi(wslpi) ]
-      !!                               + dj[ aeiv e1v mj(wslpj) ] }
-      !!      add the eiv component to the model velocity:
-      !!         p.n = p.n + z._eiv
-      !!
-      !! ** Action  : - add to p.n the eiv component
-      !!----------------------------------------------------------------------
-      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)
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean velocity components 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv
-      !!
-      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
-      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars
-      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      -
-# if defined key_diaeiv 
-      REAL(wp) ::   zztmp                      ! local scalar
-# endif  
-      REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'tra_adv_eiv')
-      !
-# if defined key_diaeiv 
-      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d )
-# else
-      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv )
-# endif
-
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection on ', cdtype,' :'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   add to velocity fields the eiv component'
-# if defined key_diaeiv 
-         IF( cdtype == 'TRA') THEN
-            u_eiv(:,:,:) = 0.e0
-            v_eiv(:,:,:) = 0.e0
-            w_eiv(:,:,:) = 0.e0
-         END IF
-# endif
-      ENDIF
-
-      zu_eiv(:,:) = 0.e0   ;   zv_eiv(:,:) = 0.e0   ;    zw_eiv(:,:) = 0.e0  
-      
-                                                    ! =================
-      DO jk = 1, jpkm1                              !  Horizontal slab
-         !                                          ! =================
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk  ) ) * fsaeiu(ji,jj,jk  ) * umask(ji,jj,jk  )
-               zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj,jk+1) ) * fsaeiu(ji,jj,jk+1) * umask(ji,jj,jk+1)
-               zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk  ) ) * fsaeiv(ji,jj,jk  ) * vmask(ji,jj,jk  )
-               zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji,jj+1,jk+1) ) * fsaeiv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
-
-               zu_eiv(ji,jj) = 0.5 * umask(ji,jj,jk) * ( zuwk - zuwk1 ) 
-               zv_eiv(ji,jj) = 0.5 * vmask(ji,jj,jk) * ( zvwk - zvwk1 ) 
-   
-               pun(ji,jj,jk) = pun(ji,jj,jk) + e2u(ji,jj) * zu_eiv(ji,jj)
-               pvn(ji,jj,jk) = pvn(ji,jj,jk) + e1v(ji,jj) * zv_eiv(ji,jj)
-            END DO
-         END DO
-# if defined key_diaeiv 
-         IF( cdtype == 'TRA') THEN
-            u_eiv(:,:,jk) = zu_eiv(:,:) / fse3u(:,:,jk)
-            v_eiv(:,:,jk) = zv_eiv(:,:) / fse3v(:,:,jk)
-         END IF
-# endif
-         IF( jk >=2 ) THEN                             ! jk=1 zw_eiv=0, not computed
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-# if defined key_traldf_c2d || defined key_traldf_c3d
-                  zuwi  = ( wslpi(ji,jj,jk)+wslpi(ji-1,jj,jk) ) * fsaeiu(ji-1,jj,jk) * e2u(ji-1,jj) * umask(ji-1,jj,jk)
-                  zuwi1 = ( wslpi(ji,jj,jk)+wslpi(ji+1,jj,jk) ) * fsaeiu(ji  ,jj,jk) * e2u(ji  ,jj) * umask(ji  ,jj,jk)
-                  zvwj  = ( wslpj(ji,jj,jk)+wslpj(ji,jj-1,jk) ) * fsaeiv(ji,jj-1,jk) * e1v(ji,jj-1) * vmask(ji,jj-1,jk)
-                  zvwj1 = ( wslpj(ji,jj,jk)+wslpj(ji,jj+1,jk) ) * fsaeiv(ji,jj  ,jk) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
-  
-                  zw_eiv(ji,jj) = - 0.5 * tmask(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj ) 
-# else
-                  zuwi  = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) ) * e2u(ji-1,jj) * umask(ji-1,jj,jk)
-                  zuwi1 = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) ) * e2u(ji  ,jj) * umask(ji  ,jj,jk)
-                  zvwj  = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) ) * e1v(ji,jj-1) * vmask(ji,jj-1,jk)
-                  zvwj1 = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) ) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
-
-                  zw_eiv(ji,jj) = - 0.5 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj )
-# endif
-                  pwn(ji,jj,jk) = pwn(ji,jj,jk) + zw_eiv(ji,jj)
-               END DO
-            END DO
-# if defined key_diaeiv 
-            IF( cdtype == 'TRA')  w_eiv(:,:,jk) = zw_eiv(:,:) / ( e1t(:,:) * e2t(:,:) )
-# endif
-         ENDIF
-         !                                          ! =================
-      END DO                                        !    End of slab  
-      !                                             ! =================
-
-# if defined key_diaeiv 
-      IF( cdtype == 'TRA') THEN
-         CALL iom_put( "uoce_eiv", u_eiv )    ! i-eiv current
-         CALL iom_put( "voce_eiv", v_eiv )    ! j-eiv current
-         CALL iom_put( "woce_eiv", w_eiv )    ! vert. eiv current
-         IF( iom_use('ueiv_heattr') ) THEN
-            zztmp = 0.5 * rau0 * rcp 
-            z2d(:,:) = 0.e0 
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     z2d(ji,jj) = z2d(ji,jj) + u_eiv(ji,jj,jk) &
-                       &         * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e2u(ji,jj) * fse3u(ji,jj,jk) 
-                  END DO
-               END DO
-            END DO
-            CALL lbc_lnk( z2d, 'U', -1. )
-            CALL iom_put( "ueiv_heattr", zztmp * z2d )                  ! heat transport in i-direction
-         ENDIF
-            
-         IF( iom_use('veiv_heattr') ) THEN
-            zztmp = 0.5 * rau0 * rcp 
-            z2d(:,:) = 0.e0 
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     z2d(ji,jj) = z2d(ji,jj) + v_eiv(ji,jj,jk) &
-                     &           * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e1v(ji,jj) * fse3v(ji,jj,jk) 
-                  END DO
-               END DO
-            END DO
-            CALL lbc_lnk( z2d, 'V', -1. )
-            CALL iom_put( "veiv_heattr", zztmp * z2d )                  !  heat transport in i-direction
-         ENDIF
-    END IF
-# endif  
-      ! 
-# if defined key_diaeiv 
-      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d )
-# else
-      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv )
-# endif
-      !
-      IF( nn_timing == 1 )  CALL timing_stop( 'tra_adv_eiv')
-      !
-    END SUBROUTINE tra_adv_eiv
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :             No rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE tra_adv_eiv( kt, kit000, pun, pvn, pwn, cdtype )              ! Empty routine
-      INTEGER  ::   kt    
-      INTEGER  ::   kit000    
-      CHARACTER(len=3) ::   cdtype
-      REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn
-      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1)
-   END SUBROUTINE tra_adv_eiv
-#endif
-
-   !!==============================================================================
-END MODULE traadv_eiv
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90	(revision 5901)
@@ -0,0 +1,809 @@
+MODULE traadv_fct
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_fct  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend (2nd/4th order Flux Corrected Transport method)
+   !!==============================================================================
+   !! History :  3.7  !  2015-09  (L. Debreu, G. Madec)  original code (inspired from traadv_tvd.F90)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  tra_adv_fct    : update the tracer trend with a 3D advective trends using a 2nd or 4th order FCT scheme
+   !!  tra_adv_fct_zts: update the tracer trend with a 3D advective trends using a 2nd order FCT scheme 
+   !!                   with sub-time-stepping in the vertical direction
+   !!  nonosc         : compute monotonic tracer fluxes by a non-oscillatory algorithm 
+   !!  interp_4th_cpt : 4th order compact scheme for the vertical component of the advection
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! tracers trends
+   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient
+   USE diaptr         ! poleward transport diagnostics
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_fct        ! routine called by traadv.F90
+   PUBLIC   tra_adv_fct_zts    ! routine called by traadv.F90
+   PUBLIC   interp_4th_cpt     ! routine called by traadv_cen.F90
+
+   LOGICAL  ::   l_trd   ! flag to compute trends
+   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pun, pvn, pwn,       &
+      &                                              ptb, ptn, pta, kjpt, kn_fct_h, kn_fct_v )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_fct  ***
+      !! 
+      !! **  Purpose :   Compute the now trend due to total advection of 
+      !!       tracers and add it to the general trend of tracer equations
+      !!
+      !! **  Method  : - 2nd or 4th FCT scheme on the horizontal direction
+      !!               (choice through the value of kn_fct)
+      !!               - 4th order compact scheme on the vertical 
+      !!               - corrected flux (monotonic correction) 
+      !!
+      !! ** Action : - update (pta) with the now advective tracer trends
+      !!             - send the trends for further diagnostics
+      !!----------------------------------------------------------------------
+      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
+      INTEGER                              , INTENT(in   ) ::   kn_fct_h        ! order of the FCT scheme (=2 or 4)
+      INTEGER                              , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4)
+      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, ztra                              ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrdz
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_fct : FCT advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      l_trd = .FALSE.
+      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
+      !
+      IF( l_trd )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp
+      ENDIF
+      !
+      !                                         ! surface & bottom value : flux set to zero one for all
+      IF( lk_vvl )   zwz(:,:, 1 ) = 0._wp                ! except at the surface in linear free surface case
+      zwx(:,:,jpk) = 0._wp   ;   zwy(:,:,jpk) = 0._wp    ;    zwz(:,:,jpk) = 0._wp
+      !
+      zwi(:,:,:) = 0._wp        
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !
+         !        !==  upstream advection with initial mass fluxes & intermediate update  ==!
+         !                    !* 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 *!
+         DO jk = 2, jpkm1         ! Interior value ( multiplied by wmask)
+            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) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                    
+         IF(.NOT.lk_vvl ) THEN   ! top ocean value (only in linear free surface as zwz has been w-masked)
+            IF( ln_isfcav ) THEN             ! top of the ice-shelf cavities and at the ocean surface
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                  END DO
+               END DO   
+            ELSE                             ! no cavities: only at the ocean surface
+               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !               
+         DO jk = 1, jpkm1     !* trend and after field with monotonic scheme
+            z2dtt = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! total intermediate advective trends
+                  ztra = - (  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) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )
+                  ! update and guess with monotonic sheme
+!!gm why tmask added in the two following lines ???    the mask is done in tranxt !
+                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra   * tmask(ji,jj,jk)
+                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwi, 'T', 1. )  ! Lateral boundary conditions on zwi  (unchanged sign)
+         !                
+         IF( l_trd )  THEN             ! trend diagnostics (contribution of upstream fluxes)
+            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
+         ENDIF
+         !
+         !
+         !        !==  anti-diffusive flux : high order minus low order  ==!
+         !
+         SELECT CASE( kn_fct_h )         !* horizontal anti-diffusive fluxes
+         !
+         CASE(  2  )                         ! 2nd order centered
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zwx(ji,jj,jk) = 0.5_wp * 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_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         CASE(  4  )                         ! 4th order centered
+            zltu(:,:,jpk) = 0._wp                            ! Bottom value : flux set to zero
+            zltv(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1                                 ! Laplacian
+               DO jj = 1, jpjm1                                   ! First derivative (gradient)
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+                  END DO
+               END DO
+               DO jj = 2, jpjm1                                   ! 
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zltu(ji,jj,jk) = (  ztu(ji,jj,jk) + ztu(ji-1,jj,jk)  ) * r1_6
+                     zltv(ji,jj,jk) = (  ztv(ji,jj,jk) + ztv(ji,jj-1,jk)  ) * r1_6
+                  END DO
+               END DO
+            END DO
+            !
+            CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO jk = 1, jpkm1                                 ! Horizontal advective fluxes
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points
+                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn)
+                     !                                                  ! C4 minus upstream advective fluxes 
+                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk)
+                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk)
+                  END DO
+               END DO
+            END DO         
+            !
+         CASE(  41 )                         ! 4th order centered       ==>>   !!gm coding attempt   need to be tested
+            ztu(:,:,jpk) = 0._wp                             ! Bottom value : flux set to zero
+            ztv(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1                                 ! gradient
+               DO jj = 1, jpjm1                                   ! First derivative (gradient)
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO jk = 1, jpkm1                                 ! Horizontal advective fluxes
+               DO jj = 2, jpjm1
+                  DO ji = 2, fs_jpim1   ! vector opt.
+                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points (x2)
+                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn)
+                     !                                                  ! C4 interpolation of T at u- & v-points (x2)
+                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) )
+                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) )
+                     !                                                  ! C4 minus upstream advective fluxes 
+                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)
+                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         END SELECT
+         !                                !* vertical anti-diffusive fluxes
+         SELECT CASE( kn_fct_v )                ! Interior values (w-masked)
+         !
+         CASE(  2  )                                  ! 2nd order centered
+            DO jk = 2, jpkm1    
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwz(ji,jj,jk) =  ( 0.5_wp * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   &
+                                       - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         CASE(  4  )                                  ! 4th order COMPACT
+            !    
+            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )         ! COMPACT interpolation of T at w-point
+            !
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwz(ji,jj,jk) = ( pwn(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         END SELECT
+         !                                      ! top ocean value: high order = upstream  ==>>  zwz=0
+         zwz(:,:, 1 ) = 0._wp                   ! only ocean surface as interior zwz values have been w-masked
+         !
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
+         CALL lbc_lnk( zwz, 'W',  1. )
+
+         !        !==  monotonicity algorithm  ==!
+         !
+         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
+
+
+         !        !==  final trend with corrected fluxes  ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - (  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) ) &
+                     &                                / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !
+         IF( l_trd ) THEN                 ! trend diagnostics (contribution of upstream fluxes)
+            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_xad, ztrdx, pun, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )
+            !
+            CALL wrk_dealloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz )
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
+         ENDIF
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct')
+      !
+   END SUBROUTINE tra_adv_fct
+
+
+   SUBROUTINE tra_adv_fct_zts( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                                  ptb, ptn, pta, kjpt, kn_fct_zts )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_fct_zts  ***
+      !! 
+      !! **  Purpose :   Compute the now trend due to total advection of 
+      !!       tracers and add it to the general trend of tracer equations
+      !!
+      !! **  Method  :   TVD ZTS scheme, i.e. 2nd order centered scheme with
+      !!       corrected flux (monotonic correction). This version use sub-
+      !!       timestepping for the vertical advection which increases stability
+      !!       when vertical metrics are small.
+      !!       note: - this advection scheme needs a leap-frog time scheme
+      !!
+      !! ** Action : - update (pta) with the now advective tracer trends
+      !!             - save the trends 
+      !!----------------------------------------------------------------------
+      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
+      INTEGER                              , INTENT(in   ) ::   kn_fct_zts      ! number of number of vertical sub-timesteps
+      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 
+      !
+      REAL(wp), DIMENSION( jpk )                           ::   zts             ! length of sub-timestep for vertical advection
+      REAL(wp), DIMENSION( jpk )                           ::   zr_p2dt         ! reciprocal of tracer timestep
+      INTEGER  ::   ji, jj, jk, jl, jn       ! dummy loop indices  
+      INTEGER  ::   jtb, jtn, jta   ! sub timestep pointers for leap-frog/euler forward steps
+      INTEGER  ::   jtaken          ! toggle for collecting appropriate fluxes from sub timesteps
+      REAL(wp) ::   z_rzts          ! Fractional length of Euler forward sub-timestep for vertical advection
+      REAL(wp) ::   z2dtt, ztra              ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zwx_sav , zwy_sav
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdx, ztrdy, ztrdz
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrs
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct_zts')
+      !
+      CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav )
+      CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav )
+      CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_fct_zts : 2nd order FCT scheme with ', kn_fct_zts, ' vertical sub-timestep on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      l_trd = .FALSE.
+      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
+      !
+      IF( l_trd )  THEN
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz )
+         ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp
+      ENDIF
+      !
+      zwi(:,:,:) = 0._wp
+      z_rzts = 1._wp / REAL( kn_fct_zts, wp )
+      zr_p2dt(:) = 1._wp / p2dt(:)
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         ! ----------------------------------
+         zwx(:,:,jpk) = 0._wp   ;    zwz(:,:,jpk) = 0._wp
+         zwy(:,:,jpk) = 0._wp   ;    zwi(:,:,jpk) = 0._wp
+
+         ! 2. upstream advection with initial mass fluxes & intermediate update
+         ! --------------------------------------------------------------------
+         ! 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_wp * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5_wp * ( 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
+         DO jk = 2, jpkm1         ! Interior value
+            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_wp * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                       ! top value
+         IF( lk_vvl ) THEN             ! variable volume: only k=1 as zwz is multiplied by wmask
+            zwz(:,:, 1 ) = 0._wp
+         ELSE                          ! linear free surface
+            IF( ln_isfcav ) THEN             ! ice-shelf cavities
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) 
+                  END DO
+               END DO   
+            ELSE                             ! standard case
+               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !
+         DO jk = 1, jpkm1         ! total advective trend
+            z2dtt = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! total intermediate advective trends
+                  ztra = - (  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) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )
+                  ! 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(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                           
+         CALL lbc_lnk( zwi, 'T', 1. )     ! Lateral boundary conditions on zwi  (unchanged sign)
+         !                
+         IF( l_trd )  THEN                ! trend diagnostics (contribution of upstream fluxes)
+            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
+         ENDIF
+
+         ! 3. anti-diffusive flux : high order minus low order
+         ! ---------------------------------------------------
+
+         DO jk = 1, jpkm1                    !* horizontal anti-diffusive fluxes
+            !
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx_sav(ji,jj) = zwx(ji,jj,jk)
+                  zwy_sav(ji,jj) = zwy(ji,jj,jk)
+                  !
+                  zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) )
+               END DO
+            END DO
+            !
+            DO jj = 2, jpjm1                    ! partial horizontal divergence
+               DO ji = fs_2, fs_jpim1
+                  zhdiv(ji,jj,jk) = (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
+                     &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
+               END DO
+            END DO
+            !
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = zwx(ji,jj,jk) - zwx_sav(ji,jj)
+                  zwy(ji,jj,jk) = zwy(ji,jj,jk) - zwy_sav(ji,jj)
+               END DO
+            END DO
+         END DO
+      
+         !                                !* vertical anti-diffusive flux
+         zwz_sav(:,:,:)   = zwz(:,:,:)
+         ztrs   (:,:,:,1) = ptb(:,:,:,jn)
+         zwzts  (:,:,:)   = 0._wp
+         IF( lk_vvl )   zwz(:,:, 1 ) = 0._wp    ! surface value set to zero in vvl case
+         !
+         DO jl = 1, kn_fct_zts                  ! Start of sub timestepping loop
+            !
+            IF( jl == 1 ) THEN                        ! Euler forward to kick things off
+               jtb = 1   ;   jtn = 1   ;   jta = 2
+               zts(:) = p2dt(:) * z_rzts
+               jtaken = MOD( kn_fct_zts + 1 , 2)            ! Toggle to collect every second flux
+               !                                            ! starting at jl =1 if kn_fct_zts is odd; 
+               !                                            ! starting at jl =2 otherwise
+            ELSEIF( jl == 2 ) THEN                    ! First leapfrog step
+               jtb = 1   ;   jtn = 2   ;   jta = 3
+               zts(:) = 2._wp * p2dt(:) * z_rzts
+            ELSE                                      ! Shuffle pointers for subsequent leapfrog steps
+               jtb = MOD(jtb,3) + 1
+               jtn = MOD(jtn,3) + 1
+               jta = MOD(jta,3) + 1
+            ENDIF
+            DO jk = 2, jpkm1                          ! interior value
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwz(ji,jj,jk) = 0.5_wp * pwn(ji,jj,jk) * ( ztrs(ji,jj,jk,jtn) + ztrs(ji,jj,jk-1,jtn) ) * wmask(ji,jj,jk)
+                     IF( jtaken == 0 )   zwzts(ji,jj,jk) = zwzts(ji,jj,jk) + zwz(ji,jj,jk) * zts(jk)    ! Accumulate time-weighted vertcal flux
+                  END DO
+               END DO
+            END DO
+            IF(.NOT.lk_vvl ) THEN                    ! top value (only in linear free surface case)
+               IF( ln_isfcav ) THEN                      ! ice-shelf cavities
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                     END DO
+                  END DO   
+               ELSE                                      ! standard case
+                  zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+               ENDIF
+            ENDIF
+            !
+            jtaken = MOD( jtaken + 1 , 2 )
+            !
+            DO jk = 2, jpkm1                             ! total advective trends
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb)                                                 &
+                        &               - zts(jk) * (  zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   &
+                        &                         / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  END DO
+               END DO
+            END DO
+            !
+         END DO
+
+         DO jk = 2, jpkm1          ! Anti-diffusive vertical flux using average flux from the sub-timestepping
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zwz(ji,jj,jk) = ( zwzts(ji,jj,jk) * zr_p2dt(jk) - zwz_sav(ji,jj,jk) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
+         CALL lbc_lnk( zwz, 'W',  1. )
+
+         ! 4. monotonicity algorithm
+         ! -------------------------
+         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
+
+
+         ! 5. final trend with corrected fluxes
+         ! ------------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (   zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )       &
+                     &                                    + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   )   &
+                     &                                / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+
+         !                                 ! 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_xad, ztrdx, pun, ptn(:,:,:,jn) )   
+            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )  
+            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
+            !
+            CALL wrk_dealloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz )
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
+         ENDIF
+         !
+      END DO
+      !
+      CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav )
+      CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav )
+      CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct_zts')
+      !
+   END SUBROUTINE tra_adv_fct_zts
+
+
+   SUBROUTINE nonosc( 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(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
+
+      ! Search local extrema
+      ! --------------------
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+      zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ),   &
+         &        paft * tmask - zbig * ( 1._wp - tmask )  )
+      zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ),   &
+         &        paft * tmask + zbig * ( 1._wp - tmask )  )
+
+      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 = e1t(ji,jj) * e2t(ji,jj) * fse3t(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 lbc_lnk( zbetup, 'T', 1. )   ;   CALL 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._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+               zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) )
+               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu )
+
+               zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+               zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) )
+               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv )
+
+      ! 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) ) )
+               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('nonosc')
+      !
+   END SUBROUTINE nonosc
+
+
+   SUBROUTINE interp_4th_cpt( pt_in, pt_out )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interp_4th_cpt  ***
+      !! 
+      !! **  Purpose :   Compute the interpolation of tracer at w-point
+      !!
+      !! **  Method  :   4th order compact interpolation
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! now tracer fields
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pt_out   ! now tracer field interpolated at w-pts
+      !
+      INTEGER :: ji, jj, jk   ! dummy loop integers
+      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt
+      !!----------------------------------------------------------------------
+      
+      DO jk = 3, jpkm1        !==  build the three diagonal matrix  ==!
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwd (ji,jj,jk) = 4._wp
+               zwi (ji,jj,jk) = 1._wp
+               zws (ji,jj,jk) = 1._wp
+               zwrm(ji,jj,jk) = 3._wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+               !
+               IF( tmask(ji,jj,jk+1) == 0._wp) THEN   ! Switch to second order centered at bottom
+                  zwd (ji,jj,jk) = 1._wp
+                  zwi (ji,jj,jk) = 0._wp
+                  zws (ji,jj,jk) = 0._wp
+                  zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )    
+               ENDIF
+            END DO
+         END DO
+      END DO
+      !
+      jk=2                                            ! Switch to second order centered at top
+      DO jj=1,jpj
+         DO ji=1,jpi
+            zwd (ji,jj,jk) = 1._wp
+            zwi (ji,jj,jk) = 0._wp
+            zws (ji,jj,jk) = 0._wp
+            zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+         END DO
+      END DO   
+      !
+      !                       !==  tridiagonal solve  ==!
+      DO jj = 1, jpj                ! first recurrence
+         DO ji = 1, jpi
+            zwt(ji,jj,2) = zwd(ji,jj,2)
+         END DO
+      END DO
+      DO jk = 3, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               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
+      !
+      DO jj = 1, jpj                ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         DO ji = 1, jpi
+            pt_out(ji,jj,2) = zwrm(ji,jj,2)
+         END DO
+      END DO
+      DO jk = 3, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)             
+            END DO
+         END DO
+      END DO
+
+      DO jj = 1, jpj                ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
+         DO ji = 1, jpi
+            pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 2, -1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !    
+   END SUBROUTINE interp_4th_cpt
+   
+   !!======================================================================
+END MODULE traadv_fct
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90	(revision 5901)
@@ -28,5 +28,5 @@
    PUBLIC   tra_adv_mle_init   ! routine called in traadv.F90
 
-   !                                               !!* namelist namtra_adv_mle *
+   !                                       !!* namelist namtra_adv_mle *
    LOGICAL, PUBLIC ::   ln_mle              ! flag to activate the Mixed Layer Eddy (MLE) parameterisation
    INTEGER         ::   nn_mle              ! MLE type: =0 standard Fox-Kemper ; =1 new formulation
@@ -34,10 +34,10 @@
    INTEGER         ::   nn_conv             ! =1 no MLE in case of convection ; =0 always MLE
    REAL(wp)        ::   rn_ce               ! MLE coefficient
-   !                                           ! parameters used in nn_mle = 0 case
+   !                                        ! parameters used in nn_mle = 0 case
    REAL(wp)        ::   rn_lf                  ! typical scale of mixed layer front
-   REAL(wp)        ::   rn_time             ! time scale for mixing momentum across the mixed layer
-   !                                             ! parameters used in nn_mle = 1 case
-   REAL(wp)        ::   rn_lat                   ! reference latitude for a 5 km scale of ML front
-   REAL(wp)        ::   rn_rho_c_mle         ! Density criterion for definition of MLD used by FK
+   REAL(wp)        ::   rn_time                ! time scale for mixing momentum across the mixed layer
+   !                                        ! parameters used in nn_mle = 1 case
+   REAL(wp)        ::   rn_lat                 ! reference latitude for a 5 km scale of ML front
+   REAL(wp)        ::   rn_rho_c_mle           ! Density criterion for definition of MLD used by FK
 
    REAL(wp) ::   r5_21 = 5.e0 / 21.e0   ! factor used in mle streamfunction computation
@@ -52,5 +52,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
@@ -80,5 +80,4 @@
       !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008
       !!----------------------------------------------------------------------
-      !
       INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
       INTEGER                         , INTENT(in   ) ::   kit000     ! first time step index
@@ -93,5 +92,5 @@
       REAL(wp) ::   zcvw, zmvw   !   -      -
       REAL(wp) ::   zc                                     !   -      -
-
+      !
       INTEGER  ::   ii, ij, ik              ! local integers
       INTEGER, DIMENSION(3) ::   ilocu      !
@@ -101,5 +100,5 @@
       INTEGER, POINTER, DIMENSION(:,:) :: inml_mle
       !!----------------------------------------------------------------------
-
+      !
       IF( nn_timing == 1 )  CALL timing_start('tra_adv_mle')
       CALL wrk_alloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH)
@@ -171,11 +170,11 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            &
-                  &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp          , e1u(ji,jj)                 )   &
-                  &           / (         e1u(ji,jj)          * MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   )
+               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            &
+                  &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   &
+                  &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   )
                   !
-               zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1v(ji,jj)                                            &
-                  &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp          , e2v(ji,jj)                 )   &
-                  &           / (         e2v(ji,jj)          * MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   )
+               zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1_e2v(ji,jj)                                            &
+                  &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )   &
+                  &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   )
             END DO
          END DO
@@ -184,8 +183,8 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj) / e1u(ji,jj)          &
+               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               &
                   &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )
                   !
-               zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1v(ji,jj) / e2v(ji,jj)          &
+               zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1_e2v(ji,jj)               &
                   &                  * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )
             END DO
@@ -252,6 +251,6 @@
          ! divide by cross distance to give streamfunction with dimensions m^2/s
          DO jk = 1, ikmax+1
-            zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk)/e2u(:,:)
-            zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk)/e1v(:,:)
+            zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) * r1_e2u(:,:)
+            zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) * r1_e1v(:,:)
          END DO
          CALL iom_put( "psiu_mle", zpsi_uw )    ! i-mle streamfunction
@@ -281,5 +280,4 @@
       NAMELIST/namtra_adv_mle/ ln_mle , nn_mle, rn_ce, rn_lf, rn_time, rn_lat, nn_mld_uv, nn_conv, rn_rho_c_mle
       !!----------------------------------------------------------------------
-
 
       REWIND( numnam_ref )              ! Namelist namtra_adv_mle in reference namelist : Tracer advection scheme
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90	(revision 5901)
@@ -0,0 +1,288 @@
+MODULE traadv_mus
+   !!======================================================================
+   !!                       ***  MODULE  traadv_mus  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend
+   !!======================================================================
+   !! History :       !  2000-06  (A.Estublier)  for passive tracers
+   !!                 !  2001-08  (E.Durand, G.Madec)  adapted for T & S
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!            3.4  !  2012-06  (P. Oddo, M. Vichi) include the upstream where needed
+   !!            3.7  !  2015-09  (G. Madec) add the ice-shelf cavities boundary condition
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_mus   : update the tracer trend with the horizontal
+   !!                   and vertical advection trends using MUSCL scheme
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE dom_oce        ! ocean space and time domain
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! tracers trends manager
+   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient
+   USE sbcrnf         ! river runoffs
+   USE diaptr         ! poleward transport diagnostics
+   !
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_mus   ! routine called by traadv.F90
+   
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits
+   !                                                           !  and in closed seas (orca 2 and 4 configurations)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_mus( kt, kit000, cdtype, p2dt, pun, pvn, pwn,             &
+      &                                              ptb, pta, kjpt, ld_msc_ups )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE tra_adv_mus  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to total advection of tracers
+      !!              using a MUSCL scheme (Monotone Upstream-centered Scheme for
+      !!              Conservation Laws) and add it to the general tracer trend.
+      !!
+      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
+      !!              ld_msc_ups=T : 
+      !!
+      !! ** Action  : - update (ta,sa) with the now advective tracer trends
+      !!              - send trends to trdtra module for further diagnostcs
+      !!
+      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
+      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
+      !!----------------------------------------------------------------------
+      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
+      LOGICAL                              , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl
+      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             ! before tracer field
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
+      INTEGER  ::   ierr                 ! local integer
+      REAL(wp) ::   zu, z0u, zzwx, zw    ! local scalars
+      REAL(wp) ::   zv, z0v, zzwy, z0w   !   -      -
+      REAL(wp) ::   zdt, zalpha          !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      - 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_mus')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '        : mixed up-stream           ', ld_msc_ups
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         IF(lwp) WRITE(numout,*)
+         !
+         ! Upstream / MUSCL scheme indicator
+         !
+         ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr )
+         xind(:,:,:) = 1._wp              ! set equal to 1 where up-stream is not needed
+         !
+         IF( ld_msc_ups ) THEN            ! define the upstream indicator (if asked)
+            ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
+            upsmsk(:,:) = 0._wp                             ! not upstream by default
+            !
+            DO jk = 1, jpkm1
+               xind(:,:,jk) = 1._wp                              &                 ! =>1 where up-stream is not needed
+                  &         - MAX ( rnfmsk(:,:) * rnfmsk_z(jk),  &                 ! =>0 near runoff mouths (& closed sea outflows)
+                  &                 upsmsk(:,:)                ) * tmask(:,:,jk)   ! =>0 in some user defined area
+            END DO
+         ENDIF 
+         !
+      ENDIF 
+      !      
+      !                                                     ! ===========
+      DO jn = 1, kjpt                                       ! tracer loop
+         !                                                  ! ===========
+         ! I. Horizontal advective fluxes
+         ! ------------------------------
+         ! first guess of the slopes
+         zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
+         ! interior values
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1      
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
+                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+           END DO
+         END DO
+         !
+         CALL lbc_lnk( zwx, 'U', -1. )                        ! lateral boundary conditions on zwx, zwy   (changed sign)
+         CALL lbc_lnk( zwy, 'V', -1. )
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
+         DO jk = 1, jpkm1                                     ! interior values
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
+                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1                                     ! Slopes limitation
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
+                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
+               END DO
+           END DO
+         END DO
+         !
+         !                                             !-- MUSCL horizontal advective fluxes
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! MUSCL fluxes
+                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
+                  zalpha = 0.5 - z0u
+                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk)
+                  zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk)
+                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+                  !
+                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
+                  zalpha = 0.5 - z0v
+                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )
+                  zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk)
+                  zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk)
+                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign)
+         !
+         DO jk = 1, jpkm1         ! Tracer flux divergence at t-point added to the general trend
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       &
+                  &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     &
+                  &                                   / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+           END DO
+         END DO        
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.   &
+            &( cdtype == 'TRC' .AND. l_trdtrc )      )  THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) )
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
+            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
+         ENDIF
+
+         ! II. Vertical advective fluxes
+         ! -----------------------------
+         !                                !-- first guess of the slopes
+         zwx(:,:, 1 ) = 0._wp                   ! surface & bottom boundary conditions
+         zwx(:,:,jpk) = 0._wp                   ! surface & bottom boundary conditions
+         DO jk = 2, jpkm1                                     ! interior values
+            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
+         END DO
+
+         !                                !-- Slopes of tracer
+         zslpx(:,:,1) = 0._wp                   ! surface values
+         DO jk = 2, jpkm1                       ! interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
+               END DO
+            END DO
+         END DO
+         !                                !-- Slopes limitation
+         DO jk = 2, jpkm1                       ! interior values
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
+               END DO
+            END DO
+         END DO
+         !                                !-- vertical advective flux
+         DO jk = 1, jpkm1                       ! interior values
+            zdt  = p2dt(jk)
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
+                  zalpha = 0.5 + z0w
+                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt  / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) )
+                  zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1)
+                  zzwy = ptb(ji,jj,jk  ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  )
+                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk)
+               END DO 
+            END DO
+         END DO
+         !                                      ! top values  (bottom already set to zero)
+         IF( lk_vvl ) THEN                            !  variable volume
+            zwx(:,:, 1 ) = 0._wp                            ! k=1 only as zwx has been multiplied by wmask
+         ELSE                                         ! linear free surface 
+            IF( ln_isfcav ) THEN                            ! ice-shelf cavities (top of the ocean)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwx(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)
+                  END DO
+               END DO   
+            ELSE                                             ! no cavities: only at the ocean surface
+               zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !
+         DO jk = 1, jpkm1                    ! Compute & add the vertical advective trend
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !                                 ! Save the vertical advective trends for diagnostic
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.     &
+            &( cdtype == 'TRC' .AND. l_trdtrc )      )   &
+            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) )
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_mus')
+      !
+   END SUBROUTINE tra_adv_mus
+
+   !!======================================================================
+END MODULE traadv_mus
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 5891)
+++ 	(revision )
@@ -1,300 +1,0 @@
-MODULE traadv_muscl
-   !!======================================================================
-   !!                       ***  MODULE  traadv_muscl  ***
-   !! Ocean  tracers:  horizontal & vertical advective trend
-   !!======================================================================
-   !! History :       !  2000-06  (A.Estublier)  for passive tracers
-   !!                 !  2001-08  (E.Durand, G.Madec)  adapted for T & S
-   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
-   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!            3.4  !  2012-06  (P. Oddo, M. Vichi) include the upstream where needed
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_muscl : update the tracer trend with the horizontal
-   !!                   and vertical advection trends using MUSCL scheme
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE dom_oce        ! ocean space and time domain
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! tracers trends manager
-   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient
-   USE sbcrnf         ! river runoffs
-   USE diaptr         ! poleward transport diagnostics
-   !
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! distribued memory computing
-   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_muscl   ! routine called by traadv.F90
-   
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits
-   !                                                           !  and in closed seas (orca 2 and 4 configurations)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index
-   
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_muscl( kt, kit000, cdtype, p2dt, pun, pvn, pwn,   &
-      &                                                ptb, pta, kjpt, ld_msc_ups )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE tra_adv_muscl  ***
-      !!
-      !! ** Purpose :   Compute the now trend due to total advection of T and 
-      !!      S using a MUSCL scheme (Monotone Upstream-centered Scheme for
-      !!      Conservation Laws) and add it to the general tracer trend.
-      !!
-      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
-      !!
-      !! ** Action  : - update (ta,sa) with the now advective tracer trends
-      !!              - save trends 
-      !!
-      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
-      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
-      !!----------------------------------------------------------------------
-      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
-      LOGICAL                              , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl
-      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             ! before tracer field
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
-      !
-      INTEGER  ::   ji, jj, jk, jn            ! dummy loop indices
-      INTEGER  ::   ierr                      ! local integer
-      REAL(wp) ::   zu, z0u, zzwx, zw         ! local scalars
-      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      -
-      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      - 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_muscl')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy )
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '        : mixed up-stream           ', ld_msc_ups
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-         IF(lwp) WRITE(numout,*)
-         !
-         !
-         IF( ld_msc_ups ) THEN
-            IF( .NOT. ALLOCATED( upsmsk ) )  THEN
-                ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
-                IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_muscl: unable to allocate upsmsk array')
-            ENDIF
-            upsmsk(:,:) = 0._wp                             ! not upstream by default
-         ENDIF
-
-         IF( .NOT. ALLOCATED( xind ) ) THEN
-             ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr )
-             IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_muscl: unable to allocate zind array')
-         ENDIF
-         !
-
-         !
-         ! Upstream / MUSCL scheme indicator
-         ! ------------------------------------
-!!gm  useless
-         xind(:,:,:) = 1._wp                             ! set equal to 1 where up-stream is not needed
-!!gm
-         !
-         IF( ld_msc_ups )  THEN
-            DO jk = 1, jpkm1
-               xind(:,:,jk) = 1._wp                              &                 ! =>1 where up-stream is not needed
-                  &         - MAX ( rnfmsk(:,:) * rnfmsk_z(jk),  &                 ! =>0 near runoff mouths (& closed sea outflows)
-                  &                 upsmsk(:,:)                ) * tmask(:,:,jk)   ! =>0 near some straits
-            END DO
-         ENDIF 
-         !
-      ENDIF 
-      !      
-      !                                                     ! ===========
-      DO jn = 1, kjpt                                       ! tracer loop
-         !                                                  ! ===========
-         ! I. Horizontal advective fluxes
-         ! ------------------------------
-         ! first guess of the slopes
-         zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
-         ! interior values
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1      
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
-                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
-               END DO
-           END DO
-         END DO
-         !
-         CALL lbc_lnk( zwx, 'U', -1. )                        ! lateral boundary conditions on zwx, zwy   (changed sign)
-         CALL lbc_lnk( zwy, 'V', -1. )
-         !                                             !-- Slopes of tracer
-         zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
-         DO jk = 1, jpkm1                                     ! interior values
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
-                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, jpkm1                                     ! Slopes limitation
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
-                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
-                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
-                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
-                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
-                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
-               END DO
-           END DO
-         END DO             ! interior values
-
-         !                                             !-- MUSCL horizontal advective fluxes
-         DO jk = 1, jpkm1                                     ! interior values
-            zdt  = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! MUSCL fluxes
-                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
-                  zalpha = 0.5 - z0u
-                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
-                  zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk)
-                  zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk)
-                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-                  !
-                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
-                  zalpha = 0.5 - z0v
-                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
-                  zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk)
-                  zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk)
-                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-               END DO
-            END DO
-         END DO
-         !                                                    ! lateral boundary conditions on zwx, zwy   (changed sign)
-         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )
-         !
-         ! Tracer flux divergence at t-point added to the general trend
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! horizontal advective trends
-                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                  &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )
-                  ! add it to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-           END DO
-         END DO        
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.   &
-            &( cdtype == 'TRC' .AND. l_trdtrc )      )  THEN
-            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) )
-            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) )
-         END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-
-         ! II. Vertical advective fluxes
-         ! -----------------------------
-         !                                             !-- first guess of the slopes
-         zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0    ! surface & bottom boundary conditions
-         DO jk = 2, jpkm1                                     ! interior values
-            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
-         END DO
-
-         !                                             !-- Slopes of tracer
-         zslpx(:,:,1) = 0.e0                                  ! surface values
-         DO jk = 2, jpkm1                                     ! interior value
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
-               END DO
-            END DO
-         END DO
-         !                                             !-- Slopes limitation
-         DO jk = 2, jpkm1                                     ! interior values
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
-                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
-                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
-               END DO
-            END DO
-         END DO
-         !                                             !-- vertical advective flux
-         !                                                    ! surface values  (bottom already set to zero)
-         IF( lk_vvl ) THEN    ;   zwx(:,:, 1 ) = 0.e0                      !  variable volume
-         ELSE                 ;   zwx(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface
-         ENDIF 
-         !
-         DO jk = 1, jpkm1                                     ! interior values
-            zdt  = p2dt(jk)
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) )
-                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
-                  zalpha = 0.5 + z0w
-                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr 
-                  zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1)
-                  zzwy = ptb(ji,jj,jk  ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  )
-                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-               END DO 
-            END DO
-         END DO
-
-         DO jk = 1, jpkm1                    ! Compute & add the vertical advective trend
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! vertical advective trends 
-                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
-                  ! add it to the general tracer trends
-                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
-         !                                 ! Save the vertical advective trends for diagnostic
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.     &
-            &( cdtype == 'TRC' .AND. l_trdtrc )      )   &
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) )
-         !
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_muscl')
-      !
-   END SUBROUTINE tra_adv_muscl
-
-   !!======================================================================
-END MODULE traadv_muscl
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 5891)
+++ 	(revision )
@@ -1,293 +1,0 @@
-MODULE traadv_muscl2
-   !!======================================================================
-   !!                       ***  MODULE  traadv_muscl2  ***
-   !! Ocean  tracers:  horizontal & vertical advective trend
-   !!======================================================================
-   !! History :  1.0  !  2002-06  (G. Madec) from traadv_muscl
-   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_muscl2 : update the tracer trend with the horizontal
-   !!                    and vertical advection trends using MUSCL2 scheme
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE dom_oce         ! ocean space and time domain
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
-   USE in_out_manager  ! I/O manager
-   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
-   USE diaptr          ! poleward transport diagnostics
-   !
-   USE lib_mpp         ! distribued memory computing
-   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_muscl2        ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_muscl2( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
-      &                                         ptb, ptn, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE tra_adv_muscl2  ***
-      !!
-      !! ** Purpose :   Compute the now trend due to total advection of T and 
-      !!      S using a MUSCL scheme (Monotone Upstream-centered Scheme for
-      !!      Conservation Laws) and add it to the general tracer trend.
-      !!
-      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
-      !!
-      !! ** Action  : - update (pta) with the now advective tracer trends
-      !!              - save trends 
-      !!
-      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
-      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
-      !!----------------------------------------------------------------------
-      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 & 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) ::   zu, z0u, zzwx, zw         ! local scalars
-      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      -
-      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy , zwx, zwy
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_muscl2')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy )
-      !
-
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
-      ENDIF
-      !
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         ! I. Horizontal advective fluxes
-         ! ------------------------------
-         ! first guess of the slopes
-         zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
-         ! interior values
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1      
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
-                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
-               END DO
-           END DO
-         END DO
-         !
-         CALL lbc_lnk( zwx, 'U', -1. )                        ! lateral boundary conditions on zwx, zwy   (changed sign)
-         CALL lbc_lnk( zwy, 'V', -1. )
-         !                                             !-- Slopes of tracer
-         zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
-         DO jk = 1, jpkm1                                     ! interior values
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
-                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, jpkm1                                     ! Slopes limitation
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
-                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
-                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
-                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
-                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
-                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
-               END DO
-           END DO
-         END DO             ! interior values
-
-        !                                             !-- MUSCL horizontal advective fluxes
-         DO jk = 1, jpkm1                                     ! interior values
-            zdt  = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! MUSCL fluxes
-                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
-                  zalpha = 0.5 - z0u
-                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
-                  zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk)
-                  zzwy = ptb(ji  ,jj,jk,jn) + zu * zslpx(ji  ,jj,jk)
-                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-                  !
-                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
-                  zalpha = 0.5 - z0v
-                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
-                  zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk)
-                  zzwy = ptb(ji,jj  ,jk,jn) + zv * zslpy(ji,jj  ,jk)
-                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-               END DO
-            END DO
-         END DO
-
-         !!  centered scheme at lateral b.C. if off-shore velocity
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF( umask(ji,jj,jk) == 0. ) THEN
-                     IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
-                        zwx(ji+1,jj,jk) = 0.5 * pun(ji+1,jj,jk) * ( ptn(ji+1,jj,jk,jn) + ptn(ji+2,jj,jk,jn) )
-                     ENDIF
-                     IF( pun(ji-1,jj,jk) < 0. ) THEN
-                        zwx(ji-1,jj,jk) = 0.5 * pun(ji-1,jj,jk) * ( ptn(ji-1,jj,jk,jn) + ptn(ji,jj,jk,jn) ) 
-                     ENDIF
-                  ENDIF
-                  IF( vmask(ji,jj,jk) == 0. ) THEN
-                     IF( pvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
-                        zwy(ji,jj+1,jk) = 0.5 * pvn(ji,jj+1,jk) * ( ptn(ji,jj+1,jk,jn) + ptn(ji,jj+2,jk,jn) )
-                     ENDIF
-                     IF( pvn(ji,jj-1,jk) < 0. ) THEN
-                        zwy(ji,jj-1,jk) = 0.5 * pvn(ji,jj-1,jk) * ( ptn(ji,jj-1,jk,jn) + ptn(ji,jj,jk,jn) ) 
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )   ! lateral boundary condition (changed sign)
-
-         ! Tracer flux divergence at t-point added to the general trend
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! horizontal advective trends 
-                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                  &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )
-                  ! added to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-           END DO
-         END DO
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.   &
-            &( cdtype == 'TRC' .AND. l_trdtrc )      ) THEN
-            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) )
-            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) )
-         END IF
-
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
-            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-
-         ! II. Vertical advective fluxes
-         ! -----------------------------
-         !                                             !-- first guess of the slopes
-         zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0    ! surface & bottom boundary conditions
-         DO jk = 2, jpkm1                                     ! interior values
-            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
-         END DO
-
-         !                                             !-- Slopes of tracer
-         zslpx(:,:,1) = 0.e0                                  ! surface values
-         DO jk = 2, jpkm1                                     ! interior value
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
-               END DO
-            END DO
-         END DO
-         !                                             !-- Slopes limitation
-         DO jk = 2, jpkm1                                     ! interior values
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
-                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
-                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
-               END DO
-            END DO
-         END DO
-         !                                             !-- vertical advective flux
-         !                                                    ! surface values  (bottom already set to zero)
-         IF( lk_vvl ) THEN    ;   zwx(:,:, 1 ) = 0.e0                      !  variable volume
-         ELSE                 ;   zwx(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface
-         ENDIF
-         !
-         DO jk = 1, jpkm1                                     ! interior values
-            zdt  = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) )
-                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
-                  zalpha = 0.5 + z0w
-                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr
-                  zzwx = ptb(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1)
-                  zzwy = ptb(ji,jj,jk  ,jn) + zw * zslpx(ji,jj,jk  )
-                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 2, jpkm1        ! centered near the bottom
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF( tmask(ji,jj,jk+1) == 0. ) THEN
-                     IF( pwn(ji,jj,jk) > 0. ) THEN
-                        zwx(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) 
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, jpkm1        ! Compute & add the vertical advective trend
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! vertical advective trends 
-                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
-                  ! added to the general tracer trends
-                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
-         !                       ! trend diagnostics (contribution of upstream fluxes)
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.     &
-            &( cdtype == 'TRC' .AND. l_trdtrc )      )   &
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) )
-         !
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_muscl2')
-      !
-   END SUBROUTINE tra_adv_muscl2
-
-   !!======================================================================
-END MODULE traadv_muscl2
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 5901)
@@ -102,4 +102,5 @@
          IF(lwp) WRITE(numout,*)
       ENDIF
+      !
       l_trd = .FALSE.
       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
@@ -130,7 +131,7 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
       !!
-      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zfu, zfc, zfd
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zfu, zfc, zfd
       !----------------------------------------------------------------------
       !
@@ -139,16 +140,13 @@
       DO jn = 1, kjpt                                            ! tracer loop
          !                                                       ! ===========
-         zfu(:,:,:) = 0.0     ;   zfc(:,:,:) = 0.0  
-         zfd(:,:,:) = 0.0     ;   zwx(:,:,:) = 0.0     
-         !                                                  
-         DO jk = 1, jpkm1                                
-            !                                             
-            !--- Computation of the ustream and downstream value of the tracer and the mask
+         zfu(:,:,:) = 0._wp     ;   zfc(:,:,:) = 0._wp 
+         zfd(:,:,:) = 0._wp     ;   zwx(:,:,:) = 0._wp   
+         !
+!!gm why not using a SHIFT instruction...
+         DO jk = 1, jpkm1     !--- Computation of the ustream and downstream value of the tracer and the mask
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! Upstream in the x-direction for the tracer
-                  zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)
-                  ! Downstream in the x-direction for the tracer
-                  zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn)
+                  zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)        ! Upstream   in the x-direction for the tracer
+                  zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn)        ! Downstream in the x-direction for the tracer
                END DO
             END DO
@@ -159,5 +157,4 @@
          ! Horizontal advective fluxes
          ! ---------------------------
-         !
          DO jk = 1, jpkm1                             
             DO jj = 2, jpjm1
@@ -220,5 +217,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! horizontal advective trends
                   ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) )
@@ -344,5 +341,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
                   ! horizontal advective trends
                   ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) )
@@ -380,36 +377,41 @@
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zbtr , ztra      ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz
       !!----------------------------------------------------------------------
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zwz )
+      CALL wrk_alloc( jpi,jpj,jpk,   zwz )
+      !
+      !                          ! surface & bottom values 
+      IF( lk_vvl )   zwz(:,:, 1 ) = 0._wp             ! set to zero one for all
+                     zwz(:,:,jpk) = 0._wp             ! except at the surface in linear free surface
+      !
       !                                                          ! ===========
       DO jn = 1, kjpt                                            ! tracer loop
          !                                                       ! ===========
-         ! 1. Bottom value : flux set to zero
-         zwz(:,:,jpk) = 0.e0             ! Bottom value : flux set to zero
-         !
-         !                                 ! Surface value
-         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                      ! Variable volume : flux set to zero
-         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)   ! Constant volume : advective flux through the surface
+         !
+         DO jk = 2, jpkm1                    !* Interior point   (w-masked 2nd order centered flux)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF(.NOT.lk_vvl ) THEN               !* top value   (only in linear free surf. as zwz is multiplied by wmask)
+            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                  END DO
+               END DO   
+            ELSE                                   ! no ice-shelf cavities (only ocean surface)
+               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn)
+            ENDIF
          ENDIF
          !
-         DO jk = 2, jpkm1                  ! Interior point: second order centered tracer flux at w-point
+         DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==!
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) )
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==!
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! k- vertical advective trends 
-                  ztra = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) 
-                  ! added to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   &
+                     &                                / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
                END DO
             END DO
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 5891)
+++ 	(revision )
@@ -1,684 +1,0 @@
-MODULE traadv_tvd
-   !!==============================================================================
-   !!                       ***  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 3D advection trends using a TVD scheme
-   !!   nonosc        : compute monotonic tracer fluxes by a non-oscillatory algorithm 
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE dom_oce        ! ocean space and time domain
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! tracers trends
-   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient
-   USE diaptr         ! poleward transport diagnostics
-   !
-   USE lib_mpp        ! MPP library
-   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
-   USE in_out_manager ! I/O manager
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_tvd        ! routine called by traadv.F90
-   PUBLIC   tra_adv_tvd_zts    ! routine called by traadv.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$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_tvd ( 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 
-      !!----------------------------------------------------------------------
-      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
-      INTEGER  ::   ik  
-      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
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz )
-      !
-      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.
-      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 and k=1 value : flux set to zero
-         ! ----------------------------------
-         zwx(:,:,jpk) = 0.e0    ;    zwz(:,:,jpk) = 0.e0
-         zwy(:,:,jpk) = 0.e0    ;    zwi(:,:,jpk) = 0.e0
-          
-         zwz(:,:,1  ) = 0._wp
-         ! 2. upstream advection with initial mass fluxes & intermediate update
-         ! --------------------------------------------------------------------
-         ! 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
-         ! 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) ) * wmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         ! Surface value
-         IF( lk_vvl ) THEN   
-            IF ( ln_isfcav ) THEN
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwz(ji,jj, mikt(ji,jj) ) = 0.e0          ! volume variable
-                  END DO
-               END DO
-            ELSE
-               zwz(:,:,1) = 0.e0          ! volume variable
-            END IF
-         ELSE                
-            IF ( ln_isfcav ) THEN
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
-                  END DO
-               END DO   
-            ELSE
-               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface
-            END IF
-         ENDIF
-
-         ! total advective trend
-         DO jk = 1, jpkm1
-            z2dtt = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(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   * tmask(ji,jj,jk)
-                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !                             ! Lateral boundary conditions on zwi  (unchanged sign)
-         CALL 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 ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( 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.
-                  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)
-               END DO
-            END DO
-         END DO
-      
-         ! antidiffusive flux on k
-         ! Interior value
-         DO jk = 2, jpkm1                    
-            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)
-               END DO
-            END DO
-         END DO
-         ! surface value
-         IF ( ln_isfcav ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zwz(ji,jj,mikt(ji,jj)) = 0.e0
-               END DO
-            END DO
-         ELSE
-            zwz(:,:,1) = 0.e0
-         END IF
-         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
-         CALL lbc_lnk( zwz, 'W',  1. )
-
-         ! 4. monotonicity algorithm
-         ! -------------------------
-         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
-
-
-         ! 5. final trend with corrected fluxes
-         ! ------------------------------------
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(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 * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-         !                                 ! 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_xad, ztrdx, pun, ptn(:,:,:,jn) )   
-            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )  
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
-         END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
-         ENDIF
-         !
-      END DO
-      !
-                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz )
-      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd')
-      !
-   END SUBROUTINE tra_adv_tvd
-
-   SUBROUTINE tra_adv_tvd_zts ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
-      &                                       ptb, ptn, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_tvd_zts  ***
-      !! 
-      !! **  Purpose :   Compute the now trend due to total advection of 
-      !!       tracers and add it to the general trend of tracer equations
-      !!
-      !! **  Method  :   TVD ZTS scheme, i.e. 2nd order centered scheme with
-      !!       corrected flux (monotonic correction). This version use sub-
-      !!       timestepping for the vertical advection which increases stability
-      !!       when vertical metrics are small.
-      !!       note: - this advection scheme needs a leap-frog time scheme
-      !!
-      !! ** Action : - update (pta) with the now advective tracer trends
-      !!             - save the trends 
-      !!----------------------------------------------------------------------
-      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 
-      !
-      REAL(wp), DIMENSION( jpk )                           ::   zts             ! length of sub-timestep for vertical advection
-      REAL(wp), DIMENSION( jpk )                           ::   zr_p2dt         ! reciprocal of tracer timestep
-      INTEGER  ::   ji, jj, jk, jl, jn       ! dummy loop indices  
-      INTEGER  ::   jnzts = 5       ! number of sub-timesteps for vertical advection
-      INTEGER  ::   jtb, jtn, jta   ! sub timestep pointers for leap-frog/euler forward steps
-      INTEGER  ::   jtaken          ! toggle for collecting appropriate fluxes from sub timesteps
-      REAL(wp) ::   z_rzts          ! Fractional length of Euler forward sub-timestep for vertical advection
-      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(:,:  ) :: zwx_sav , zwy_sav
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd_zts')
-      !
-      CALL wrk_alloc( jpi, jpj, zwx_sav, zwy_sav )
-      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz , zhdiv, zwz_sav, zwzts )
-      CALL wrk_alloc( jpi, jpj, jpk, 3, ztrs )
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_tvd_zts : TVD ZTS advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-      !
-      l_trd = .FALSE.
-      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
-      !
-      IF( l_trd )  THEN
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
-         ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp
-      ENDIF
-      !
-      zwi(:,:,:) = 0._wp
-      z_rzts = 1._wp / REAL( jnzts, wp )
-      zr_p2dt(:) = 1._wp / p2dt(:)
-      !
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         ! 1. Bottom value : flux set to zero
-         ! ----------------------------------
-         zwx(:,:,jpk) = 0._wp   ;    zwz(:,:,jpk) = 0._wp
-         zwy(:,:,jpk) = 0._wp   ;    zwi(:,:,jpk) = 0._wp
-
-         ! 2. upstream advection with initial mass fluxes & intermediate update
-         ! --------------------------------------------------------------------
-         ! 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_wp * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
-                  zwy(ji,jj,jk) = 0.5_wp * ( 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
-         ! 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_wp * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) )
-               END DO
-            END DO
-         END DO
-         ! Surface value
-         IF( lk_vvl ) THEN
-            IF ( ln_isfcav ) THEN
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwz(ji,jj, mikt(ji,jj) ) = 0.e0          ! volume variable +    isf
-                  END DO
-               END DO
-            ELSE
-               zwz(:,:,1) = 0.e0                              ! volume variable + no isf
-            END IF
-         ELSE
-            IF ( ln_isfcav ) THEN
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface +    isf
-                  END DO
-               END DO
-            ELSE
-               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)                                               ! linear free surface + no isf
-            END IF
-         ENDIF
-
-         ! total advective trend
-         DO jk = 1, jpkm1
-            z2dtt = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(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(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !                             ! Lateral boundary conditions on zwi  (unchanged sign)
-         CALL 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 ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( 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.
-                  zwx_sav(ji,jj) = zwx(ji,jj,jk)
-                  zwy_sav(ji,jj) = zwy(ji,jj,jk)
-
-                  zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) )
-                  zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) )
-               END DO
-            END DO
-
-            DO jj = 2, jpjm1         ! partial horizontal divergence
-               DO ji = fs_2, fs_jpim1
-                  zhdiv(ji,jj,jk) = (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
-                     &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
-               END DO
-            END DO
-
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwx(ji,jj,jk) = zwx(ji,jj,jk)  - zwx_sav(ji,jj)
-                  zwy(ji,jj,jk) = zwy(ji,jj,jk)  - zwy_sav(ji,jj)
-               END DO
-            END DO
-         END DO
-      
-         ! antidiffusive flux on k
-         zwz(:,:,1) = 0._wp        ! Surface value
-         zwz_sav(:,:,:) = zwz(:,:,:)
-         !
-         ztrs(:,:,:,1) = ptb(:,:,:,jn)
-         zwzts(:,:,:) = 0._wp
-
-         DO jl = 1, jnzts                   ! Start of sub timestepping loop
-
-            IF( jl == 1 ) THEN              ! Euler forward to kick things off
-              jtb = 1   ;   jtn = 1   ;   jta = 2
-              zts(:) = p2dt(:) * z_rzts
-              jtaken = MOD( jnzts + 1 , 2)  ! Toggle to collect every second flux
-                                            ! starting at jl =1 if jnzts is odd; 
-                                            ! starting at jl =2 otherwise
-            ELSEIF( jl == 2 ) THEN          ! First leapfrog step
-              jtb = 1   ;   jtn = 2   ;   jta = 3
-              zts(:) = 2._wp * p2dt(:) * z_rzts
-            ELSE                            ! Shuffle pointers for subsequent leapfrog steps
-              jtb = MOD(jtb,3) + 1
-              jtn = MOD(jtn,3) + 1
-              jta = MOD(jta,3) + 1
-            ENDIF
-            DO jk = 2, jpkm1          ! Interior value
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zwz(ji,jj,jk) = 0.5_wp * pwn(ji,jj,jk) * ( ztrs(ji,jj,jk,jtn) + ztrs(ji,jj,jk-1,jtn) )
-                     IF( jtaken == 0 ) zwzts(ji,jj,jk) = zwzts(ji,jj,jk) + zwz(ji,jj,jk)*zts(jk)           ! Accumulate time-weighted vertcal flux
-                  END DO
-               END DO
-            END DO
-
-            jtaken = MOD( jtaken + 1 , 2 )
-
-            DO jk = 2, jpkm1          ! Interior value
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     ! total advective trends
-                     ztra = - zbtr * (  zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
-                     ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb) + zts(jk) * ztra
-                  END DO
-               END DO
-            END DO
-
-         END DO
-
-         DO jk = 2, jpkm1          ! Anti-diffusive vertical flux using average flux from the sub-timestepping
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zwz(ji,jj,jk) = zwzts(ji,jj,jk) * zr_p2dt(jk) - zwz_sav(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
-         CALL lbc_lnk( zwz, 'W',  1. )
-
-         ! 4. monotonicity algorithm
-         ! -------------------------
-         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
-
-
-         ! 5. final trend with corrected fluxes
-         ! ------------------------------------
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(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
-               END DO
-            END DO
-         END DO
-
-         !                                 ! 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_xad, ztrdx, pun, ptn(:,:,:,jn) )   
-            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )  
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
-         END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
-         ENDIF
-         !
-      END DO
-      !
-                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz, zhdiv, zwz_sav, zwzts )
-                   CALL wrk_dealloc( jpi, jpj, jpk, 3, ztrs )
-                   CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav )
-      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd_zts')
-      !
-   END SUBROUTINE tra_adv_tvd_zts
-
-   SUBROUTINE nonosc( 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(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
-
-      ! Search local extrema
-      ! --------------------
-      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
-      zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ),   &
-         &        paft * tmask - zbig * ( 1._wp - tmask )  )
-      zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ),   &
-         &        paft * tmask + zbig * ( 1._wp - tmask )  )
-
-      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 = e1t(ji,jj) * e2t(ji,jj) * fse3t(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 lbc_lnk( zbetup, 'T', 1. )   ;   CALL 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._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
-               zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
-               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) )
-               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu )
-
-               zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
-               zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
-               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) )
-               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv )
-
-      ! 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) ) )
-               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb )
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('nonosc')
-      !
-   END SUBROUTINE nonosc
-
-   !!======================================================================
-END MODULE traadv_tvd
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 5901)
@@ -16,4 +16,5 @@
    USE trc_oce        ! share passive tracers/Ocean variables
    USE trd_oce        ! trends: ocean variables
+   USE traadv_fct      ! acces to routine interp_4th_cpt 
    USE trdtra         ! trends manager: tracers 
    USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient
@@ -38,5 +39,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -44,6 +45,6 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_ubs ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
-      &                                       ptb, ptn, pta, kjpt )
+   SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pun, pvn, pwn,          &
+      &                                                ptb, ptn, pta, kjpt, kn_ubs_v )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_ubs  ***
@@ -52,5 +53,5 @@
       !!      and add it to the general trend of passive tracer equations.
       !!
-      !! ** Method  :   The upstream biased scheme (UBS) is based on a 3rd order
+      !! ** Method  :   The 3rd order Upstream Biased Scheme (UBS) is based on an
       !!      upstream-biased parabolic interpolation (Shchepetkin and McWilliams 2005)
       !!      It is only used in the horizontal direction.
@@ -61,14 +62,17 @@
       !!      where zltu is the second derivative of the before temperature field:
       !!          zltu = 1/e3t di[ e2u e3u / e1u di[Tb] ]
-      !!      This results in a dissipatively dominant (i.e. hyper-diffusive) 
+      !!        This results in a dissipatively dominant (i.e. hyper-diffusive) 
       !!      truncation error. The overall performance of the advection scheme 
       !!      is similar to that reported in (Farrow and Stevens, 1995). 
-      !!      For stability reasons, the first term of the fluxes which corresponds
+      !!        For stability reasons, the first term of the fluxes which corresponds
       !!      to a second order centered scheme is evaluated using the now velocity 
       !!      (centered in time) while the second term which is the diffusive part 
       !!      of the scheme, is evaluated using the before velocity (forward in time). 
       !!      Note that UBS is not positive. Do not use it on passive tracers.
-      !!                On the vertical, the advection is evaluated using a TVD scheme,
-      !!      as the UBS have been found to be too diffusive.
+      !!                On the vertical, the advection is evaluated using a FCT scheme,
+      !!      as the UBS have been found to be too diffusive. 
+!!gm  !!                kn_ubs_v argument (not coded for the moment)
+      !!      controles whether the FCT is based on a 2nd order centrered scheme (kn_ubs_v=2) 
+      !!      or on a 4th order compact scheme (kn_ubs_v=4).
       !!
       !! ** Action : - update (pta) with the now advective tracer trends
@@ -81,4 +85,5 @@
       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kn_ubs_v        ! 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 transport components
@@ -95,5 +100,5 @@
       IF( nn_timing == 1 )  CALL timing_start('tra_adv_ubs')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, ztu, ztv, zltu, zltv, zti, ztw )
+      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw )
       !
       IF( kt == kit000 )  THEN
@@ -106,25 +111,24 @@
       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       !
+      zltu(:,:,jpk) = 0._wp   ;   zltv(:,:,jpk) = 0._wp     ! Bottom value : set to zero one for all
+      ztw (:,:,jpk) = 0._wp   ;   zti (:,:,jpk) = 0._wp
+      IF( lk_vvl )   ztw(:,:, 1 ) = 0._wp                   ! surface value: set to zero only in vvl case
+      !
       !                                                          ! ===========
       DO jn = 1, kjpt                                            ! tracer loop
          !                                                       ! ===========
-         ! 1. Bottom value : flux set to zero
-         ! ----------------------------------
-         zltu(:,:,jpk) = 0.e0       ;      zltv(:,:,jpk) = 0.e0
          !                                              
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                   
-            !  Laplacian
-            DO jj = 1, jpjm1            ! First derivative (gradient)
+         DO jk = 1, jpkm1        !==  horizontal laplacian of before tracer ==!
+            DO jj = 1, jpjm1              ! First derivative (masked gradient)
                DO ji = 1, fs_jpim1   ! vector opt.
-                  zeeu = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
-                  zeev = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
+                  zeeu = e2_e1u(ji,jj) * fse3u(ji,jj,jk) * umask(ji,jj,jk)
+                  zeev = e1_e2v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk)
                   ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
                   ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
                END DO
             END DO
-            DO jj = 2, jpjm1            ! Second derivative (divergence)
+            DO jj = 2, jpjm1              ! Second derivative (divergence)
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zcoef = 1. / ( 6. * fse3t(ji,jj,jk) )
+                  zcoef = 1._wp / ( 6._wp * fse3t(ji,jj,jk) )
                   zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef
                   zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef
@@ -132,30 +136,27 @@
             END DO
             !                                    
-         END DO                                           ! End of slab         
+         END DO         
          CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn)
-
          !    
-         !  Horizontal advective fluxes               
-         DO jk = 1, jpkm1                                 ! Horizontal slab
+         DO jk = 1, jpkm1        !==  Horizontal advective fluxes  ==!     (UBS)
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  ! upstream transport (x2)
-                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )      ! upstream transport (x2)
                   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) )
-                  ! 2nd order centered advective fluxes (x2)
+                  !                                                  ! 2nd order centered advective fluxes (x2)
                   zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
                   zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
-                  ! UBS advective fluxes
+                  !                                                  ! UBS advective fluxes
                   ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) )
                   ztv(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) )
                END DO
             END DO
-         END DO                                           ! End of slab         
-
-         zltu(:,:,:) = pta(:,:,:,jn)      ! store pta trends
-
-         DO jk = 1, jpkm1                 ! Horizontal advective trends
+         END DO         
+         !
+         zltu(:,:,:) = pta(:,:,:,jn)      ! store the initial trends before its update
+         !
+         DO jk = 1, jpkm1        !==  add the horizontal advective trend  ==!
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -166,9 +167,8 @@
             END DO
             !                                             
-         END DO                                           !   End of slab
-
-         ! Horizontal trend used in tra_adv_ztvd subroutine
-         zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:)
-
+         END DO
+         !
+         zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:)    ! Horizontal advective trend used in vertical 2nd order FCT case
+         !                                            ! and/or in trend diagnostic (l_trd=T) 
          !                
          IF( l_trd ) THEN                  ! trend diagnostics
@@ -181,76 +181,89 @@
             IF( jn == jp_sal )  str_adv(:) = ptr_sj( ztv(:,:,:) )
          ENDIF
-         
-         ! TVD scheme for the vertical direction  
-         ! ----------------------
-         IF( l_trd )   zltv(:,:,:) = pta(:,:,:,jn)          ! store pta if trend diag.
-
-         !  Bottom value : flux set to zero
-         ztw(:,:,jpk) = 0.e0   ;   zti(:,:,jpk) = 0.e0
-
-         ! Surface value
-         IF( lk_vvl ) THEN   ;   ztw(:,:,1) = 0.e0                      ! variable volume : flux set to zero
-         ELSE                ;   ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)   ! free constant surface 
-         ENDIF
-         !  upstream advection with initial mass fluxes & intermediate update
-         ! -------------------------------------------------------------------
-         ! 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) )
-                   ztw(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 
-         ! update and guess with monotonic sheme
-         DO jk = 1, jpkm1
-            z2dtt = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
-                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak 
-                  zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !
-         CALL lbc_lnk( zti, 'T', 1. )      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
-
-         !  antidiffusive flux : high order minus low order
-         ztw(:,:,1) = 0.e0       ! Surface value
-         DO jk = 2, jpkm1        ! Interior value
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztw(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - ztw(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !
-         CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt )      !  monotonicity algorithm
-
-         !  final trend with corrected fluxes
-         DO jk = 1, jpkm1
+         !
+         !                       !== vertical advective trend  ==!
+         !
+         SELECT CASE( kn_ubs_v )       ! select the vertical advection scheme
+         !
+         CASE(  2  )                   ! 2nd order FCT 
+            !         
+            IF( l_trd )   zltv(:,:,:) = pta(:,:,:,jn)          ! store pta if trend diag.
+            !
+            !                          !*  upstream advection with initial mass fluxes & intermediate update  ==!
+            DO jk = 2, jpkm1                 ! Interior value (w-masked)
+               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) )
+                     ztw(ji,jj,jk) = 0.5_wp * (  zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn)  ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO 
+            IF(.NOT.lk_vvl ) THEN            ! top ocean value (only in linear free surface as ztw has been w-masked)
+               IF( ln_isfcav ) THEN                ! top of the ice-shelf cavities and at the ocean surface
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        ztw(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                     END DO
+                  END DO   
+               ELSE                                ! no cavities: only at the ocean surface
+                  ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+               ENDIF
+            ENDIF
+            !
+            DO jk = 1, jpkm1           !* trend and after field with monotonic scheme
+               z2dtt = p2dt(jk)
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )
+                     pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak 
+                     zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( zti, 'T', 1. )      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
+            !
+            !                          !*  anti-diffusive flux : high order minus low order
+            DO jk = 2, jpkm1        ! Interior value  (w-masked)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ztw(ji,jj,jk) = (   0.5_wp * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   &
+                        &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !                                            ! top ocean value: high order == upstream  ==>>  zwz=0
+            IF(.NOT.lk_vvl )   ztw(:,:, 1 ) = 0._wp      ! only ocean surface as interior zwz values have been w-masked
+            !
+            CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt )      !  monotonicity algorithm
+            !
+         CASE(  4  )                               ! 4th order COMPACT
+            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )         ! 4th order compact interpolation of T at w-point
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztw(ji,jj,jk) = pwn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            IF(.NOT.lk_vvl )   ztw(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)     !!gm ISF & 4th COMPACT doesn't work
+            !
+         END SELECT
+         !
+         DO jk = 1, jpkm1        !  final trend with corrected fluxes
             DO jj = 2, jpjm1 
                DO ji = fs_2, fs_jpim1   ! vector opt.   
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! k- vertical advective trends  
-                  ztra = - zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )
-                  ! added to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
-
-         !  Save the final vertical advective trends
-         IF( l_trd )  THEN                        ! vertical advective trend diagnostics
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !
+         IF( l_trd )  THEN       ! vertical advective trend diagnostics
             DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w])
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     z_hdivn = (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  ) * zbtr
-                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk) + ptn(ji,jj,jk,jn) * z_hdivn
+                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk)                          &
+                        &           + ptn(ji,jj,jk,jn) * (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  )   &
+                        &                              / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )
                   END DO
                END DO
@@ -261,5 +274,5 @@
       END DO
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, ztu, ztv, zltu, zltv, zti, ztw )
+      CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw )
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_ubs')
@@ -294,17 +307,17 @@
       IF( nn_timing == 1 )  CALL timing_start('nonosc_z')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo )
+      CALL wrk_alloc( jpi,jpj,jpk,   zbetup, zbetdo )
       !
       zbig  = 1.e+40_wp
       zrtrn = 1.e-15_wp
       zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
-
+      !
       ! Search local extrema
       ! --------------------
-      ! large negative value (-zbig) inside land
+      !                    ! large negative value (-zbig) inside land
       pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
-      ! search maximum in neighbourhood
-      DO jk = 1, jpkm1
+      !
+      DO jk = 1, jpkm1     ! search maximum in neighbourhood
          ikm1 = MAX(jk-1,1)
          DO jj = 2, jpjm1
@@ -316,9 +329,9 @@
          END DO
       END DO
-      ! large positive value (+zbig) inside land
+      !                    ! large positive value (+zbig) inside land
       pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
-      ! search minimum in neighbourhood
-      DO jk = 1, jpkm1
+      !
+      DO jk = 1, jpkm1     ! search minimum in neighbourhood
          ikm1 = MAX(jk-1,1)
          DO jj = 2, jpjm1
@@ -330,13 +343,10 @@
          END DO
       END DO
-
-      ! restore masked values to zero
+      !                    ! restore masked values to zero
       pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:)
       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:)
-
-
-      ! 2. Positive and negative part of fluxes and beta terms
-      ! ------------------------------------------------------
-
+      !
+      ! Positive and negative part of fluxes and beta terms
+      ! ---------------------------------------------------
       DO jk = 1, jpkm1
          z2dtt = p2dt(jk)
@@ -347,5 +357,5 @@
                zneg = MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
                ! up & down beta terms
-               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
+               zbt = e1e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
                zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt
                zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt
@@ -353,4 +363,5 @@
          END DO
       END DO
+      !
       ! monotonic flux in the k direction, i.e. pcc
       ! -------------------------------------------
@@ -366,5 +377,5 @@
       END DO
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zbetup, zbetdo )
       !
       IF( nn_timing == 1 )  CALL timing_stop('nonosc_z')
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 5901)
@@ -14,5 +14,5 @@
    !!             -   ! 2013-04  (F. Roquet, G. Madec)  use of eosbn2 instead of local hard coded alpha and beta
    !!----------------------------------------------------------------------
-#if   defined key_trabbl   ||   defined key_esopa
+#if   defined key_trabbl
    !!----------------------------------------------------------------------
    !!   'key_trabbl'   or                             bottom boundary layer
@@ -29,5 +29,5 @@
    USE phycst         ! physical constant
    USE eosbn2         ! equation of state
-   USE trd_oce     ! trends: ocean variables
+   USE trd_oce        ! trends: ocean variables
    USE trdtra         ! trends: active tracers
    !
@@ -198,6 +198,6 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               ik = mbkt(ji,jj)                              ! bottom T-level index
-               zptb(ji,jj) = ptb(ji,jj,ik,jn)       ! bottom before T and S
+               ik = mbkt(ji,jj)                             ! bottom T-level index
+               zptb(ji,jj) = ptb(ji,jj,ik,jn)               ! bottom before T and S
             END DO
          END DO
@@ -205,11 +205,11 @@
          DO jj = 2, jpjm1                                    ! Compute the trend
             DO ji = 2, jpim1
-               ik = mbkt(ji,jj)                              ! bottom T-level index
-               zbtr = r1_e12t(ji,jj)  / fse3t(ji,jj,ik)
-               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         &
-                  &               + (   ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   &
-                  &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   &
-                  &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   &
-                  &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr
+               ik = mbkt(ji,jj)                            ! bottom T-level index
+               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                  &
+                  &             + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     &
+                  &                - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     &
+                  &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     &
+                  &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  &
+                  &             / ( e1e2t(ji,jj) * fse3t(ji,jj,ik) )
             END DO
          END DO
@@ -263,15 +263,15 @@
                   !
                   !                                               ! up  -slope T-point (shelf bottom point)
-                  zbtr = r1_e12t(iis,jj) / fse3t(iis,jj,ikus)
+                  zbtr = r1_e1e2t(iis,jj) / fse3t(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_e12t(iid,jj) / fse3t(iid,jj,jk)
+                     zbtr = r1_e1e2t(iid,jj) / fse3t(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_e12t(iid,jj) / fse3t(iid,jj,ikud)
+                  zbtr = r1_e1e2t(iid,jj) / fse3t(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
@@ -285,15 +285,15 @@
                   !
                   ! up  -slope T-point (shelf bottom point)
-                  zbtr = r1_e12t(ji,ijs) / fse3t(ji,ijs,ikvs)
+                  zbtr = r1_e1e2t(ji,ijs) / fse3t(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_e12t(ji,ijd) / fse3t(ji,ijd,jk)
+                     zbtr = r1_e1e2t(ji,ijd) / fse3t(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_e12t(ji,ijd) / fse3t(ji,ijd,ikvd)
+                  zbtr = r1_e1e2t(ji,ijd) / fse3t(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
@@ -566,6 +566,6 @@
 
       !                             !* masked diffusive flux coefficients
-      ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)  * umask(:,:,1)
-      ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)  * vmask(:,:,1)
+      ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1)
+      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1)
 
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 5901)
@@ -6,8 +6,6 @@
    !! History :  OPA  ! 1991-03  (O. Marti, G. Madec)  Original code
    !!                 ! 1992-06  (M. Imbard)  doctor norme
-   !!                 ! 1996-01  (G. Madec)  statement function for e3
-   !!                 ! 1997-05  (G. Madec)  macro-tasked on jk-slab
    !!                 ! 1998-07  (M. Imbard, G. Madec) ORCA version
-   !!            7.0  ! 2001-02  (M. Imbard)  cofdis, Original code
+   !!            7.0  ! 2001-02  (M. Imbard)  add distance to coast, Original code
    !!            8.1  ! 2001-02  (G. Madec, E. Durand)  cleaning
    !!  NEMO      1.0  ! 2002-08  (G. Madec, E. Durand)  free form + modules
@@ -15,4 +13,6 @@
    !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC 
    !!            3.4  ! 2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
+   !!            3.6  ! 2015-06  (T. Graham)  read restoring coefficient in a file
+   !!            3.7  ! 2015-10  (G. Madec)  remove useless trends arrays
    !!----------------------------------------------------------------------
 
@@ -42,16 +42,11 @@
 
    PUBLIC   tra_dmp      ! routine called by step.F90
-   PUBLIC   tra_dmp_init ! routine called by opa.F90
-
-   !                               !!* Namelist namtra_dmp : T & S newtonian damping *
-   ! nn_zdmp and cn_resto are public as they are used by C1D/dyndmp.F90
-   LOGICAL , PUBLIC ::   ln_tradmp   !: internal damping flag
-   INTEGER , PUBLIC ::   nn_zdmp     ! = 0/1/2 flag for damping in the mixed layer
-   CHARACTER(LEN=200) , PUBLIC :: cn_resto      ! name of netcdf file containing restoration coefficient field
+   PUBLIC   tra_dmp_init ! routine called by nemogcm.F90
+
+   !                                           !!* Namelist namtra_dmp : T & S newtonian damping *
+   LOGICAL            , PUBLIC ::   ln_tradmp   !: internal damping flag
+   INTEGER            , PUBLIC ::   nn_zdmp     !: = 0/1/2 flag for damping in the mixed layer
+   CHARACTER(LEN=200) , PUBLIC ::   cn_resto    !: name of netcdf file containing restoration coefficient field
    !
-
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   strdmp   !: damping salinity trend (psu/s)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ttrdmp   !: damping temperature trend (Celcius/s)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1)
 
@@ -70,5 +65,5 @@
       !!                ***  FUNCTION tra_dmp_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
+      ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
       !
       IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc )
@@ -96,69 +91,58 @@
       !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend
       !!----------------------------------------------------------------------
-      !
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zta, zsa             ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'tra_dmp')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, jpts,  zts_dta )
-      !
-      !                           !==   input T-S data at kt   ==!
+      !
+      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta, ztrdts
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('tra_dmp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,jpts,   zts_dta )
+      !
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         CALL wrk_alloc( jpi,jpj,jpk,jpts,   ztrdts ) 
+         ztrdts(:,:,:,:) = tsa(:,:,:,:) 
+      ENDIF
+      !                           !==  input T-S data at kt  ==!
       CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt
       !
-      SELECT CASE ( nn_zdmp )     !==    type of damping   ==!
-      !
-      CASE( 0 )                   !==  newtonian damping throughout the water column  ==!
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
-                  zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
-                  strdmp(ji,jj,jk) = zsa           ! save the trend (used in asmtrj)
-                  ttrdmp(ji,jj,jk) = zta      
+      SELECT CASE ( nn_zdmp )     !==  type of damping  ==!
+      !
+      CASE( 0 )                        !*  newtonian damping throughout the water column  *!
+         DO jn = 1, jpts
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - tsb(ji,jj,jk,jn) )
+                  END DO
                END DO
             END DO
          END DO
          !
-      CASE ( 1 )                  !==  no damping in the turbocline (avt > 5 cm2/s)  ==!
+      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *!
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
-                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
-                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
-                  ELSE
-                     zta = 0._wp
-                     zsa = 0._wp  
+                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
+                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
+                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
+                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
                   ENDIF
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
-                  strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj)
-                  ttrdmp(ji,jj,jk) = zta
                END DO
             END DO
          END DO
          !
-      CASE ( 2 )                  !==  no damping in the mixed layer   ==!
+      CASE ( 2 )                       !*  no damping in the mixed layer   *!
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
-                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
-                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
-                  ELSE
-                     zta = 0._wp
-                     zsa = 0._wp  
+                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
+                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
+                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
+                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
                   ENDIF
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
-                  strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj)
-                  ttrdmp(ji,jj,jk) = zta
                END DO
             END DO
@@ -168,6 +152,8 @@
       !
       IF( l_trdtra )   THEN       ! trend diagnostic
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ttrdmp )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, strdmp )
+         ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
+         CALL wrk_dealloc( jpi,jpj,jpk,jpts,   ztrdts ) 
       ENDIF
       !                           ! Control print
@@ -175,7 +161,7 @@
          &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts,  zts_dta )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop( 'tra_dmp')
+      CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zts_dta )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('tra_dmp')
       !
    END SUBROUTINE tra_dmp
@@ -190,8 +176,7 @@
       !! ** Method  :   read the namtra_dmp namelist and check the parameters
       !!----------------------------------------------------------------------
+      INTEGER ::   ios, imask   ! local integers 
+      !!
       NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
-      INTEGER ::  ios         ! Local integer for output status of namelist read
-      INTEGER :: imask        ! File handle 
-      !!
       !!----------------------------------------------------------------------
       !
@@ -204,9 +189,9 @@
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namtra_dmp )
-
-      IF(lwp) THEN                 !Namelist print
+      !
+      IF(lwp) THEN                  ! Namelist print
          WRITE(numout,*)
          WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
-         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
          WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp
@@ -215,34 +200,31 @@
          WRITE(numout,*)
       ENDIF
-
+      !
       IF( ln_tradmp) THEN
-         !
-         !Allocate arrays
+         !                          ! Allocate arrays
          IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
-
-         !Check values of nn_zdmp
-         SELECT CASE (nn_zdmp)
-         CASE ( 0 )  ; IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
-         CASE ( 1 )  ; IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline'
-         CASE ( 2 )  ; IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
+         !
+         SELECT CASE (nn_zdmp)      ! Check values of nn_zdmp
+         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
+         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixing layer (kz > 5 cm2/s)'
+         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed  layer'
+         CASE DEFAULT
+            CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp')
          END SELECT
-
-         !TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
-         !so can damp to something other than intitial conditions files?
+         !
+         !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
+         !    so can damp to something other than intitial conditions files?
+         !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated.
          IF( .NOT.ln_tsd_tradmp ) THEN
-            CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' )
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout, *)  '   read T-S data not initialized, we force ln_tsd_tradmp=T'
             CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
          ENDIF
-
-         !initialise arrays - Are these actually used anywhere else?
-         strdmp(:,:,:) = 0._wp
-         ttrdmp(:,:,:) = 0._wp
-
-         !Read in mask from file
+         !                          ! Read in mask from file
          CALL iom_open ( cn_resto, imask)
-         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto)
+         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto )
          CALL iom_close( imask )
-       ENDIF
-
+      ENDIF
+      !
    END SUBROUTINE tra_dmp_init
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 5901)
@@ -4,6 +4,9 @@
    !! Ocean Active 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 
+   !! History :  9.0  ! 2005-11  (G. Madec)  Original code
+   !!  NEMO      3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!            3.7  ! 2013-12  (G. Madec) remove the optional computation from T & S anomaly profiles and traldf_bilapg
+   !!             -   ! 2013-12  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
+   !!             -   ! 2014-01  (G. Madec, S. Masson)  restructuration/simplification of lateral diffusive operators
    !!----------------------------------------------------------------------
 
@@ -11,25 +14,23 @@
    !!   tra_ldf      : update the tracer trend with the lateral diffusion
    !!   tra_ldf_init : initialization, namelist read, and parameters control
-   !!       ldf_ano  : compute lateral diffusion for constant T-S profiles
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE ldftra_oce      ! ocean tracer   lateral physics
-   USE ldfslp          ! ???
-   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine)
-   USE traldf_bilap    ! lateral mixing             (tra_ldf_bilap routine)
-   USE traldf_iso      ! lateral mixing               (tra_ldf_iso routine)
-   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
-   USE traldf_lap      ! lateral mixing               (tra_ldf_lap routine)
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
+   !!----------------------------------------------------------------------
+   USE oce           ! ocean dynamics and tracers
+   USE dom_oce       ! ocean space and time domain
+   USE phycst        ! physical constants
+   USE ldftra        ! lateral diffusion: eddy diffusivity & EIV coeff.
+   USE ldfslp        ! lateral diffusion: iso-neutral slope
+   USE traldf_lap    ! lateral diffusion: laplacian iso-level            operator  (tra_ldf_lap   routine)
+   USE traldf_iso    ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso   routine)
+   USE traldf_triad  ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_triad routine)
+   USE traldf_blp    ! lateral diffusion (iso-level lap/blp)                       (tra_ldf_lap   routine)
+   USE trd_oce       ! trends: ocean variables
+   USE trdtra        ! ocean active tracers trends
    !
-   USE prtctl          ! Print control
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distribued memory computing library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -37,16 +38,13 @@
 
    PUBLIC   tra_ldf        ! called by step.F90 
-   PUBLIC   tra_ldf_init   ! called by opa.F90 
+   PUBLIC   tra_ldf_init   ! called by nemogcm.F90 
    !
-   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals)
-
-   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   !: lateral diffusion trends of T & S for a cst profile
-   !                                                               !  (key_traldf_ano only)
-
+   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... (namlist logicals)
+   
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -65,67 +63,36 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('tra_ldf')
-      !
-      rldf = 1     ! For active tracers the 
-
+      IF( nn_timing == 1 )   CALL timing_start('tra_ldf')
+      !
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt, ztrds ) 
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
          ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
-
-      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
-      CASE ( 0 )   ;   CALL tra_ldf_lap     ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        &
-                               &                                   tsb, tsa, jpts        )  ! iso-level laplacian
-      CASE ( 1 )                                                                              ! rotated laplacian
-         IF( ln_traldf_grif ) THEN                                                          
-                       CALL tra_ldf_iso_grif( kt, nit000,'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Griffies operator
-         ELSE                                                                                
-                       CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        &
-                               &                                  tsb, tsa, jpts, ahtb0 )      ! Madec operator
-         ENDIF
-      CASE ( 2 )   ;   CALL tra_ldf_bilap   ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        &
-                               &                                   tsb, tsa, jpts        )  ! iso-level bilaplacian
-      CASE ( 3 )   ;   CALL tra_ldf_bilapg  ( kt, nit000, 'TRA',             tsb, tsa, jpts        )  ! s-coord. geopot. bilap.
-         !
-      CASE ( -1 )                                ! esopa: test all possibility with control print
-         CALL tra_ldf_lap   ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        &
-         &                                       tsb, tsa, jpts        ) 
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask,               &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         IF( ln_traldf_grif ) THEN
-            CALL tra_ldf_iso_grif( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )
-         ELSE
-            CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        &
-            &                                               tsb, tsa, jpts, ahtb0 )  
-         ENDIF
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask,               &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        &
-         &                                       tsb, tsa, jpts        ) 
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask,               &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_ldf_bilapg( kt, nit000, 'TRA',             tsb, tsa, jpts        ) 
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask,               &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      !
+      SELECT CASE ( nldf )                     !* compute lateral mixing trend and add it to the general trend
+      !
+      CASE ( np_lap   )                                  ! laplacian: iso-level operator
+         CALL tra_ldf_lap  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb,      tsa, jpts,  1   )
+      CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec)
+         CALL tra_ldf_iso  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   )
+      CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies)
+         CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   )
+      CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators
+         CALL tra_ldf_blp  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb      , tsa, jpts, nldf )
       END SELECT
 
-#if defined key_traldf_ano
-      tsa(:,:,:,jp_tem) = tsa(:,:,:,jp_tem) - t0_ldf(:,:,:)      ! anomaly: substract the reference diffusivity
-      tsa(:,:,:,jp_sal) = tsa(:,:,:,jp_sal) - s0_ldf(:,:,:)
-#endif
-
-      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+      IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt )
          CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds )
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
-      ENDIF
-      !                                          ! print mean trends (used for debugging)
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt, ztrds ) 
+      ENDIF
+      !                                        !* print mean trends (used for debugging)
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf  - Ta: ', mask1=tmask,               &
          &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf')
+      IF( nn_timing == 1 )   CALL timing_stop('tra_ldf')
       !
    END SUBROUTINE tra_ldf
@@ -139,17 +106,9 @@
       !!
       !! ** Method  :   set nldf from the namtra_ldf logicals
-      !!      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 
-      !!----------------------------------------------------------------------
-
-      !  Define the lateral mixing oparator for tracers
-      ! ===============================================
-    
-      IF(lwp) THEN                    ! Namelist print
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ierr   ! temporary integers 
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                     ! Namelist print
          WRITE(numout,*)
          WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator'
@@ -159,204 +118,83 @@
          WRITE(numout,*)
       ENDIF
-
-      !                               ! control the input
+      !                                   ! use of lateral operator or not
+      nldf   = np_ERROR
       ioptio = 0
-      IF( ln_traldf_lap   )   ioptio = ioptio + 1
-      IF( ln_traldf_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_traldf_level )   ioptio = ioptio + 1
-      IF( ln_traldf_hor   )   ioptio = ioptio + 1
-      IF( ln_traldf_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_traldf_... logicals
-      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
-      ierr = 0
-      IF( ln_traldf_lap ) THEN       ! laplacian operator
-         IF ( ln_zco ) THEN                ! z-coordinate
-            IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation)
-            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation)
-            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+      IF( ln_traldf_lap )   ioptio = ioptio + 1
+      IF( ln_traldf_blp )   ioptio = ioptio + 1
+      IF( ioptio >  1   )   CALL ctl_stop( 'tra_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on tracer' )
+      IF( ioptio == 0   )   nldf = np_no_ldf     ! No lateral diffusion
+      !
+      IF( nldf /= np_no_ldf ) THEN        ! direction ==>> type of operator  
+         ioptio = 0
+         IF( ln_traldf_lev )   ioptio = ioptio + 1
+         IF( ln_traldf_hor )   ioptio = ioptio + 1
+         IF( ln_traldf_iso )   ioptio = ioptio + 1
+         IF( ioptio >  1 )   CALL ctl_stop( 'tra_ldf_init: use only ONE direction (level/hor/iso)' )
+         !
+         !                                ! defined the type of lateral diffusion from ln_traldf_... logicals
+         ierr = 0
+         IF( ln_traldf_lap ) THEN         ! laplacian operator
+            IF ( ln_zco ) THEN               ! z-coordinate
+               IF ( ln_traldf_lev   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_traldf_hor   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_traldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
+            IF ( ln_zps ) THEN               ! z-coordinate with partial step
+               IF ( ln_traldf_lev   )   ierr = 1          ! iso-level not allowed 
+               IF ( ln_traldf_hor   )   nldf = np_lap     ! horizontal             (no rotation)
+               IF ( ln_traldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard     (rotation)
+               IF ( ln_traldf_triad )   nldf = np_lap_it  ! iso-neutral: triad        (rotation)
+            ENDIF
+            IF ( ln_sco ) THEN               ! s-coordinate
+               IF ( ln_traldf_lev   )   nldf = np_lap     ! iso-level              (no rotation)
+               IF ( ln_traldf_hor   )   nldf = np_lap_i   ! horizontal             (   rotation)
+               IF ( ln_traldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
          ENDIF
-         IF ( ln_zps ) THEN             ! zps-coordinate
-            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed
-            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation)
-            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         !
+         IF( ln_traldf_blp ) THEN         ! bilaplacian operator
+            IF ( ln_zco ) THEN               ! z-coordinate
+               IF ( ln_traldf_lev   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+               IF ( ln_traldf_hor   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+               IF ( ln_traldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_blp_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
+            IF ( ln_zps ) THEN               ! z-coordinate with partial step
+               IF ( ln_traldf_lev   )   ierr = 1          ! iso-level not allowed 
+               IF ( ln_traldf_hor   )   nldf = np_blp     ! horizontal             (no rotation)
+               IF ( ln_traldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_blp_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
+            IF ( ln_sco ) THEN               ! s-coordinate
+               IF ( ln_traldf_lev   )   nldf = np_blp     ! iso-level              (no rotation)
+               IF ( ln_traldf_hor   )   nldf = np_blp_it  ! horizontal             (   rotation)
+               IF ( ln_traldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_blp_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
          ENDIF
-         IF ( ln_sco ) THEN             ! s-coordinate
-            IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation)
-            IF ( ln_traldf_hor   )   nldf = 1      ! horizontal (   rotation)
-            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
-         ENDIF
-      ENDIF
-
-      IF( ln_traldf_bilap ) THEN      ! bilaplacian operator
-         IF ( ln_zco ) THEN                ! z-coordinate
-            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation)
-            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation)
-            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_zps ) THEN             ! zps-coordinate
-            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed 
-            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation)
-            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_sco ) THEN             ! s-coordinate
-            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation)
-            IF ( ln_traldf_hor   )   nldf = 3      ! horizontal (   rotation)
-            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-      ENDIF
-
-      IF( nldf == 3 )   CALL ctl_warn( 'geopotential bilaplacian tracer diffusion in s-coords not thoroughly tested' )
+      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_traldf_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' )
-         l_traldf_rot = .TRUE.                 ! needed for trazdf_imp
-      ENDIF
-
-      IF( lk_esopa ) THEN
-         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options'
-         nldf = -1
-      ENDIF
-
+      IF( ln_ldfeiv .AND. .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) )                                    &
+           &            CALL ctl_stop( '          eddy induced velocity on tracers requires isopycnal',    &
+           &                                                                    ' laplacian diffusion' )
+      IF(  nldf == np_lap_i .OR. nldf == np_lap_it .OR. &
+         & nldf == np_blp_i .OR. nldf == np_blp_it  )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required 
+      !
       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
-
-      ! Reference T & S diffusivity (if necessary)
-      ! ===========================
-      CALL ldf_ano
+         IF( nldf == np_no_ldf )   WRITE(numout,*) '          NO lateral diffusion'
+         IF( nldf == np_lap    )   WRITE(numout,*) '          laplacian iso-level operator'
+         IF( nldf == np_lap_i  )   WRITE(numout,*) '          Rotated laplacian operator (standard)'
+         IF( nldf == np_lap_it )   WRITE(numout,*) '          Rotated laplacian operator (triad)'
+         IF( nldf == np_blp    )   WRITE(numout,*) '          bilaplacian iso-level operator'
+         IF( nldf == np_blp_i  )   WRITE(numout,*) '          Rotated bilaplacian operator (standard)'
+         IF( nldf == np_blp_it )   WRITE(numout,*) '          Rotated bilaplacian operator (triad)'
+      ENDIF
       !
    END SUBROUTINE tra_ldf_init
-
-#if defined key_traldf_ano
-   !!----------------------------------------------------------------------
-   !!   'key_traldf_ano'               T & S lateral diffusion on anomalies
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_ano
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_ano  ***
-      !!
-      !! ** Purpose :   initializations of 
-      !!----------------------------------------------------------------------
-      !
-      USE zdf_oce         ! vertical mixing
-      USE trazdf          ! vertical mixing: double diffusion
-      USE zdfddm          ! vertical mixing: double diffusion
-      !
-      INTEGER  ::   jk              ! Dummy loop indice
-      INTEGER  ::   ierr            ! local integer
-      LOGICAL  ::   llsave          ! local logical
-      REAL(wp) ::   zt0, zs0, z12   ! local scalar
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_ref, zs_ref, ztb, zsb, zavt     
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ldf_ano')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt ) 
-      !
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on anomalies'
-         WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-
-      !                              ! allocate trabbl arrays
-      ALLOCATE( t0_ldf(jpi,jpj,jpk) , s0_ldf(jpi,jpj,jpk) , STAT=ierr )
-      IF( lk_mpp    )   CALL mpp_sum( ierr )
-      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_ano: unable to allocate arrays' )
-
-      ! defined the T & S reference profiles
-      ! ------------------------------------
-      zt0 =10.e0                               ! homogeneous ocean
-      zs0 =35.e0
-      zt_ref(:,:,:) = 10.0 * tmask(:,:,:)
-      zs_ref(:,:,:) = 35.0 * tmask(:,:,:)
-      IF(lwp) WRITE(numout,*) '              homogeneous ocean T = ', zt0, ' S = ',zs0
-
-      ! Initialisation of gtui/gtvi in case of no cavity
-      IF ( .NOT. ln_isfcav ) THEN
-         gtui(:,:,:) = 0.0_wp
-         gtvi(:,:,:) = 0.0_wp
-      END IF
-      !                                        ! T & S profile (to be coded +namelist parameter
-
-      ! prepare the ldf computation
-      ! ---------------------------
-      llsave = l_trdtra
-      l_trdtra = .false.      ! desactivate trend computation
-      t0_ldf(:,:,:) = 0.e0
-      s0_ldf(:,:,:) = 0.e0
-      ztb   (:,:,:) = tsb (:,:,:,jp_tem)
-      zsb   (:,:,:) = tsb (:,:,:,jp_sal)
-      ua    (:,:,:) = tsa (:,:,:,jp_tem)
-      va    (:,:,:) = tsa (:,:,:,jp_sal)
-      zavt  (:,:,:) = avt(:,:,:)
-      IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' )
-      ! set tb, sb to reference values and avr to zero
-      tsb (:,:,:,jp_tem) = zt_ref(:,:,:)
-      tsb (:,:,:,jp_sal) = zs_ref(:,:,:)
-      tsa (:,:,:,jp_tem) = 0.e0
-      tsa (:,:,:,jp_sal) = 0.e0
-      avt(:,:,:)         = 0.e0
-
-      ! Compute the ldf trends
-      ! ----------------------
-      CALL tra_ldf( nit000 + 1 )      ! horizontal components (+1: no more init)
-      CALL tra_zdf( nit000     )      ! vertical component (if necessary nit000 to performed the init)
-
-      ! finalise the computation and recover all arrays
-      ! -----------------------------------------------
-      l_trdtra = llsave
-      z12 = 2.e0
-      IF( neuler == 1)   z12 = 1.e0
-      IF( ln_zdfexp ) THEN      ! ta,sa are the trends
-         t0_ldf(:,:,:) = tsa(:,:,:,jp_tem)
-         s0_ldf(:,:,:) = tsa(:,:,:,jp_sal)
-      ELSE
-         DO jk = 1, jpkm1
-            t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdttra(jk) )
-            s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdttra(jk) )
-         END DO
-      ENDIF
-      tsb(:,:,:,jp_tem) = ztb (:,:,:)
-      tsb(:,:,:,jp_sal) = zsb (:,:,:)
-      tsa(:,:,:,jp_tem) = ua  (:,:,:)
-      tsa(:,:,:,jp_sal) = va  (:,:,:)
-      avt(:,:,:)        = zavt(:,:,:)
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ldf_ano')
-      !
-   END SUBROUTINE ldf_ano
-
-#else
-   !!----------------------------------------------------------------------
-   !!   default option :   Dummy code   NO T & S background profiles
-   !!----------------------------------------------------------------------
-   SUBROUTINE ldf_ano
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on the full fields'
-         WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-   END SUBROUTINE ldf_ano
-#endif
 
    !!======================================================================
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 5891)
+++ 	(revision )
@@ -1,189 +1,0 @@
-MODULE traldf_bilap
-   !!==============================================================================
-   !!                   ***  MODULE  traldf_bilap  ***
-   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
-   !!==============================================================================
-   !! History :  OPA  !  1991-11  (G. Madec)  Original code
-   !!                 !  1993-03  (M. Guyon)  symetrical conditions
-   !!                 !  1995-11  (G. Madec)  suppress volumetric scale factors
-   !!                 !  1996-01  (G. Madec)  statement function for e3
-   !!                 !  1996-01  (M. Imbard)  mpp exchange
-   !!                 !  1997-07  (G. Madec)  optimization, and ahtt
-   !!            8.5  !  2002-08  (G. Madec)  F90: Free form and module
-   !!   NEMO     1.0  !  2004-08  (C. Talandier) New trends organization
-   !!             -   !  2005-11  (G. Madec)  zps or sco as default option
-   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
-   !!==============================================================================
-
-   !!----------------------------------------------------------------------
-   !!   tra_ldf_bilap : update the tracer trend with the horizontal diffusion
-   !!                   using a iso-level biharmonic operator
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE ldftra_oce      ! ocean tracer   lateral physics
-   USE in_out_manager  ! I/O manager
-   USE ldfslp          ! iso-neutral slopes 
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE diaptr          ! poleward transport diagnostics
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_ldf_bilap   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
-#  include "ldfeiv_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
- 
-   SUBROUTINE tra_ldf_bilap( kt, kit000, cdtype, pgu, pgv,            &
-      &                                          pgui, pgvi,          &
-      &                                  ptb, pta, kjpt )  
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_ldf_bilap  ***
-      !!
-      !! ** Purpose :   Compute the before horizontal tracer diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   4th order diffusive operator along model level surfaces 
-      !!      evaluated using before fields (forward time scheme). The hor.
-      !!      diffusive trends  is given by:
-      !!      Laplacian of tb:
-      !!         zlt   = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(tb) ]
-      !!                                  + dj-1[ e1v*e3v/e2v dj(tb) ]  }
-      !!      Multiply by the eddy diffusivity coef. and insure lateral bc:
-      !!        zlt   = ahtt * zlt
-      !!        call to lbc_lnk
-      !!      Bilaplacian (laplacian of zlt):
-      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(zlt) ]
-      !!                                  + dj-1[ e1v*e3v/e2v dj(zlt) ]  }
-      !!
-      !!      Add this trend to the general trend
-      !!         (pta) = (pta) + ( difft )
-      !!
-      !! ** Action : - Update pta arrays with the before iso-level
-      !!               biharmonic 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,    kjpt), INTENT(in   ) ::   pgui, pgvi ! 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
-      REAL(wp) ::  zbtr, ztra       ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:) ::  zeeu, zeev, zlt
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'tra_ldf_bilap')
-      !
-      CALL wrk_alloc( jpi, jpj, zeeu, zeev, zlt ) 
-      !
-
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
-      ENDIF
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         !                                               
-         DO jk = 1, jpkm1                                        ! Horizontal slab
-            !                                             
-            !                          !==  Initialization of metric arrays (for z- or s-coordinates)  ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zeeu(ji,jj) = re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) * umask(ji,jj,jk)
-                  zeev(ji,jj) = re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) * vmask(ji,jj,jk)
-               END DO
-            END DO
-            !                          !==  Laplacian  ==!
-            !
-            DO jj = 1, jpjm1                 ! First derivative (gradient)
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
-                  ztv(ji,jj,jk) = zeev(ji,jj) * ( 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 (last ocean level)
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     IF( mbku(ji,jj) == jk )  ztu(ji,jj,jk) = zeeu(ji,jj) * pgu(ji,jj,jn)
-                     IF( mbkv(ji,jj) == jk )  ztv(ji,jj,jk) = zeev(ji,jj) * pgv(ji,jj,jn)
-                  END DO
-               END DO
-            ENDIF
-            ! (ISH)
-            IF( ln_zps .AND. ln_isfcav ) THEN ! set gradient at partial step level (first ocean level in a cavity)
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     IF( miku(ji,jj) == MAX(jk,2) )  ztu(ji,jj,jk) = zeeu(ji,jj) * pgui(ji,jj,jn)
-                     IF( mikv(ji,jj) == MAX(jk,2) )  ztu(ji,jj,jk) = zeev(ji,jj) * pgvi(ji,jj,jn)
-                  END DO
-               END DO
-            ENDIF
-            !
-            DO jj = 2, jpjm1                 ! Second derivative (divergence) time the eddy diffusivity coefficient
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
-                  zlt(ji,jj) = fsahtt(ji,jj,jk) * zbtr * (   ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
-                     &                                     + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)   )
-               END DO
-            END DO
-            CALL lbc_lnk( zlt, 'T', 1. )     ! Lateral boundary conditions (unchanged sgn)
-
-            !                          !==  Bilaplacian  ==!
-            !
-            DO jj = 1, jpjm1                 ! third derivative (gradient)
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) )
-                  ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji  ,jj+1) - zlt(ji,jj) )
-               END DO
-            END DO
-            DO jj = 2, jpjm1                 ! fourth derivative (divergence) and add to the general tracer trend
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! horizontal diffusive trends
-                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
-                  ztra = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
-                  ! add it to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-            !                                             
-         END DO                                           ! Horizontal slab
-         !                                                
-         ! "zonal" mean lateral diffusive heat and salt transport
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_ldf(:) = ptr_sj( ztv(:,:,:) )
-           IF( jn == jp_sal )  str_ldf(:) = ptr_sj( ztv(:,:,:) )
-         ENDIF
-         !                                                ! ===========
-      END DO                                              ! tracer loop
-      !                                                   ! ===========
-      IF( nn_timing == 1 )  CALL timing_stop( 'tra_ldf_bilap')
-      !
-      CALL wrk_dealloc( jpi, jpj, zeeu, zeev, zlt ) 
-      !
-   END SUBROUTINE tra_ldf_bilap
-
-   !!==============================================================================
-END MODULE traldf_bilap
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 5891)
+++ 	(revision )
@@ -1,363 +1,0 @@
-MODULE traldf_bilapg
-   !!==============================================================================
-   !!                       ***  MODULE  traldf_bilapg  ***
-   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
-   !!==============================================================================
-   !! History : 8.0   ! 1997-07  (G. Madec)  Original code
-   !!   NEMO    1.0   ! 2002-08  (G. Madec)  F90: Free form and module
-   !!           3.3   ! 2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
-   !!==============================================================================
-#if defined key_ldfslp   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-   !!   tra_ldf_bilapg : update the tracer trend with the horizontal diffusion
-   !!                    using an horizontal biharmonic operator in s-coordinate 
-   !!   ldfght         :  ???
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE in_out_manager  ! I/O manager
-   USE ldfslp          ! iso-neutral slopes available
-   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
-   USE diaptr          ! poleward transport diagnostics 
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_ldf_bilapg   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
-#  include "ldfeiv_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_ldf_bilapg( kt, kit000, cdtype, ptb, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE tra_ldf_bilapg  ***
-      !!                    
-      !! ** Purpose :   Compute the before horizontal tracer diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The lateral diffusive trends is provided by a 4th order
-      !!      operator rotated along geopotential surfaces. It is computed
-      !!      using before fields (forward in time) and geopotential slopes
-      !!      computed in routine inildf.
-      !!         -1- compute the geopotential harmonic operator applied to
-      !!        ptb and multiply it by the eddy diffusivity coefficient
-      !!       (done by a call to ldfght routine, result in wk1 arrays).
-      !!      Applied the domain lateral boundary conditions by call to lbc_lnk
-      !!         -2- compute the geopotential harmonic operator applied to
-      !!      wk1 by a second call to ldfght routine (result in wk2)
-      !!      arrays).
-      !!         -3- Add this trend to the general trend 
-      !!            pta = pta + wk2
-      !!
-      !! ** Action : - Update pta arrays with the before geopotential 
-      !!               biharmonic mixing trend.
-      !!----------------------------------------------------------------------
-      !
-      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,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), POINTER, DIMENSION(:,:,:,:) :: zwk1, zwk2 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_bilapg')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, kjpt, zwk1, zwk2 ) 
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
-      ENDIF
-
-      ! 1. Laplacian of ptb * aht
-      ! ----------------------------- 
-      CALL ldfght( kt, cdtype, ptb, zwk1, kjpt, 1 )      ! rotated harmonic operator applied to ptb and multiply by aht 
-      !                                                 ! output in wk1 
-      !
-      DO jn = 1, kjpt
-         CALL lbc_lnk( zwk1(:,:,:,jn) , 'T', 1. )        ! Lateral boundary conditions on wk1   (unchanged sign)
-      END DO
-
-      ! 2. Bilaplacian of ptb
-      ! -------------------------
-      CALL ldfght( kt, cdtype, zwk1, zwk2, kjpt, 2 )      ! rotated harmonic operator applied to wk1 ; output in wk2
-
-
-      ! 3. Update the tracer trends                    (j-slab :   2, jpj-1)
-      ! ---------------------------
-      DO jn = 1, kjpt
-         DO jj = 2, jpjm1
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  ! add it to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zwk2(ji,jj,jk,jn)
-               END DO
-            END DO
-         END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, kjpt, zwk1, zwk2 ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_bilapg')
-      !
-   END SUBROUTINE tra_ldf_bilapg
-
-
-   SUBROUTINE ldfght ( kt, cdtype, pt, plt, kjpt, kaht )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldfght  ***
-      !!          
-      !! ** Purpose :   Apply a geopotential harmonic operator to (pt) and 
-      !!      multiply it by the eddy diffusivity coefficient (if kaht=1).
-      !!      Routine only used in s-coordinates (l_sco=T) with bilaplacian
-      !!      operator (ln_traldf_bilap=T) acting along geopotential surfaces
-      !!      (ln_traldf_hor).
-      !!
-      !! ** Method  :   The harmonic operator rotated along geopotential 
-      !!      surfaces is applied to (pt) using the slopes of geopotential
-      !!      surfaces computed in inildf routine. The result is provided in
-      !!      (plt,pls) arrays. It is computed in 2 steps:
-      !!
-      !!      First step: horizontal part of the operator. It is computed on
-      !!      ==========  pt as follows (idem on ps)
-      !!      horizontal fluxes :
-      !!         zftu = e2u*e3u/e1u di[ pt ] - e2u*uslp dk[ mi(mk(pt)) ]
-      !!         zftv = e1v*e3v/e2v dj[ pt ] - e1v*vslp dk[ mj(mk(pt)) ]
-      !!      take the horizontal divergence of the fluxes (no divided by
-      !!      the volume element :
-      !!         plt  = di-1[ zftu ] +  dj-1[ zftv ]
-      !!
-      !!      Second step: vertical part of the operator. It is computed on
-      !!      ===========  pt as follows (idem on ps)
-      !!      vertical fluxes :
-      !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pt ]
-      !!              -     e2t     *       wslpi        di[ mi(mk(pt)) ]
-      !!              -     e1t     *       wslpj        dj[ mj(mk(pt)) ]
-      !!      take the vertical divergence of the fluxes add it to the hori-
-      !!      zontal component, divide the result by the volume element and
-      !!      if kaht=1, multiply by the eddy diffusivity coefficient:
-      !!         plt  = aht / (e1t*e2t*e3t) { plt + dk[ zftw ] }
-      !!      else:
-      !!         plt  =  1  / (e1t*e2t*e3t) { plt + dk[ zftw ] }
-      !!
-      !!----------------------------------------------------------------------
-      USE oce     , ONLY:   zftv => ua       ! ua used as workspace
-      !
-      INTEGER         , INTENT(in )                              ::  kt      ! ocean time-step index
-      CHARACTER(len=3), INTENT(in )                              ::  cdtype  ! =TRA or TRC (tracer indicator) 
-      INTEGER         , INTENT(in )                              ::  kjpt    !: dimension of 
-      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) ::  pt      ! tracer fields ( before for 1st call
-      !                                                         ! and laplacian of these fields for 2nd call. 
-      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk,kjpt) ::  plt     !: partial harmonic operator applied to  pt  components except
-      !                                                             !: second order vertical derivative term  
-      INTEGER         , INTENT(in )                              ::  kaht    !: =1 multiply the laplacian by the eddy diffusivity coeff.
-      !                                                             !: =2 no multiplication 
-      !!
-      INTEGER ::   ji, jj, jk,jn          ! dummy loop indices
-      !                                   ! temporary scalars
-      REAL(wp) ::  zabe1, zabe2, zmku, zmkv 
-      REAL(wp) ::  zbtr, ztah, ztav
-      REAL(wp) ::  zcof0, zcof1, zcof2, zcof3, zcof4
-      REAL(wp), POINTER, DIMENSION(:,:) ::  zftu, zdkt, zdk1t
-      REAL(wp), POINTER, DIMENSION(:,:) ::  zftw, zdit, zdjt, zdj1t
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ldfght')
-      !
-      CALL wrk_alloc( jpi, jpj, zftu, zdkt, zdk1t ) 
-      CALL wrk_alloc( jpi, jpk, zftw, zdit, zdjt, zdj1t ) 
-      !
-      DO jn = 1, kjpt
-         !                               ! ********** !   ! ===============
-         DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
-            !                            ! ********** !   ! ===============
-            
-            ! I.1 Vertical gradient of pt and ps at level jk and jk+1
-            ! -------------------------------------------------------
-            !     surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-            
-            zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
-            IF( jk == 1 ) THEN
-               zdkt(:,:) = zdk1t(:,:)
-            ELSE
-               zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * tmask(:,:,jk)
-            ENDIF
-
-
-            ! I.2 Horizontal fluxes
-            ! ---------------------
-            
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zabe1 = re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
-                  zabe2 = re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
-                  
-                  zmku = 1./MAX( tmask(ji+1,jj,jk  )+tmask(ji,jj,jk+1)   &
-                     &          +tmask(ji+1,jj,jk+1)+tmask(ji,jj,jk  ),1. )
-                  zmkv = 1./MAX( tmask(ji,jj+1,jk  )+tmask(ji,jj,jk+1)   &
-                     &          +tmask(ji,jj+1,jk+1)+tmask(ji,jj,jk  ),1. )
-                  
-                  zcof1 = -e2u(ji,jj) * uslp(ji,jj,jk) * zmku
-                  zcof2 = -e1v(ji,jj) * vslp(ji,jj,jk) * zmkv
-                  
-                  zftu(ji,jj)= umask(ji,jj,jk) *   &
-                     &         (  zabe1 *( pt   (ji+1,jj,jk,jn) - pt(ji,jj,jk,jn) )   &
-                     &          + zcof1 *( zdkt (ji+1,jj) + zdk1t(ji,jj)     &
-                     &                    +zdk1t(ji+1,jj) + zdkt (ji,jj) )  )
-                  
-                  zftv(ji,jj,jk)= vmask(ji,jj,jk) *   &
-                     &         (  zabe2 *( pt(ji,jj+1,jk,jn) - pt(ji,jj,jk,jn) )   &
-                     &          + zcof2 *( zdkt (ji,jj+1) + zdk1t(ji,jj)     &
-                     &                    +zdk1t(ji,jj+1) + zdkt (ji,jj) )  )                  
-               END DO
-            END DO
-
-
-            ! I.3 Second derivative (divergence) (not divided by the volume)
-            ! ---------------------
-            
-            DO jj = 2 , jpjm1
-               DO ji = 2 , jpim1
-                  ztah = zftu(ji,jj) - zftu(ji-1,jj) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)
-                  plt(ji,jj,jk,jn) = ztah
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         ! "Poleward" diffusive heat or salt transport
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN
-            ! note sign is reversed to give down-gradient diffusive transports (#1043)
-            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) )
-            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) )
-         ENDIF
-
-         !                             ! ************ !   ! ===============
-         DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
-            !                          ! ************ !   ! ===============
-            
-            ! II.1 horizontal tracer gradient
-            ! -------------------------------
-            
-            DO jk = 1, jpk
-               DO ji = 1, jpim1
-                  zdit (ji,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj  ,jk,jn) ) * umask(ji,jj  ,jk)
-                  zdjt (ji,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj  ,jk,jn) ) * vmask(ji,jj  ,jk)
-                  zdj1t(ji,jk) = ( pt(ji  ,jj  ,jk,jn) - pt(ji,jj-1,jk,jn) ) * vmask(ji,jj-1,jk)
-               END DO
-            END DO
-
-
-            ! II.2 Vertical fluxes
-            ! --------------------
-            
-            ! Surface and bottom vertical fluxes set to zero
-            zftw(:, 1 ) = 0.e0
-            zftw(:,jpk) = 0.e0
-            
-            ! interior (2=<jk=<jpk-1)
-            DO jk = 2, jpkm1
-               DO ji = 2, jpim1
-                  zcof0 = e12t(ji,jj) / fse3w_n(ji,jj,jk)   &
-                     &     * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)        &
-                     &        + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
-                  
-                  zmku = 1./MAX(  umask(ji  ,jj,jk-1)+umask(ji-1,jj,jk)   &
-                     &           +umask(ji-1,jj,jk-1)+umask(ji  ,jj,jk), 1. )
-                  
-                  zmkv = 1./MAX(  vmask(ji,jj  ,jk-1)+vmask(ji,jj-1,jk)   &
-                     &           +vmask(ji,jj-1,jk-1)+vmask(ji,jj  ,jk), 1. )
-                  
-                  zcof3 = - e2t(ji,jj) * wslpi (ji,jj,jk) * zmku
-                  zcof4 = - e1t(ji,jj) * wslpj (ji,jj,jk) * zmkv
-                  
-                  zftw(ji,jk) = tmask(ji,jj,jk) *   &
-                     &    (  zcof0 * ( pt   (ji,jj,jk-1,jn) - pt   (ji  ,jj,jk,jn) )   &
-                     &     + zcof3 * ( zdit (ji   ,jk-1   ) + zdit (ji-1,jk      )     &
-                     &                +zdit (ji-1 ,jk-1   ) + zdit (ji  ,jk      ) )   &
-                     &     + zcof4 * ( zdjt (ji   ,jk-1   ) + zdj1t(ji  ,jk)     &
-                     &                +zdj1t(ji   ,jk-1   ) + zdjt (ji  ,jk      ) )  )                 
-               END DO
-            END DO
-
-
-            ! II.3 Divergence of vertical fluxes added to the horizontal divergence
-            ! ---------------------------------------------------------------------
-            
-            IF( kaht == 1 ) THEN
-               ! multiply the laplacian by the eddy diffusivity coefficient
-               DO jk = 1, jpkm1
-                  DO ji = 2, jpim1
-                     ! eddy coef. divided by the volume element
-                     zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
-                     ! vertical divergence
-                     ztav = fsahtt(ji,jj,jk) * ( zftw(ji,jk) - zftw(ji,jk+1) )
-                     ! harmonic operator applied to (pt,ps) and multiply by aht
-                     plt(ji,jj,jk,jn) = ( plt(ji,jj,jk,jn) + ztav ) * zbtr
-                  END DO
-               END DO
-            ELSEIF( kaht == 2 ) THEN
-               ! second call, no multiplication
-               DO jk = 1, jpkm1
-                  DO ji = 2, jpim1
-                     ! inverse of the volume element
-                     zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
-                     ! vertical divergence
-                     ztav = zftw(ji,jk) - zftw(ji,jk+1)
-                     ! harmonic operator applied to (pt,ps) 
-                     plt(ji,jj,jk,jn) = ( plt(ji,jj,jk,jn) + ztav ) * zbtr
-                  END DO
-               END DO
-            ELSE
-               IF(lwp) WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht
-               IF(lwp) WRITE(numout,*) '         We stop'
-               STOP 'ldfght'
-            ENDIF
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, zftu, zdkt, zdk1t ) 
-      CALL wrk_dealloc( jpi, jpk, zftw, zdit, zdjt, zdj1t ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ldfght')
-      !
-   END SUBROUTINE ldfght
-
-#else  
-   !!----------------------------------------------------------------------
-   !!   Dummy module :             NO rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE tra_ldf_bilapg( kt, kit000, cdtype, ptb, pta, kjpt )      ! Empty routine
-      INTEGER :: kt, kit000
-      CHARACTER(len=3) ::   cdtype
-      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
-      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', &
-        &         kt, kit000, cdtype, ptb(1,1,1,1), pta(1,1,1,1), kjpt
-   END SUBROUTINE tra_ldf_bilapg
-#endif
-
-   !!==============================================================================
-END MODULE traldf_bilapg
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_blp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_blp.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_blp.F90	(revision 5901)
@@ -0,0 +1,148 @@
+MODULE traldf_blp
+   !!======================================================================
+   !!                   ***  MODULE  traldf_blp  ***
+   !! Ocean  tracers:  bilaplacian lateral mixing trend on tracers
+   !!======================================================================
+   !! History :  3.7  ! 2015-09  (G. Madec)  original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   traldf_blp    : update the tracer trend with the bilaplacian lateral mixing trend
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE zdf_oce        ! ocean vertical physics
+   USE ldftra         ! lateral physics: eddy diffusivity
+   USE ldfslp         ! lateral physics: iso-neutral slopes
+   USE traldf_lap     ! lateral diffusion (Standard operator)         (tra_ldf_lap   routine)
+   USE traldf_iso     ! lateral diffusion (Standard operator)         (tra_ldf_iso   routine)
+   USE traldf_triad   ! lateral diffusion (Standard operator)         (tra_ldf_triad routine)
+   USE diaptr         ! poleward transport diagnostics
+   USE zpshde         ! partial step: hor. derivative     (zps_hde routine)
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_blp   ! routine called by traldf.F90
+
+   !                      ! Flag to control the type of lateral diffusive operator
+   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   ! error in specification of lateral diffusion
+   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00   ! without operator (i.e. no lateral diffusive trend)
+   !                          !!      laplacian     !    bilaplacian    !
+   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  ! iso-level operator
+   INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11   ,   np_blp_i  = 21  ! standard iso-neutral or geopotential operator
+   INTEGER, PARAMETER, PUBLIC ::   np_lap_it = 12   ,   np_blp_it = 22  ! triad    iso-neutral or geopotential operator
+
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d   !: vertical tracer gradient at 2 levels
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id: traldf_iso_grif.F90 5147 2015-03-13 10:01:32Z cetlod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                    pgui, pgvi,   &
+      &                                                    ptb , pta , kjpt, kldf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_ldf_blp  ***
+      !!                    
+      !! ** Purpose :   Compute the before lateral tracer diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The lateral diffusive trends is provided by a bilaplacian
+      !!      operator applied to before field (forward in time).
+      !!      It is computed by two successive calls to laplacian routine
+      !!
+      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion
+      !!----------------------------------------------------------------------
+      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
+      INTEGER                              , INTENT(in   ) ::   kldf       ! type of operator used
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top 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
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap         ! laplacian at t-point
+      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points)
+      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points)
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_blp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,kjpt,   zlap ) 
+      CALL wrk_alloc( jpi,jpj,    kjpt,   zglu, zglv, zgui, zgvi ) 
+      !
+      IF( kt == kit000 .AND. lwp )  THEN
+         WRITE(numout,*)
+         SELECT CASE ( kldf )
+         CASE ( np_blp    )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-level   bilaplacian operator on ', cdtype
+         CASE ( np_blp_i  )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)'
+         CASE ( np_blp_it )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)'
+         END SELECT
+         WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      zlap(:,:,:,:) = 0._wp
+      !
+      SELECT CASE ( kldf )       !==  1st laplacian applied to ptb (output in zlap)  ==!
+      !
+      CASE ( np_blp    )               ! iso-level bilaplacian
+         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb,      zlap, kjpt, 1 )
+         !
+      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec)
+         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
+         !
+      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies)
+         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
+         !
+      END SELECT
+      !
+      DO jn = 1, kjpt
+         CALL lbc_lnk( zlap(:,:,:,jn) , 'T', 1. )     ! Lateral boundary conditions (unchanged sign)
+      END DO
+      !                                               ! Partial top/bottom cell: GRADh( zlap )  
+      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom
+      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, kjpt, zlap, zglu, zglv )              ! only bottom 
+      ENDIF
+      !
+      SELECT CASE ( kldf )       !==  2nd laplacian applied to zlap (output in pta)  ==!
+      !
+      CASE ( np_blp    )               ! iso-level bilaplacian
+         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta,      kjpt, 2 )
+         !
+      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec)
+         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
+         !
+      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies)
+         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
+         !
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,kjpt,   zlap ) 
+      CALL wrk_dealloc( jpi,jpj    ,kjpt,   zglu, zglv, zgui, zgvi ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_blp')
+      !
+   END SUBROUTINE tra_ldf_blp
+
+   !!==============================================================================
+END MODULE traldf_blp
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 5901)
@@ -4,18 +4,16 @@
    !! 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
+   !! 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
+   !!            3.7  ! 2014-01  (G. Madec, S. Masson)  restructuration/simplification of aht/aeiv specification
+   !!             -   ! 2014-02  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
    !!----------------------------------------------------------------------
-#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 
+   !!   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
@@ -23,7 +21,8 @@
    USE trc_oce         ! share passive tracers/Ocean variables
    USE zdf_oce         ! ocean vertical physics
-   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldftra          ! lateral diffusion: tracer eddy coefficients
    USE ldfslp          ! iso-neutral slopes
    USE diaptr          ! poleward transport diagnostics
+   !
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O library
@@ -40,8 +39,7 @@
    !! * Substitutions
 #  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -49,7 +47,7 @@
 CONTAINS
 
-   SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv,              &
-      &                                pgui, pgvi,                    &
-      &                                ptb, pta, kjpt, pahtb0 )
+  SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                   pgui, pgvi,   &
+      &                                       ptb , ptbb, pta , kjpt, kpass )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf_iso  ***
@@ -66,14 +64,15 @@
       !!
       !!      1st part :  masked horizontal derivative of T  ( di[ t ] )
-      !!      ========    with partial cell update if ln_zps=T.
+      !!      ========    with partial cell update if ln_zps=T
+      !!                  with top     cell update if ln_isfcav
       !!
       !!      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)) ]
+      !!         zftu =  pahu e2u*e3u/e1u di[ tb ]
+      !!               - pahu e2u*uslp    dk[ mi(mk(tb)) ]
+      !!         zftv =  pahv e1v*e3v/e2v dj[ tb ]
+      !!               - pahv e2u*vslp    dk[ mj(mk(tb)) ]
       !!      take the horizontal divergence of the fluxes:
-      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
+      !!         difft = 1/(e1e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
       !!      Add this trend to the general trend (ta,sa):
       !!         ta = ta + difft
@@ -82,8 +81,8 @@
       !!      ========  (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)) ]  }
+      !!         zftw = - {  mi(mk(pahu)) * e2t*wslpi di[ mi(mk(tb)) ]
+      !!                   + mj(mk(pahv)) * e1t*wslpj dj[ mj(mk(tb)) ]  }
       !!      take the horizontal divergence of the fluxes:
-      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
+      !!         difft = 1/(e1e2t*e3t) dk[ zftw ]
       !!      Add this trend to the general trend (ta,sa):
       !!         pta = pta + difft
@@ -91,35 +90,116 @@
       !! ** 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
+      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    ,kjpt), INTENT(in   ) ::   pgui, pgvi   ! 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                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
       !
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
-      INTEGER  ::  ikt
-      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars
-      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
-      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdkt, zdk1t, zdit, zdjt, ztfw 
+      INTEGER  ::  ierr             ! local integer
+      REAL(wp) ::  zmsku, zahu_w, zabe1, zcof1, zcoef3   ! local scalars
+      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      -
+      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt   !   -      -
+#if defined key_diaar5
+      REAL(wp) ::   zztmp   ! local scalar
+#endif
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdkt, zdk1t, z2d
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdit, zdjt, zftu, zftv, ztfw 
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso')
       !
-      CALL wrk_alloc( jpi, jpj,      z2d ) 
-      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 
-      !
-
+      CALL wrk_alloc( jpi,jpj,       zdkt, zdk1t, z2d ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt , zftu, zftv, 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,*) '~~~~~~~~~~~'
+         !
+         akz     (:,:,:) = 0._wp      
+         ah_wslp2(:,:,:) = 0._wp
+      ENDIF
+      !
+      !                                               ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2dt =     rdttra(1)      ! at nit000   (Euler)
+      ELSE                                        ;   z2dt = 2.* rdttra(1)      !             (Leapfrog)
+      ENDIF
+      z1_2dt = 1._wp / z2dt
+      !
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
+      ELSE                    ;   zsign = -1._wp
+      ENDIF
+         
+         
+      !!----------------------------------------------------------------------
+      !!   0 - calculate  ah_wslp2 and akz
+      !!----------------------------------------------------------------------
+      !
+      IF( kpass == 1 ) THEN                  !==  first pass only  ==!
+         !
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !
+                  zmsku = tmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
+                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  )
+                  zmskv = tmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          &
+                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
+                     !
+                  zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
+                     &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
+                  zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
+                     &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
+                     !
+                  ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                     &               + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     akz(ji,jj,jk) = 0.25_wp * (                                                                     &
+                        &              ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   &
+                        &            + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )   &
+                        &            + ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) )   &
+                        &            + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )   )
+                  END DO
+               END DO
+            END DO
+            !
+            IF( ln_traldf_blp ) THEN                ! bilaplacian operator
+               DO jk = 2, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   &
+                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) )  )
+                     END DO
+                  END DO
+               END DO
+            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
+               DO jk = 2, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk)
+                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
+                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt
+                     END DO
+                  END DO
+               END DO
+           ENDIF
+           !
+         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
+            akz(:,:,:) = ah_wslp2(:,:,:)      
+         ENDIF
       ENDIF
       !
@@ -131,7 +211,7 @@
          !!   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
+!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient....
+         zdit (1,:,:) = 0._wp     ;     zdit (jpi,:,:) = 0._wp
+         zdjt (1,:,:) = 0._wp     ;     zdjt (jpi,:,:) = 0._wp
          !!end
 
@@ -145,61 +225,50 @@
             END DO
          END DO
-
-         ! partial cell correction
-         IF( ln_zps ) THEN      ! partial steps correction at the last ocean level 
-            DO jj = 1, jpjm1
+         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient
+            DO jj = 1, jpjm1              ! bottom correction (partial bottom cell)
                DO ji = 1, fs_jpim1   ! vector opt.
-! IF useless if zpshde defines pgu everywhere
+!!gm  the following anonymous remark is to considered: ! IF useless if zpshde defines pgu everywhere
                   zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)          
                   zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
                END DO
             END DO
+            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)          
+                     IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)     
+                  END DO
+               END DO
+            ENDIF
          ENDIF
-         IF( ln_zps .AND. ln_isfcav ) THEN      ! partial steps correction at the first wet level beneath a cavity
-            DO jj = 1, jpjm1
+
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+         !
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !
+            !                             !== Vertical tracer gradient
+            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1
+            !
+            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2)
+            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk)
+            ENDIF
+!!gm I don't understand why we should need this.... since wmask is used instead of tmask
+!         IF ( ln_isfcav ) THEN
+!            DO jj = 1, jpj
+!               DO ji = 1, jpi   ! vector opt.
+!                  ikt = mikt(ji,jj) ! surface level
+!                  zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn  ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1)
+!                  zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt)
+!               END DO
+!            END DO
+!         END IF
+!!gm 
+
+            DO jj = 1 , jpjm1            !==  Horizontal fluxes
                DO ji = 1, fs_jpim1   ! vector opt.
-                  IF (miku(ji,jj) > 1) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)          
-                  IF (mikv(ji,jj) > 1) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)     
-               END DO
-            END DO
-         END IF
-
-         !!----------------------------------------------------------------------
-         !!   II - horizontal trend  (full)
-         !!----------------------------------------------------------------------
-!!!!!!!!!!CDIR PARALLEL DO PRIVATE( zdk1t ) 
-            ! 1. Vertical tracer gradient at level jk and jk+1
-            ! ------------------------------------------------
-         ! 
-         ! interior value 
-         DO jk = 2, jpkm1               
-            DO jj = 1, jpj
-               DO ji = 1, jpi   ! vector opt.
-                  zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn  ) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)
-                  !
-                  zdkt(ji,jj,jk)  = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn  ) ) * wmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-         zdk1t(:,:,1) = ( ptb(:,:,1,jn  ) - ptb(:,:,2,jn) ) * wmask(:,:,2)
-         zdkt (:,:,1) = zdk1t(:,:,1)
-         IF ( ln_isfcav ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi   ! vector opt.
-                  ikt = mikt(ji,jj) ! surface level
-                  zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn  ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1)
-                  zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt)
-               END DO
-            END DO
-         END IF
-
-         ! 2. Horizontal fluxes
-         ! --------------------   
-         DO jk = 1, jpkm1
-            DO jj = 1 , jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
-                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
+                  zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk)
+                  zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk)
                   !
                   zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
@@ -209,73 +278,31 @@
                      &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )
                   !
-                  zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
-                  zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+                  zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
+                  zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
                   !
                   zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   &
-                     &              + zcof1 * (  zdkt (ji+1,jj,jk) + zdk1t(ji,jj,jk)      &
-                     &                         + zdk1t(ji+1,jj,jk) + zdkt (ji,jj,jk)  )  ) * umask(ji,jj,jk)
+                     &               + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
+                     &                          + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
                   zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
-                     &              + zcof2 * (  zdkt (ji,jj+1,jk) + zdk1t(ji,jj,jk)      &
-                     &                         + zdk1t(ji,jj+1,jk) + zdkt (ji,jj,jk)  )  ) * vmask(ji,jj,jk)                  
-               END DO
-            END DO
-
-            ! II.4 Second derivative (divergence) and add to the general trend
-            ! ----------------------------------------------------------------
-            DO jj = 2 , jpjm1
+                     &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
+                     &                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                  
+               END DO
+            END DO
+            !
+            DO jj = 2 , jpjm1          !== horizontal divergence and add to pta
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(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
-            !                                          ! ===============
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      &
+                     &                                           + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   &
+                     &                                        / (  e1e2t(ji,jj) * fse3t(ji,jj,jk)  )
+               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 ) THEN
-            ! note sign is reversed to give down-gradient diffusive transports (#1043)
-            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) )
-            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) )
-         ENDIF
- 
-         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
-           !
-           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
-               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) + zftu(ji,jj,jk) 
-                     END DO
-                  END DO
-               END DO
-               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043)
-               CALL lbc_lnk( z2d, 'U', -1. )
-               CALL 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(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043)
-               CALL lbc_lnk( z2d, 'V', -1. )
-               CALL 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
+
+
+         !!----------------------------------------------------------------------
+         !!   III - vertical trend (full)
+         !!----------------------------------------------------------------------
+         
+         ztfw(1,:,:) = 0._wp     ;     ztfw(jpi,:,:) = 0._wp
          
          ! Vertical fluxes
@@ -283,5 +310,5 @@
          
          ! Surface and bottom vertical fluxes set to zero
-         ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0
+         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp
          
          ! interior (2=<jk=<jpk-1)
@@ -289,13 +316,17 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zcoef0 = - fsahtw(ji,jj,jk) * wmask(ji,jj,jk)
-                  !
-                  zmsku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      &
-                     &            + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.  )
-                  zmskv = 1./MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      &
-                     &            + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.  )
-                  !
-                  zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)
-                  zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
+                  !
+                  zmsku = tmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
+                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  )
+                  zmskv = tmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          &
+                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
+                     !
+                  zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
+                     &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
+                  zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
+                     &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
+                     !
+                  zcoef3 = - zahu_w * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)   !wslpi & j are already w-masked
+                  zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
                   !
                   ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
@@ -306,41 +337,105 @@
             END DO
          END DO
-         
-         
-         ! I.5 Divergence of vertical fluxes added to the general tracer trend
-         ! -------------------------------------------------------------------
-         DO jk = 1, jpkm1
+         !
+         !                                !==  add the vertical 33 flux  ==!
+         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
+            DO jk = 2, jpkm1       
+               DO jj = 1, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)   &
+                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             &
+                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
+                  END DO
+               END DO
+            END DO
+            !
+         ELSE                                   ! bilaplacian 
+            SELECT CASE( kpass )
+            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
+               DO jk = 2, jpkm1 
+                  DO jj = 1, jpjm1
+                     DO ji = fs_2, fs_jpim1
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk)    &
+                           &           + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   &
+                           &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) / fse3w(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO 
+            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp.
+               DO jk = 2, jpkm1 
+                  DO jj = 1, jpjm1
+                     DO ji = fs_2, fs_jpim1
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)                      &
+                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   &
+                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   )
+                     END DO
+                  END DO
+               END DO
+            END SELECT
+         ENDIF
+         !         
+         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==!
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(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
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   &
+                     &                                        / (  e1e2t(ji,jj) * fse3t_n(ji,jj,jk)  )
                END DO
             END DO
          END DO
          !
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, z2d ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 
+         IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==!
+             ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==!
+            !
+            !                             ! "Poleward" diffusive heat or salt transports (T-S case only)
+            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+               ! note sign is reversed to give down-gradient diffusive transports (#1043)
+               IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) )
+               IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) )
+            ENDIF
+            !
+            IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
+              !
+              IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
+                  z2d(:,:) = zftu(ji,jj,1) 
+                  DO jk = 2, 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
+!!gm CAUTION I think there is an error of sign when using BLP operator....
+!!gm         a multiplication by zsign is required (to be checked twice !)
+                  z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043)
+                  CALL lbc_lnk( z2d, 'U', -1. )
+                  CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
+                  !
+                  z2d(:,:) = zftv(ji,jj,1) 
+                  DO jk = 2, 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(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043)
+                  CALL lbc_lnk( z2d, 'V', -1. )
+                  CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
+               END IF
+               !
+            ENDIF
+            !
+         ENDIF                                                    !== end pass selection  ==!
+         !
+         !                                                        ! ===============
+      END DO                                                      ! end tracer loop
+      !                                                           ! ===============
+      !
+      CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , zftu, zftv, ztfw  ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso')
       !
    END SUBROUTINE tra_ldf_iso
-
-#else
-   !!----------------------------------------------------------------------
-   !!   default option :   Dummy code   NO rotation of the diffusive tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE tra_ldf_iso( kt, kit000,cdtype, pgu, pgv, pgui, pgvi, ptb, pta, kjpt, pahtb0 )      ! Empty routine
-      INTEGER:: kt, kit000
-      CHARACTER(len=3) ::   cdtype
-      REAL, DIMENSION(:,:,:) ::   pgu, pgv, pgui, pgvi    ! 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
-#endif
 
    !!==============================================================================
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90	(revision 5891)
+++ 	(revision )
@@ -1,450 +1,0 @@
-MODULE traldf_iso_grif
-   !!======================================================================
-   !!                   ***  MODULE  traldf_iso_grif  ***
-   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
-   !!======================================================================
-   !! History : 3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)
-   !!                !          Griffies operator version adapted from traldf_iso.F90
-   !!----------------------------------------------------------------------
-#if   defined key_ldfslp   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_ldfslp'               slope of the lateral diffusive direction
-   !!----------------------------------------------------------------------
-   !!   tra_ldf_iso_grif  : update the tracer trend with the horizontal component
-   !!                       of the Griffies iso-neutral laplacian operator
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   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 diaptr          ! poleward transport diagnostics
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_ldf_iso_grif   ! routine called by traldf.F90
-
-   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   psix_eiv, psiy_eiv   !: eiv stream function (diag only)
-   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   ah_wslp2             !: aeiv*w-slope^2
-   REAL(wp),         DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d               !: vertical tracer gradient at 2 levels
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-#  include "ldfeiv_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-  SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv,              &
-       &                                   ptb, pta, kjpt, pahtb0 )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_ldf_iso_grif  ***
-      !!
-      !! ** 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 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(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
-      INTEGER  ::  ip,jp,kp        ! dummy loop indices
-      INTEGER  ::  ierr            ! temporary integer
-      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars
-      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
-      REAL(wp) ::  zcoef0, zbtr                  !   -      -
-      !
-      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
-      REAL(wp) ::   ze1ur, zdxt, ze2vr, ze3wr, zdyt, zdzt
-      REAL(wp) ::   zah, zah_slp, zaei_slp
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw 
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso_grif')
-      !
-      CALL wrk_alloc( jpi, jpj,      z2d ) 
-      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
-      !
-
-      IF( kt == kit000 .AND. .NOT.ALLOCATED(ah_wslp2) )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_iso_grif : rotated laplacian diffusion operator on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-         ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt3d(jpi,jpj,0:1), STAT=ierr )
-         IF( lk_mpp   )   CALL mpp_sum ( ierr )
-         IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate arrays')
-         IF( ln_traldf_gdia ) THEN
-            IF (.NOT. ALLOCATED(psix_eiv))THEN
-                ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr )
-                IF( lk_mpp   )   CALL mpp_sum ( ierr )
-                IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics')
-            ENDIF
-         ENDIF
-      ENDIF
-
-      !!----------------------------------------------------------------------
-      !!   0 - calculate  ah_wslp2, psix_eiv, psiy_eiv
-      !!----------------------------------------------------------------------
-
-      !!gm Future development: consider using Ah defined at T-points and attached to the 4 t-point triads
-
-      ah_wslp2(:,:,:) = 0._wp
-      IF( ln_traldf_gdia ) THEN
-         psix_eiv(:,:,:) = 0._wp
-         psiy_eiv(:,:,:) = 0._wp
-      ENDIF
-
-      DO ip = 0, 1
-         DO kp = 0, 1
-            DO jk = 1, jpkm1
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     ze1ur = 1._wp / e1u(ji,jj)
-                     ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
-                     zbu   = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-                     zah   = fsahtu(ji,jj,jk)                                  ! fsaht(ji+ip,jj,jk)
-                     zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
-                     ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
-                     ! (do this by *adding* gradient of depth)
-                     zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * ze1ur * umask(ji,jj,jk+kp)
-                     zslope2 = zslope2 *zslope2
-                     ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp)    &
-                        &                     + zah * ( zbu * ze3wr / ( e1t(ji+ip,jj) * e2t(ji+ip,jj) ) ) * zslope2
-                     IF( ln_traldf_gdia ) THEN
-                        zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew           ! fsaeit(ji+ip,jj,jk)*zslope_skew
-                        psix_eiv(ji,jj,jk+kp) = psix_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-         END DO
-      END DO
-      !
-      DO jp = 0, 1
-         DO kp = 0, 1
-            DO jk = 1, jpkm1
-               DO jj = 1, jpjm1
-                  DO ji=1,fs_jpim1
-                     ze2vr = 1._wp / e2v(ji,jj)
-                     ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp)
-                     zbv   = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
-                     zah   = fsahtv(ji,jj,jk)                                  ! fsaht(ji,jj+jp,jk)
-                     zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
-                     ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
-                     !    (do this by *adding* gradient of depth)
-                     zslope2 = zslope_skew + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * ze2vr * vmask(ji,jj,jk+kp)
-                     zslope2 = zslope2 * zslope2
-                     ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp)   &
-                        &                     + zah * ( zbv * ze3wr / ( e1t(ji,jj+jp) * e2t(ji,jj+jp) ) ) * zslope2
-                     IF( ln_traldf_gdia ) THEN
-                        zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew           ! fsaeit(ji,jj+jp,jk)*zslope_skew
-                        psiy_eiv(ji,jj,jk+kp) = psiy_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-         END DO
-      END DO
-      !
-      IF( iom_use("uoce_eiv") .OR. iom_use("voce_eiv") .OR. iom_use("woce_eiv") )  THEN
-         !
-         IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN
-            CALL wrk_alloc( jpi , jpj , jpk  , zw3d )
-            DO jk=1,jpkm1
-               zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz
-            END DO
-            zw3d(:,:,jpk) = 0._wp
-            CALL iom_put( "uoce_eiv", zw3d )    ! i-eiv current
-
-            DO jk=1,jpk-1
-               zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz
-            END DO
-            zw3d(:,:,jpk) = 0._wp
-            CALL iom_put( "voce_eiv", zw3d )    ! j-eiv current
-
-            DO jk=1,jpk-1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1  ! vector opt.
-                     zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + &
-                          &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx
-                  END DO
-               END DO
-            END DO
-            zw3d(:,:,jpk) = 0._wp
-            CALL iom_put( "woce_eiv", zw3d )    ! vert. eiv current
-            CALL wrk_dealloc( jpi , jpj , jpk  , zw3d )
-         ENDIF
-         !
-      ENDIF
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         ! Zero fluxes for each tracer
-         ztfw(:,:,:) = 0._wp
-         zftu(:,:,:) = 0._wp
-         zftv(:,:,:) = 0._wp
-         !
-         DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==!
-            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(ji,jj,jk)
-                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         IF( ln_zps.and.l_grad_zps ) THEN              ! partial steps: correction at the last level
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
-                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
-               END DO
-            END DO
-         ENDIF
-
-         !!----------------------------------------------------------------------
-         !!   II - horizontal trend  (full)
-         !!----------------------------------------------------------------------
-         !
-         DO jk = 1, jpkm1
-            !
-            !                    !==  Vertical tracer gradient at level jk and jk+1
-            zdkt3d(:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
-            !
-            !                    ! surface boundary condition: zdkt3d(jk=0)=zdkt3d(jk=1)
-            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1)
-            ELSE                 ;   zdkt3d(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk)
-            ENDIF
-
-
-            IF (ln_botmix_grif) THEN
-               DO ip = 0, 1              !==  Horizontal & vertical fluxes
-                  DO kp = 0, 1
-                     DO jj = 1, jpjm1
-                        DO ji = 1, fs_jpim1
-                           ze1ur = 1._wp / e1u(ji,jj)
-                           zdxt  = zdit(ji,jj,jk) * ze1ur
-                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
-                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
-                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
-                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp)
-
-                           zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-                           ! ln_botmix_grif is .T. don't mask zah for bottom half cells
-                           zah = fsahtu(ji,jj,jk)   !*umask(ji,jj,jk+kp)         !fsaht(ji+ip,jj,jk)           ===>>  ????
-                           zah_slp  = zah * zslope_iso
-                           zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew    !fsaeit(ji+ip,jj,jk)*zslope_skew
-                           zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
-                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
-                        END DO
-                     END DO
-                  END DO
-               END DO
-
-               DO jp = 0, 1
-                  DO kp = 0, 1
-                     DO jj = 1, jpjm1
-                        DO ji = 1, fs_jpim1
-                           ze2vr = 1._wp / e2v(ji,jj)
-                           zdyt  = zdjt(ji,jj,jk) * ze2vr
-                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)
-                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
-                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
-                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
-                           zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
-                           ! ln_botmix_grif is .T. don't mask zah for bottom half cells
-                           zah = fsahtv(ji,jj,jk)        !*vmask(ji,jj,jk+kp)  ! fsaht(ji,jj+jp,jk)
-                           zah_slp = zah * zslope_iso
-                           zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew
-                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
-                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
-                        END DO
-                     END DO
-                  END DO
-               END DO
-            ELSE
-               DO ip = 0, 1              !==  Horizontal & vertical fluxes
-                  DO kp = 0, 1
-                     DO jj = 1, jpjm1
-                        DO ji = 1, fs_jpim1
-                           ze1ur = 1._wp / e1u(ji,jj)
-                           zdxt  = zdit(ji,jj,jk) * ze1ur
-                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
-                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
-                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
-                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp)
-
-                           zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-                           ! ln_botmix_grif is .F. mask zah for bottom half cells
-                           zah = fsahtu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! fsaht(ji+ip,jj,jk)   ===>>  ????
-                           zah_slp  = zah * zslope_iso
-                           zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew        ! fsaeit(ji+ip,jj,jk)*zslope_skew
-                           zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
-                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
-                        END DO
-                     END DO
-                  END DO
-               END DO
-
-               DO jp = 0, 1
-                  DO kp = 0, 1
-                     DO jj = 1, jpjm1
-                        DO ji = 1, fs_jpim1
-                           ze2vr = 1._wp / e2v(ji,jj)
-                           zdyt  = zdjt(ji,jj,jk) * ze2vr
-                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)
-                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
-                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
-                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
-                           zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
-                           ! ln_botmix_grif is .F. mask zah for bottom half cells
-                           zah = fsahtv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! fsaht(ji,jj+jp,jk)
-                           zah_slp = zah * zslope_iso
-                           zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew
-                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
-                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
-                        END DO
-                     END DO
-                  END DO
-               END DO
-            END IF
-            !                          !==  divergence and add to the general trend  ==!
-            DO jj = 2 , jpjm1
-               DO ji = fs_2, fs_jpim1  ! vector opt.
-                  zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (   zftu(ji-1,jj,jk) - zftu(ji,jj,jk)   &
-                     &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )
-               END DO
-            END DO
-            !
-         END DO
-         !
-         DO jk = 1, jpkm1              !== Divergence of vertical fluxes added to the general tracer trend
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1  ! vector opt.
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   &
-                     &                                / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
-         !
-         !                             ! "Poleward" diffusive heat or salt transports (T-S case only)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
-            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names
-            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) )
-         ENDIF
-
-         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
-           !
-           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
-               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) + zftu(ji,jj,jk) 
-                     END DO
-                  END DO
-               END DO
-               z2d(:,:) = rau0_rcp * z2d(:,:) 
-               CALL lbc_lnk( z2d, 'U', -1. )
-               CALL 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(:,:) = rau0_rcp * z2d(:,:)     
-               CALL lbc_lnk( z2d, 'V', -1. )
-               CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
-            END IF
-            !
-         ENDIF
-         !
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj,      z2d ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso_grif')
-      !
-  END SUBROUTINE tra_ldf_iso_grif
-
-#else
-   !!----------------------------------------------------------------------
-   !!   default option :   Dummy code   NO rotation of the diffusive tensor
-   !!----------------------------------------------------------------------
-   REAL, PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   psix_eiv, psiy_eiv   !: eiv stream function (diag only)
-CONTAINS
-   SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv,              &
-       &                                   ptb, pta, kjpt, pahtb0 )
-      CHARACTER(len=3) ::   cdtype
-      INTEGER          ::   kit000     ! first time step index
-      REAL, DIMENSION(:,:,:) ::   pgu, pgv   ! tracer gradient at pstep levels
-      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
-      WRITE(*,*) 'tra_ldf_iso_grif: You should not have seen this print! error?', kt, 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_grif
-#endif
-
-   !!==============================================================================
-END MODULE traldf_iso_grif
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 5901)
@@ -2,40 +2,44 @@
    !!==============================================================================
    !!                       ***  MODULE  traldf_lap  ***
-   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !! Ocean tracers:  lateral diffusivity trend  (laplacian and bilaplacian)
    !!==============================================================================
-   !! 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
+   !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code
+   !!                 ! 1991-11  (G. Madec)
+   !!                 ! 1995-11  (G. Madec)  suppress volumetric scale factors
+   !!                 ! 1996-01  (G. Madec)  statement function for e3
+   !!            NEMO ! 2002-06  (G. Madec)  F90: Free form and module
+   !!            1.0  ! 2004-08  (C. Talandier) New trends organization
+   !!                 ! 2005-11  (G. Madec)  add zps case
+   !!            3.0  ! 2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!            3.7  ! 2014-01  (G. Madec, S. Masson) re-entrant laplacian 
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   tra_ldf_lap  : update the tracer trend with the horizontal diffusion
-   !!                 using a iso-level harmonic (laplacien) operator.
+   !!   tra_ldf_lap : update the tracer trend with the lateral diffusion : iso-level laplacian operator
+   !!   tra_ldf_blp : update the tracer trend with the lateral diffusion : iso-level bilaplacian operator
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE in_out_manager  ! I/O manager
+   USE ldftra          ! lateral physics: eddy diffusivity
    USE diaptr          ! poleward transport diagnostics
    USE trc_oce         ! share passive tracers/Ocean variables
-   USE lib_mpp         ! MPP library
+   USE zpshde          ! partial step: hor. derivative     (zps_hde routine)
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! distribued memory computing library
    USE timing          ! Timing
+   USE wrk_nemo        ! Memory allocation
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   tra_ldf_lap   ! routine called by step.F90
+   PUBLIC   tra_ldf_lap   ! routine called by traldf.F90
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -43,7 +47,7 @@
 CONTAINS
 
-   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pgu , pgv ,    &
-      &                                        pgui, pgvi,    &
-      &                                ptb, pta, kjpt ) 
+   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                    pgui, pgvi,   &
+      &                                        ptb , pta , kjpt, kpass ) 
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf_lap  ***
@@ -55,6 +59,6 @@
       !!      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) ] }
+      !!          difft = 1/(e1e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ]
+      !!                                 + dj-1[ pahv e1v*e3v/e2v dj(tb) ] }
       !!      Add this trend to the general tracer trend pta :
       !!          pta = pta + difft
@@ -63,106 +67,100 @@
       !!                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
+      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
+      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
-      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top levels
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   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
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zsign            ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 ) CALL timing_start('tra_ldf_lap')
+      IF( nn_timing == 1 )   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( kt == nit000 .AND. lwp )  THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass
+         WRITE(numout,*) '~~~~~~~~~~~ '
       ENDIF
-
-      !                                                          ! =========== !
-      DO jn = 1, kjpt                                            ! tracer loop !
-         !                                                       ! =========== !    
-         DO jk = 1, jpkm1                                            ! slab loop
-            !                                           
-            ! 1. First derivative (gradient)
-            ! -------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev ) 
+      !
+      !                                !==  Initialization of metric arrays used for all tracers  ==!
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
+      ELSE                    ;   zsign = -1._wp
+      ENDIF
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk)   !!gm   * umask(ji,jj,jk) pah masked!
+               zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk)   !!gm   * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      !                             ! =========== !
+      DO jn = 1, kjpt               ! tracer loop !
+         !                          ! =========== !    
+         !                               
+         DO jk = 1, jpkm1              !== First derivative (gradient)  ==!
             DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
-                  zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(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) )
+               DO ji = 1, fs_jpim1
+                  ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( 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 for the last ocean cell
+         END DO  
+         IF( ln_zps ) THEN                ! set gradient at bottom/top ocean level
+            DO jj = 1, jpjm1                    ! bottom
+               DO ji = 1, fs_jpim1
+                  ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn)
+                  ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn)
+               END DO
+            END DO  
+            IF( ln_isfcav ) THEN                ! top in ocean cavities only
                DO jj = 1, jpjm1
                   DO ji = 1, fs_jpim1   ! vector opt.
-                     ! last level
-                     iku = mbku(ji,jj)
-                     ikv = mbkv(ji,jj)
-                     IF( iku == jk ) THEN
-                        zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku)
-                        ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn)
-                     ENDIF
-                     IF( ikv == jk ) THEN
-                        zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv)
-                        ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn)
-                     ENDIF
+                     IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 
+                     IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 
                   END DO
                END DO
             ENDIF
-            ! (ISH)
-            IF( ln_zps .AND. ln_isfcav ) THEN      ! set gradient at partial step level for the first ocean cell
-                                                   ! into a cavity
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     ! ice shelf level level MAX(2,jk) => only where ice shelf
-                     iku = miku(ji,jj) 
-                     ikv = mikv(ji,jj) 
-                     IF( iku == MAX(2,jk) ) THEN 
-                        zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku) 
-                        ztu(ji,jj,jk) = zabe1 * pgui(ji,jj,jn) 
-                     ENDIF 
-                     IF( ikv == MAX(2,jk) ) THEN 
-                        zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 
-                        ztv(ji,jj,jk) = zabe2 * pgvi(ji,jj,jn) 
-                     END IF 
-                  END DO
-               END DO
-            ENDIF
-         
-         
-            ! 2. Second derivative (divergence) added to the general tracer trends
-            ! ---------------------------------------------------------------------
+         ENDIF
+         !
+         DO jk = 1, jpkm1              !== Second derivative (divergence) added to the general tracer trends  ==!
             DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1._wp / ( e12t(ji,jj) * fse3t_n(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)  )
+               DO ji = fs_2, fs_jpim1
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     &
+                     &                                   + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   &
+                     &                                / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )
                END DO
             END DO
-            !
-         END DO                                             !  End of slab  
+         END DO  
          !
-         ! "Poleward" diffusive heat or salt transports
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
-            IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( ztv(:,:,:) )
-            IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( ztv(:,:,:) )
+         !                             !== "Poleward" diffusive heat or salt transports  ==!
+         IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR.  &     !==  first pass only (  laplacian)  ==!
+             ( kpass == 2 .AND.      ln_traldf_blp ) ) THEN      !==  2nd   pass only (bilaplacian)  ==!
+            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+               IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( -ztv(:,:,:) )
+               IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( -ztv(:,:,:) )
+            ENDIF
          ENDIF
-         !                                                  ! ==================
-      END DO                                                ! end of tracer loop
-      !                                                     ! ==================
-      IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap')
+         !                          ! ==================
+      END DO                        ! end of tracer loop
+      !                             ! ==================
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_lap')
       !
    END SUBROUTINE tra_ldf_lap
-
+   
    !!==============================================================================
 END MODULE traldf_lap
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90	(revision 5901)
@@ -0,0 +1,470 @@
+MODULE traldf_triad
+   !!======================================================================
+   !!                   ***  MODULE  traldf_triad  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!======================================================================
+   !! History :  3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  Griffies operator (original code)
+   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_triad : update the tracer trend with the iso-neutral laplacian triad-operator
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE zdf_oce         ! ocean vertical physics
+   USE ldftra          ! lateral physics: eddy diffusivity
+   USE ldfslp          ! lateral physics: iso-neutral slopes
+   USE traldf_iso      ! lateral diffusion (Madec operator)         (tra_ldf_iso routine)
+   USE diaptr          ! poleward transport diagnostics
+   USE zpshde          ! partial step: hor. derivative     (zps_hde routine)
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_triad   ! routine called by traldf.F90
+
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d   !: vertical tracer gradient at 2 levels
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+  SUBROUTINE tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                     pgui, pgvi,   &
+      &                                         ptb , ptbb, pta , kjpt, kpass )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_triad  ***
+      !!
+      !! ** 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.
+      !!
+      !!      see documentation for the desciption
+      !!
+      !! ** Action :   pta   updated with the before rotated diffusion
+      !!               ah_wslp2 ....
+      !!               akz   stabilizing vertical diffusivity coefficient (used in trazdf_imp)
+      !!----------------------------------------------------------------------
+      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
+      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::  ip,jp,kp         ! dummy loop indices
+      INTEGER  ::  ierr            ! local integer
+      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3          ! local scalars
+      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4          !   -      -
+      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt  !   -      -
+      !
+      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
+      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt
+      REAL(wp) ::   zah, zah_slp, zaei_slp
+#if defined key_diaar5
+      REAL(wp) ::   zztmp              ! local scalar
+#endif
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d                                            ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_triad')
+      !
+      CALL wrk_alloc( jpi,jpj,       z2d ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  ) 
+      !
+      IF( .NOT.ALLOCATED(zdkt3d) )  THEN
+         ALLOCATE( zdkt3d(jpi,jpj,0:1) , STAT=ierr )
+         IF( lk_mpp   )   CALL mpp_sum ( ierr )
+         IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_triad: unable to allocate arrays')
+      ENDIF
+     !
+      IF( kpass == 1 .AND. kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_triad : rotated laplacian diffusion operator on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+      !
+      !                                               ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == kit000 ) THEN   ;   z2dt =     rdttra(1)      ! at nit000   (Euler)
+      ELSE                                        ;   z2dt = 2.* rdttra(1)      !             (Leapfrog)
+      ENDIF
+      z1_2dt = 1._wp / z2dt
+      !
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
+      ELSE                    ;   zsign = -1._wp
+      ENDIF
+                  
+      !!----------------------------------------------------------------------
+      !!   0 - calculate  ah_wslp2, akz, and optionally zpsi_uw, zpsi_vw
+      !!----------------------------------------------------------------------
+      !
+      IF( kpass == 1 ) THEN         !==  first pass only  and whatever the tracer is  ==!
+         !
+         akz     (:,:,:) = 0._wp      
+         ah_wslp2(:,:,:) = 0._wp
+         IF( ln_ldfeiv_dia ) THEN
+            zpsi_uw(:,:,:) = 0._wp
+            zpsi_vw(:,:,:) = 0._wp
+         ENDIF
+         !
+         DO ip = 0, 1                            ! i-k triads
+            DO kp = 0, 1
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
+                        zbu   = e1e2u(ji,jj) * fse3u(ji,jj,jk)
+                        zah   = 0.25_wp * pahu(ji,jj,jk)
+                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                        ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth)
+                        zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)
+                        zslope2 = zslope2 *zslope2
+                        ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2
+                        akz     (ji+ip,jj,jk+kp) = akz     (ji+ip,jj,jk+kp) + zah * r1_e1u(ji,jj)       &
+                           &                                                      * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)
+                        !
+                       IF( ln_ldfeiv_dia )   zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp)   &
+                           &                                       + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * zslope_skew
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         DO jp = 0, 1                            ! j-k triads 
+            DO kp = 0, 1
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp)
+                        zbv   = e1e2v(ji,jj) * fse3v(ji,jj,jk)
+                        zah   = 0.25_wp * pahv(ji,jj,jk)
+                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                        ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
+                        !    (do this by *adding* gradient of depth)
+                        zslope2 = zslope_skew + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)
+                        zslope2 = zslope2 * zslope2
+                        ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2
+                        akz     (ji,jj+jp,jk+kp) = akz     (ji,jj+jp,jk+kp) + zah * r1_e2v(ji,jj)     &
+                           &                                                      * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)
+                        !
+                        IF( ln_ldfeiv_dia )   zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp)   &
+                           &                                       + 0.25 * aeiv(ji,jj,jk) * e1v(ji,jj) * zslope_skew
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient
+            !
+            IF( ln_traldf_blp ) THEN                ! bilaplacian operator
+               DO jk = 2, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   &
+                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) )  )
+                     END DO
+                  END DO
+               END DO
+            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
+               DO jk = 2, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk)
+                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
+                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt
+                     END DO
+                  END DO
+               END DO
+           ENDIF
+           !
+         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
+            akz(:,:,:) = ah_wslp2(:,:,:)      
+         ENDIF
+         !
+         IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw )
+         !
+      ENDIF                                  !==  end 1st pass only  ==!
+      !
+      !                                                           ! ===========
+      DO jn = 1, kjpt                                             ! tracer loop
+         !                                                        ! ===========
+         ! Zero fluxes for each tracer
+!!gm  this should probably be done outside the jn loop
+         ztfw(:,:,:) = 0._wp
+         zftu(:,:,:) = 0._wp
+         zftv(:,:,:) = 0._wp
+         !
+         DO jk = 1, jpkm1        !==  before lateral T & S gradients at T-level jk  ==!
+            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(ji,jj,jk)
+                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_zps .AND. l_grad_zps ) THEN    ! partial steps: correction at top/bottom ocean level
+            DO jj = 1, jpjm1                       ! bottom level
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
+                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
+               END DO
+            END DO
+            IF( ln_isfcav ) THEN                   ! top level (ocean cavities only)
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 
+                     IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) 
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+         !
+         DO jk = 1, jpkm1
+            !
+            !                    !==  Vertical tracer gradient at level jk and jk+1
+            zdkt3d(:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+            !
+            !                    ! surface boundary condition: zdkt3d(jk=0)=zdkt3d(jk=1)
+            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1)
+            ELSE                 ;   zdkt3d(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+            !
+            zaei_slp = 0._wp
+            !
+            IF( ln_botmix_triad ) THEN
+               DO ip = 0, 1              !==  Horizontal & vertical fluxes
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze1ur = r1_e1u(ji,jj)
+                           zdxt  = zdit(ji,jj,jk) * ze1ur
+                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
+                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
+                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                           zslope_iso  = triadi  (ji+ip,jj,jk,1-ip,kp)
+
+                           zbu = 0.25_wp * e1e2u(ji,jj) * fse3u(ji,jj,jk)
+                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked....
+                           zah = pahu(ji,jj,jk)
+                           zah_slp  = zah * zslope_iso
+                           IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew
+                           zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - ( zah_slp + zaei_slp) * zdxt                 * zbu * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+
+               DO jp = 0, 1
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze2vr = r1_e2v(ji,jj)
+                           zdyt  = zdjt(ji,jj,jk) * ze2vr
+                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)
+                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
+                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
+                           zbv = 0.25_wp * e1e2v(ji,jj) * fse3v(ji,jj,jk)
+                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????  ahv is masked...
+                           zah = pahv(ji,jj,jk)
+                           zah_slp = zah * zslope_iso
+                           IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew
+                           zftv(ji,jj   ,jk   ) = zftv(ji,jj   ,jk   ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - ( zah_slp + zaei_slp ) * zdyt                * zbv * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+
+            ELSE
+
+               DO ip = 0, 1               !==  Horizontal & vertical fluxes
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze1ur = r1_e1u(ji,jj)
+                           zdxt  = zdit(ji,jj,jk) * ze1ur
+                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
+                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
+                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp)
+
+                           zbu = 0.25_wp * e1e2u(ji,jj) * fse3u(ji,jj,jk)
+                           ! ln_botmix_triad is .F. mask zah for bottom half cells
+                           zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ????
+                           zah_slp  = zah * zslope_iso
+                           IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew        ! fsaeit(ji+ip,jj,jk)*zslope_skew
+                           zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+
+               DO jp = 0, 1
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze2vr = r1_e2v(ji,jj)
+                           zdyt  = zdjt(ji,jj,jk) * ze2vr
+                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)
+                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
+                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
+                           zbv = 0.25_wp * e1e2v(ji,jj) * fse3v(ji,jj,jk)
+                           ! ln_botmix_triad is .F. mask zah for bottom half cells
+                           zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ????
+                           zah_slp = zah * zslope_iso
+                           IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew
+                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+            !                             !==  horizontal divergence and add to the general trend  ==!
+            DO jj = 2 , jpjm1
+               DO ji = fs_2, fs_jpim1  ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji-1,jj,jk) - zftu(ji,jj,jk)       &
+                     &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )   &
+                     &                                        / (  e1e2t(ji,jj) * fse3t(ji,jj,jk)  )
+               END DO
+            END DO
+            !
+         END DO
+         !
+         !                                !==  add the vertical 33 flux  ==!
+         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
+            DO jk = 2, jpkm1       
+               DO jj = 1, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)   &
+                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             &
+                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
+                  END DO
+               END DO
+            END DO
+         ELSE                                   ! bilaplacian 
+            SELECT CASE( kpass )
+            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
+               DO jk = 2, jpkm1 
+                  DO jj = 1, jpjm1
+                     DO ji = fs_2, fs_jpim1
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)             &
+                           &                            * ah_wslp2(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
+                     END DO
+                  END DO
+               END DO 
+            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp.
+               DO jk = 2, jpkm1 
+                  DO jj = 1, jpjm1
+                     DO ji = fs_2, fs_jpim1
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)                      &
+                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   &
+                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   )
+                     END DO
+                  END DO
+               END DO
+            END SELECT 
+         ENDIF
+         !
+         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1  ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   &
+                     &                                        / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !
+         IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==!
+             ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==!
+            !
+            !                          ! "Poleward" diffusive heat or salt transports (T-S case only)
+            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+               IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names
+               IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) )
+            ENDIF
+            !
+            IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
+              !
+              IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
+                  z2d(:,:) = zftu(ji,jj,1) 
+                  DO jk = 2, 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(:,:) = rau0_rcp * z2d(:,:) 
+                  CALL lbc_lnk( z2d, 'U', -1. )
+                  CALL iom_put( "udiff_heattr", z2d )                  ! heat i-transport
+                  !
+                  z2d(:,:) = zftv(ji,jj,1) 
+                  DO jk = 2, 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(:,:) = rau0_rcp * z2d(:,:)     
+                  CALL lbc_lnk( z2d, 'V', -1. )
+                  CALL iom_put( "vdiff_heattr", z2d )                  !  heat j-transport
+               ENDIF
+               !
+            ENDIF
+            !
+         ENDIF                                                    !== end pass selection  ==!
+         !
+         !                                                        ! ===============
+      END DO                                                      ! end tracer loop
+      !                                                           ! ===============
+      !
+      CALL wrk_dealloc( jpi,jpj,       z2d ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_triad')
+      !
+   END SUBROUTINE tra_ldf_triad
+
+   !!==============================================================================
+END MODULE traldf_triad
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 5901)
@@ -28,4 +28,5 @@
    USE sbc_oce         ! surface boundary condition: ocean
    USE sbcrnf          ! river runoffs
+   USE sbcisf          ! ice shelf melting/freezing
    USE zdf_oce         ! ocean vertical mixing
    USE domvvl          ! variable volume
@@ -36,5 +37,6 @@
    USE traqsr          ! penetrative solar radiation (needed for nksr)
    USE phycst          ! physical constant
-   USE ldftra_oce      ! lateral physics on tracers
+   USE ldftra          ! lateral physics on tracers
+   USE ldfslp
    USE bdy_oce         ! BDY open boundary condition variables
    USE bdytra          ! open boundary condition (bdy_tra routine)
@@ -46,5 +48,4 @@
    USE timing          ! Timing
 #if defined key_agrif
-   USE agrif_opa_update
    USE agrif_opa_interp
 #endif
@@ -110,4 +111,8 @@
       ! Update after tracer on domain lateral boundaries
       ! 
+#if defined key_agrif
+      CALL Agrif_tra                     ! AGRIF zoom boundaries
+#endif
+      !
       CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign)
       CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
@@ -115,7 +120,4 @@
 #if defined key_bdy 
       IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
-#endif
-#if defined key_agrif
-      CALL Agrif_tra                     ! AGRIF zoom boundaries
 #endif
  
@@ -148,10 +150,5 @@
          ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level 
          ENDIF
-      ENDIF 
-      !
-#if defined key_agrif
-      ! Update tracer at AGRIF zoom boundaries
-      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only
-#endif      
+      ENDIF     
       !
       ! trends computation
@@ -279,5 +276,5 @@
 
       !!     
-      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf   ! local logical
+      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf   ! local logical
       INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
       REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
@@ -295,8 +292,14 @@
          ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
          ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
+         IF (nn_isf .GE. 1) THEN 
+            ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing
+         ELSE
+            ll_isf = .FALSE.
+         END IF
       ELSE                          
          ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
          ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
          ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
+         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing
       ENDIF
       !
@@ -321,15 +324,31 @@
                   ztc_f  = ztc_n  + atfp * ztc_d
                   !
-                  IF( jk == 1 ) THEN           ! first level 
-                     ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) + rnf(ji,jj) - rnf_b(ji,jj) )
+                  IF( jk == mikt(ji,jj) ) THEN           ! first level 
+                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
+                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
+                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
                      ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
                   ENDIF
 
-                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only)
+                  ! solar penetration (temperature only)
+                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
                      &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
 
-                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )   & 		      ! river runoffs
+                  ! river runoff
+                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
                      &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
                      &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
+
+                  ! ice shelf
+                  IF( ll_isf ) THEN
+                     ! level fully include in the Losch_2008 ice shelf boundary layer
+                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
+                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
+                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
+                     ! level partially include in Losch_2008 ice shelf boundary layer 
+                     IF ( jk == misfkb(ji,jj) )                                                   &
+                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
+                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
+                  END IF
 
                   ze3t_f = 1.e0 / ze3t_f
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 5901)
@@ -189,8 +189,5 @@
                   CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step
                   !         
-!CDIR COLLAPSE
-!CDIR NOVERRCHK
                   DO jj = 1, jpj                                         ! Separation in R-G-B depending of the surface Chl
-!CDIR NOVERRCHK
                      DO ji = 1, jpi
                         zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) )
@@ -217,7 +214,5 @@
                !
                DO jk = 2, nksr+1
-!CDIR NOVERRCHK
                   DO jj = 1, jpj
-!CDIR NOVERRCHK   
                      DO ji = 1, jpi
                         zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r     )
@@ -495,7 +490,5 @@
                
                   DO jk = 2, nksr+1
-!CDIR NOVERRCHK
                      DO jj = 1, jpj
-!CDIR NOVERRCHK   
                         DO ji = 1, jpi
                            zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r     )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 5901)
@@ -120,5 +120,4 @@
       REAL(wp) ::   zfact, z1_e3t, zdep
       REAL(wp) ::   zalpha, zhk
-      REAL(wp) ::  zt_frz, zpress
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -232,11 +231,7 @@
                DO jk = ikt, ikb - 1
                ! compute tfreez for the temperature correction (we add water at freezing temperature)
-!                  zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04
-                  zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress )
                ! compute trend
                   tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                          &
-                     &           + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)          &
-                     &               - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) &
-                     &           * r1_hisf_tbl(ji,jj)
+                     &           + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)) * r1_hisf_tbl(ji,jj)
                   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)                                          &
                      &           + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj)
@@ -245,11 +240,7 @@
                ! level partially include in ice shelf boundary layer 
                ! compute tfreez for the temperature correction (we add water at freezing temperature)
-!               zpress = grav*rau0*fsdept(ji,jj,ikb)*1.e-04
-               zt_frz = -1.9 !eos_fzp( tsn(ji,jj,ikb,jp_sal), zpress )
                ! compute trend
                tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem)                                           &
-                  &              + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)          &
-                  &                  - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) & 
-                  &              * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
+                  &              + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
                tsa(ji,jj,ikb,jp_sal) = tsa(ji,jj,ikb,jp_sal)                                           &
                   &              + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 5901)
@@ -19,7 +19,10 @@
    USE sbc_oce         ! surface boundary condition: ocean
    USE dynspg_oce
+   !
+   USE ldftra          ! lateral diffusion: eddy diffusivity
+   USE ldfslp          ! lateral diffusion: iso-neutral slope 
    USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine)
    USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine)
-   USE ldftra_oce      ! ocean active tracers: lateral physics
+   !
    USE trd_oce         ! trends: ocean variables
    USE trdtra          ! trends manager: tracers 
@@ -45,5 +48,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -80,16 +83,11 @@
       CASE ( 0 )    ;    CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme 
       CASE ( 1 )    ;    CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra,            tsb, tsa, jpts )  !   implicit scheme 
-      CASE ( -1 )                                       ! esopa: test all possibility with control print
-         CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask,               &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra,            tsb, tsa, jpts ) 
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask,               &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       END SELECT
+!!gm WHY here !   and I don't like that !
       ! DRAKKAR SSS control {
       ! JMM avoid negative salinities near river outlet ! Ugly fix
       ! JMM : restore negative salinities to small salinities:
       WHERE ( tsa(:,:,:,jp_sal) < 0._wp )   tsa(:,:,:,jp_sal) = 0.1_wp
+!!gm
 
       IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
@@ -98,6 +96,8 @@
             ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk)
          END DO
+!!gm this should be moved in trdtra.F90 and done on all trends
          CALL lbc_lnk( ztrdt, 'T', 1. )
          CALL lbc_lnk( ztrds, 'T', 1. )
+!!gm
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt )
          CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds )
@@ -123,10 +123,9 @@
       !!      nzdf = 0   explicit (time-splitting) scheme (ln_zdfexp=T)
       !!           = 1   implicit (euler backward) scheme (ln_zdfexp=F)
-      !!      NB: rotation of lateral mixing operator or TKE or KPP scheme,
-      !!      the implicit scheme is required.
+      !!      NB: rotation of lateral mixing operator or TKE & GLS schemes,
+      !!          an implicit scheme is required.
       !!----------------------------------------------------------------------
       USE zdftke
       USE zdfgls
-      USE zdfkpp
       !!----------------------------------------------------------------------
 
@@ -137,12 +136,9 @@
 
       ! Force implicit schemes
-      IF( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp )   nzdf = 1      ! TKE, GLS or KPP physics
-      IF( ln_traldf_iso                           )   nzdf = 1      ! iso-neutral lateral physics
-      IF( ln_traldf_hor .AND. ln_sco              )   nzdf = 1      ! horizontal lateral physics in s-coordinate
+      IF( lk_zdftke .OR. lk_zdfgls   )   nzdf = 1   ! TKE, or GLS physics
+      IF( ln_traldf_iso              )   nzdf = 1   ! iso-neutral lateral physics
+      IF( ln_traldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate
       IF( ln_zdfexp .AND. nzdf == 1 )   CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator',   &
-            &                         ' TKE or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
-
-      ! Test: esopa
-      IF( lk_esopa )    nzdf = -1                      ! All schemes used
+            &                         ' GLS or TKE scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
 
       IF(lwp) THEN
@@ -150,5 +146,4 @@
          WRITE(numout,*) 'tra_zdf_init : vertical 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'
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 5901)
@@ -19,22 +19,21 @@
   
    !!----------------------------------------------------------------------
-   !!   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         ! 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          ! 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 lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   !!   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        ! 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         ! lateral mixing type
+   USE ldfslp         ! lateral physics: slope of diffusion
+   USE zdfddm         ! ocean vertical physics: double diffusion
+   USE traldf_triad   ! active tracers: Method of Stabilizing Correction
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -47,9 +46,8 @@
    !! * 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)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -76,6 +74,4 @@
       !! ** 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
@@ -88,10 +84,10 @@
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
       REAL(wp) ::  zrhs, ze3tb, ze3tn, ze3ta   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt, zwd, zws
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwt ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   zwi, zwt, zwd, zws ) 
       !
       IF( kt == kit000 )  THEN
@@ -120,32 +116,26 @@
             ELSE                                            ;   zwt(:,:,2:jpk) = fsavs(:,:,2:jpk)
             ENDIF
-            DO jj=1, jpj
-               DO ji=1, jpi
-                  zwt(ji,jj,1) = 0._wp
-               END DO
-            END DO
-!
-#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)       
+            zwt(:,:,1) = 0._wp
+            !
+            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution 
+               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator 
+                  DO jk = 2, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)  
+                        END DO
                      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(ji,jj,jk) * wslpi(ji,jj,jk)   &
-                           &                             + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
+               ELSE                          ! standard or triad iso-neutral operator
+                  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)
+                        END DO
                      END DO
                   END DO
-               END DO
+               ENDIF
             ENDIF
-#endif
+            !
             ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked)
             DO jk = 1, jpkm1
@@ -202,6 +192,5 @@
                ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,1)
                ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1)
-               pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn)                     &
-                  &                      + p2dt(1) * ze3tn * pta(ji,jj,1,jn)
+               pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn)
             END DO
          END DO
@@ -235,5 +224,5 @@
       !                                               ! ================= !
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwt ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwi, zwt, zwd, zws ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_imp')
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 5901)
@@ -93,16 +93,15 @@
       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom)
       !
-      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
-      REAL(wp), DIMENSION(jpi,jpj)      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos
-      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::  zti, ztj             ! 
+      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  ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj)      ::   zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos
+      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::   zti, ztj             ! 
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde')
-      !
-      pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ;
-      zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ;
-      zhi (:,:  )=0.0_wp ; zhj (:,:  )=0.0_wp ;
+      IF( nn_timing == 1 )   CALL timing_start( 'zps_hde')
+      !
+      pgtu(:,:,:)=0._wp   ;   zti (:,:,:)=0._wp   ;   zhi (:,:  )=0._wp
+      pgtv(:,:,:)=0._wp   ;   ztj (:,:,:)=0._wp   ;   zhj (:,:  )=0._wp
       !
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
@@ -149,8 +148,8 @@
          !
       END DO
-
-      ! horizontal derivative of density anomalies (rd)
-      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
-         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ; 
+      !                
+      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
+         pgru(:,:) = 0._wp
+         pgrv(:,:) = 0._wp                ! depth of the partial step level
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
@@ -167,12 +166,9 @@
             END DO
          END DO
-
-         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
-         ! step and store it in  zri, zrj for each  case
-         CALL eos( zti, zhi, zri )  
-         CALL eos( ztj, zhj, zrj )
-
-         ! Gradient of density at the last level 
-         DO jj = 1, jpjm1
+         !
+         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj 
+         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj 
+         !
+         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
             DO ji = 1, jpim1
                iku = mbku(ji,jj)
@@ -192,11 +188,12 @@
       END IF
       !
-      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde')
+      IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde')
       !
    END SUBROUTINE zps_hde
-   !
-   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv,   &
-      &                          prd, pgru, pgrv, pmru, pmrv, pgzu, pgzv, pge3ru, pge3rv,  &
-      &                   pgtui, pgtvi, pgrui, pgrvi, pmrui, pmrvi, pgzui, pgzvi, pge3rui, pge3rvi )
+
+
+   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu , pgtv , pgtui, pgtvi,                                   &
+      &                              prd, pgru , pgrv , pmru , pmrv , pgzu , pgzv , pge3ru , pge3rv ,   &
+      &                                   pgrui, pgrvi, pmrui, pmrvi, pgzui, pgzvi, pge3rui, pge3rvi )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE zps_hde  ***
@@ -245,18 +242,20 @@
       !!              - pge3ru, pge3rv, pge3rui, pge3rvi: horizontal gradient of rho weighted by local e3w 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,    kjpt), INTENT(  out)           ::  pgtui, pgtvi  ! hor. grad. of stra at u- & v-pts (ISF)
-      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 (bottom)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pmru, pmrv      ! hor. sum  of prd at u- & v-pts (bottom)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzu, pgzv      ! hor. grad of z   at u- & v-pts (bottom)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3ru, pge3rv  ! hor. grad of prd weighted by local e3w at u- & v-pts (bottom)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi      ! hor. grad of prd at u- & v-pts (top)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pmrui, pmrvi      ! hor. sum  of prd at u- & v-pts (top)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzui, pgzvi      ! hor. grad of z   at u- & v-pts (top)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3rui, pge3rvi  ! hor. grad of prd weighted by local e3w at u- & v-pts (top)
+      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
+      !                                                              !!  u-point ! v-point !
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu    , pgtv    ! bottom GRADh( ptra )  
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtui   , pgtvi   ! top    GRADh( ptra )
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd               ! 3D density anomaly fields
+      !                                                              !!  u-point ! v-point !
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru    , pgrv    ! bottom GRADh( prd  )
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pmru    , pmrv    ! bottom SUM  ( prd  )
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzu    , pgzv    ! bottom GRADh( z    ) 
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3ru  , pge3rv  ! bottom GRADh( prd  ) weighted by e3w
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui   , pgrvi   ! top    GRADh( prd  ) 
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pmrui   , pmrvi   ! top    SUM  ( prd  ) 
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzui   , pgzvi   ! top    GRADh( z    ) 
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3rui , pge3rvi ! top    GRADh( prd  ) weighted by e3w
       !
       INTEGER  ::   ji, jj, jn      ! Dummy loop indices
@@ -269,8 +268,8 @@
       IF( nn_timing == 1 )  CALL timing_start( 'zps_hde_isf')
       !
-      pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ;
-      pgtui(:,:,:)=0.0_wp ; pgtvi(:,:,:)=0.0_wp ;
-      zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ;
-      zhi (:,:  )=0.0_wp ; zhj (:,:  )=0.0_wp ;
+      pgtu (:,:,:) = 0._wp   ;   pgtv (:,:,:) =0._wp
+      pgtui(:,:,:) = 0._wp   ;   pgtvi(:,:,:) =0._wp
+      zti  (:,:,:) = 0._wp   ;   ztj  (:,:,:) =0._wp
+      zhi  (:,:  ) = 0._wp   ;   zhj  (:,:  ) =0._wp
       !
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
@@ -322,11 +321,12 @@
       END DO
 
-      ! horizontal derivative of density anomalies (rd)
-      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
-         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ; 
-         pgzu(:,:)=0.0_wp   ; pgzv(:,:)=0.0_wp ;
-         pmru(:,:)=0.0_wp   ; pmru(:,:)=0.0_wp ;
-         pge3ru(:,:)=0.0_wp ; pge3rv(:,:)=0.0_wp ;
-         DO jj = 1, jpjm1
+      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
+         !
+         pgru  (:,:)=0._wp   ;   pgrv  (:,:) = 0._wp
+         pgzu  (:,:)=0._wp   ;   pgzv  (:,:) = 0._wp 
+         pmru  (:,:)=0._wp   ;   pmru  (:,:) = 0._wp 
+         pge3ru(:,:)=0._wp   ;   pge3rv(:,:) = 0._wp 
+         !
+         DO jj = 1, jpjm1                 ! depth of the partial step level
             DO ji = 1, jpim1
                iku = mbku(ji,jj)
@@ -334,5 +334,5 @@
                ze3wu  = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku))
                ze3wv  = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv))
-
+               !
                IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji+1,jj,iku) - ze3wu     ! i-direction: case 1
                ELSE                        ;   zhi(ji,jj) = fsdept(ji  ,jj,iku) + ze3wu    ! -     -      case 2
@@ -343,12 +343,9 @@
             END DO
          END DO
-         
-         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
-         ! step and store it in  zri, zrj for each  case
-         CALL eos( zti, zhi, zri )  
-         CALL eos( ztj, zhj, zrj )
-
-         ! Gradient of density at the last level 
-         DO jj = 1, jpjm1
+         !
+         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj 
+         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj 
+
+         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
             DO ji = 1, jpim1
                iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
@@ -394,5 +391,7 @@
          !
       END IF
-         ! (ISH)  compute grui and gruvi
+      !
+      !     !==  (ISH)  compute grui and gruvi  ==!
+      !
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            !
          DO jj = 1, jpjm1
@@ -442,12 +441,12 @@
       END DO
 
-      ! horizontal derivative of density anomalies (rd)
-      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
+      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
+         !
          pgrui(:,:)  =0.0_wp ; pgrvi(:,:)  =0.0_wp ;
          pgzui(:,:)  =0.0_wp ; pgzvi(:,:)  =0.0_wp ;
          pmrui(:,:)  =0.0_wp ; pmrui(:,:)  =0.0_wp ;
          pge3rui(:,:)=0.0_wp ; pge3rvi(:,:)=0.0_wp ;
-
-         DO jj = 1, jpjm1
+         !
+         DO jj = 1, jpjm1        ! depth of the partial step level
             DO ji = 1, jpim1
                iku = miku(ji,jj)
@@ -455,5 +454,5 @@
                ze3wu  = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku))
                ze3wv  = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv))
-
+               !
                IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji+1,jj,iku) + ze3wu    ! i-direction: case 1
                ELSE                        ;   zhi(ji,jj) = fsdept(ji  ,jj,iku) - ze3wu    ! -     -      case 2
@@ -464,12 +463,9 @@
             END DO
          END DO
-
-         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
-         ! step and store it in  zri, zrj for each  case
-         CALL eos( zti, zhi, zri )  
-         CALL eos( ztj, zhj, zrj )
-
-         ! Gradient of density at the last level 
-         DO jj = 1, jpjm1
+         !
+         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj 
+         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj 
+         !
+         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
             DO ji = 1, jpim1
                iku = miku(ji,jj) ; ikup1 = miku(ji,jj) + 1
@@ -482,6 +478,6 @@
                  pmrui  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) + prd(ji,jj,iku) )          ! i: 1 
                  pge3rui(ji,jj) = umask(ji,jj,iku+1)                                                                  &
-                                * ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj    ) + prd(ji+1,jj,iku+1) + 2._wp)   &
-                                   - fse3w(ji  ,jj,iku+1)          * (prd(ji,jj,iku) + prd(ji  ,jj,iku+1) + 2._wp)   ) ! i: 1
+                    &           * ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj    ) + prd(ji+1,jj,iku+1) + 2._wp)   &
+                    &              - fse3w(ji  ,jj,iku+1)          * (prd(ji,jj,iku) + prd(ji  ,jj,iku+1) + 2._wp)   ) ! i: 1
                ELSE
                  pgzui  (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu)
@@ -489,6 +485,6 @@
                  pmrui  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) + zri(ji,jj) )      ! i: 2
                  pge3rui(ji,jj) = umask(ji,jj,iku+1)                                                                   &
-                                * (  fse3w(ji+1,jj,iku+1)          * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp)  &
-                                   -(fse3w(ji  ,jj,iku+1) + ze3wu) * (zri(ji,jj      ) + prd(ji  ,jj,iku+1) + 2._wp)  )     ! i: 2
+                    &           * (  fse3w(ji+1,jj,iku+1)          * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp)  &
+                    &              -(fse3w(ji  ,jj,iku+1) + ze3wu) * (zri(ji,jj      ) + prd(ji  ,jj,iku+1) + 2._wp)  )     ! i: 2
                ENDIF
                IF( ze3wv >= 0._wp ) THEN
@@ -497,6 +493,6 @@
                  pmrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) + prd(ji,jj,ikv) )        ! j: 1
                  pge3rvi(ji,jj) = vmask(ji,jj,ikv+1)                                                                  & 
-                                * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj    ) + prd(ji,jj+1,ikv+1) + 2._wp)  &
-                                   - fse3w(ji,jj  ,ikv+1)          * ( prd(ji,jj,ikv) + prd(ji,jj  ,ikv+1) + 2._wp)  ) ! j: 1
+                     &           * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj    ) + prd(ji,jj+1,ikv+1) + 2._wp)  &
+                     &                - fse3w(ji,jj  ,ikv+1)          * ( prd(ji,jj,ikv) + prd(ji,jj  ,ikv+1) + 2._wp)  ) ! j: 1
                                   ! + 2 due to the formulation in density and not in anomalie in hpg sco
                ELSE
@@ -505,6 +501,6 @@
                  pmrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) + zrj(ji,jj) )     ! j: 2
                  pge3rvi(ji,jj) = vmask(ji,jj,ikv+1)                                                                   &
-                                * (  fse3w(ji,jj+1,ikv+1)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) &
-                                   -(fse3w(ji,jj  ,ikv+1) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikv+1) + 2._wp) )  ! j: 2
+                    &           * (  fse3w(ji,jj+1,ikv+1)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) &
+                    &              -(fse3w(ji,jj  ,ikv+1) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikv+1) + 2._wp) )  ! j: 2
                ENDIF
             END DO
@@ -517,5 +513,5 @@
       END IF  
       !
-      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde_isf')
+      IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde_isf')
       !
    END SUBROUTINE zps_hde_isf
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90	(revision 5901)
@@ -4,6 +4,6 @@
    !! Ocean diagnostics:  global domain averaged tracer and momentum trends
    !!=====================================================================
-   !! History :  1.0  !  2004-08 (C. Talandier) New trends organization
-   !!            3.5  !  2012-02 (G. Madec)  add 3D tracer zdf trend output using iom
+   !! History :  1.0  !  2004-08  (C. Talandier) New trends organization
+   !!            3.5  !  2012-02  (G. Madec)  add 3D tracer zdf trend output using iom
    !!----------------------------------------------------------------------
 
@@ -19,6 +19,6 @@
    USE trd_oce         ! trends: ocean variables
    USE phycst          ! physical constants
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE ldftra          ! lateral diffusion: eddy diffusivity & EIV coeff.
+   USE ldfdyn          ! ocean dynamics: lateral physics
    USE zdf_oce         ! ocean vertical physics
    USE zdfbfr          ! bottom friction
@@ -26,4 +26,5 @@
    USE eosbn2          ! equation of state
    USE phycst          ! physical constants
+   !
    USE lib_mpp         ! distibuted memory computing library
    USE in_out_manager  ! I/O manager
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90	(revision 5901)
@@ -13,14 +13,15 @@
    USE oce            ! ocean dynamics and tracers variables
    USE dom_oce        ! ocean space and time domain variables
+   USE sbc_oce        ! surface boundary condition: ocean
    USE zdf_oce        ! ocean vertical physics variables
    USE trd_oce        ! trends: ocean variables
 !!gm   USE dynhpg          ! hydrostatic pressure gradient   
    USE zdfbfr         ! bottom friction
-   USE ldftra_oce     ! ocean active tracers lateral physics
-   USE sbc_oce        ! surface boundary condition: ocean
+   USE ldftra         ! ocean active tracers lateral physics
    USE phycst         ! physical constants
    USE trdvor         ! ocean vorticity trends 
    USE trdglo         ! trends:global domain averaged
-   USE trdmxl         ! ocean active mixed layer tracers trends 
+   USE trdmxl         ! ocean active mixed layer tracers trends
+   !
    USE in_out_manager ! I/O manager
    USE iom            ! I/O manager library
@@ -96,6 +97,6 @@
          nkstp = kt
          DO jk = 1, jpkm1
-            bu   (:,:,jk) =  e1u(:,:) * e2u(:,:) * fse3u_n(:,:,jk)
-            bv   (:,:,jk) =  e1v(:,:) * e2v(:,:) * fse3v_n(:,:,jk)
+            bu   (:,:,jk) =           e1e2u(:,:) * fse3u_n(:,:,jk)
+            bv   (:,:,jk) =           e1e2v(:,:) * fse3v_n(:,:,jk)
             r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) ) * tmask(:,:,jk)
          END DO
@@ -117,28 +118,28 @@
       !
       SELECT CASE( ktrd )
-      	CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient
-      	CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient
-      	CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit)
-      	CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter)
-      	CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity
-      	CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term)
-      	CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had)
-      	CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection
-      	CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion
-      	CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion 
+         CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient
+         CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient
+         CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit)
+         CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter)
+         CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity
+         CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term)
+         CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had)
+         CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection
+         CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion
+         CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion 
                                  !                                   ! wind stress trends
-                              	CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d )
-         						z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1)
-         						z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1)
-         						zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
-         						DO jj = 2, jpj
-            					   DO ji = 2, jpi
-               						zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
-                  					&                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1)
-            					   END DO
-         						END DO
-                              	CALL iom_put( "ketrd_tau", zke2d )
-                              	CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d )
-      	CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case) 
+                                 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d )
+                           z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1)
+                           z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1)
+                           zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
+                           DO jj = 2, jpj
+                              DO ji = 2, jpi
+                                 zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
+                                 &                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1)
+                              END DO
+                           END DO
+                                 CALL iom_put( "ketrd_tau", zke2d )
+                                 CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d )
+         CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case) 
 !!gm TO BE DONE properly
 !!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation....
@@ -162,5 +163,5 @@
 !         ENDIF
 !!gm end
-      	CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends 
+         CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends 
 !! a faire !!!!  idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!!
 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf....
@@ -184,12 +185,12 @@
 !                              CALL iom_put( "ketrd_bfri", zke2d )
 !         ENDIF
-      	CASE( jpdyn_ken )   ;   ! kinetic energy
-      							! called in dynnxt.F90 before asselin time filter
-      							! with putrd=ua and pvtrd=va
-      							zke(:,:,:) = 0.5_wp * zke(:,:,:)
-      							CALL iom_put( "KE", zke )
-      							!
-      							CALL ken_p2k( kt , zke )
-            					CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w
+         CASE( jpdyn_ken )   ;   ! kinetic energy
+                           ! called in dynnxt.F90 before asselin time filter
+                           ! with putrd=ua and pvtrd=va
+                           zke(:,:,:) = 0.5_wp * zke(:,:,:)
+                           CALL iom_put( "KE", zke )
+                           !
+                           CALL ken_p2k( kt , zke )
+                           CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w
          !
       END SELECT
@@ -263,13 +264,13 @@
       ENDIF
       !                           ! allocate box volume arrays
-      IF ( trd_ken_alloc() /= 0 )   CALL ctl_stop('trd_ken_alloc: failed to allocate arrays')
+      IF( trd_ken_alloc() /= 0 )   CALL ctl_stop('trd_ken_alloc: failed to allocate arrays')
       !
 !!gm      IF( .NOT. (ln_hpg_zco.OR.ln_hpg_zps) )   &
 !!gm         &   CALL ctl_stop('trd_ken_init : only full and partial cells are coded for conversion rate')
       !
-      IF ( .NOT.lk_vvl ) THEN     ! constant volume: bu, bv, 1/bt computed one for all
+      IF( .NOT.lk_vvl ) THEN      ! constant volume: bu, bv, 1/bt computed one for all
          DO jk = 1, jpkm1
-            bu   (:,:,jk) =  e1u(:,:) * e2u(:,:) * fse3u_n(:,:,jk)
-            bv   (:,:,jk) =  e1v(:,:) * e2v(:,:) * fse3v_n(:,:,jk)
+            bu   (:,:,jk) =           e1e2u(:,:) * fse3u_n(:,:,jk)
+            bv   (:,:,jk) =           e1e2v(:,:) * fse3v_n(:,:,jk)
             r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) )
          END DO
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90	(revision 5901)
@@ -22,7 +22,6 @@
    USE trd_oce         ! trends: ocean variables
    USE trdmxl_oce      ! ocean variables trends
-   USE ldftra_oce      ! ocean active tracers lateral physics
+   USE ldftra          ! lateral diffusion: eddy diffusivity & EIV coeff.
    USE zdf_oce         ! ocean vertical physics
-   USE in_out_manager  ! I/O manager
    USE phycst          ! Define parameters for the routines
    USE dianam          ! build the name of file (routine)
@@ -30,8 +29,10 @@
    USE zdfmxl          ! mixed layer depth
    USE zdfddm          ! ocean vertical physics: double diffusion
-   USE ioipsl          ! NetCDF library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE diadimg         ! dimg direct access file format output
    USE trdmxl_rst      ! restart for diagnosing the ML trends
+   !
+   USE in_out_manager  ! I/O manager
+   USE ioipsl          ! NetCDF library
    USE prtctl          ! Print control
    USE restart         ! for lrst_oce
@@ -73,5 +74,4 @@
    !! * Substitutions
 #  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
 #  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
@@ -165,11 +165,11 @@
 
 
-		SELECT CASE( ktrd )
-		CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf
+         SELECT CASE( ktrd )
+         CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf
 !!gm : to be completed ! 
 !		   IF( ....
 !!gm end
-		CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion
-		   !                                   ! regroup iso-neutral diffusion in one term
+         CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion
+!                                   ! regroup iso-neutral diffusion in one term
          tmltrd(:,:,jpmxl_ldf) = tmltrd(:,:,jpmxl_ldf) + ( tmltrd(:,:,jpmxl_zdf) - tmltrd(:,:,jpmxl_zdfp) )
          smltrd(:,:,jpmxl_ldf) = smltrd(:,:,jpmxl_ldf) + ( smltrd(:,:,jpmxl_zdf) - smltrd(:,:,jpmxl_zdfp) )
@@ -801,7 +801,4 @@
       END IF
 
-      IF( nn_cla == 1 )   CALL ctl_warn( '      You set n_cla = 1. Note that the Mixed-Layer diagnostics  ',   &
-         &                               '      are not exact along the corresponding straits.            ')
-
       !                                   ! allocate trdmxl arrays
       IF( trd_mxl_alloc()    /= 0 )   CALL ctl_stop( 'STOP', 'trd_mxl_init : unable to allocate trdmxl     arrays' )
@@ -810,6 +807,5 @@
 
 
-
-   	nkstp     = nit000 - 1              ! current time step indicator initialization
+      nkstp     = nit000 - 1              ! current time step indicator initialization
 
 
@@ -851,5 +847,5 @@
       IF( nn_ctls == 1 ) THEN
          CALL ctl_opn( inum, 'ctlsurf_idx', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-         READ ( inum ) nbol
+         READ ( inum, * ) nbol
          CLOSE( inum )
       END IF
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90	(revision 5901)
@@ -17,7 +17,8 @@
    USE trd_oce        ! trends: ocean variables
    USE eosbn2         ! equation of state and related derivatives
-   USE ldftra_oce     ! ocean active tracers lateral physics
+   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
    USE zdfddm         ! vertical physics: double diffusion
    USE phycst         ! physical constants
+   !
    USE in_out_manager ! I/O manager
    USE iom            ! I/O manager library
@@ -99,7 +100,7 @@
                                    CALL wrk_alloc( jpi, jpj, z2d )
                                    z2d(:,:) = wn(:,:,1) * ( &
-                                   	  &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    &
-                                   	  &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    &
-                                      &   					) / fse3t(:,:,1)
+                                     &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    &
+                                     &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    &
+                                     & ) / fse3t(:,:,1)
                                    CALL iom_put( "petrd_sad" , z2d )
                                    CALL wrk_dealloc( jpi, jpj, z2d )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 5901)
@@ -23,7 +23,9 @@
    USE trdpen         ! trends: Potential ENergy
    USE trdmxl         ! ocean active mixed layer tracers trends 
-   USE ldftra_oce     ! ocean active tracers lateral physics
+   USE ldftra         ! ocean active tracers lateral physics
+   USE ldfslp
    USE zdfddm         ! vertical physics: double diffusion
    USE phycst         ! physical constants
+   !
    USE in_out_manager ! I/O manager
    USE iom            ! I/O manager library
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 5901)
@@ -20,10 +20,11 @@
    USE sbc_oce         ! surface boundary condition: ocean
    USE phycst          ! Define parameters for the routines
-   USE ldfdyn_oce      ! ocean active tracers: lateral physics
+   USE ldfdyn          ! ocean active tracers: lateral physics
    USE dianam          ! build the name of file (routine)
    USE zdfmxl          ! mixed layer depth
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   !
    USE in_out_manager  ! I/O manager
    USE ioipsl          ! NetCDF library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp         ! MPP library
    USE wrk_nemo        ! Memory allocation
@@ -57,5 +58,4 @@
    !! * Substitutions
 #  include "domzgr_substitute.h90"
-#  include "ldfdyn_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 5901)
@@ -16,5 +16,5 @@
    PUBLIC  zdf_oce_alloc    ! Called in nemogcm.F90
 
-#if defined key_zdfcst   ||   defined key_esopa
+#if defined key_zdfcst
    LOGICAL, PARAMETER, PUBLIC ::   lk_zdfcst        = .TRUE.         !: constant vertical mixing flag
 #else
@@ -43,5 +43,8 @@
    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts       [m2/s]
    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt [m2/s]
- 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en              !: now turbulent kinetic energy   [m2/s2]
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
@@ -59,6 +62,9 @@
          &     avtb(jpk) , bfrva(jpi,jpj) , avtb_2d(jpi,jpj) ,      &
          &     tfrua(jpi, jpj), tfrva(jpi, jpj)              ,      &
-         &     avmu(jpi,jpj,jpk), avm(jpi,jpj,jpk)           ,      &
-         &     avmv(jpi,jpj,jpk), avt(jpi,jpj,jpk)           , STAT = zdf_oce_alloc )
+         &     avmu  (jpi,jpj,jpk), avm   (jpi,jpj,jpk)      ,      &
+         &     avmv  (jpi,jpj,jpk), avt   (jpi,jpj,jpk)      ,      &
+         &     avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk)      ,      & 
+         &     avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk)      ,      &
+         &     en    (jpi,jpj,jpk), STAT = zdf_oce_alloc )
          !
       IF( zdf_oce_alloc /= 0 )   CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays')
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 5901)
@@ -9,5 +9,5 @@
    !!            3.6  ! 2013-04  (G. Madec, F. Roquet) zrau compute locally using interpolation of alpha & beta
    !!----------------------------------------------------------------------
-#if defined key_zdfddm   ||   defined key_esopa
+#if defined key_zdfddm
    !!----------------------------------------------------------------------
    !!   'key_zdfddm' :                                     double diffusion
@@ -162,7 +162,5 @@
          ! ------------------
          ! Constant eddy coefficient: reset to the background value
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                zinr = 1._wp / zrau(ji,jj)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 5901)
@@ -7,19 +7,19 @@
    !! History :  OPA  !  1997-06  (G. Madec, A. Lazar)  Original code
    !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
-   !!             -   !  2005-06  (C. Ethe) KPP parameterization
    !!            3.2  !  2009-03  (M. Leclair, G. Madec, R. Benshila) test on both before & after
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   zdf_evd      : increase the momentum and tracer Kz at the location of
-   !!                  statically unstable portion of the water column (ln_zdfevd=T)
+   !!   zdf_evd       : increase the momentum and tracer Kz at the location of
+   !!                   statically unstable portion of the water column (ln_zdfevd=T)
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers variables
    USE dom_oce         ! ocean space and time domain variables
    USE zdf_oce         ! ocean vertical physics variables
-   USE zdfkpp          ! KPP vertical mixing
+   !
    USE in_out_manager  ! I/O manager
    USE iom             ! for iom_put
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! work arrays
    USE timing          ! Timing
 
@@ -53,9 +53,8 @@
       !! References :   Lazar, A., these de l'universite Paris VI, France, 1997
       !!----------------------------------------------------------------------
-      USE oce,   zavt_evd => ua , zavm_evd => va  ! (ua,va) used ua workspace
-      !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step indexocean time step
       !
       INTEGER ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zavt_evd, zavm_evd
       !!----------------------------------------------------------------------
       !
@@ -68,7 +67,9 @@
          IF(lwp) WRITE(numout,*)
       ENDIF
-
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zavt_evd, zavm_evd ) 
+      !
       zavt_evd(:,:,:) = avt(:,:,:)           ! set avt prior to evd application
-
+      !
       SELECT CASE ( nn_evdm )
       !
@@ -80,10 +81,5 @@
             DO jj = 2, jpj             ! no vector opt.
                DO ji = 2, jpi
-#if defined key_zdfkpp
-                  ! no evd mixing in the boundary layer with KPP
-                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  ) THEN
-#else
                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN
-#endif
                      avt (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk)
                      avm (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk)
@@ -107,10 +103,5 @@
             DO jj = 1, jpj             ! loop over the whole domain (no lbc_lnk call)
                DO ji = 1, jpi
-#if defined key_zdfkpp
-                  ! no evd mixing in the boundary layer with KPP
-                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  )   &          
-#else
                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   &
-#endif
                      avt(ji,jj,jk) = rn_avevd * tmask(ji,jj,jk)
                END DO
@@ -123,4 +114,6 @@
       CALL iom_put( "avt_evd", zavt_evd )              ! output this change
       !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zavt_evd, zavm_evd ) 
+      !
       IF( nn_timing == 1 )  CALL timing_stop('zdf_evd')
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 5901)
@@ -8,5 +8,5 @@
    !!             3.3  !  2010-10  (C. Bricaud)  Add in the reference
    !!----------------------------------------------------------------------
-#if defined key_zdfgls   ||   defined key_esopa
+#if defined key_zdfgls
    !!----------------------------------------------------------------------
    !!   'key_zdfgls'                 Generic Length Scale vertical physics
@@ -42,11 +42,6 @@
    LOGICAL , PUBLIC, PARAMETER ::   lk_zdfgls = .TRUE.   !: TKE vertical mixing flag
    !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en      !: now turbulent kinetic energy
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k   ! not enhanced Kz
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avm_k   ! not enhanced Kz
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k  ! not enhanced Kz
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmv_k  ! not enhanced Kz
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustars2 !: Squared surface velocity scale at T-points
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustarb2 !: Squared bottom  velocity scale at T-points
@@ -120,8 +115,6 @@
       !!                ***  FUNCTION zdf_gls_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( en(jpi,jpj,jpk),  mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     &
-         &      avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk),                    &
-         &      avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk),                    &
-         &      ustars2(jpi,jpj), ustarb2(jpi,jpj)                      , STAT= zdf_gls_alloc )
+      ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     &
+         &      ustars2(jpi,jpj) , ustarb2(jpi,jpj)   , STAT= zdf_gls_alloc )
          !
       IF( lk_mpp             )   CALL mpp_sum ( zdf_gls_alloc )
@@ -161,6 +154,6 @@
       IF( nn_timing == 1 )  CALL timing_start('zdf_gls')
       !
-      CALL wrk_alloc( jpi,jpj, zdep, zkar, zflxs, zhsro )
-      CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi  )
+      CALL wrk_alloc( jpi,jpj,       zdep, zkar, zflxs, zhsro )
+      CALL wrk_alloc( jpi,jpj,jpk,   eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi  )
       
       ! Preliminary computing
@@ -176,7 +169,5 @@
 
       ! Compute surface and bottom friction at T-points
-!CDIR NOVERRCHK          
       DO jj = 2, jpjm1          
-!CDIR NOVERRCHK         
          DO ji = fs_2, fs_jpim1   ! vector opt.         
             !
@@ -367,7 +358,5 @@
          !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin
          !                      ! Balance between the production and the dissipation terms
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
@@ -390,7 +379,5 @@
       CASE ( 1 )             ! Neumman boundary condition
          !                      
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
@@ -595,7 +582,5 @@
          !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * rn_bfrz0
          !                      ! Balance between the production and the dissipation terms
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
@@ -618,7 +603,5 @@
       CASE ( 1 )             ! Neumman boundary condition
          !                      
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
@@ -841,6 +824,6 @@
       avmv_k(:,:,:) = avmv(:,:,:)
       !
-      CALL wrk_dealloc( jpi,jpj, zdep, zkar, zflxs, zhsro )
-      CALL wrk_dealloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )
+      CALL wrk_dealloc( jpi,jpj,       zdep, zkar, zflxs, zhsro )
+      CALL wrk_dealloc( jpi,jpj,jpk,   eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )
       !
       IF( nn_timing == 1 )  CALL timing_stop('zdf_gls')
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 5901)
@@ -6,6 +6,7 @@
    !! History :  8.0  ! 1997-06  (G. Madec)  Original code from inimix
    !!            1.0  ! 2002-08  (G. Madec)  F90 : free form
-   !!             -   ! 2005-06  (C. Ethe) KPP parameterization
+   !!             -   ! 2005-06  (C. Ethe) KPP scheme
    !!             -   ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection
+   !!            3.7  ! 2014-12  (G. Madec) remove KPP scheme
    !!----------------------------------------------------------------------
 
@@ -14,19 +15,17 @@
    !!----------------------------------------------------------------------
    USE par_oce         ! mesh and scale factors
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldfdyn_oce      ! ocean dynamics lateral physics
    USE zdf_oce         ! TKE vertical mixing          
-   USE lib_mpp         ! distribued memory computing
+   USE sbc_oce         ! surface module (only for nn_isf in the option compatibility test)
    USE zdftke          ! TKE vertical mixing
    USE zdfgls          ! GLS vertical mixing
-   USE zdfkpp          ! KPP vertical mixing          
+   USE zdfric          ! Richardson vertical mixing   
    USE zdfddm          ! double diffusion mixing      
    USE zdfevd          ! enhanced vertical diffusion  
-   USE zdfric          ! Richardson vertical mixing   
    USE tranpc          ! convection: non penetrative adjustment
    USE ldfslp          ! iso-neutral slopes
-
+   !
    USE in_out_manager  ! I/O manager
    USE iom             ! IOM library
+   USE lib_mpp         ! distribued memory computing
 
    IMPLICIT NONE
@@ -50,6 +49,5 @@
       !! ** Method  :   Read namelist namzdf, control logicals 
       !!----------------------------------------------------------------------
-      INTEGER ::   ioptio       ! temporary scalar
-      INTEGER ::   ios
+      INTEGER ::   ioptio, ios       ! local integers
       !!
       NAMELIST/namzdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp,   &
@@ -111,11 +109,7 @@
          ioptio = ioptio+1
       ENDIF
-      IF( lk_zdfkpp ) THEN
-         IF(lwp) WRITE(numout,*) '      KPP dependent eddy coefficients'
-         ioptio = ioptio+1
-      ENDIF
-      IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa )   &
+      IF( ioptio == 0 .OR. ioptio > 1 )   &
          &   CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' )
-      IF( ( lk_zdfric .OR. lk_zdfgls .OR. lk_zdfkpp ) .AND. ln_isfcav )   &
+      IF( ( lk_zdfric .OR. lk_zdfgls ) .AND. ln_isfcav )   &
          &   CALL ctl_stop( ' only zdfcst and zdftke were tested with ice shelves cavities ' )
       !
@@ -143,14 +137,7 @@
          IF(lwp) WRITE(numout,*) '      use the GLS closure scheme'
       ENDIF
-      IF( lk_zdfkpp ) THEN
-         IF(lwp) WRITE(numout,*) '      use the KPP closure scheme'
-         IF(lk_mpp) THEN
-            IF(lwp) WRITE(numout,cform_err)
-            IF(lwp) WRITE(numout,*) 'The KPP scheme is not ready to run in MPI'
-         ENDIF
-      ENDIF
-      IF ( ioptio > 1 .AND. .NOT. lk_esopa )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' )
-      IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) )           &
-         CALL ctl_stop( ' except for TKE, GLS or KPP physics, a convection scheme is',   &
+      IF ( ioptio > 1 )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' )
+      IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls ) )           &
+         CALL ctl_stop( ' except for TKE or GLS physics, a convection scheme is',   &
          &              ' required: ln_zdfevd or ln_zdfnpc logicals' )
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90	(revision 5891)
+++ 	(revision )
@@ -1,1592 +1,0 @@
-MODULE zdfkpp
-   !!======================================================================
-   !!                       ***  MODULE  zdfkpp  ***
-   !! Ocean physics:  vertical mixing coefficient compute from the KPP 
-   !!                 turbulent closure parameterization
-   !!=====================================================================
-   !! History :  OPA  ! 2000-03 (W.G. Large, J. Chanut) Original code
-   !!            8.1  ! 2002-06 (J.M. Molines) for real case CLIPPER  
-   !!            8.2  ! 2003-10 (Chanut J.) re-writting
-   !!   NEMO     1.0  ! 2005-01 (C. Ethe, G. Madec) Free form, F90 + creation of tra_kpp routine
-   !!            3.3  ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
-   !!----------------------------------------------------------------------
-#if defined key_zdfkpp   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_zdfkpp'                                             KPP scheme
-   !!----------------------------------------------------------------------
-   !!   zdf_kpp       : update momentum and tracer Kz from a kpp scheme
-   !!   zdf_kpp_init  : initialization, namelist read, and parameters control
-   !!   tra_kpp       : compute and add to the T & S trend the non-local flux
-   !!   trc_kpp       : compute and add to the passive tracer trend the non-local flux (lk_top=T)
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers 
-   USE dom_oce        ! ocean space and time domain
-   USE zdf_oce        ! ocean vertical physics
-   USE sbc_oce        ! surface boundary condition: ocean
-   USE phycst         ! physical constants
-   USE eosbn2         ! equation of state
-   USE zdfddm         ! double diffusion mixing (avs array)
-   USE lib_mpp        ! MPP library
-   USE trd_oce        ! ocean trends definition
-   USE trdtra         ! tracers trends
-   !
-   USE in_out_manager ! I/O manager
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl         ! Print control
-   USE wrk_nemo       ! work arrays
-   USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   zdf_kpp       ! routine called by step.F90
-   PUBLIC   zdf_kpp_init  ! routine called by opa.F90
-   PUBLIC   tra_kpp       ! routine called by step.F90
-   PUBLIC   trc_kpp       ! routine called by trcstp.F90
-
-   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfkpp = .TRUE.    !: KPP vertical mixing flag
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghats    !: non-local scalar mixing term (gamma/<ws>o)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wt0      !: surface temperature flux for non local flux
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ws0      !: surface salinity flux for non local flux
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hkpp     !: boundary layer depth
-
-   !                          !!* Namelist namzdf_kpp *
-   REAL(wp) ::   rn_difmiw     ! constant internal wave viscosity (m2/s)
-   REAL(wp) ::   rn_difsiw     ! constant internal wave diffusivity (m2/s)
-   REAL(wp) ::   rn_riinfty    ! local Richardson Number limit for shear instability
-   REAL(wp) ::   rn_difri      ! maximum shear mixing at Rig = 0    (m2/s)
-   REAL(wp) ::   rn_bvsqcon    ! Brunt-Vaisala squared (1/s**2) for maximum convection
-   REAL(wp) ::   rn_difcon     ! maximum mixing in interior convection (m2/s)
-   INTEGER  ::   nn_ave        ! = 0/1 flag for horizontal average on avt, avmu, avmv
-
-#if defined key_zdfddm
-   !                                        !!! ** Double diffusion Mixing
-   REAL(wp) ::   difssf  = 1.e-03_wp         ! maximum salt fingering mixing 
-   REAL(wp) ::   Rrho0   = 1.9_wp            ! limit for salt  fingering mixing 
-   REAL(wp) ::   difsdc  = 1.5e-06_wp        ! maximum diffusive convection mixing
-#endif
-   LOGICAL  ::   ln_kpprimix       ! Shear instability mixing 
-
-   !                                        !!! ** General constants  **
-   REAL(wp) ::   epsln   = 1.0e-20_wp        ! a small positive number    
-   REAL(wp) ::   pthird  = 1._wp/3._wp       ! 1/3
-   REAL(wp) ::   pfourth = 1._wp/4._wp       ! 1/4
-
-   !                                        !!! ** Boundary Layer Turbulence Parameters  **
-   REAL(wp) ::   vonk     = 0.4_wp           ! von Karman's constant
-   REAL(wp) ::   epsilon  = 0.1_wp           ! nondimensional extent of the surface layer
-   REAL(wp) ::   rconc1   = 5.0_wp           ! standard flux profile function parmaeters
-   REAL(wp) ::   rconc2   = 16.0_wp          !         "        "
-   REAL(wp) ::   rconcm   = 8.38_wp          ! momentum flux profile fit
-   REAL(wp) ::   rconam   = 1.26_wp          !         "       "
-   REAL(wp) ::   rzetam   = -.20_wp          !         "       "       
-   REAL(wp) ::   rconcs   = 98.96_wp         !  scalar  flux profile fit
-   REAL(wp) ::   rconas   = -28.86_wp        !         "       "
-   REAL(wp) ::   rzetas   = -1.0_wp          !         "       "  
-   
-   !                                        !!! ** Boundary Layer Depth Diagnostic  **
-   REAL(wp) ::   Ricr     = 0.3_wp           ! critical bulk Richardson Number
-   REAL(wp) ::   rcekman  = 0.7_wp           ! coefficient for ekman depth  
-   REAL(wp) ::   rcmonob  = 1.0_wp           ! coefficient for Monin-Obukhov depth 
-   REAL(wp) ::   rconcv   = 1.7_wp           ! ratio of interior buoyancy frequency to its value at entrainment depth
-   REAL(wp) ::   hbf      = 1.0_wp           ! fraction of bound. layer depth to which absorbed solar 
-      !                                      ! rad. and contributes to surf. buo. forcing
-   REAL(wp) ::   Vtc                         ! function of rconcv,rconcs,epsilon,vonk,Ricr
-   
-   !                                        !!! ** Nonlocal Boundary Layer Mixing **
-   REAL(wp) ::   rcstar   = 5.0_wp           ! coefficient for convective nonlocal transport
-   REAL(wp) ::   rcs      = 1.0e-3_wp        ! conversion: mm/s ==> m/s   
-   REAL(wp) ::   rcg                         ! non-dimensional coefficient for nonlocal transport
-
-#if ! defined key_kppcustom
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   del     ! array for reference mean values of vertical integration 
-#endif
-
-#if defined key_kpplktb
-   !                                         !!! ** Parameters for lookup table for turbulent velocity scales ** 
-   INTEGER, PARAMETER ::   nilktb   = 892     ! number of values for zehat in KPP lookup table
-   INTEGER, PARAMETER ::   njlktb   = 482     ! number of values for ustar in KPP lookup table
-   INTEGER, PARAMETER ::   nilktbm1 = nilktb-1   !
-   INTEGER, PARAMETER ::   njlktbm1 = njlktb-1   !
-
-   REAL(wp), DIMENSION(nilktb,njlktb) ::   wmlktb   ! lookup table for the turbulent vertical velocity scale (momentum)
-   REAL(wp), DIMENSION(nilktb,njlktb) ::   wslktb   ! lookup table for the turbulent vertical velocity scale (tracers)
-
-   REAL(wp) ::   dehatmin = -4.e-7_wp    ! minimum limit for zhat in lookup table (m3/s3) 
-   REAL(wp) ::   dehatmax = 0._wp        ! maximum limit for zhat in lookup table (m3/s3)
-   REAL(wp) ::   ustmin   = 0._wp        ! minimum limit for ustar in lookup table (m/s)
-   REAL(wp) ::   ustmax   = 0.04_wp      ! maximum limit for ustar in lookup table (m/s)    
-   REAL(wp) ::   dezehat                 ! delta zhat in lookup table
-   REAL(wp) ::   deustar                 ! delta ustar in lookup table
-#endif
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   ratt   ! attenuation coef  (already defines in module traqsr, 
-   !                                    ! but only if the solar radiation penetration is considered)
-   
-   !                                    !!! * penetrative solar radiation coefficient *
-   REAL(wp) ::   rabs = 0.58_wp          ! fraction associated with xsi1
-   REAL(wp) ::   xsi1 = 0.35_wp          ! first depth of extinction 
-   REAL(wp) ::   xsi2 = 23.0_wp          ! second depth of extinction 
-      !                           ! (default values: water type Ib) 
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   etmean, eumean, evmean   ! coeff. used for hor. smoothing at t-, u- & v-points
-        
-#if defined key_c1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rig    !: gradient Richardson number
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rib    !: bulk Richardson number
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   buof   !: buoyancy forcing
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mols   !: moning-Obukhov length scale 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ekdp   !: Ekman depth
-#endif
-
-   INTEGER  ::   jip = 62 , jjp = 111
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-#  include  "zdfddm_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION zdf_kpp_alloc()
-      !!----------------------------------------------------------------------
-      !!                 ***  FUNCTION zdf_kpp_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( ghats(jpi,jpj,jpk), wt0(jpi,jpj), ws0(jpi,jpj), hkpp(jpi,jpj), &
-#if ! defined key_kpplktb
-         &      del(jpk,jpk),                                                  &
-#endif
-         &      ratt(jpk),                                                     &
-         &      etmean(jpi,jpj,jpk), eumean(jpi,jpj,jpk), evmean(jpi,jpj,jpk), &
-#if defined key_c1d
-         &      rig (jpi,jpj,jpk), rib(jpi,jpj,jpk), buof(jpi,jpj,jpk),        &
-         &      mols(jpi,jpj,jpk), ekdp(jpi,jpj),                              &
-#endif
-         &      STAT= zdf_kpp_alloc )
-         !
-      IF( lk_mpp             )   CALL mpp_sum ( zdf_kpp_alloc )
-      IF( zdf_kpp_alloc /= 0 )   CALL ctl_warn('zdf_kpp_alloc: failed to allocate arrays')
-   END FUNCTION zdf_kpp_alloc
-
-
-   SUBROUTINE zdf_kpp( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE zdf_kpp  ***
-      !!
-      !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity
-      !!      coefficients and non local mixing using K-profile parameterization
-      !!
-      !! ** Method :   The boundary layer depth hkpp is diagnosed at tracer points
-      !!      from profiles of buoyancy, and shear, and the surface forcing.
-      !!      Above hbl (sigma=-z/hbl <1) the mixing coefficients are computed from 
-      !!
-      !!                      Kx =  hkpp  Wx(sigma) G(sigma)  
-      !!
-      !!             and the non local term ghat = Cs / Ws(sigma) / hkpp
-      !!      Below hkpp  the coefficients are the sum of mixing due to internal waves
-      !!      shear instability and double diffusion.
-      !!
-      !!      -1- Compute the now interior vertical mixing coefficients at all depths. 
-      !!      -2- Diagnose the boundary layer depth. 
-      !!      -3- Compute the now boundary layer vertical mixing coefficients. 
-      !!      -4- Compute the now vertical eddy vicosity and diffusivity.
-      !!      -5- Smoothing
-      !!
-      !!        N.B. The computation is done from jk=2 to jpkm1 
-      !!             Surface value of avt avmu avmv are set once a time to zero
-      !!             in routine zdf_kpp_init.
-      !!
-      !! ** Action  :   update the non-local terms ghats
-      !!                update avt, avmu, avmv (before vertical eddy coef.)
-      !!
-      !! References : Large W.G., Mc Williams J.C. and Doney S.C.              
-      !!         Reviews of Geophysics, 32, 4, November 1994
-      !!         Comments in the code refer to this paper, particularly 
-      !!         the equation number. (LMD94, here after)
-      !!----------------------------------------------------------------------
-      USE oce     , zviscos => ua   ! temp. array for viscosities use ua as workspace
-      USE oce     , zdiffut => va   ! temp. array for diffusivities use sa as workspace
-      !!
-      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
-      !!
-      INTEGER ::   ji, jj, jk              ! dummy loop indices
-      INTEGER ::   ikbot, jkmax, jkm1, jkp2   !
-
-      REAL(wp) ::   ztx, zty, zflageos, zstabl, zbuofdep,zucube     !
-      REAL(wp) ::   zrhos, zalbet, zbeta, zthermal, zhalin, zatt1   !
-      REAL(wp) ::   zref, zt, zs, zh, zu, zv, zrh                   ! Bulk richardson number
-      REAL(wp) ::   zrib, zrinum, zdVsq, zVtsq                      !
-      REAL(wp) ::   zehat, zeta, zhrib, zsig, zscale, zwst, zws, zwm   ! Velocity scales
-#if defined key_kpplktb
-      INTEGER ::    il, jl                                          ! Lookup table or Analytical functions 
-      REAL(wp) ::   ud, zfrac, ufrac, zwam, zwbm, zwas, zwbs        !
-#else
-      REAL(wp) ::   zwsun, zwmun, zcons, zconm, zwcons, zwconm      !
-#endif
-      REAL(wp) ::   zsr, zbw, ze, zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zcomp , zrhd,zrhdr,zbvzed   ! In situ density
-#if ! defined key_kppcustom     
-      INTEGER  ::   jm                          ! dummy loop indices
-      REAL(wp) ::   zr1, zr2, zr3, zr4, zrhop   ! Compression terms
-#endif
-      REAL(wp) ::   zflag, ztemp, zrn2, zdep21, zdep32, zdep43
-      REAL(wp) ::   zdku2, zdkv2, ze3sqr, zsh2, zri, zfri          ! Interior richardson mixing
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zmoek                 ! Moning-Obukov limitation
-      REAL(wp), POINTER, DIMENSION(:)   ::   zmoa, zekman                
-      REAL(wp)                          ::   zmob, zek
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zdepw, zdift, zvisc   ! The pipe 
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zdept
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zriblk
-      REAL(wp), POINTER, DIMENSION(:)   ::   zhmax, zria, zhbl 
-      REAL(wp) ::   zflagri, zflagek, zflagmo, zflagh, zflagkb   !
-      REAL(wp), POINTER, DIMENSION(:)   ::   za2m, za3m, zkmpm, za2t, za3t, zkmpt   ! Shape function (G)
-      REAL(wp) ::   zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t
-#if defined key_zdfddm
-      REAL(wp) ::   zrw, zkm1s                    ! local scalars
-      REAL(wp) ::   zrrau, zdt, zds, zavdds, zavddt, zinr   ! double diffusion mixing
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdifs
-      REAL(wp), POINTER, DIMENSION(:)     ::   za2s, za3s, zkmps
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zblcs
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdiffus
-#endif
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zBo, zBosol, zustar         ! Surface buoyancy forcing, friction velocity
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask, zblcm, zblct
-      !!--------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('zdf_kpp')
-      !
-      CALL wrk_alloc( jpi, zmoa, zekman, zhmax, zria, zhbl )
-      CALL wrk_alloc( jpi, za2m, za3m, zkmpm, za2t, za3t, zkmpt )
-      CALL wrk_alloc( jpi,2, zriblk )
-      CALL wrk_alloc( jpi,3, zmoek, kjstart = 0 )
-      CALL wrk_alloc( jpi,3, zdept )
-      CALL wrk_alloc( jpi,4, zdepw, zdift, zvisc )
-      CALL wrk_alloc( jpi,jpj, zBo, zBosol, zustar )
-      CALL wrk_alloc( jpi,jpk, zmask, zblcm, zblct )
-#if defined key_zdfddm
-      CALL wrk_alloc( jpi,4, zdifs )
-      CALL wrk_alloc( jpi, zmoa, za2s, za3s, zkmps )
-      CALL wrk_alloc( jpi,jpk, zblcs )
-      CALL wrk_alloc( jpi,jpi,jpk, zdiffus )
-#endif
-
-      zviscos(:,:,:) = 0._wp
-      zblcm  (:,:  ) = 0._wp
-      zdiffut(:,:,:) = 0._wp
-      zblct  (:,:  ) = 0._wp 
-#if defined key_zdfddm
-      zdiffus(:,:,:) = 0._wp
-      zblcs  (:,:  ) = 0._wp 
-#endif
-      ghats  (:,:,:) = 0._wp
-      zBo    (:,:  ) = 0._wp
-      zBosol (:,:  ) = 0._wp
-      zustar (:,:  ) = 0._wp
-      !
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! I. Interior diffusivity and viscosity at w points ( T interfaces)
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1 
-               ! Mixing due to internal waves breaking
-               ! -------------------------------------
-               avmu(ji,jj,jk)  = rn_difmiw 
-               avt (ji,jj,jk)  = rn_difsiw             
-               ! Mixing due to vertical shear instability
-               ! -------------------------------------               
-               IF( ln_kpprimix ) THEN          
-                  ! Compute the gradient Richardson  number at interfaces (zri):
-                  ! LMD94, eq. 27 (is vertical smoothing needed : Rig=N^2 / (dz(u))^2 + (dz(v))^2
-                  zdku2 =   ( un(ji - 1,jj,jk - 1) - un(ji - 1,jj,jk) ) &
-                     &    * ( un(ji - 1,jj,jk - 1) - un(ji - 1,jj,jk) ) &
-                     &    + ( un(ji    ,jj,jk - 1) - un(ji    ,jj,jk) ) &
-                     &    * ( un(ji    ,jj,jk - 1) - un(ji    ,jj,jk) )  
-                  
-                  zdkv2 =   ( vn(ji,jj - 1,jk - 1) - vn(ji,jj - 1,jk) ) &
-                     &    * ( vn(ji,jj - 1,jk - 1) - vn(ji,jj - 1,jk) ) &
-                     &    + ( vn(ji,    jj,jk - 1) - vn(ji,    jj,jk) ) &
-                     &    * ( vn(ji,    jj,jk - 1) - vn(ji,    jj,jk) )  
-
-                  ze3sqr = 1. / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) )
-                  ! Square of vertical shear  at interfaces
-                  zsh2   = 0.5 * ( zdku2 + zdkv2 ) * ze3sqr
-                  zri    = MAX( rn2(ji,jj,jk), 0. ) / ( zsh2 + epsln ) 
-#if defined key_c1d
-                  ! save the gradient richardson number
-                  rig(ji,jj,jk) = zri * tmask(ji,jj,jk)
-#endif                  
-                  ! Evaluate f of Ri (zri) for shear instability store in zfri
-                  ! LMD94, eq. 28a,b,c, figure 3 ; Rem: p1 is 3, hard coded
-                  zfri  = MAX( zri , 0. )
-                  zfri  = MIN( zfri / rn_riinfty , 1.0 )
-                  zfri  = ( 1.0 - zfri * zfri )
-                  zfri  = zfri * zfri  * zfri
-                  ! add shear contribution to mixing coef. 
-                  avmu(ji,jj,jk) =  avmu(ji,jj,jk) + rn_difri * zfri   
-                  avt (ji,jj,jk) =  avt (ji,jj,jk) + rn_difri * zfri    
-               ENDIF
-               !
-#if defined key_zdfddm 
-               !
-               !  Double diffusion mixing ; NOT IN ROUTINE ZDFDDM.F90
-               ! -------------------------
-               avs (ji,jj,jk) =  avt (ji,jj,jk)   
-
-               ! R=zrau = (alpha / beta) (dk[t] / dk[s])
-               zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   &
-                  &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 
-               !
-               zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  ) * tmask(ji,jj,jk)
-               zbw = (  rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw  ) * tmask(ji,jj,jk)
-               !
-               zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )
-               zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) 
-               IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp
-               zrrau = MAX(  epsln , zdt / zds  )    ! only retains positive value of zrau
-               !
-               IF( zrrau > 1. .AND. zds > 0.) THEN                        ! Salt fingering case.
-                  !                                                       !---------------------
-                  ! Compute interior diffusivity for double diffusive mixing of salinity. 
-                  ! Upper bound "zrrau" by "Rrho0"; (Rrho0=1.9, difcoefnuf=0.001).
-                  ! After that set interior diffusivity for double diffusive mixing of temperature
-                  zavdds = MIN( zrrau, Rrho0 )
-                  zavdds = ( zavdds - 1.0 ) / ( Rrho0 - 1.0 )
-                  zavdds = 1.0 - zavdds * zavdds 
-                  zavdds = zavdds * zavdds * zavdds 
-                  zavdds = difssf * zavdds 
-                  zavddt = 0.7 * zavdds
-                  !
-               ELSEIF( zrrau < 1. .AND. zrrau > 0. .AND. zds < 0.) THEN   ! Diffusive convection case.
-                  !                                                       !---------------------------
-                  ! Compute interior diffusivity for double diffusive mixing of temperature (Marmorino and Caldwell, 1976); 
-                  ! Compute interior diffusivity for double diffusive mixing of salinity 
-                  zinr   = 1. / zrrau
-                  zavddt = 0.909 * EXP( 4.6 * EXP( -0.54* ( zinr - 1. ) ) ) 
-                  zavddt = difsdc * zavddt
-                  IF( zrrau < 0.5) THEN   ;   zavdds = zavddt * 0.15 * zrrau
-                  ELSE                    ;   zavdds = zavddt * (1.85 * zrrau - 0.85 ) 
-                  ENDIF
-               ELSE
-                  zavddt = 0.
-                  zavdds = 0.
-               ENDIF 
-               ! Add double diffusion contribution to temperature and salinity  mixing coefficients.
-               avt (ji,jj,jk) =  avt (ji,jj,jk) +  zavddt 
-               avs (ji,jj,jk) =  avs (ji,jj,jk) +  zavdds         
-#endif                      
-            END DO
-         END DO
-      END DO
-
-
-      ! Radiative (zBosol) and non radiative (zBo) surface buoyancy
-      !JMM at the time zdfkpp is called, q still holds the sum q + qsr
-      !---------------------------------------------------------------------
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1           
-            zrhos    = rau0 * ( 1._wp + rhd(ji,jj,1) ) * tmask(ji,jj,1)
-            zthermal = rab_n(ji,jj,1,jp_tem) / ( rcp * zrhos + epsln )
-            zbeta    = rab_n(ji,jj,1,jp_sal)
-            zhalin   = zbeta * tsn(ji,jj,1,jp_sal) * rcs
-            !
-            ! Radiative surface buoyancy force
-            zBosol(ji,jj) = grav * zthermal * qsr(ji,jj)
-            ! Non radiative surface buoyancy force
-            zBo   (ji,jj) = grav * zthermal * qns(ji,jj) -  grav * zhalin * ( emp(ji,jj)-rnf(ji,jj) )  &
-               &                                         -  grav * zbeta * rcs * sfx(ji,jj)
-            ! Surface Temperature flux for non-local term
-            wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* r1_rau0_rcp * tmask(ji,jj,1)
-            ! Surface salinity flux for non-local term
-            ws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal)                          &
-               &             + sfx(ji,jj)                                     ) * rcs * tmask(ji,jj,1) 
-         END DO
-      END DO
-
-      zflageos = 0.5 + SIGN( 0.5, nn_eos - 1. ) 
-      !  Compute surface buoyancy forcing, Monin Obukhov and Ekman depths  
-      !------------------------------------------------------------------    
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            !  Reference surface density = density at first T point level   
-            zrhos         = rhop(ji,jj,1) + zflageos * rau0 * ( 1. - tmask(ji,jj,1) )  
-            ! Friction velocity (zustar), at T-point : LMD94 eq. 2
-            zustar(ji,jj) = SQRT( taum(ji,jj) / ( zrhos +  epsln ) )
-         END DO
-      END DO
-
-!CDIR NOVERRCHK  
-      !                                               ! ===============
-      DO jj = 2, jpjm1                                 !  Vertical slab
-         !                                             ! ===============
-         
-         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-         ! II Compute Boundary layer mixing coef. and diagnose the new boundary layer depth
-         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-         
-         ! Initialization
-         jkmax       = 0
-         zdept (:,:) = 0.
-         zdepw (:,:) = 0.
-         zriblk(:,:) = 0.
-         zmoek (:,:) = 0.
-         zvisc (:,:) = 0.
-         zdift (:,:) = 0.
-#if defined key_zdfddm
-         zdifs (:,:) = 0.
-#endif
-         zmask (:,:) = 0.
-         DO ji = fs_2, fs_jpim1
-            zria(ji ) = 0.
-            ! Maximum boundary layer depth
-            ikbot     = mbkt(ji,jj)    ! ikbot is the last T point in the water
-            zhmax(ji) = fsdept(ji,jj,ikbot) - 0.001      
-            ! Compute Monin obukhov length scale at the surface and Ekman depth:
-            zbuofdep   = zBo(ji,jj) + zBosol(ji,jj) * ratt(1)
-            zekman(ji) = rcekman * zustar(ji,jj) / ( ABS( ff(ji,jj) ) + epsln )
-            zucube     = zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) 
-            zmoa(ji)   = zucube / ( vonk * ( zbuofdep + epsln ) )   
-#if defined key_c1d
-            ! store the surface buoyancy forcing
-            zstabl        = 0.5 + SIGN( 0.5, zbuofdep )
-            buof(ji,jj,1) = zbuofdep * tmask(ji,jj,1)
-            ! store the moning-oboukov length scale at surface
-            zmob          = zstabl * zmoa(ji) + ( 1.0 - zstabl ) * fsdept(ji,jj,1)
-            mols(ji,jj,1) = MIN( zmob , zhmax(ji) ) * tmask(ji,jj,1)
-            ! store Ekman depth
-            zek           = zstabl * zekman(ji) + ( 1.0 - zstabl ) * fsdept(ji,jj,1)  
-            ekdp(ji,jj )  = MIN( zek , zhmax(ji) ) * tmask(ji,jj,1)  
-#endif 
-         END DO     
-         ! Compute the pipe
-         ! ---------------------
-         DO jk = 2, jpkm1
-            DO ji = fs_2, fs_jpim1
-               ! Compute bfsfc = Bo + radiative contribution down to hbf*depht
-               zbuofdep = zBo(ji,jj) + zBosol(ji,jj) * ratt(jk)
-               ! Flag (zstabl  = 1) if positive forcing
-               zstabl   =  0.5 + SIGN(  0.5, zbuofdep)
-
-               !   Compute bulk richardson number zrib at depht 
-               !-------------------------------------------------------
-               !                           [Br - B(d)] * d         zrinum
-               !             Rib(z) = ----------------------- = -------------
-               !                       |Vr - V(d)|^2 + Vt(d)^2   zdVsq + zVtsq
-               !
-               ! First compute zt,zs,zu,zv = means in the surface layer < epsilon*depht  
-               ! Else surface values are taken at the first T level.
-               ! For stability, resolved vertical shear is computed with "before velocities".
-               zref = epsilon * fsdept(ji,jj,jk)
-#if defined key_kppcustom
-               ! zref = gdept(1)
-               zref = fsdept(ji,jj,1)
-               zt   = tsn(ji,jj,1,jp_tem)
-               zs   = tsn(ji,jj,1,jp_sal)
-               zrh  = rhop(ji,jj,1)
-               zu   = ( ub(ji,jj,1) + ub(ji - 1,jj    ,1) ) / MAX( 1. , umask(ji,jj,1) + umask(ji - 1,jj   ,1) )
-               zv   = ( vb(ji,jj,1) + vb(ji    ,jj - 1,1) ) / MAX( 1. , vmask(ji,jj,1) + vmask(ji   ,jj - 1,1) )
-#else
-               zt   = 0.
-               zs   = 0.
-               zu   = 0.
-               zv   = 0.
-               zrh  = 0.
-               ! vertically integration over the upper epsilon*gdept(jk) ; del () array is computed once in zdf_kpp_init
-               DO jm = 1, jpkm1
-                  zt   = zt  + del(jk,jm) * tsn(ji,jj,jm,jp_tem)
-                  zs   = zs  + del(jk,jm) * tsn(ji,jj,jm,jp_sal)
-                  zu   = zu  + 0.5 * del(jk,jm) &
-                     &            * ( ub(ji,jj,jm) + ub(ji - 1,jj,jm) ) &
-                     &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) )
-                  zv   = zv  + 0.5 * del(jk,jm) &
-                     &            * ( vb(ji,jj,jm) + vb(ji,jj - 1,jm) ) &
-                     &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) )
-                  zrh  = zrh + del(jk,jm) * rhop(ji,jj,jm)
-               END DO
-#endif
-               zsr = SQRT( ABS( tsn(ji,jj,jk,jp_sal) ) )
-               ! depth
-               zh = fsdept(ji,jj,jk)
-               ! compute compression terms on density
-               ze  = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
-               zbw = (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
-               zb  = zbw + ze * zs
-               
-               zd  = -2.042967e-2
-               zc  =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
-               zaw = ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
-               za  = ( zd*zsr + zc ) *zs + zaw
-               
-               zb1 =   (-0.1909078*zt+7.390729 ) *zt-55.87545
-               za1 = ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
-               zkw = ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
-               zk0 = ( zb1*zsr + za1 )*zs + zkw
-               zcomp =   1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )
-               
-#if defined key_kppcustom
-               ! potential density of water(zrh = zt,zs at level jk):
-               zrhdr = zrh / zcomp
-#else
-               ! potential density of water(ztref,zsref at level jk):
-               ! compute volumic mass pure water at atm pressure
-               IF ( nn_eos < 1 ) THEN
-                  zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   &
-                     &       -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
-                  ! seawater volumic mass atm pressure
-                  zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt   &
-                     &   -4.0899e-3 ) *zt+0.824493
-                  zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
-                  zr4= 4.8314e-4              
-                  ! potential volumic mass (reference to the surface)
-                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1                 
-                  zrhdr = zrhop / zcomp
-               ELSE
-                  zrhdr = zrh / zcomp
-               ENDIF
-#endif
-               
-               ! potential density of ambiant water at level jk :
-               zrhd   = ( rhd(ji,jj,jk) * rau0 + rau0 )  
-               
-               ! And now the Rib number numerator .
-               zrinum = grav * ( zrhd - zrhdr ) / rau0
-               zrinum = zrinum * ( fsdept(ji,jj,jk) - zref ) * tmask(ji,jj,jk)
-           
-               ! Resolved shear contribution to Rib at depth T-point (zdVsq)
-               ztx    =   ( ub( ji , jj ,jk)   +  ub(ji - 1, jj ,jk) ) &
-                  &     / MAX( 1. , umask( ji , jj ,jk) + umask(ji - 1, jj ,jk) )   
-               zty    =   ( vb( ji , jj ,jk)   +  vb(ji  ,jj - 1,jk) ) &
-                  &     / MAX( 1., vmask( ji , jj ,jk) + vmask(ji  ,jj - 1,jk) ) 
-               
-               zdVsq  = ( zu - ztx ) * ( zu - ztx ) + ( zv - zty ) * ( zv - zty )
-               
-               ! Scalar turbulent velocity scale zws for hbl=gdept
-               zscale = zstabl + ( 1.0 - zstabl ) * epsilon
-               zehat  = vonk * zscale * fsdept(ji,jj,jk) * zbuofdep
-               zucube = zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj)              
-               zeta   = zehat / ( zucube + epsln )
-               
-               IF( zehat > 0. ) THEN
-                  ! Stable case
-                  zws  = vonk * zustar(ji,jj) / ( 1.0 + rconc1 * zeta )
-               ELSE
-                  ! Unstable case
-#if defined key_kpplktb
-                  ! use lookup table
-                  zd     = zehat - dehatmin
-                  il     = INT( zd / dezehat )
-                  il     = MIN( il, nilktbm1 )
-                  il     = MAX( il, 1 )
-                  
-                  ud     = zustar(ji,jj) - ustmin
-                  jl     = INT( ud / deustar )
-                  jl     = MIN( jl, njlktbm1 )
-                  jl     = MAX( jl, 1 )
-                  
-                  zfrac  = zd / dezehat - FLOAT( il )  
-                  ufrac  = ud / deustar - FLOAT( jl )
-                  zwas   = ( 1. - zfrac ) * wslktb(il,jl+1) + zfrac * wslktb(il+1,jl+1)
-                  zwbs   = ( 1. - zfrac ) * wslktb(il,jl  ) + zfrac * wslktb(il+1,jl  )
-                  !
-                  zws    = ( 1. - ufrac ) * zwbs + ufrac * zwas
-#else
-                  ! use analytical functions:
-                  zcons  = 0.5 + SIGN( 0.5 , ( rzetas - zeta ) )
-                  zwcons = vonk * zustar(ji,jj) * ( ( ABS( rconas - rconcs * zeta ) )**pthird ) 
-                  zwsun  = vonk * zustar(ji,jj) * SQRT( ABS ( 1.0 - rconc2 * zeta ) )
-                  !
-                  zws    = zcons * zwcons +  ( 1.0 - zcons) * zwsun
-#endif
-               ENDIF
-               
-               ! Turbulent shear contribution to Rib (zVtsq) bv frequency at levels  ( ie T-point jk)
-               zrn2   = 0.5 * ( rn2(ji,jj,jk) + rn2(ji,jj,jk+1) )   
-               zbvzed = SQRT( ABS( zrn2 ) ) 
-               zVtsq  = fsdept(ji,jj,jk) * zws * zbvzed  * Vtc
-               
-               ! Finally, the bulk Richardson number at depth fsdept(i,j,k) 
-               zrib  = zrinum   / ( zdVsq + zVtsq + epsln )
- 
-               ! Find subscripts around the boundary layer depth, build the pipe
-               ! ----------------------------------------------------------------
-
-               ! Flag (zflagri = 1) if zrib < Ricr  
-               zflagri = 0.5 + SIGN( 0.5, ( Ricr - zrib ) )
-               !  Flag (zflagh  = 1) if still within overall boundary layer
-               zflagh  = 0.5 + SIGN( 0.5, ( fsdept(ji,jj,1) - zdept(ji,2) ) )
-               
-               ! Ekman layer depth
-               zek     = zstabl * zekman(ji) + ( 1.0 - zstabl ) * zhmax(ji)
-               zflag   = 0.5 + SIGN( 0.5, ( zek - fsdept(ji,jj,jk-1) ) )
-               zek     = zflag * zek + ( 1.0 - zflag ) * zhmax(ji)
-               zflagek = 0.5 + SIGN( 0.5, ( zek - fsdept(ji,jj,jk) ) )
-               ! Flag (zflagmo = 1) if still within stable Monin-Obukhov and in water
-               zmob    = zucube / ( vonk * ( zbuofdep + epsln ) )  
-               ztemp   = zstabl * zmob + ( 1.0 - zstabl) * zhmax(ji)
-               ztemp   = MIN( ztemp , zhmax(ji) ) 
-               zflagmo = 0.5 + SIGN( 0.5, ( ztemp - fsdept(ji,jj,jk) ) )             
-
-               ! No limitation by Monin Obukhov or Ekman depths:
-!               zflagek = 1.0
-!               zflagmo = 0.5 + SIGN( 0.5, ( zhmax(ji) - fsdept(ji,jj,jk) ) )
-
-               ! Load  pipe via zflagkb  for later calculations
-               ! Flag (zflagkb = 1) if zflagh = 1 and (zflagri = 0 or zflagek = 0 or zflagmo = 0)
-               zflagkb = zflagh * ( 1.0 - ( zflagri * zflagek * zflagmo ) )
-
-               zmask(ji,jk) = zflagh
-               jkp2         = MIN( jk+2 , ikbot )
-               jkm1         = MAX( jk-1 , 2 )
-               jkmax        = MAX( jkmax, jk * INT( REAL( zflagh+epsln ) ) ) 
-
-               zdept(ji,1)  = zdept(ji,1) + zflagkb * fsdept(ji,jj,jk-1) 
-               zdept(ji,2)  = zdept(ji,2) + zflagkb * fsdept(ji,jj,jk  ) 
-               zdept(ji,3)  = zdept(ji,3) + zflagkb * fsdept(ji,jj,jk+1) 
-
-               zdepw(ji,1)  = zdepw(ji,1) + zflagkb * fsdepw(ji,jj,jk-1) 
-               zdepw(ji,2)  = zdepw(ji,2) + zflagkb * fsdepw(ji,jj,jk  ) 
-               zdepw(ji,3)  = zdepw(ji,3) + zflagkb * fsdepw(ji,jj,jk+1)
-               zdepw(ji,4)  = zdepw(ji,4) + zflagkb * fsdepw(ji,jj,jkp2)  
-
-               zriblk(ji,1) = zriblk(ji,1) + zflagkb * zria(ji)
-               zriblk(ji,2) = zriblk(ji,2) + zflagkb * zrib
-
-               zmoek (ji,0) = zmoek (ji,0) + zflagkb * zek
-               zmoek (ji,1) = zmoek (ji,1) + zflagkb * zmoa(ji)
-               zmoek (ji,2) = zmoek (ji,2) + zflagkb * ztemp  
-               ! Save Monin Obukhov depth
-               zmoa  (ji)   = zmob
-           
-               zvisc(ji,1) = zvisc(ji,1) + zflagkb * avmu(ji,jj,jkm1)
-               zvisc(ji,2) = zvisc(ji,2) + zflagkb * avmu(ji,jj,jk  )
-               zvisc(ji,3) = zvisc(ji,3) + zflagkb * avmu(ji,jj,jk+1)
-               zvisc(ji,4) = zvisc(ji,4) + zflagkb * avmu(ji,jj,jkp2)
-               
-               zdift(ji,1) = zdift(ji,1) + zflagkb * avt (ji,jj,jkm1)
-               zdift(ji,2) = zdift(ji,2) + zflagkb * avt (ji,jj,jk  )
-               zdift(ji,3) = zdift(ji,3) + zflagkb * avt (ji,jj,jk+1)
-               zdift(ji,4) = zdift(ji,4) + zflagkb * avt (ji,jj,jkp2)
-
-#if defined key_zdfddm
-               zdifs(ji,1) = zdifs(ji,1) + zflagkb * avs (ji,jj,jkm1)
-               zdifs(ji,2) = zdifs(ji,2) + zflagkb * avs (ji,jj,jk  )
-               zdifs(ji,3) = zdifs(ji,3) + zflagkb * avs (ji,jj,jk+1)
-               zdifs(ji,4) = zdifs(ji,4) + zflagkb * avs (ji,jj,jkp2)
-#endif               
-               ! Save the Richardson number 
-               zria  (ji)   = zrib  
-#if defined key_c1d
-               ! store buoyancy length scale
-               buof(ji,jj,jk) = zbuofdep * tmask(ji,jj,jk) 
-               ! store Monin Obukhov
-               zmob           = zstabl * zmob + ( 1.0 - zstabl) * fsdept(ji,jj,1)
-               mols(ji,jj,jk) = MIN( zmob , zhmax(ji) ) * tmask(ji,jj,jk) 
-               ! Bulk Richardson number
-               rib(ji,jj,jk)  = zrib * tmask(ji,jj,jk)             
-#endif               
-            END DO
-         END DO
-         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-         ! III PROCESS THE PIPE
-         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-         
-         DO ji = fs_2, fs_jpim1 
-            
-            ! Find the boundary layer depth zhbl
-            ! ----------------------------------------
-            
-            ! Interpolate monin Obukhov and critical Ri mumber depths   
-            ztemp = zdept(ji,2) - zdept(ji,1)
-            zflag = ( Ricr - zriblk(ji,1) ) / ( zriblk(ji,2) - zriblk(ji,1)  + epsln )
-            zhrib = zdept(ji,1) + zflag * ztemp      
-
-            IF( zriblk(ji,2) < Ricr ) zhrib = zhmax(ji) 
-         
-            IF( zmoek(ji,2) < zdept(ji,2) ) THEN
-               IF ( zmoek(ji,1) < 0. ) THEN
-                  zmob = zdept(ji,2) - epsln
-               ELSE
-                  zmob = ztemp + zmoek(ji,1) - zmoek(ji,2)
-                  zmob = ( zmoek(ji,1) * zdept(ji,2) - zmoek(ji,2) * zdept(ji,1) ) / zmob
-                  zmob = MAX( zmob , zdept(ji,1) + epsln )                
-               ENDIF
-            ELSE           
-               zmob = zhmax(ji) 
-            ENDIF
-            ztemp   = MIN( zmob , zmoek(ji,0) )
-                         
-            ! Finally, the boundary layer depth, zhbl 
-            zhbl(ji) = MAX( fsdept(ji,jj,1) + epsln, MIN( zhrib , ztemp ) )
-            
-            ! Save hkpp for further diagnostics (optional)
-            hkpp(ji,jj) = zhbl(ji) * tmask(ji,jj,1) 
-          
-            ! Correct mask if zhbl < fsdepw(ji,jj,2) for no viscosity/diffusivity enhancement at fsdepw(ji,jj,2)
-            !     zflag = 1 if zhbl(ji) > fsdepw(ji,jj,2)
-            IF( zhbl(ji) < fsdepw(ji,jj,2) ) zmask(ji,2) = 0.
-          
-            
-            !  Velocity scales at depth zhbl
-            ! -----------------------------------
-            
-            !  Compute bouyancy forcing down to zhbl
-            ztemp    = -hbf * zhbl(ji)
-            zatt1    = 1.0 - ( rabs * EXP( ztemp / xsi1 ) + ( 1.0 - rabs ) * EXP( ztemp / xsi2 ) )
-            zbuofdep = zBo(ji,jj) + zBosol(ji,jj) * zatt1
-            zstabl   = 0.5 + SIGN( 0.5 , zbuofdep ) 
-
-            zbuofdep = zbuofdep + zstabl * epsln
-
-            zscale = zstabl + ( 1.0 - zstabl ) * epsilon          
-            zehat  = vonk * zscale * zhbl(ji) * zbuofdep
-            zucube = zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj)              
-            zeta   = zehat / ( zucube + epsln )
-            
-            IF( zehat > 0. ) THEN
-               ! Stable case
-               zws  = vonk * zustar(ji,jj) / ( 1.0 + rconc1 * zeta )
-               zwm  = zws
-            ELSE
-               ! Unstable case
-#if defined key_kpplktb
-               ! use lookup table
-               zd     = zehat - dehatmin
-               il     = INT( zd / dezehat )
-               il     = MIN( il, nilktbm1 )
-               il     = MAX( il, 1 )
-               
-               ud     = zustar(ji,jj) - ustmin
-               jl     = INT( ud / deustar )
-               jl     = MIN( jl, njlktbm1 )
-               jl     = MAX( jl, 1 )
-               
-               zfrac  = zd / dezehat - FLOAT( il )  
-               ufrac  = ud / deustar - FLOAT( jl )
-               zwas   = ( 1. - zfrac ) * wslktb(il,jl+1) + zfrac * wslktb(il+1,jl+1)
-               zwbs   = ( 1. - zfrac ) * wslktb(il,jl  ) + zfrac * wslktb(il+1,jl  )
-               zwam   = ( 1. - zfrac ) * wmlktb(il,jl+1) + zfrac * wmlktb(il+1,jl+1)
-               zwbm   = ( 1. - zfrac ) * wmlktb(il,jl  ) + zfrac * wmlktb(il+1,jl  )
-               !
-               zws    = ( 1. - ufrac ) * zwbs + ufrac * zwas
-               zwm    = ( 1. - ufrac ) * zwbm + ufrac * zwam
-#else
-               ! use analytical functions
-               zconm  = 0.5 + SIGN( 0.5, ( rzetam - zeta) )
-               zcons  = 0.5 + SIGN( 0.5, ( rzetas - zeta) )
-               
-               ! Momentum : zeta < rzetam (zconm = 1)
-               ! Scalars  : zeta < rzetas (zcons = 1) 
-               zwconm = zustar(ji,jj) * vonk * ( ( ABS( rconam - rconcm * zeta) )**pthird )
-               zwcons = zustar(ji,jj) * vonk * ( ( ABS( rconas - rconcs * zeta) )**pthird )
-               
-               ! Momentum : rzetam <= zeta < 0 (zconm = 0)
-               ! Scalars  : rzetas <= zeta < 0 (zcons = 0)	
-               zwmun  = SQRT( ABS( 1.0 - rconc2 * zeta ) )
-               zwsun  = vonk * zustar(ji,jj) * zwmun
-               zwmun  = vonk * zustar(ji,jj) * SQRT(zwmun)
-               !
-               zwm    = zconm * zwconm + ( 1.0 - zconm ) * zwmun
-               zws    = zcons * zwcons + ( 1.0 - zcons ) * zwsun
-               
-#endif
-            ENDIF
-            
-            
-            ! Viscosity, diffusivity values and derivatives at h
-            ! --------------------------------------------------------
-            
-            ! check between at which interfaces is located zhbl(ji)
-            ! ztemp = 1, zdepw(ji,2) < zhbl <  zdepw(ji,3)
-            ! ztemp = 0, zdepw(ji,1) < zhbl <  zdepw(ji,2)
-            ztemp  =  0.5 + SIGN( 0.5, ( zhbl(ji) - zdepw(ji,2) ) )  
-            zdep21 =   zdepw(ji,2) - zdepw(ji,1) + epsln
-            zdep32 =   zdepw(ji,3) - zdepw(ji,2) + epsln
-            zdep43 =   zdepw(ji,4) - zdepw(ji,3) + epsln  
-            
-            ! Compute R as in LMD94, eq D5b
-            zdelta =  ( zhbl(ji) - zdepw(ji,2) ) *         ztemp   / zdep32   &
-               &    + ( zhbl(ji) - zdepw(ji,1) ) * ( 1.0 - ztemp ) / zdep21 
-            
-            ! Compute the vertical derivative of viscosities (zdzh) at z=zhbl(ji)
-            zdzup  =  ( zvisc(ji,2) - zvisc(ji,3) ) *         ztemp   / zdep32 &
-               &    + ( zvisc(ji,1) - zvisc(ji,2) ) * ( 1.0 - ztemp ) / zdep21
-            
-            zdzdn  =  ( zvisc(ji,3) - zvisc(ji,4) ) *         ztemp   / zdep43 &
-               &    + ( zvisc(ji,2) - zvisc(ji,3) ) * ( 1.0 - ztemp ) / zdep32
-            
-            ! LMD94, eq D5b :          
-            zdzh   = ( 1.0 - zdelta ) * zdzup + zdelta * zdzdn
-            zdzh   = MAX( zdzh , 0. )
-            
-            ! Compute viscosities (zvath) at z=zhbl(ji), LMD94 eq D5a
-            zvath  =          ztemp   * ( zvisc(ji,3) + zdzh * ( zdepw(ji,3) - zhbl(ji) ) ) &
-               &    + ( 1.0 - ztemp ) * ( zvisc(ji,2) + zdzh * ( zdepw(ji,2) - zhbl(ji) ) )
-            
-            ! Compute G (zgat1) and its derivative (zdat1) at z=hbl(ji), LMD94 eq 18
-            
-            ! Vertical derivative of velocity scale divided by velocity scale squared at z=hbl(ji) 
-            ! (non zero only in stable conditions)
-            zflag  =  -zstabl * rconc1 * zbuofdep / ( zucube * zustar(ji,jj) + epsln )
-            
-            ! G at its derivative at z=hbl:
-            zgat1  = zvath  / ( zhbl(ji) * ( zwm + epsln )  )
-            zdat1  = -zdzh  / ( zwm + epsln ) -  zflag * zvath / zhbl(ji)
-            
-            ! G coefficients, LMD94 eq 17
-            za2m(ji) = -2.0 + 3.0 * zgat1 - zdat1
-            za3m(ji) =  1.0 - 2.0 * zgat1 + zdat1
-
-            
-            ! Compute the vertical derivative of temperature diffusivities (zdzh) at z=zhbl(ji)
-            zdzup  =  ( zdift(ji,2) - zdift(ji,3) ) *         ztemp   / zdep32 &
-               &    + ( zdift(ji,1) - zdift(ji,2) ) * ( 1.0 - ztemp ) / zdep21
-            
-            zdzdn  =  ( zdift(ji,3) - zdift(ji,4) ) *         ztemp   / zdep43 &
-               &    + ( zdift(ji,2) - zdift(ji,3) ) * ( 1.0 - ztemp ) / zdep32
-            
-            ! LMD94, eq D5b :          
-            zdzh   = ( 1.0 - zdelta ) * zdzup + zdelta * zdzdn
-            zdzh   = MAX( zdzh , 0. )
-            
-            
-            ! Compute diffusivities (zvath) at z=zhbl(ji), LMD94 eq D5a
-            zvath  =          ztemp   * ( zdift(ji,3) + zdzh * ( zdepw(ji,3) - zhbl(ji) ) ) &
-               &    + ( 1.0 - ztemp ) * ( zdift(ji,2) + zdzh * ( zdepw(ji,2) - zhbl(ji) ) )
-                        
-            ! G at its derivative at z=hbl:
-            zgat1  = zvath  / ( zhbl(ji) * ( zws + epsln )  )
-            zdat1  = -zdzh  / ( zws + epsln ) -  zflag * zvath / zhbl(ji)
-            
-            ! G coefficients, LMD94 eq 17
-            za2t(ji) = -2.0 + 3.0 * zgat1 - zdat1
-            za3t(ji) =  1.0 - 2.0 * zgat1 + zdat1
-
-#if defined key_zdfddm
-            ! Compute the vertical derivative of salinities diffusivities (zdzh) at z=zhbl(ji)
-            zdzup  =  ( zdifs(ji,2) - zdifs(ji,3) ) *         ztemp   / zdep32 &
-               &    + ( zdifs(ji,1) - zdifs(ji,2) ) * ( 1.0 - ztemp ) / zdep21
-            
-            zdzdn  =  ( zdifs(ji,3) - zdifs(ji,4) ) *         ztemp   / zdep43 &
-               &    + ( zdifs(ji,2) - zdifs(ji,3) ) * ( 1.0 - ztemp ) / zdep32
-            
-            ! LMD94, eq D5b :          
-            zdzh   = ( 1.0 - zdelta ) * zdzup + zdelta * zdzdn
-            zdzh   = MAX( zdzh , 0. )           
-            
-            ! Compute diffusivities (zvath) at z=zhbl(ji), LMD94 eq D5a
-            zvath  =          ztemp   * ( zdifs(ji,3) + zdzh * ( zdepw(ji,3) - zhbl(ji) ) ) &
-               &    + ( 1.0 - ztemp ) * ( zdifs(ji,2) + zdzh * ( zdepw(ji,2) - zhbl(ji) ) )
-                        
-            ! G at its derivative at z=hbl:
-            zgat1  = zvath  / ( zhbl(ji) * ( zws + epsln )  )
-            zdat1  = -zdzh  / ( zws + epsln ) -  zflag * zvath / zhbl(ji)
-            
-            ! G coefficients, LMD94 eq 17
-            za2s(ji) = -2.0 + 3.0 * zgat1 - zdat1
-            za3s(ji) =  1.0 - 2.0 * zgat1 + zdat1
-#endif
-
-            !-------------------turn off interior matching here------
-            !          za2(ji,1) = -2.0
-            !          za3(ji,1) =  1.0
-            !          za2(ji,2) = -2.0
-            !          za3(ji,2) =  1.0
-            !--------------------------------------------------------
-            
-            !  Compute Enhanced Mixing Coefficients (LMD94,eq D6)
-            ! ---------------------------------------------------------------
-            
-            ! Delta 
-            zdelta  = ( zhbl(ji)  - zdept(ji,1) ) / ( zdept(ji,2) - zdept(ji,1) + epsln )
-            zdelta2 = zdelta * zdelta
-            
-            !  Mixing coefficients at first level above h (zdept(ji,1)) 
-            ! and at first interface in the pipe (zdepw(ji,2))
-            
-            ! At first T level above h (zdept(ji,1)) (always in the boundary layer)
-            zsig    = zdept(ji,1) / zhbl(ji)
-            ztemp   = zstabl * zsig  + ( 1.0 - zstabl ) * MIN( zsig , epsilon )
-            zehat   = vonk * ztemp * zhbl(ji) * zbuofdep
-            zeta    = zehat / ( zucube + epsln)
-            zwst    = vonk * zustar(ji,jj) / ( ABS( 1.0 + rconc1 * zeta ) + epsln)
-            zwm     = zstabl * zwst + ( 1.0 - zstabl ) * zwm
-            zws     = zstabl * zwst + ( 1.0 - zstabl ) * zws
-
-            zkm1m  = zhbl(ji) * zwm * zsig * ( 1.0 + zsig * ( za2m(ji) + zsig * za3m(ji) ) )
-            zkm1t  = zhbl(ji) * zws * zsig * ( 1.0 + zsig * ( za2t(ji) + zsig * za3t(ji) ) )
-#if defined key_zdfddm
-            zkm1s  = zhbl(ji) * zws * zsig * ( 1.0 + zsig * ( za2s(ji) + zsig * za3s(ji) ) )
-#endif                        
-            ! At first W level in the pipe (zdepw(ji,2)) (not always in the boundary layer ):
-            zsig    = MIN( zdepw(ji,2) / zhbl(ji) , 1.0 )
-            ztemp   = zstabl * zsig + ( 1.0 - zstabl ) * MIN( zsig , epsilon )
-            zehat   = vonk * ztemp * zhbl(ji) * zbuofdep
-            zeta    = zehat / ( zucube + epsln )
-            zwst    = vonk * zustar(ji,jj) / ( ABS( 1.0 + rconc1 * zeta ) + epsln)
-            zws     = zstabl * zws + ( 1.0 - zstabl ) * zws
-            zwm     = zstabl * zws + ( 1.0 - zstabl ) * zwm
-
-            zkmpm(ji) = zhbl(ji) * zwm * zsig * ( 1.0 + zsig * ( za2m(ji) + zsig * za3m(ji) ) )
-            zkmpt(ji) = zhbl(ji) * zws * zsig * ( 1.0 + zsig * ( za2t(ji) + zsig * za3t(ji) ) )
-#if defined key_zdfddm
-            zkmps(ji) = zhbl(ji) * zws * zsig * ( 1.0 + zsig * ( za2s(ji) + zsig * za3s(ji) ) )
-#endif  
-      
-            ! check if this point is in the boundary layer,else take interior viscosity/diffusivity:
-            zflag       = 0.5 + SIGN( 0.5, ( zhbl(ji) - zdepw(ji,2) ) )
-            zkmpm(ji) = zkmpm(ji) * zflag + ( 1.0 - zflag ) * zvisc(ji,2)
-            zkmpt(ji) = zkmpt(ji) * zflag + ( 1.0 - zflag ) * zdift(ji,2)
-#if defined key_zdfddm
-            zkmps(ji) = zkmps(ji) * zflag + ( 1.0 - zflag ) * zdifs(ji,2)
-#endif
-
-            ! Enhanced viscosity/diffusivity at zdepw(ji,2)
-            ztemp     = ( 1.0 - 2.0 * zdelta + zdelta2 ) * zkm1m + zdelta2 * zkmpm(ji)
-            zkmpm(ji) = ( 1.0 - zdelta ) * zvisc(ji,2) + zdelta * ztemp
-            ztemp     = ( 1.0 - 2.0 * zdelta + zdelta2 ) * zkm1t + zdelta2 * zkmpt(ji)
-            zkmpt(ji) = ( 1.0 - zdelta ) * zdift(ji,2) + zdelta * ztemp
-#if defined key_zdfddm
-            ztemp     = ( 1.0 - 2.0 * zdelta + zdelta2 ) * zkm1s + zdelta2 * zkmps(ji)
-            zkmps(ji) = ( 1.0 - zdelta ) * zdifs(ji,2) + zdelta * ztemp
-#endif            
-
-         END DO
-         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-         ! IV. Compute vertical eddy viscosity and diffusivity coefficients
-         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-         
-         DO jk  = 2, jkmax
-            
-            ! Compute turbulent velocity scales on the interfaces
-            ! --------------------------------------------------------
-            DO  ji = fs_2, fs_jpim1
-               zbuofdep = zBo(ji,jj) + zBosol(ji,jj) * zatt1
-               zstabl   = 0.5 + SIGN( 0.5 , zbuofdep ) 
-               zbuofdep = zbuofdep + zstabl * epsln          
-               zsig    = fsdepw(ji,jj,jk) / zhbl(ji)
-               ztemp   = zstabl * zsig + ( 1. - zstabl ) * MIN( zsig , epsilon )
-               zehat   = vonk * ztemp * zhbl(ji) * zbuofdep
-               zucube  = zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj)
-               zeta    = zehat / ( zucube + epsln )
-
-               IF( zehat > 0. ) THEN
-                  ! Stable case
-                  zws  = vonk * zustar(ji,jj) / ( 1.0 + rconc1 * zeta )
-                  zwm  = zws
-               ELSE
-                  ! Unstable case
-#if defined key_kpplktb
-                  ! use lookup table
-                  zd     = zehat - dehatmin
-                  il     = INT( zd / dezehat )
-                  il     = MIN( il, nilktbm1 )
-                  il     = MAX( il, 1 )
-                  
-                  ud     = zustar(ji,jj) - ustmin
-                  jl     = INT( ud / deustar )
-                  jl     = MIN( jl, njlktbm1 )
-                  jl     = MAX( jl, 1 )
-                  
-                  zfrac  = zd / dezehat - FLOAT( il )  
-                  ufrac  = ud / deustar - FLOAT( jl )
-                  zwas   = ( 1. - zfrac ) * wslktb(il,jl+1) + zfrac * wslktb(il+1,jl+1)
-                  zwbs   = ( 1. - zfrac ) * wslktb(il,jl  ) + zfrac * wslktb(il+1,jl  )
-                  zwam   = ( 1. - zfrac ) * wmlktb(il,jl+1) + zfrac * wmlktb(il+1,jl+1)
-                  zwbm   = ( 1. - zfrac ) * wmlktb(il,jl  ) + zfrac * wmlktb(il+1,jl  )
-                  !
-                  zws    = ( 1. - ufrac ) * zwbs + ufrac * zwas
-                  zwm    = ( 1. - ufrac ) * zwbm + ufrac * zwam
-#else
-                  ! use analytical functions
-                  zconm  = 0.5 + SIGN( 0.5, ( rzetam - zeta) )
-                  zcons  = 0.5 + SIGN( 0.5, ( rzetas - zeta) )
-                  
-                  ! Momentum : zeta < rzetam (zconm = 1)
-                  ! Scalars  : zeta < rzetas (zcons = 1) 
-                  zwconm = zustar(ji,jj) * vonk * ( ( ABS( rconam - rconcm * zeta) )**pthird )
-                  zwcons = zustar(ji,jj) * vonk * ( ( ABS( rconas - rconcs * zeta) )**pthird )
-                  
-                  ! Momentum : rzetam <= zeta < 0 (zconm = 0)
-                  ! Scalars  : rzetas <= zeta < 0 (zcons = 0)	
-                  zwmun  = SQRT( ABS( 1.0 - rconc2 * zeta ) )
-                  zwsun  = vonk * zustar(ji,jj) * zwmun
-                  zwmun  = vonk * zustar(ji,jj) * SQRT(zwmun)
-                  !
-                  zwm    = zconm * zwconm + ( 1.0 - zconm ) * zwmun
-                  zws    = zcons * zwcons + ( 1.0 - zcons ) * zwsun
-                  
-#endif
-               ENDIF
-               
-               zblcm(ji,jk) = zhbl(ji) * zwm * zsig  * ( 1.0 + zsig * ( za2m(ji) + zsig * za3m(ji) ) )
-               zblct(ji,jk) = zhbl(ji) * zws * zsig  * ( 1.0 + zsig * ( za2t(ji) + zsig * za3t(ji) ) )
-#if defined key_zdfddm
-               zblcs(ji,jk) = zhbl(ji) * zws * zsig  * ( 1.0 + zsig * ( za2s(ji) + zsig * za3s(ji) ) )
-#endif              
-               !  Compute Nonlocal transport term = ghats * <ws>o
-               ! ----------------------------------------------------
-               ghats(ji,jj,jk-1) = ( 1. - zstabl ) * rcg / ( zws * zhbl(ji) + epsln ) * tmask(ji,jj,jk)
-
-            END DO
-         END DO     
-         !  Combine interior and boundary layer coefficients and nonlocal term
-         ! -----------------------------------------------------------------------
-         DO jk = 2, jpkm1   
-            DO ji = fs_2, fs_jpim1
-               zflag = zmask(ji,jk) * zmask(ji,jk+1)
-               zviscos(ji,jj,jk) = ( 1.0 - zmask(ji,jk) )         * avmu (ji,jj,jk) & ! interior viscosities
-                  &              +                        zflag   * zblcm(ji,jk    ) & ! boundary layer viscosities
-                  &              + zmask(ji,jk) * ( 1.0 - zflag ) * zkmpm(ji       )   ! viscosity enhancement at W_level near zhbl
-               
-               zviscos(ji,jj,jk) = zviscos(ji,jj,jk) * tmask(ji,jj,jk)   
-
-            
-               zdiffut(ji,jj,jk) = ( 1.0 - zmask(ji,jk) )          * avt (ji,jj,jk) & ! interior diffusivities 
-                  &              +                        zflag   * zblct(ji,jk   ) & ! boundary layer diffusivities
-                  &              + zmask(ji,jk) * ( 1.0 - zflag ) * zkmpt(ji      )   ! diffusivity enhancement at W_level near zhbl
-                       
-               zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) * tmask(ji,jj,jk) 
-#if defined key_zdfddm
-               zdiffus(ji,jj,jk) = ( 1.0 - zmask(ji,jk) )         * avs (ji,jj,jk) & ! interior diffusivities 
-                  &              +                        zflag   * zblcs(ji,jk   ) & ! boundary layer diffusivities
-                  &              + zmask(ji,jk) * ( 1.0 - zflag ) * zkmps(ji      )   ! diffusivity enhancement at W_level near zhbl
-               zdiffus(ji,jj,jk) = zdiffus(ji,jj,jk) * tmask(ji,jj,jk) 
-#endif               
-               ! Non local flux in the boundary layer only
-               ghats(ji,jj,jk-1) = zmask(ji,jk) * ghats(ji,jj,jk-1)
-
-            ENDDO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      ! Lateral boundary conditions on zvicos and zdiffus  (sign unchanged)
-      CALL lbc_lnk( zviscos(:,:,:), 'U', 1. )  ; CALL lbc_lnk( zdiffut(:,:,:), 'W', 1. )  
-#if defined key_zdfddm  
-      CALL lbc_lnk( zdiffus(:,:,:), 'W', 1. ) 
-#endif
-
-      SELECT CASE ( nn_ave )
-         !
-         CASE ( 0 )             ! no viscosity and diffusivity smoothing
-
-            DO jk = 2, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     avmu(ji,jj,jk) = ( zviscos(ji,jj,jk) + zviscos(ji+1,jj,jk) ) &
-                        &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk)
-                     
-                     avmv(ji,jj,jk) = ( zviscos(ji,jj,jk) + zviscos(ji,jj+1,jk) ) &
-                        &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk)
-                     
-                     avt (ji,jj,jk) =  zdiffut(ji,jj,jk) * tmask(ji,jj,jk)  
-#if defined key_zdfddm     
-                     avs (ji,jj,jk) =  zdiffus(ji,jj,jk) * tmask(ji,jj,jk)  
-#endif
-                  END DO
-               END DO
-            END DO
-            
-         CASE ( 1 )                ! viscosity and diffusivity smoothing
-            !                      
-            !           ( 1/2  1  1/2 )              ( 1/2  1/2 )             ( 1/2  1  1/2 )
-            ! avt = 1/8 ( 1    2  1   )   avmu = 1/4 ( 1    1   )   avmv= 1/4 ( 1/2  1  1/2 )
-            !           ( 1/2  1  1/2 )              ( 1/2  1/2 )
-  
-            DO jk = 2, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-
-                     avmu(ji,jj,jk) = (      zviscos(ji  ,jj  ,jk) + zviscos(ji+1,jj  ,jk)   &
-                        &              +.5*( zviscos(ji  ,jj-1,jk) + zviscos(ji+1,jj-1,jk)   &
-                        &                   +zviscos(ji  ,jj+1,jk) + zviscos(ji+1,jj+1,jk) ) ) * eumean(ji,jj,jk)
-                     
-                     avmv(ji,jj,jk) = (      zviscos(ji  ,jj  ,jk) + zviscos(ji  ,jj+1,jk)   &
-                        &              +.5*( zviscos(ji-1,jj  ,jk) + zviscos(ji-1,jj+1,jk)   &
-                        &                   +zviscos(ji+1,jj  ,jk) + zviscos(ji+1,jj+1,jk) ) ) * evmean(ji,jj,jk)
- 
-                     avt (ji,jj,jk) = ( .5*( zdiffut(ji-1,jj+1,jk) + zdiffut(ji-1,jj-1,jk)    &
-                        &                   +zdiffut(ji+1,jj+1,jk) + zdiffut(ji+1,jj-1,jk) )  &
-                        &              +1.*( zdiffut(ji-1,jj  ,jk) + zdiffut(ji  ,jj+1,jk)    &
-                        &                   +zdiffut(ji  ,jj-1,jk) + zdiffut(ji+1,jj  ,jk) )  &
-                        &              +2.*  zdiffut(ji  ,jj  ,jk)                          ) * etmean(ji,jj,jk)
-#if defined key_zdfddm   
-                     avs (ji,jj,jk) = ( .5*( zdiffus(ji-1,jj+1,jk) + zdiffus(ji-1,jj-1,jk)    &
-                        &                   +zdiffus(ji+1,jj+1,jk) + zdiffus(ji+1,jj-1,jk) )  &
-                        &              +1.*( zdiffus(ji-1,jj  ,jk) + zdiffus(ji  ,jj+1,jk)    &
-                        &                   +zdiffus(ji  ,jj-1,jk) + zdiffus(ji+1,jj  ,jk) )  &
-                        &              +2.*  zdiffus(ji  ,jj  ,jk)                          ) * etmean(ji,jj,jk)  
-#endif                
-                  END DO
-               END DO
-            END DO
-         
-         END SELECT
-
-         DO jk = 2, jpkm1                       ! vertical slab
-            !
-            !  Minimum value on the eddy diffusivity
-            ! ----------------------------------------
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  avt(ji,jj,jk) = MAX( avt(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
-#if defined key_zdfddm  
-                  avs(ji,jj,jk) = MAX( avs(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
-#endif
-               END DO
-            END DO
-
-            !
-            ! Minimum value on the eddy viscosity
-            ! ----------------------------------------
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), avmb(jk) ) * umask(ji,jj,jk)
-                  avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), avmb(jk) ) * vmask(ji,jj,jk)
-               END DO
-            END DO
-            !
-         END DO
-
-         ! Lateral boundary conditions on avt  (sign unchanged)
-         CALL lbc_lnk( hkpp(:,:), 'T', 1. )
-
-         ! Lateral boundary conditions on avt  (sign unchanged)
-         CALL lbc_lnk( avt(:,:,:), 'W', 1. )
-#if defined key_zdfddm  
-         CALL lbc_lnk( avs(:,:,:), 'W', 1. )  
-#endif
-         ! Lateral boundary conditions (avmu,avmv) (U- and V- points, sign unchanged)
-         CALL lbc_lnk( avmu(:,:,:), 'U', 1. )   ;    CALL lbc_lnk( avmv(:,:,:), 'V', 1. )  
- 
-         IF(ln_ctl) THEN
-#if defined key_zdfddm
-            CALL prt_ctl(tab3d_1=avt , clinfo1=' kpp - t: ', tab3d_2=avs , clinfo2=' s: ', ovlap=1, kdim=jpk)
-#else
-            CALL prt_ctl(tab3d_1=avt , clinfo1=' kpp - t: ', ovlap=1, kdim=jpk)
-#endif
-            CALL prt_ctl(tab3d_1=avmu, clinfo1=' kpp - u: ', mask1=umask,  &
-               &         tab3d_2=avmv, clinfo2=      ' v: ', mask2=vmask, ovlap=1, kdim=jpk)
-         ENDIF
-
-      CALL wrk_dealloc( jpi, zmoa, zekman, zhmax, zria, zhbl )
-      CALL wrk_dealloc( jpi, za2m, za3m, zkmpm, za2t, za3t, zkmpt )
-      CALL wrk_dealloc( jpi,2, zriblk )
-      CALL wrk_dealloc( jpi,3, zmoek, kjstart = 0 )
-      CALL wrk_dealloc( jpi,3, zdept )
-      CALL wrk_dealloc( jpi,4, zdepw, zdift, zvisc )
-      CALL wrk_dealloc( jpi,jpj, zBo, zBosol, zustar )
-      CALL wrk_dealloc( jpi,jpk, zmask, zblcm, zblct )
-#if defined key_zdfddm
-      CALL wrk_dealloc( jpi,4, zdifs )
-      CALL wrk_dealloc( jpi, zmoa, za2s, za3s, zkmps )
-      CALL wrk_dealloc( jpi,jpk, zblcs )
-      CALL wrk_dealloc( jpi,jpi,jpk, zdiffus )
-#endif
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('zdf_kpp')
-      !
-   END SUBROUTINE zdf_kpp
-
-
-   SUBROUTINE tra_kpp( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_kpp  ***
-      !!
-      !! ** Purpose :   compute and add to the tracer trend the non-local tracer flux
-      !!
-      !! ** Method  :   ???
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kt
-      INTEGER :: ji, jj, jk
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_kpp')
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*) 
-         IF(lwp) WRITE(numout,*) 'tra_kpp : KPP non-local tracer fluxes'
-         IF(lwp) WRITE(numout,*) '~~~~~~~   '
-      ENDIF
-
-      IF( l_trdtra )   THEN                    !* Save ta and sa trends
-         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
-         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
-      ENDIF
-
-      ! add non-local temperature and salinity flux ( in convective case only)
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1
-               tsa(ji,jj,jk,jp_tem) =  tsa(ji,jj,jk,jp_tem)                      &
-                  &                 - (  ghats(ji,jj,jk  ) * avt  (ji,jj,jk  )   & 
-                  &                    - ghats(ji,jj,jk+1) * avt  (ji,jj,jk+1) ) * wt0(ji,jj) / fse3t(ji,jj,jk)
-               tsa(ji,jj,jk,jp_sal) =  tsa(ji,jj,jk,jp_sal)                      &
-                  &                 - (  ghats(ji,jj,jk  ) * fsavs(ji,jj,jk  )   & 
-                  &                    - ghats(ji,jj,jk+1) * fsavs(ji,jj,jk+1) ) * ws0(ji,jj) / fse3t(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! save the non-local tracer flux trends for diagnostic
-      IF( l_trdtra )   THEN
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
-!!bug gm jpttdzdf ==> jpttkpp
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds )
-         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )
-      ENDIF
-
-      IF(ln_ctl) THEN
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' kpp  - Ta: ', mask1=tmask,   &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_kpp')
-      !
-   END SUBROUTINE tra_kpp
-
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   SUBROUTINE trc_kpp( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_kpp  ***
-      !!
-      !! ** Purpose :   compute and add to the tracer trend the non-local
-      !!                tracer flux
-      !!
-      !! ** Method  :   ???
-      !!
-      !! history :
-      !!            9.0  ! 2005-11 (G. Madec)  Original code
-      !!       NEMO 3.3  ! 2010-06 (C. Ethe )  Adapted to passive tracers
-      !!----------------------------------------------------------------------
-      USE trc
-      USE prtctl_trc          ! Print control
-      !
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk, jn      ! Dummy loop indices
-      CHARACTER (len=35) :: charout
-      REAL(wp) ::   ztra, zflx
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*) 
-         IF(lwp) WRITE(numout,*) 'trc_kpp : KPP non-local tracer fluxes'
-         IF(lwp) WRITE(numout,*) '~~~~~~~   '
-      ENDIF
-
-      IF( l_trdtrc )  ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-      !
-      DO jn = 1, jptra
-         !
-         IF( l_trdtrc )  ztrtrd(:,:,:)  = tra(:,:,:,jn)
-         ! add non-local on passive tracer flux ( in convective case only)
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1
-                  ! Surface tracer flux for non-local term 
-                  zflx = - ( sfx (ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1)
-                  ! compute the trend
-                  ztra = - ( ghats(ji,jj,jk  ) * fsavs(ji,jj,jk  )   &
-                  &        - ghats(ji,jj,jk+1) * fsavs(ji,jj,jk+1) ) * zflx / fse3t(ji,jj,jk)
-                  ! add the trend to the general trend
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)  + ztra
-               END DO
-            END DO
-         END DO
-         !
-         IF( l_trdtrc ) THEN         ! save the non-local tracer flux trends for diagnostic
-            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
-            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:) )
-         ENDIF
-         !
-      END DO
-      IF( l_trdtrc )  DEALLOCATE( ztrtrd )
-      IF( ln_ctl )   THEN
-         WRITE(charout, FMT="(' kpp')")  ;  CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
-      ENDIF
-      !
-   END SUBROUTINE trc_kpp
-
-#else
-   !!----------------------------------------------------------------------
-   !!   NO 'key_top'           DUMMY routine                  No TOP models
-   !!----------------------------------------------------------------------
-   SUBROUTINE trc_kpp( kt )         ! Dummy routine
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      WRITE(*,*) 'tra_kpp: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_kpp
-#endif
-
-   SUBROUTINE zdf_kpp_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE zdf_kpp_init  ***
-      !!                     
-      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
-      !!      viscosity when using a kpp turbulent closure scheme
-      !!
-      !! ** Method  :   Read the namkpp namelist and check the parameters
-      !!      called at the first timestep (nit000)
-      !!
-      !! ** input   :   Namlist namkpp
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk     ! dummy loop indices
-      INTEGER  ::   ios            ! local integer
-#if ! defined key_kppcustom
-      INTEGER  ::   jm             ! dummy loop indices     
-      REAL(wp) ::   zref, zdist    ! tempory scalars
-#endif
-#if defined key_kpplktb
-      REAL(wp) ::   zustar, zucube, zustvk, zeta, zehat   ! tempory scalars
-#endif
-      REAL(wp) ::   zhbf           ! tempory scalars
-      LOGICAL  ::   ll_kppcustom   ! 1st ocean level taken as surface layer
-      LOGICAL  ::   ll_kpplktb     ! Lookup table for turbul. velocity scales 
-      !!
-      NAMELIST/namzdf_kpp/ ln_kpprimix, rn_difmiw, rn_difsiw, rn_riinfty, rn_difri, rn_bvsqcon, rn_difcon, nn_ave
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('zdf_kpp_init')
-      !
-      REWIND( numnam_ref )              ! Namelist namzdf_kpp in reference namelist : Vertical eddy diffivity and viscosity using kpp turbulent closure scheme
-      READ  ( numnam_ref, namzdf_kpp, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_kpp in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namzdf_kpp in configuration namelist : Vertical eddy diffivity and viscosity using kpp turbulent closure scheme
-      READ  ( numnam_cfg, namzdf_kpp, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_kpp in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namzdf_kpp )
-
-      IF(lwp) THEN                    ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'zdf_kpp_init : K-Profile Parameterisation'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namzdf_kpp : set tke mixing parameters'
-         WRITE(numout,*) '     Shear instability mixing                      ln_kpprimix = ', ln_kpprimix
-         WRITE(numout,*) '     max. internal wave viscosity                  rn_difmiw   = ', rn_difmiw
-         WRITE(numout,*) '     max. internal wave diffusivity                rn_difsiw   = ', rn_difsiw
-         WRITE(numout,*) '     Richardson Number limit for shear instability rn_riinfty  = ', rn_riinfty
-         WRITE(numout,*) '     max. shear mixing at Rig = 0                  rn_difri    = ', rn_difri
-         WRITE(numout,*) '     Brunt-Vaisala squared for max. convection     rn_bvsqcon  = ', rn_bvsqcon
-         WRITE(numout,*) '     max. mix. in interior convec.                 rn_difcon   = ', rn_difcon
-         WRITE(numout,*) '     horizontal average flag                       nn_ave      = ', nn_ave
-      ENDIF
-
-      !                              ! allocate zdfkpp arrays
-      IF( zdf_kpp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_kpp_init : unable to allocate arrays' )
-
-      ll_kppcustom = .FALSE.
-      ll_kpplktb   = .FALSE.
-
-#if defined key_kppcustom
-      ll_kppcustom = .TRUE.
-#endif
-#if defined key_kpplktb
-      ll_kpplktb   = .TRUE.
-#endif
-      IF(lwp) THEN
-         WRITE(numout,*) '     Lookup table for turbul. velocity scales ll_kpplktb   = ', ll_kpplktb
-         WRITE(numout,*) '     1st ocean level taken as surface layer   ll_kppcustom = ', ll_kppcustom
-      ENDIF
-      
-      IF( lk_zdfddm) THEN
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) '    Double diffusion mixing on temperature and salinity '
-            WRITE(numout,*) '    CAUTION : done in routine zdfkpp, not in routine zdfddm '
-         ENDIF
-      ENDIF
-      
-
-      !set constants not in namelist
-      !-----------------------------
-      Vtc  = rconcv * SQRT( 0.2 / ( rconcs * epsilon ) ) / ( vonk * vonk * Ricr )
-      rcg  = rcstar * vonk * ( rconcs * vonk * epsilon )**pthird
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '     Constant value for unreso. turbul. velocity shear Vtc = ', Vtc
-         WRITE(numout,*) '     Non-dimensional coef. for nonlocal transport      rcg = ', rcg
-       ENDIF
-
-      ! ratt is the attenuation coefficient for solar flux
-      ! Should be different is s_coordinate
-      DO jk = 1, jpk
-         zhbf     = - fsdept(1,1,jk) * hbf
-         ratt(jk) = 1.0 - ( rabs * EXP( zhbf / xsi1 ) + ( 1.0 - rabs ) * EXP( zhbf / xsi2 ) )        
-      ENDDO
-
-      ! Horizontal average : initialization of weighting arrays 
-      ! -------------------
-      
-      SELECT CASE ( nn_ave )
-
-      CASE ( 0 )                ! no horizontal average
-         IF(lwp) WRITE(numout,*) '          no horizontal average on avt, avmu, avmv'
-         IF(lwp) WRITE(numout,*) '          only in very high horizontal resolution !'
-         ! weighting mean arrays etmean, eumean and evmean
-         !           ( 1  1 )                                          ( 1 )
-         ! avt = 1/4 ( 1  1 )     avmu = 1/2 ( 1  1 )       avmv=  1/2 ( 1 )
-         !                          
-         etmean(:,:,:) = 0.e0
-         eumean(:,:,:) = 0.e0
-         evmean(:,:,:) = 0.e0
-         
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1   ! vector opt.
-                  etmean(ji,jj,jk) = tmask(ji,jj,jk)                     &
-                  &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   &
-                  &            + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  )
-                  
-                  eumean(ji,jj,jk) = umask(ji,jj,jk)                     &
-                  &  / MAX( 1.,  tmask(ji,jj,jk) + tmask(ji+1,jj  ,jk)  )
-
-                  evmean(ji,jj,jk) = vmask(ji,jj,jk)                     &
-                  &  / MAX( 1.,  tmask(ji,jj,jk) + tmask(ji  ,jj+1,jk)  )
-               END DO
-            END DO
-         END DO
-
-      CASE ( 1 )                ! horizontal average 
-         IF(lwp) WRITE(numout,*) '          horizontal average on avt, avmu, avmv'
-         ! weighting mean arrays etmean, eumean and evmean
-         !           ( 1/2  1  1/2 )              ( 1/2  1/2 )             ( 1/2  1  1/2 )
-         ! avt = 1/8 ( 1    2  1   )   avmu = 1/4 ( 1    1   )   avmv= 1/4 ( 1/2  1  1/2 )
-         !           ( 1/2  1  1/2 )              ( 1/2  1/2 )
-         etmean(:,:,:) = 0.e0
-         eumean(:,:,:) = 0.e0
-         evmean(:,:,:) = 0.e0
-         
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  etmean(ji,jj,jk) = tmask(ji, jj,jk)                           &
-                     & / MAX( 1., 2.* tmask(ji,jj,jk)                           &
-                     &      +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk)   &
-                     &             +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) &
-                     &      +1. * ( tmask(ji-1,jj  ,jk) + tmask(ji  ,jj+1,jk)   &
-                     &             +tmask(ji  ,jj-1,jk) + tmask(ji+1,jj  ,jk) ) )
-                  
-                  eumean(ji,jj,jk) = umask(ji,jj,jk)                        &
-                     &  / MAX( 1.,   tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk)   &
-                     &       +.5 * ( tmask(ji,jj-1,jk) + tmask(ji+1,jj-1,jk)   &
-                     &              +tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) )  )
-                  
-                  evmean(ji,jj,jk) = vmask(ji,jj,jk)                        &
-                     &  / MAX( 1.,   tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
-                     &       +.5 * ( tmask(ji-1,jj,jk) + tmask(ji-1,jj+1,jk)   &
-                     &              +tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) )  )
-               END DO
-            END DO
-         END DO
-
-      CASE DEFAULT
-         WRITE(ctmp1,*) '          bad flag value for nn_ave = ', nn_ave
-         CALL ctl_stop( ctmp1 )
-
-      END SELECT
- 
-      ! Initialization of vertical eddy coef. to the background value
-      ! -------------------------------------------------------------
-      DO jk = 1, jpk
-         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
-         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
-         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
-      END DO
-
-      ! zero the surface flux for non local term and kpp mixed layer depth
-      ! ------------------------------------------------------------------
-      ghats(:,:,:) = 0.
-      wt0  (:,:  ) = 0.
-      ws0  (:,:  ) = 0.
-      hkpp (:,:  ) = 0. ! just a diagnostic (not essential)
-
-#if ! defined key_kppcustom
-      ! compute arrays (del, wz) for reference mean values 
-      ! (increase speed for vectorization key_kppcustom not defined)
-      del(1:jpk, 1:jpk) = 0.
-      DO jk = 1, jpk
-         zref = epsilon * fsdept(1,1,jk)    
-         DO jm = 1 , jpk
-            zdist = zref - fsdepw(1,1,jm)   
-            IF( zdist > 0.  ) THEN
-               del(jk,jm) = MIN( zdist, fse3t(1,1,jm) ) / zref   
-            ELSE
-               del(jk,jm) = 0.
-            ENDIF
-         ENDDO
-      ENDDO
-#endif
-
-#if defined key_kpplktb
-      ! build lookup table for turbulent velocity scales
-      dezehat = ( dehatmax - dehatmin ) / nilktbm1
-      deustar = ( ustmax   - ustmin   ) / njlktbm1
- 
-      DO jj = 1, njlktb
-         zustar = ( jj - 1) * deustar + ustmin
-         zustvk = vonk * zustar 
-         zucube = zustar * zustar * zustar 
-         DO ji = 1 , nilktb
-            zehat = ( ji - 1 ) * dezehat + dehatmin
-            zeta   = zehat / ( zucube + epsln )
-            IF( zehat >= 0 ) THEN             ! Stable case
-               wmlktb(ji,jj) = zustvk / ABS( 1.0 + rconc1 * zeta + epsln )                        
-               wslktb(ji,jj) = wmlktb(ji,jj)
-            ELSE                                ! Unstable case 
-               IF( zeta > rzetam ) THEN
-                  wmlktb(ji,jj) = zustvk * ABS( 1.0    - rconc2 * zeta )**pfourth
-               ELSE
-                  wmlktb(ji,jj) = zustvk * ABS( rconam - rconcm * zeta )**pthird
-               ENDIF
-               
-               IF( zeta > rzetas ) THEN
-                  wslktb(ji,jj) = zustvk * SQRT( ABS( 1.0 - rconc2 * zeta ) )
-               ELSE
-                  wslktb(ji,jj) = zustvk * ABS( rconas - rconcs * zeta )**pthird
-               ENDIF
-            ENDIF
-         END DO
-      END DO
-#endif
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('zdf_kpp_init')
-      !
-   END SUBROUTINE zdf_kpp_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                                        NO KPP scheme
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfkpp = .FALSE.   !: KPP flag
-CONTAINS
-   SUBROUTINE zdf_kpp_init           ! Dummy routine
-      WRITE(*,*) 'zdf_kpp_init: You should not have seen this print! error?'
-   END SUBROUTINE zdf_kpp_init
-   SUBROUTINE zdf_kpp( kt )          ! Dummy routine
-      WRITE(*,*) 'zdf_kpp: You should not have seen this print! error?', kt
-   END SUBROUTINE zdf_kpp
-   SUBROUTINE tra_kpp( kt )          ! Dummy routine
-      WRITE(*,*) 'tra_kpp: You should not have seen this print! error?', kt
-   END SUBROUTINE tra_kpp
-   SUBROUTINE trc_kpp( kt )          ! Dummy routine
-      WRITE(*,*) 'trc_kpp: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_kpp
-#endif
-
-   !!======================================================================
-END MODULE zdfkpp
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 5901)
@@ -13,5 +13,5 @@
    !!            3.3.1! 2011-09  (P. Oddo) Mixed layer depth parameterization
    !!----------------------------------------------------------------------
-#if defined key_zdfric   ||   defined key_esopa
+#if defined key_zdfric
    !!----------------------------------------------------------------------
    !!   'key_zdfric'                                             Kz = f(Ri)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 5901)
@@ -28,5 +28,5 @@
    !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
    !!----------------------------------------------------------------------
-#if defined key_zdftke   ||   defined key_esopa
+#if defined key_zdftke
    !!----------------------------------------------------------------------
    !!   'key_zdftke'                                   TKE vertical physics
@@ -53,4 +53,8 @@
    USE timing         ! Timing
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+#if defined key_agrif
+   USE agrif_opa_interp
+   USE agrif_opa_update
+#endif
 
    IMPLICIT NONE
@@ -85,9 +89,7 @@
    REAL(wp) ::   rhftau_scl = 1.0_wp       ! scale factor applied to HF part of taum  (nn_etau=3)
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy   [m2/s2]
    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau)
    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   apdlr          ! now mixing lenght of dissipation
 #if defined key_c1d
    !                                                                        !!** 1D cfg only  **   ('key_c1d')
@@ -100,5 +102,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -115,7 +117,6 @@
          &      e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) ,                          &
 #endif
-         &      en    (jpi,jpj,jpk) , htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     & 
-         &      avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk),                          &
-         &      avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), STAT= zdf_tke_alloc      )
+         &      htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     & 
+         &      apdlr(jpi,jpj,jpk) ,                                           STAT= zdf_tke_alloc      )
          !
       IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc )
@@ -173,4 +174,9 @@
       !!----------------------------------------------------------------------
       !
+#if defined key_agrif 
+      ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2)
+      IF( .NOT.Agrif_Root() )   CALL Agrif_Tke
+#endif
+      !
       IF( kt /= nit000 ) THEN   ! restore before value to compute tke
          avt (:,:,:) = avt_k (:,:,:) 
@@ -189,5 +195,10 @@
       avmv_k(:,:,:) = avmv(:,:,:) 
       !
-   END SUBROUTINE zdf_tke
+#if defined key_agrif
+      ! Update child grid f => parent grid 
+      IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke( kt )      ! children only
+#endif      
+     ! 
+  END SUBROUTINE zdf_tke
 
 
@@ -221,14 +232,15 @@
       REAL(wp) ::   zzd_up, zzd_lw                  !    -         -
 !!bfr      REAL(wp) ::   zebot                           !    -         -
-      INTEGER , POINTER, DIMENSION(:,:  ) :: imlc
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zhlc
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw
+      INTEGER , POINTER, DIMENSION(:,:  ) ::   imlc
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhlc
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zpelc, zdiag, zd_up, zd_lw, z3du, z3dv
+      REAL(wp)                            ::   zri  !   local Richardson number
       !!--------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tke_tke')
       !
-      CALL wrk_alloc( jpi,jpj, imlc )    ! integer
-      CALL wrk_alloc( jpi,jpj, zhlc ) 
-      CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 
+      CALL wrk_alloc( jpi,jpj,       imlc )    ! integer
+      CALL wrk_alloc( jpi,jpj,       zhlc ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 
       !
       zbbrau = rn_ebb / rau0       ! Local constant initialisation
@@ -244,5 +256,5 @@
          DO jj = 2, jpjm1            ! en(mikt(ji,jj))   = rn_emin
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               en(ji,jj,mikt(ji,jj))=rn_emin * tmask(ji,jj,1)
+               en(ji,jj,mikt(ji,jj)) = rn_emin * tmask(ji,jj,1)
             END DO
          END DO
@@ -265,7 +277,5 @@
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !                     en(bot)   = (rn_ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin)
-!CDIR NOVERRCHK
 !!    DO jj = 2, jpjm1
-!CDIR NOVERRCHK
 !!       DO ji = fs_2, fs_jpim1   ! vector opt.
 !!          ztx2 = bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) + &
@@ -306,9 +316,6 @@
          END DO
          zcof = 0.016 / SQRT( zrhoa * zcdrag )
-!CDIR NOVERRCHK
          DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en
-!CDIR NOVERRCHK
-            DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+            DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift
@@ -332,18 +339,37 @@
       !
       DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form)
-         DO jj = 1, jpj                 ! here avmu, avmv used as workspace
-            DO ji = 1, jpi
-               avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   &
-                  &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   & 
-                  &                            / (  fse3uw_n(ji,jj,jk)               &
-                  &                              *  fse3uw_b(ji,jj,jk)  )
-               avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   &
-                  &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   &
-                  &                            / (  fse3vw_n(ji,jj,jk)               &
-                  &                              *  fse3vw_b(ji,jj,jk)  )
-            END DO
-         END DO
-      END DO
-      !
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               z3du(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji+1,jj,jk) )   &
+                  &                 * (  un(ji,jj,jk-1) -  un(ji  ,jj,jk) )   &
+                  &                 * (  ub(ji,jj,jk-1) -  ub(ji  ,jj,jk) ) * wumask(ji,jj,jk) &
+                  &                 / (  fse3uw_n(ji,jj,jk) * fse3uw_b(ji,jj,jk) )
+               z3dv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji,jj+1,jk) )   &
+                  &                 * (  vn(ji,jj,jk-1) -  vn(ji,jj  ,jk) )   &
+                  &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj  ,jk) ) * wvmask(ji,jj,jk) &
+                  &                 / (  fse3vw_n(ji,jj,jk) * fse3vw_b(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      !
+      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: compute apdlr
+         ! Note that zesh2 is also computed in the next loop.
+         ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !                                          ! shear prod. at w-point weightened by mask
+                  zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                     &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
+                  !                                          ! local Richardson number
+                  zri   = MAX( rn2b(ji,jj,jk), 0._wp ) * avm(ji,jj,jk) / ( zesh2 + rn_bshear )
+                  apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  )
+                  
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      !         
       DO jk = 2, jpkm1           !* Matrix and right hand side in en
          DO jj = 2, jpjm1
@@ -354,8 +380,8 @@
                zzd_lw = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &  ! lower diagonal
                   &          / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
-                  !                                                           ! shear prod. at w-point weightened by mask
-               zesh2  =  ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
-                  &    + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
-                  !
+               !                                   ! shear prod. at w-point weightened by mask
+               zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                  &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
+               !
                zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw)
                zd_lw(ji,jj,jk) = zzd_lw
@@ -377,7 +403,5 @@
          END DO
       END DO
-      !
-      ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
-      DO jj = 2, jpjm1
+      DO jj = 2, jpjm1                             ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
          DO ji = fs_2, fs_jpim1   ! vector opt.
             zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke
@@ -391,7 +415,5 @@
          END DO
       END DO
-      !
-      ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
-      DO jj = 2, jpjm1
+      DO jj = 2, jpjm1                             ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
          DO ji = fs_2, fs_jpim1   ! vector opt.
             en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1)
@@ -434,9 +456,6 @@
          END DO
       ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability)
-!CDIR NOVERRCHK
          DO jk = 2, jpkm1
-!CDIR NOVERRCHK
-            DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+            DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
@@ -453,7 +472,7 @@
       CALL lbc_lnk( en, 'W', 1. )      ! Lateral boundary conditions (sign unchanged)
       !
-      CALL wrk_dealloc( jpi,jpj, imlc )    ! integer
-      CALL wrk_dealloc( jpi,jpj, zhlc ) 
-      CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 
+      CALL wrk_dealloc( jpi,jpj,       imlc )    ! integer
+      CALL wrk_dealloc( jpi,jpj,       zhlc ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,   zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tke_tke')
@@ -499,5 +518,5 @@
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   zrn2, zraug, zcoef, zav     ! local scalars
-      REAL(wp) ::   zdku, zpdlr, zri, zsqen     !   -      -
+      REAL(wp) ::   zdku, zri, zsqen            !   -      -
       REAL(wp) ::   zdkv, zemxl, zemlm, zemlp   !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld
@@ -529,12 +548,9 @@
       ENDIF
       !
-!CDIR NOVERRCHK
       DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2)
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zrn2 = MAX( rn2(ji,jj,jk), rsmall )
-               zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) )
+               zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  )
             END DO
          END DO
@@ -543,9 +559,10 @@
       !                     !* Physical limits for the mixing length
       !
-      zmxld(:,:,1  ) = zmxlm(:,:,1)   ! surface set to the minimum value 
+      zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the minimum value 
       zmxld(:,:,jpk) = rmxl_min       ! last level  set to the minimum value
       !
       SELECT CASE ( nn_mxl )
       !
+ !!gm Not sure of that coding for ISF....
       ! where wmask = 0 set zmxlm == fse3w
       CASE ( 0 )           ! bounded by the distance to surface and bottom
@@ -606,9 +623,6 @@
             END DO
          END DO
-!CDIR NOVERRCHK
          DO jk = 2, jpkm1
-!CDIR NOVERRCHK
-            DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+            DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) )
@@ -630,9 +644,6 @@
       !                     !  Vertical eddy viscosity and diffusivity  (avmu, avmv, avt)
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-!CDIR NOVERRCHK
       DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zsqen = SQRT( en(ji,jj,jk) )
@@ -660,19 +671,10 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zcoef = avm(ji,jj,jk) * 2._wp * fse3w(ji,jj,jk) * fse3w(ji,jj,jk)
-                  !                                          ! shear
-                  zdku = avmu(ji-1,jj,jk) * ( un(ji-1,jj,jk-1) - un(ji-1,jj,jk) ) * ( ub(ji-1,jj,jk-1) - ub(ji-1,jj,jk) )   &
-                    &  + avmu(ji  ,jj,jk) * ( un(ji  ,jj,jk-1) - un(ji  ,jj,jk) ) * ( ub(ji  ,jj,jk-1) - ub(ji  ,jj,jk) )
-                  zdkv = avmv(ji,jj-1,jk) * ( vn(ji,jj-1,jk-1) - vn(ji,jj-1,jk) ) * ( vb(ji,jj-1,jk-1) - vb(ji,jj-1,jk) )   &
-                    &  + avmv(ji,jj  ,jk) * ( vn(ji,jj  ,jk-1) - vn(ji,jj  ,jk) ) * ( vb(ji,jj  ,jk-1) - vb(ji,jj  ,jk) )
-                  !                                          ! local Richardson number
-                  zri   = MAX( rn2b(ji,jj,jk), 0._wp ) * zcoef / (zdku + zdkv + rn_bshear )
-                  zpdlr = MAX(  0.1_wp,  0.2 / MAX( 0.2 , zri )  )
-!!gm and even better with the use of the "true" ri_crit=0.22222...  (this change the results!)
-!!gm              zpdlr = MAX(  0.1_wp,  ri_crit / MAX( ri_crit , zri )  )
-                  avt(ji,jj,jk)   = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
+                  avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
 # if defined key_c1d
-                  e_pdl(ji,jj,jk) = zpdlr * wmask(ji,jj,jk)  ! c1d configuration : save masked Prandlt number
-                  e_ric(ji,jj,jk) = zri   * wmask(ji,jj,jk)  ! c1d config. : save Ri
+                  e_pdl(ji,jj,jk) = apdlr(ji,jj,jk) * wmask(ji,jj,jk)    ! c1d configuration : save masked Prandlt number
+!!gm bug NO zri here....
+!!gm remove the specific diag for c1d !
+                  e_ric(ji,jj,jk) = zri * wmask(ji,jj,jk)                            ! c1d config. : save Ri
 # endif
               END DO
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 5901)
@@ -8,5 +8,5 @@
    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
-#if defined key_zdftmx   ||   defined key_esopa
+#if defined key_zdftmx
    !!----------------------------------------------------------------------
    !!   'key_zdftmx'                                  Tidal vertical mixing
@@ -54,5 +54,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -105,17 +105,17 @@
       !!              Koch-Larrouy et al. 2007, GRL.
       !!----------------------------------------------------------------------
-      USE oce, zav_tide  =>   ua    ! use ua as workspace
-      !!
       INTEGER, INTENT(in) ::   kt   ! ocean time-step 
-      !!
+      !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   ztpc         ! scalar workspace
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zkz
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkz
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zav_tide
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('zdf_tmx')
       !
-      CALL wrk_alloc( jpi,jpj, zkz )
-
+      CALL wrk_alloc( jpi,jpj,       zkz )
+      CALL wrk_alloc( jpi,jpj,jpk,   zav_tide )
+      !
       !                          ! ----------------------- !
       !                          !  Standard tidal mixing  !  (compute zav_tide)
@@ -136,22 +136,19 @@
 
       DO jk = 2, jpkm1     !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s
-         DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
-            DO ji = 1, jpi
-               zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk)  !kz max = 300 cm2/s
-            END DO
-         END DO
+         zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s
       END DO
 
       IF( kt == nit000 ) THEN       !* check at first time-step: diagnose the energy consumed by zav_tide
-         ztpc = 0.e0
+         ztpc = 0._wp
          DO jk= 1, jpk
             DO jj= 1, jpj
                DO ji= 1, jpi
-                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj)   &
-                     &         * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj)                  &
+                     &        * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
             END DO
          END DO
          ztpc= rau0 / ( rn_tfe * rn_me ) * ztpc
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
          IF(lwp) WRITE(numout,*) 
          IF(lwp) WRITE(numout,*) '          N Total power consumption by av_tide    : ztpc = ', ztpc * 1.e-12 ,'TW'
@@ -167,13 +164,6 @@
       !                          ! ----------------------- !
       DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing
-         DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
-            DO ji = 1, jpi
-               avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk)
-               avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      
-      DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing
+         avt(:,:,jk) = avt(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk)
+         avm(:,:,jk) = avm(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1  ! vector opt.
@@ -190,5 +180,6 @@
       IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_tide , clinfo1=' tmx - av_tide: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk)
       !
-      CALL wrk_dealloc( jpi,jpj, zkz )
+      CALL wrk_dealloc( jpi,jpj,       zkz )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zav_tide )
       !
       IF( nn_timing == 1 )  CALL timing_stop('zdf_tmx')
@@ -239,5 +230,4 @@
       DO jk = 1, jpkm1             
          zdn2dz     (:,:,jk) = rn2(:,:,jk) - rn2(:,:,jk+1)           ! Vertical profile of dN2/dz
-!CDIR NOVERRCHK
          zempba_3d_1(:,:,jk) = SQRT(  MAX( 0.e0, rn2(:,:,jk) )  )    !    -        -    of N
          zempba_3d_2(:,:,jk) =        MAX( 0.e0, rn2(:,:,jk) )       !    -        -    of N^2
@@ -248,6 +238,6 @@
       zsum2(:,:) = 0.e0
       DO jk= 2, jpk
-         zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * fse3w(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1)
-         zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * fse3w(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1)               
+         zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * fse3w(:,:,jk) * wmask(:,:,jk)
+         zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * fse3w(:,:,jk) * wmask(:,:,jk)               
       END DO
       DO jj = 1, jpj
@@ -285,5 +275,5 @@
       zkz(:,:) = 0.e0               ! Associated potential energy consummed over the whole water column
       DO jk = 2, jpkm1
-         zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1)
+         zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk)
       END DO
 
@@ -295,5 +285,5 @@
 
       DO jk = 2, jpkm1              ! Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zavt_itf bound by 300 cm2/s
-         zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * tmask(:,:,jk) * tmask(:,:,jk-1)   ! kz max = 120 cm2/s
+         zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * wmask(:,:,jk)   ! kz max = 120 cm2/s
       END DO
 
@@ -303,9 +293,10 @@
             DO jj= 1, jpj
                DO ji= 1, jpi
-                  ztpc = ztpc + e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   &
-                     &                     * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  ztpc = ztpc + e1e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   &
+                     &                       * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
             END DO
          END DO
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
          ztpc= rau0 * ztpc / ( rn_me * rn_tfe_itf )
          IF(lwp) WRITE(numout,*) '          N Total power consumption by zavt_itf: ztpc = ', ztpc * 1.e-12 ,'TW'
@@ -361,15 +352,13 @@
       !!              Koch-Larrouy et al. 2007, GRL.
       !!----------------------------------------------------------------------
-      USE oce     ,         zav_tide =>  ua         ! ua used as workspace
-      !!
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       INTEGER  ::   inum         ! local integer
       INTEGER  ::   ios
       REAL(wp) ::   ztpc, ze_z   ! local scalars
-      REAL(wp), DIMENSION(:,:)  , POINTER ::  zem2, zek1   ! read M2 and K1 tidal energy
-      REAL(wp), DIMENSION(:,:)  , POINTER ::  zkz          ! total M2, K1 and S2 tidal energy
-      REAL(wp), DIMENSION(:,:)  , POINTER ::  zfact        ! used for vertical structure function
-      REAL(wp), DIMENSION(:,:)  , POINTER ::  zhdep        ! Ocean depth 
-      REAL(wp), DIMENSION(:,:,:), POINTER ::  zpc      ! power consumption
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zem2, zek1     ! read M2 and K1 tidal energy
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zkz            ! total M2, K1 and S2 tidal energy
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zfact          ! used for vertical structure function
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zhdep          ! Ocean depth 
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  zpc, zav_tide  ! power consumption
       !!
       NAMELIST/namzdf_tmx/ rn_htmx, rn_n2min, rn_tfe, rn_me, ln_tmx_itf, rn_tfe_itf
@@ -378,17 +367,17 @@
       IF( nn_timing == 1 )  CALL timing_start('zdf_tmx_init')
       !
-      CALL wrk_alloc( jpi,jpj, zem2, zek1, zkz, zfact, zhdep )
-      CALL wrk_alloc( jpi,jpj,jpk, zpc )
-      
-      REWIND( numnam_ref )              ! Namelist namzdf_tmx in reference namelist : Tidal Mixing
+      CALL wrk_alloc( jpi,jpj,       zem2, zek1, zkz, zfact, zhdep )
+      CALL wrk_alloc( jpi,jpj,jpk,   zpc, zav_tide )
+      !
+      REWIND( numnam_ref )             ! Namelist namzdf_tmx in reference namelist : Tidal Mixing
       READ  ( numnam_ref, namzdf_tmx, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namzdf_tmx in configuration namelist : Tidal Mixing
+      !
+      REWIND( numnam_cfg )             ! Namelist namzdf_tmx in configuration namelist : Tidal Mixing
       READ  ( numnam_cfg, namzdf_tmx, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namzdf_tmx )
-
-      IF(lwp) THEN                   ! Control print
+      !
+      IF(lwp) THEN                     ! Control print
          WRITE(numout,*)
          WRITE(numout,*) 'zdf_tmx_init : tidal mixing'
@@ -402,33 +391,31 @@
          WRITE(numout,*) '      ITF tidal dissipation efficiency      = ', rn_tfe_itf
       ENDIF
-
-      !                              ! allocate tmx arrays
+      !                                ! allocate tmx arrays
       IF( zdf_tmx_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tmx_init : unable to allocate tmx arrays' )
 
-      IF( ln_tmx_itf ) THEN          ! read the Indonesian Through Flow mask
+      IF( ln_tmx_itf ) THEN            ! read the Indonesian Through Flow mask
          CALL iom_open('mask_itf',inum)
          CALL iom_get (inum, jpdom_data, 'tmaskitf',mask_itf,1) ! 
          CALL iom_close(inum)
       ENDIF
-
-      ! read M2 tidal energy flux : W/m2  ( zem2 < 0 )
+      !                                ! read M2 tidal energy flux : W/m2  ( zem2 < 0 )
       CALL iom_open('M2rowdrg',inum)
       CALL iom_get (inum, jpdom_data, 'field',zem2,1) ! 
       CALL iom_close(inum)
-
-      ! read K1 tidal energy flux : W/m2  ( zek1 < 0 )
+      !                                ! read K1 tidal energy flux : W/m2  ( zek1 < 0 )
       CALL iom_open('K1rowdrg',inum)
       CALL iom_get (inum, jpdom_data, 'field',zek1,1) ! 
       CALL iom_close(inum)
- 
-      ! Total tidal energy ( M2, S2 and K1  with S2=(1/2)^2 * M2 )
-      ! only the energy available for mixing is taken into account,
-      ! (mixing efficiency tidal dissipation efficiency)
+      !                                ! Total tidal energy ( M2, S2 and K1  with S2=(1/2)^2 * M2 )
+      !                                ! only the energy available for mixing is taken into account,
+      !                                ! (mixing efficiency tidal dissipation efficiency)
       en_tmx(:,:) = - rn_tfe * rn_me * ( zem2(:,:) * 1.25 + zek1(:,:) ) * ssmask(:,:)
 
 !============
 !TG: Bug for VVL? Should this section be moved out of _init and be updated at every timestep?
-      ! Vertical structure (az_tmx)
-      DO jj = 1, jpj                ! part independent of the level
+!!gm : you are right, but tidal mixing acts in deep ocean (H>500m) where e3 is O(100m)
+!!     the error is thus ~1% which I feel comfortable with, compared to uncertainties in tidal energy dissipation.
+      !                                ! Vertical structure (az_tmx)
+      DO jj = 1, jpj                         ! part independent of the level
          DO ji = 1, jpi
             zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean
@@ -437,5 +424,5 @@
          END DO
       END DO
-      DO jk= 1, jpk                 ! complete with the level-dependent part
+      DO jk= 1, jpk                          ! complete with the level-dependent part
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -445,5 +432,5 @@
       END DO
 !===========
-
+      !
       IF( nprint == 1 .AND. lwp ) THEN
          ! Control print
@@ -454,29 +441,25 @@
             zav_tide(:,:,jk) = az_tmx(:,:,jk) / MAX( rn_n2min, rn2(:,:,jk) )
          END DO
-
-         ztpc = 0.e0
+         !
+         ztpc = 0._wp
          zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:)
          DO jk= 2, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
+                  ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
             END DO
          END DO
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
          ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc
-
+         !
          WRITE(numout,*) 
          WRITE(numout,*) '          Total power consumption of the tidally driven part of Kz : ztpc = ', ztpc * 1.e-12 ,'TW'
-
-
+         !
          ! control print 2
          zav_tide(:,:,:) = MIN( zav_tide(:,:,:), 60.e-4 )   
-         zkz(:,:) = 0.e0
+         zkz(:,:) = 0._wp
          DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk) * MAX(0.e0, rn2(ji,jj,jk)) * rau0 * zav_tide(ji,jj,jk) * wmask(ji,jj,jk)
-               END DO
-            END DO
+               zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk)
          END DO
          ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz
@@ -497,31 +480,28 @@
          END DO
          WRITE(numout,*) '          Min de zkz ', ztpc, ' Max = ', maxval(zkz(:,:) )
-
+         !
          DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk)  !kz max = 300 cm2/s
-               END DO
-            END DO
-         END DO
-         ztpc = 0.e0
+            zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s
+         END DO
+         ztpc = 0._wp
          zpc(:,:,:) = Max(0.e0,rn2(:,:,:)) * zav_tide(:,:,:)
          DO jk= 1, jpk
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
+                  ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
             END DO
          END DO
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
          ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc
          WRITE(numout,*) '          2 Total power consumption of the tidally driven part of Kz : ztpc = ', ztpc * 1.e-12 ,'TW'
-
+!!gm bug mpp  in these diagnostics
          DO jk = 1, jpk
-            ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zav_tide(:,:,jk)     * tmask_i(:,:) )   &
-               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) )
-            ztpc = 1.E50
+            ze_z =                  SUM( e1e2t(:,:) * zav_tide(:,:,jk) * tmask_i(:,:) )   &
+               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask   (:,:,jk) * tmask_i(:,:) ) )
+            ztpc = 1.e50
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  IF( zav_tide(ji,jj,jk) /= 0.e0 )   ztpc =Min( ztpc, zav_tide(ji,jj,jk) )
+                  IF( zav_tide(ji,jj,jk) /= 0.e0 )   ztpc = MIN( ztpc, zav_tide(ji,jj,jk) )
                END DO
             END DO
@@ -530,5 +510,5 @@
          END DO
 
-         WRITE(numout,*) '          e_tide : ', SUM( e1t*e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW'
+         WRITE(numout,*) '          e_tide : ', SUM( e1e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW'
          WRITE(numout,*) 
          WRITE(numout,*) '          Initial profile of tidal vertical mixing'
@@ -539,16 +519,17 @@
                END DO
             END DO
-            ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zkz(:,:)     * tmask_i(:,:) )   &
-               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) )
+            ze_z =                  SUM( e1e2t(:,:) * zkz  (:,:)    * tmask_i(:,:) )   &
+               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) )
             WRITE(numout,*) '                jk= ', jk,'   ', ze_z * 1.e4,' cm2/s'
          END DO
          DO jk = 1, jpk
             zkz(:,:) = az_tmx(:,:,jk) /rn_n2min
-            ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zkz(:,:)     * tmask_i(:,:) )   &
-               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) )
+            ze_z =                  SUM( e1e2t(:,:) * zkz  (:,:)    * tmask_i(:,:) )   &
+               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) )
             WRITE(numout,*) 
             WRITE(numout,*) '          N2 min - jk= ', jk,'   ', ze_z * 1.e4,' cm2/s min= ',MINVAL(zkz)*1.e4,   &
                &       'max= ', MAXVAL(zkz)*1.e4, ' cm2/s'
          END DO
+!!gm  end bug mpp
          !
       ENDIF
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 5901)
@@ -28,6 +28,9 @@
    !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
-   !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE
-   !!                 ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
+   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms
+   !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE
+   !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
+   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 
+   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla)
    !!----------------------------------------------------------------------
 
@@ -41,6 +44,5 @@
    !!   factorise      : calculate the factors of the no. of MPI processes
    !!----------------------------------------------------------------------
-   USE step_oce        ! module used in the ocean time stepping module
-   USE cla             ! cross land advection               (tra_cla routine)
+   USE step_oce        ! module used in the ocean time stepping module (step.F90)
    USE domcfg          ! domain configuration               (dom_cfg routine)
    USE mppini          ! shared/distributed memory setting (mpp_init routine)
@@ -77,10 +79,10 @@
    USE lib_mpp         ! distributed memory computing
 #if defined key_iomput
-   USE xios
-#endif
-   USE sbctide, ONLY: lk_tide
+   USE xios            ! xIOserver
+#endif
+   USE sbctide, ONLY   : lk_tide
    USE crsini          ! initialise grid coarsening utility
-   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
-   USE sbc_oce, ONLY: lk_oasis
+   USE lbcnfd , ONLY   : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
+   USE sbc_oce, ONLY   : lk_oasis
    USE stopar
    USE stopts
@@ -96,5 +98,5 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -161,7 +163,11 @@
           ENDIF
 
+#if defined key_agrif
+          CALL Agrif_Regrid()
+#endif
+
          DO WHILE ( istp <= nitend .AND. nstop == 0 )
 #if defined key_agrif
-            CALL Agrif_Step( stp )           ! AGRIF: time stepping
+            CALL stp                         ! AGRIF: time stepping
 #else
             CALL stp( istp )                 ! standard time stepping
@@ -187,9 +193,9 @@
       !
 #if defined key_agrif
-      IF ( Agrif_Level() < Agrif_MaxLevel() ) THEN 
-         CALL Agrif_ParentGrid_To_ChildGrid()
-         IF( lk_diaobs ) CALL dia_obs_wri
+      IF(.NOT.Agrif_Root() ) THEN
+                                CALL Agrif_ParentGrid_To_ChildGrid()
+         IF( lk_diaobs )        CALL dia_obs_wri
          IF( nn_timing == 1 )   CALL timing_finalize
-         CALL Agrif_ChildGrid_To_ParentGrid()
+                                CALL Agrif_ChildGrid_To_ParentGrid()
       ENDIF
 #endif
@@ -199,6 +205,6 @@
       !
 #if defined key_iomput
-      CALL xios_finalize                ! end mpp communications with xios
-      IF( lk_oasis ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS
+      CALL xios_finalize                  ! end mpp communications with xios
+      IF( lk_oasis )   CALL cpl_finalize  ! end coupling and mpp communications with OASIS
 #else
       IF( lk_oasis ) THEN 
@@ -315,7 +321,7 @@
       ! If dimensions of processor grid weren't specified in the namelist file
       ! then we calculate them here now that we have our communicator size
-      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
+      IF( jpni < 1 .OR. jpnj < 1 ) THEN
 #if   defined key_mpp_mpi
-         IF( Agrif_Root() ) CALL nemo_partition(mppsize)
+         IF( Agrif_Root() )   CALL nemo_partition( mppsize )
 #else
          jpni  = 1
@@ -323,19 +329,24 @@
          jpnij = jpni*jpnj
 #endif
-      END IF
+      ENDIF
 
       ! Calculate domain dimensions given calculated jpni and jpnj
-      ! This used to be done in par_oce.F90 when they were parameters rather
-      ! than variables
+      ! This used to be done in par_oce.F90 when they were parameters rather than variables
       IF( Agrif_Root() ) THEN
 #if defined key_nemocice_decomp
-         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim.
-         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 
+         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim. 
 #else
-         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim.
-         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
-#endif
-      ENDIF
+         jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+         jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.
+#endif
+      ENDIF         
          jpk = jpkdta                                             ! third dim
+#if defined key_agrif
+         ! simple trick to use same vertical grid as parent but different number of levels: 
+         ! Save maximum number of levels in jpkdta, then define all vertical grids with this number.
+         ! Suppress once vertical online interpolation is ok
+         IF(.NOT.Agrif_Root())   jpkdta = Agrif_Parent( jpkdta )
+#endif
          jpim1 = jpi-1                                            ! inner domain indices
          jpjm1 = jpj-1                                            !   "           "
@@ -351,5 +362,5 @@
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.6  (2015) '
+         WRITE(numout,*) '                  version 3.7  (2015) '
          WRITE(numout,*)
          WRITE(numout,*)
@@ -384,25 +395,20 @@
                             CALL     dom_cfg    ! Domain configuration
                             CALL     dom_init   ! Domain
-
-      IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
-
+      IF( ln_crs        )   CALL     crs_init   ! coarsened grid: domain initialization 
+      IF( ln_nnogather )    CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined)
       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
-
                             CALL  istate_init   ! ocean initial state (Dynamics and tracers)
 
-      IF( lk_tide       )   CALL    tide_init( nit000 )    ! Initialisation of the tidal harmonics
-
-                            CALL     sbc_init   ! Forcings : surface module (clem: moved here for bdy purpose)
-
+      !                                      ! external forcing 
+!!gm to be added : creation and call of sbc_apr_init
+      IF( lk_tide       )   CALL    tide_init( nit000 )    ! tidal harmonics
+                            CALL     sbc_init   ! surface boundary conditions (including sea-ice)
+!!gm ==>> bdy_init should call bdy_dta_init and bdytide_init  NOT in nemogcm !!!
       IF( lk_bdy        )   CALL     bdy_init   ! Open boundaries initialisation
       IF( lk_bdy        )   CALL bdy_dta_init   ! Open boundaries initialisation of external data arrays
       IF( lk_bdy .AND. lk_tide )   &
          &                  CALL bdytide_init   ! Open boundaries initialisation of tidal harmonic forcing
-
-                            CALL dyn_nept_init  ! simplified form of Neptune effect
-      !     
-      IF( ln_crs        )   CALL     crs_init   ! Domain initialization of coarsened grid
-      !
-                                ! Ocean physics
+         
+      !                                      ! Ocean physics
       !                                         ! Vertical physics
                             CALL     zdf_init      ! namelist read
@@ -411,42 +417,44 @@
       IF( lk_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme
       IF( lk_zdfgls     )   CALL zdf_gls_init      ! GLS closure scheme
-      IF( lk_zdfkpp     )   CALL zdf_kpp_init      ! KPP closure scheme
       IF( lk_zdftmx     )   CALL zdf_tmx_init      ! tidal vertical mixing
-      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   &
-         &                  CALL zdf_ddm_init      ! double diffusive mixing
+      IF( lk_zdfddm     )   CALL zdf_ddm_init      ! double diffusive mixing
+         
       !                                         ! Lateral physics
                             CALL ldf_tra_init      ! Lateral ocean tracer physics
+                            CALL ldf_eiv_init      ! eddy induced velocity param.
                             CALL ldf_dyn_init      ! Lateral ocean momentum physics
-      IF( lk_ldfslp     )   CALL ldf_slp_init      ! slope of lateral mixing
-
-      !                                     ! 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
-                            CALL tra_dmp_init   ! internal damping trends- tracers
-                            CALL tra_adv_init   ! horizontal & vertical advection
-                            CALL tra_ldf_init   ! lateral mixing
-                            CALL tra_zdf_init   ! vertical mixing and after tracer fields
-
-      !                                     ! Dynamics
-      IF( lk_c1d        )   CALL dyn_dmp_init   ! internal damping trends- momentum
-                            CALL dyn_adv_init   ! advection (vector or flux form)
-                            CALL dyn_vor_init   ! vorticity term including Coriolis
-                            CALL dyn_ldf_init   ! lateral mixing
-                            CALL dyn_hpg_init   ! horizontal gradient of Hydrostatic pressure
-                            CALL dyn_zdf_init   ! vertical diffusion
-                            CALL dyn_spg_init   ! surface pressure gradient
-
-      !                                     ! Misc. options
-      IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_init       ! Cross Land Advection
+
+      !                                         ! 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
+                            CALL tra_dmp_init      ! internal tracer damping
+                            CALL tra_adv_init      ! horizontal & vertical advection
+                            CALL tra_ldf_init      ! lateral mixing
+                            CALL tra_zdf_init      ! vertical mixing and after tracer fields
+
+      !                                         ! Dynamics
+      IF( lk_c1d        )   CALL dyn_dmp_init      ! internal momentum damping
+                            CALL dyn_adv_init      ! advection (vector or flux form)
+                            CALL dyn_vor_init      ! vorticity term including Coriolis
+                            CALL dyn_ldf_init      ! lateral mixing
+                            CALL dyn_hpg_init      ! horizontal gradient of Hydrostatic pressure
+                            CALL dyn_zdf_init      ! vertical diffusion
+                            CALL dyn_spg_init      ! surface pressure gradient
+
+#if defined key_top
+      !                                      ! Passive tracers
+                            CALL     trc_init
+#endif
+      IF( l_ldfslp      )   CALL ldf_slp_init   ! slope of lateral mixing
+
+      !                                      ! Icebergs
                             CALL icb_init( rdt, nit000)   ! initialise icebergs instance
+
+      !                                      ! Misc. options
                             CALL sto_par_init   ! Stochastic parametrization
       IF( ln_sto_eos     )  CALL sto_pts_init   ! RRandom T/S fluctuations
      
-#if defined key_top
-      !                                     ! Passive tracers
-                            CALL     trc_init
-#endif
-      !                                     ! Diagnostics
+      !                                      ! Diagnostics
       IF( lk_floats     )   CALL     flo_init   ! drifting Floats
       IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag
@@ -459,6 +467,5 @@
                             CALL dia_obs( nit000 - 1 )   ! Observation operator for restart
       ENDIF
-
-      !                                     ! Assimilation increments
+      !                                      ! Assimilation increments
       IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments
       IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
@@ -507,15 +514,15 @@
          WRITE(numout,*) '~~~~~~~ '
          WRITE(numout,*) '   Namelist namcfg'
-         WRITE(numout,*) '      configuration name              cp_cfg      = ', TRIM(cp_cfg)
-         WRITE(numout,*) '      configuration zoom name         cp_cfz      = ', TRIM(cp_cfz)
-         WRITE(numout,*) '      configuration resolution        jp_cfg      = ', jp_cfg
-         WRITE(numout,*) '      1st lateral dimension ( >= jpi ) jpidta     = ', jpidta
-         WRITE(numout,*) '      2nd    "         "    ( >= jpj ) jpjdta     = ', jpjdta
-         WRITE(numout,*) '      3nd    "         "               jpkdta     = ', jpkdta
-         WRITE(numout,*) '      1st dimension of global domain in i jpiglo  = ', jpiglo
-         WRITE(numout,*) '      2nd    -                  -    in j jpjglo  = ', jpjglo
+         WRITE(numout,*) '      configuration name                               cp_cfg  = ', TRIM(cp_cfg)
+         WRITE(numout,*) '      configuration zoom name                          cp_cfz  = ', TRIM(cp_cfz)
+         WRITE(numout,*) '      configuration resolution                         jp_cfg  = ', jp_cfg
+         WRITE(numout,*) '      1st lateral dimension ( >= jpiglo )              jpidta  = ', jpidta
+         WRITE(numout,*) '      2nd    "         "    ( >= jpjglo )              jpjdta  = ', jpjdta
+         WRITE(numout,*) '      3nd    "         "                               jpkdta  = ', jpkdta
+         WRITE(numout,*) '      1st dimension of global domain in i              jpiglo  = ', jpiglo
+         WRITE(numout,*) '      2nd    -                  -    in j              jpjglo  = ', jpjglo
          WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom
          WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
-         WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio   
+         WRITE(numout,*) '      lateral cond. type (between 0 and 6)             jperio  = ', jperio   
          WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
       ENDIF
@@ -598,5 +605,4 @@
       IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
       IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
-
       !
       numout = 6                                     ! redefine numout in case it is used after this point...
@@ -615,6 +621,4 @@
       USE diawri    , ONLY: dia_wri_alloc
       USE dom_oce   , ONLY: dom_oce_alloc
-      USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc
-      USE ldftra_oce, ONLY: ldftra_oce_alloc
       USE trc_oce   , ONLY: trc_oce_alloc
 #if defined key_diadct 
@@ -631,6 +635,4 @@
       ierr = ierr + dia_wri_alloc   ()
       ierr = ierr + dom_oce_alloc   ()          ! ocean domain
-      ierr = ierr + ldfdyn_oce_alloc()          ! ocean lateral  physics : dynamics
-      ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers
       ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
       !
@@ -712,16 +714,15 @@
       INTEGER :: ifac, jl, inu
       INTEGER, PARAMETER :: ntest = 14
-      INTEGER :: ilfax(ntest)
+      INTEGER, DIMENSION(ntest) ::   ilfax
+      !!----------------------------------------------------------------------
       !
       ! lfax contains the set of allowed factors.
-      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  &
-         &                            128,   64,   32,   16,    8,   4,   2  /
-      !!----------------------------------------------------------------------
-
+      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
+      !
       ! Clear the error flag and initialise output vars
-      kerr = 0
-      kfax = 1
+      kerr  = 0
+      kfax  = 1
       knfax = 0
-
+      !
       ! Find the factors of n.
       IF( kn == 1 )   GOTO 20
@@ -731,8 +732,8 @@
       ! l points to the allowed factor list.
       ! ifac holds the current factor.
-
+      !
       inu   = kn
       knfax = 0
-
+      !
       DO jl = ntest, 1, -1
          !
@@ -758,5 +759,5 @@
          !
       END DO
-
+      !
    20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
       !
@@ -766,26 +767,24 @@
 
    SUBROUTINE nemo_northcomms
-      !!======================================================================
+      !!----------------------------------------------------------------------
       !!                     ***  ROUTINE  nemo_northcomms  ***
-      !! nemo_northcomms    :  Setup for north fold exchanges with explicit 
-      !!                       point-to-point messaging
-      !!=====================================================================
-      !!----------------------------------------------------------------------
-      !!
-      !! ** Purpose :   Initialization of the northern neighbours lists.
+      !! ** Purpose :   Setup for north fold exchanges with explicit 
+      !!                point-to-point messaging
+      !!
+      !! ** Method :   Initialization of the northern neighbours lists.
       !!----------------------------------------------------------------------
       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
       !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
       !!----------------------------------------------------------------------
-
       INTEGER  ::   sxM, dxM, sxT, dxT, jn
       INTEGER  ::   njmppmax
-
+      !!----------------------------------------------------------------------
+      !
       njmppmax = MAXVAL( njmppt )
-    
+      !
       !initializes the north-fold communication variables
       isendto(:) = 0
-      nsndto = 0
-
+      nsndto     = 0
+      !
       !if I am a process in the north
       IF ( njmpp == njmppmax ) THEN
@@ -834,4 +833,5 @@
       l_north_nogather = .TRUE.
    END SUBROUTINE nemo_northcomms
+
 #else
    SUBROUTINE nemo_northcomms      ! Dummy routine
@@ -843,3 +843,2 @@
 END MODULE nemogcm
 
-
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 5901)
@@ -7,4 +7,5 @@
    !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate
    !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays
+   !!            3.7  !  2014-01  (G. Madec) suppression of curl and before hdiv from in-core memory
    !!----------------------------------------------------------------------
    USE par_oce        ! ocean parameters
@@ -16,14 +17,11 @@
    PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90
 
-   LOGICAL, PUBLIC ::   l_traldf_rot = .FALSE.  !: rotated laplacian operator for lateral diffusion
-
    !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields
    !! --------------------------                            ! fields ! fields ! trends ! only after tra_zdf and dyn_spg
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity          [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity          [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ua_sv,  va_sv          !: Saved trends (time spliting)   [m/s2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity              [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rotb ,  rotn           !: relative vorticity             [s-1]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hdivb,  hdivn          !: horizontal divergence          [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ua_sv,  va_sv          !: Saved trends (time spliting) [m/s2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity            [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           hdivn          !: horizontal divergence        [s-1]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                  [Celcius,psu] 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celcius-1,psu-1]
@@ -73,5 +71,5 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -89,14 +87,11 @@
          &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &      
          &      ua_sv(jpi,jpj,jpk)      , va_sv(jpi,jpj,jpk)      ,                             &      
-         &      wn   (jpi,jpj,jpk)      ,                                                       &
-         &      rotb (jpi,jpj,jpk)      , rotn (jpi,jpj,jpk)      ,                             &   
-         &      hdivb(jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             &
+         &      wn   (jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             &
          &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     &
          &      rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) ,                             &
-         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) )
+         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)      ,                             &
+         &      rhd  (jpi,jpj,jpk)      , rhop (jpi,jpj,jpk)                              , STAT=ierr(1) )
          !
-      ALLOCATE(rhd (jpi,jpj,jpk) ,                                         &
-         &     rhop(jpi,jpj,jpk) ,                                         &
-         &     rke(jpi,jpj,jpk)  ,                                         &
+      ALLOCATE(rke(jpi,jpj,jpk)  ,                                         &
          &     sshb(jpi,jpj)     , sshn(jpi,jpj)   , ssha(jpi,jpj)   ,     &
          &     ub_b(jpi,jpj)     , un_b(jpi,jpj)   , ua_b(jpi,jpj)   ,     &
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 5901)
@@ -92,13 +92,4 @@
    INTEGER, PUBLIC  ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj
 
-   !!---------------------------------------------------------------------
-   !! Optimization/control flags
-   !!---------------------------------------------------------------------
-#if defined key_esopa
-   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .TRUE.   !: flag to activate the all options
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .FALSE.  !: flag to activate the all options
-#endif
-
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 5901)
@@ -24,6 +24,8 @@
    !!             -   !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
    !!            3.4  !  2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal
-   !!                 !  2012-07  (J. Simeon, G. Madec, C. Ethe) Online coarsening of outputs
-   !!            3.7  !  2014-04  (F. Roquet, G. Madec) New equations of state
+   !!            3.6  !  2012-07  (J. Simeon, G. Madec. C. Ethe)  Online coarsening of outputs
+   !!            3.6  !  2014-04  (F. Roquet, G. Madec) New equations of state
+   !!            3.7  !  2014-10  (G. Madec)  LDF simplication 
+   !!             -   !  2014-12  (G. Madec) remove KPP scheme
    !!----------------------------------------------------------------------
 
@@ -37,5 +39,5 @@
    PRIVATE
 
-   PUBLIC   stp   ! called by opa.F90
+   PUBLIC   stp   ! called by nemogcm.F90
 
    !! * Substitutions
@@ -43,5 +45,5 @@
 !!gm   #  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -50,5 +52,5 @@
 
 #if defined key_agrif
-   SUBROUTINE stp( )
+   RECURSIVE SUBROUTINE stp( )
       INTEGER             ::   kstp   ! ocean time-step index
 #else
@@ -69,5 +71,5 @@
       !!              -5- Compute the momentum trends
       !!              -6- Update the horizontal velocity
-      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w)
+      !!              -7- Compute the diagnostics variables (rd,N2, hdiv,w)
       !!              -8- Outputs and diagnostics
       !!----------------------------------------------------------------------
@@ -76,39 +78,40 @@
       INTEGER ::   kcall    ! optional integer argument (dom_vvl_sf_nxt)
       !! ---------------------------------------------------------------------
-
 #if defined key_agrif
       kstp = nit000 + Agrif_Nb_Step()
-!      IF ( Agrif_Root() .and. lwp) Write(*,*) '---'
-!      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp
-      IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE.
+      IF( lk_agrif_debug ) THEN
+         IF( Agrif_Root() .and. lwp)   WRITE(*,*) '---'
+         IF(lwp)   WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint()
+      ENDIF
+      IF( kstp == nit000 + 1 )   lk_agrif_fstep = .FALSE.
 # if defined key_iomput
       IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context )
 # endif
 #endif
-                             indic = 0           ! reset to no error condition
-      IF( kstp == nit000 ) THEN
-         ! must be done after nemo_init for AGRIF+XIOS+OASIS
-                      CALL iom_init(      cxios_context          )  ! iom_put initialization
-         IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" )  ! initialize context for coarse grid
-      ENDIF
-
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! update I/O and calendar 
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                             indic = 0                ! reset to no error condition
+                             
+      IF( kstp == nit000 ) THEN                       ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS)
+                             CALL iom_init(      cxios_context          )  ! for model grid (including passible AGRIF zoom)
+         IF( ln_crs      )   CALL iom_init( TRIM(cxios_context)//"_crs" )  ! for coarse grid
+      ENDIF
       IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
-                             CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell iom we are at time step kstp
-      IF( ln_crs     )       CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell iom we are at time step kstp
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Update data, open boundaries, surface boundary condition (including sea-ice)
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( lk_tide    )   CALL sbc_tide( kstp )
-      IF( lk_bdy     )  THEN
-         IF( ln_apr_dyn) CALL sbc_apr( kstp )   ! bdy_dta needs ssh_ib 
-                         CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries
-      ENDIF
-                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
-                                                      ! clem: moved here for bdy ice purpose
+                             CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell IOM we are at time step kstp
+      IF( ln_crs         )   CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell IOM we are at time step kstp
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update external forcing (tides, open boundaries, and surface boundary condition (including sea-ice)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( lk_tide    )   CALL sbc_tide( kstp )                   ! update tide potential
+      IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                   ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib) 
+      IF( lk_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries
+                         CALL sbc     ( kstp )                   ! Sea Boundary Condition (including sea-ice)
+
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Update stochastic parameters and random T/S fluctuations
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-                        CALL sto_par( kstp )          ! Stochastic parameters
+                         CALL sto_par( kstp )          ! Stochastic parameters
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -120,4 +123,5 @@
                          CALL bn2    ( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency
                          CALL bn2    ( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency
+
       !
       !  VERTICAL PHYSICS
@@ -127,5 +131,4 @@
       IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz
       IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz
-      IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz
       IF( lk_zdfcst  ) THEN                              ! Constant Kz (reset avt, avm[uv] to the background value)
          avt (:,:,:) = rn_avt0 * wmask (:,:,:)
@@ -133,6 +136,7 @@
          avmv(:,:,:) = rn_avm0 * wvmask(:,:,:)
       ENDIF
+
       IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
-         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO
+         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO
       ENDIF
       IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
@@ -140,6 +144,5 @@
       IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing
 
-      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   &
-         &               CALL zdf_ddm( kstp )         ! double diffusive mixing
+      IF( lk_zdfddm  )   CALL zdf_ddm( kstp )         ! double diffusive mixing
 
                          CALL zdf_mxl( kstp )         ! mixed layer depth
@@ -151,34 +154,32 @@
       !  LATERAL  PHYSICS
       !
-      IF( lk_ldfslp ) THEN                            ! slope of lateral mixing
+      IF( l_ldfslp ) THEN                             ! slope of lateral mixing
+!!gm : why this here ????
          IF(ln_sto_eos ) CALL sto_pts( tsn )          ! Random T/S fluctuations
+!!gm
                          CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density
+
          IF( ln_zps .AND. .NOT. ln_isfcav)                               &
             &            CALL zps_hde    ( kstp, jpts, tsb, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
             &                                          rhd, gru , grv    )  ! of t, s, rd at the last ocean level
+
          IF( ln_zps .AND.       ln_isfcav)                               &
-            &            CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
+            &            CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv, gtui, gtvi,   &    ! Partial steps for top cell (ISF)
             &                                          rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-            &                                   gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the first ocean level
-         IF( ln_traldf_grif ) THEN                           ! before slope for Griffies operator
-                         CALL ldf_slp_grif( kstp )
-         ELSE
-                         CALL ldf_slp( kstp, rhd, rn2b )     ! before slope for Madec operator
+            &                                   grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the first ocean level
+
+         IF( ln_traldf_triad ) THEN 
+                         CALL ldf_slp_triad( kstp )                       ! before slope for triad operator
+         ELSE     
+                         CALL ldf_slp     ( kstp, rhd, rn2b )             ! before slope for standard operator
          ENDIF
       ENDIF
-#if defined key_traldf_c2d
-      IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )      ! eddy induced velocity coefficient
-#endif
-#if defined key_traldf_c3d && defined key_traldf_smag
-                          CALL ldf_tra_smag( kstp )      ! eddy induced velocity coefficient
-#  endif
-#if defined key_dynldf_c3d && defined key_dynldf_smag
-                          CALL ldf_dyn_smag( kstp )      ! eddy induced velocity coefficient
-#  endif
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      !  Ocean dynamics : hdiv, rot, ssh, e3, wn
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_cur)
+      !                                               ! eddy diffusivity coeff. and/or eiv coeff.
+      IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kstp ) 
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      !  Ocean dynamics : hdiv, ssh, e3, wn
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_hor)
       IF( lk_vvl     )   CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors 
                          CALL wzv           ( kstp )  ! now cross-level velocity 
@@ -188,24 +189,25 @@
           ! Note that the computation of vertical velocity above, hence "after" sea level
           ! is necessary to compute momentum advection for the rhs of barotropic loop:
+!!gm : why also here ????
             IF(ln_sto_eos ) CALL sto_pts( tsn )                             ! Random T/S fluctuations
+!!gm
                             CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation
-            IF( ln_zps .AND. .NOT. ln_isfcav)                               &
-               &            CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
-               &                                          rhd, gru , grv    )  ! of t, s, rd at the last ocean level
-            IF( ln_zps .AND.       ln_isfcav)                               &
-               &            CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
+                            
+            IF( ln_zps .AND. .NOT. ln_isfcav)   &                           ! Partial steps: bottom before horizontal gradient
+               &            CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &  ! of t, s, rd at the last ocean level
+               &                                          rhd, gru , grv    )
+            IF( ln_zps .AND.       ln_isfcav)   &                           ! Partial steps: top & bottom before horizontal gradient
+               &            CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi,   & 
                &                                          rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-               &                                   gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
-
-                                  ua(:,:,:) = 0.e0             ! set dynamics trends to zero
-                                  va(:,:,:) = 0.e0
-          IF(  ln_asmiau .AND. &
+               &                                               grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    )
+
+                                  ua(:,:,:) = 0._wp            ! set dynamics trends to zero
+                                  va(:,:,:) = 0._wp
+          IF(  lk_asminc .AND. ln_asmiau .AND. &
              & ln_dyninc       )  CALL dyn_asm_inc  ( kstp )   ! apply dynamics assimilation increment
-          IF( ln_neptsimp )       CALL dyn_nept_cor ( kstp )   ! subtract Neptune velocities (simplified)
           IF( lk_bdy           )  CALL bdy_dyn3d_dmp( kstp )   ! bdy damping trends
                                   CALL dyn_adv      ( kstp )   ! advection (vector or flux form)
                                   CALL dyn_vor      ( kstp )   ! vorticity term including Coriolis
                                   CALL dyn_ldf      ( kstp )   ! lateral mixing
-          IF( ln_neptsimp )       CALL dyn_nept_cor ( kstp )   ! add Neptune velocities (simplified)
 #if defined key_agrif
           IF(.NOT. Agrif_Root())  CALL Agrif_Sponge_dyn        ! momentum sponge
@@ -217,5 +219,5 @@
                                   va_sv(:,:,:) = va(:,:,:)
 
-                                  CALL div_cur( kstp )         ! Horizontal divergence & Relative vorticity (2nd call in time-split case)
+                                  CALL div_hor( kstp )         ! Horizontal divergence  (2nd call in time-split case)
           IF( lk_vvl     )        CALL dom_vvl_sf_nxt( kstp, kcall=2 )  ! after vertical scale factors (update depth average component)
                                   CALL wzv           ( kstp )  ! now cross-level velocity 
@@ -225,13 +227,13 @@
       ! diagnostics and outputs             (ua, va, tsa used as workspace)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( lk_floats  )      CALL flo_stp( kstp )         ! drifting Floats
-      IF( lk_diahth  )      CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth)
-      IF( .NOT. ln_cpl )    CALL dia_fwb( kstp )         ! Fresh water budget diagnostics
-      IF( lk_diadct  )      CALL dia_dct( kstp )         ! Transports
-      IF( lk_diaar5  )      CALL dia_ar5( kstp )         ! ar5 diag
-      IF( lk_diaharm )      CALL dia_harm( kstp )        ! Tidal harmonic analysis
-                            CALL dia_wri( kstp )         ! ocean model: outputs
-      !
-      IF( ln_crs     )      CALL crs_fld( kstp )         ! ocean model: online field coarsening & output
+      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats
+      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth)
+      IF(.NOT.ln_cpl )   CALL dia_fwb( kstp )         ! Fresh water budget diagnostics
+      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports
+      IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag
+      IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis
+                         CALL dia_wri( kstp )         ! ocean model: outputs
+      !
+      IF( ln_crs     )   CALL crs_fld( kstp )         ! ocean model: online field coarsening & output
 
 #if defined key_top
@@ -242,11 +244,10 @@
 #endif
 
-
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Active tracers                              (ua, va used as workspace)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                             tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero
-
-      IF(  ln_asmiau .AND. &
+                             tsa(:,:,:,:) = 0._wp           ! set tracer trends to zero
+
+      IF(  lk_asminc .AND. ln_asmiau .AND. &
          & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment
                              CALL tra_sbc    ( kstp )       ! surface boundary condition
@@ -257,8 +258,9 @@
       IF( lk_bdy         )   CALL bdy_tra_dmp( kstp )       ! bdy damping trends
                              CALL tra_adv    ( kstp )       ! horizontal & vertical advection
-      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes
                              CALL tra_ldf    ( kstp )       ! lateral mixing
 
+!!gm : why CALL to dia_ptr has been moved here??? (use trends info?)
       IF( ln_diaptr      )   CALL dia_ptr                   ! Poleward adv/ldf TRansports diagnostics
+!!gm
 
 #if defined key_agrif
@@ -270,5 +272,7 @@
          IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
                              CALL tra_nxt( kstp )                ! tracer fields at next time step
+!!gm : why again a call to sto_pts ???
             IF( ln_sto_eos ) CALL sto_pts( tsn )                 ! Random T/S fluctuations
+!!gm
                              CALL eos    ( tsa, rhd, rhop, fsdept_n(:,:,:) )  ! Time-filtered in situ density for hpg computation
             IF( ln_zps .AND. .NOT. ln_isfcav)                                &
@@ -276,18 +280,20 @@
                &                                           rhd, gru , grv    )  ! of t, s, rd at the last ocean level
             IF( ln_zps .AND.       ln_isfcav)                                &
-               &             CALL zps_hde_isf( kstp, jpts, tsa, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
+               &             CALL zps_hde_isf( kstp, jpts, tsa, gtsu, gtsv, gtui, gtvi,  &    ! Partial steps for top/bottom cells
                &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-               &                                    gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
+               &                                                grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    )
       ELSE                                                  ! centered hpg  (eos then time stepping)
          IF ( .NOT. lk_dynspg_ts ) THEN                     ! eos already called in time-split case
+!!gm : why again a call to sto_pts ???
             IF( ln_sto_eos ) CALL sto_pts( tsn )    ! Random T/S fluctuations
+!!gm
                              CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )  ! now in situ density for hpg computation
          IF( ln_zps .AND. .NOT. ln_isfcav)                                   &
-               &             CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
-               &                                           rhd, gru , grv    )  ! of t, s, rd at the last ocean level
+               &             CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: bottom before horizontal gradient
+               &                                           rhd, gru , grv    )    ! of t, s, rd at the last ocean level
          IF( ln_zps .AND.       ln_isfcav)                                   & 
-               &             CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
+               &             CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi,   &    ! Partial steps for top/bottom cells
                &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-               &                                    gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
+               &                                    grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
          ENDIF
          IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
@@ -303,24 +309,18 @@
                                ua(:,:,:) = ua_sv(:,:,:)
                                va(:,:,:) = va_sv(:,:,:)
-                                                             ! Revert now divergence and rotational to previously computed ones 
-                                                             !(needed because of the time swap in div_cur, at the beginning of each time step)
-                               hdivn(:,:,:) = hdivb(:,:,:)
-                               rotn(:,:,:)  = rotb(:,:,:) 
 
                                CALL dyn_bfr( kstp )         ! bottom friction
                                CALL dyn_zdf( kstp )         ! vertical diffusion
       ELSE
-                               ua(:,:,:) = 0.e0             ! set dynamics trends to zero
-                               va(:,:,:) = 0.e0
-
-        IF(  ln_asmiau .AND. &
+                               ua(:,:,:) = 0._wp            ! set dynamics trends to zero
+                               va(:,:,:) = 0._wp
+
+        IF(  lk_asminc .AND. ln_asmiau .AND. &
            & ln_dyninc      )  CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment
         IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields
-        IF( ln_neptsimp )      CALL dyn_nept_cor( kstp )    ! subtract Neptune velocities (simplified)
         IF( lk_bdy          )  CALL bdy_dyn3d_dmp(kstp )    ! bdy damping trends
                                CALL dyn_adv( kstp )         ! advection (vector or flux form)
                                CALL dyn_vor( kstp )         ! vorticity term including Coriolis
                                CALL dyn_ldf( kstp )         ! lateral mixing
-        IF( ln_neptsimp )      CALL dyn_nept_cor( kstp )    ! add Neptune velocities (simplified)
 #if defined key_agrif
         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_dyn        ! momemtum sponge
@@ -335,10 +335,26 @@
                                CALL ssh_swp( kstp )         ! swap of sea surface height
       IF( lk_vvl           )   CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors
-
+      !
+
+!!gm : This does not only concern the dynamics ==>>> add a new title
+!!gm2: why ouput restart before AGRIF update?
+      IF( lrst_oce         )   CALL rst_write( kstp )       ! write output ocean restart file
+
+#if defined key_agrif
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! AGRIF
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
+                               CALL Agrif_Integrate_ChildGrids( stp )  
+
+      IF ( Agrif_NbStepint().EQ.0 ) THEN
+                               CALL Agrif_Update_Tra()      ! Update active tracers
+                               CALL Agrif_Update_Dyn()      ! Update momentum
+      ENDIF
+#endif
       IF( ln_diahsb        )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics
       IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Control and restarts
+      ! Control
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                                CALL stp_ctl( kstp, indic )
@@ -350,11 +366,12 @@
                  CALL iom_close( numror )     ! close input  ocean restart file
          IF(lwm) CALL FLUSH    ( numond )     ! flush output namelist oce
-         IF( lwm.AND.numoni /= -1 ) CALL FLUSH    ( numoni )     ! flush output namelist ice
-      ENDIF
-      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file
+         IF(lwm.AND.numoni /= -1 )   &
+            &    CALL FLUSH    ( numoni )     ! flush output namelist ice (if exist)
+      ENDIF
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Coupled mode
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+!!gm why lk_oasis and not lk_cpl ????
       IF( lk_oasis         )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 5901)
@@ -4,28 +4,19 @@
    !! Ocean time-stepping : module used in both initialisation phase and time stepping
    !!======================================================================
-   !! History :   3.3  ! 2010-08  (C. Ethe)  Original code - reorganisation of the initial phase
+   !! History :   3.3  !  2010-08  (C. Ethe)  Original code - reorganisation of the initial phase
+   !!             3.7  !  2014-01  (G. Madec) LDF simplication 
    !!----------------------------------------------------------------------
    USE oce              ! ocean dynamics and tracers variables
    USE dom_oce          ! ocean space and time domain variables
    USE zdf_oce          ! ocean vertical physics variables
-   USE ldftra_oce       ! ocean tracer   - trends
-   USE ldfdyn_oce       ! ocean dynamics - trends
-   USE divcur           ! hor. divergence and curl      (div & cur routines)
-   USE in_out_manager   ! I/O manager
-   USE iom              !
-   USE lbclnk
-   USE restart          ! restart
-#if defined key_iomput
-   USE xios
-#endif
 
    USE daymod           ! calendar                         (day     routine)
 
+   USE sbc_oce          ! surface boundary condition: ocean
    USE sbcmod           ! surface boundary condition       (sbc     routine)
    USE sbcrnf           ! surface boundary condition: runoff variables
    USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step)
-   USE sbc_oce          ! surface boundary condition: ocean
+   USE sbcapr           ! surface boundary condition: atmospheric pressure
    USE sbctide          ! Tide initialisation
-   USE sbcapr           ! surface boundary condition: ssh_ib required by bdydta 
 
    USE traqsr           ! solar radiation penetration      (tra_qsr routine)
@@ -36,5 +27,4 @@
    USE traadv           ! advection scheme control     (tra_adv_ctl routine)
    USE traldf           ! lateral mixing                   (tra_ldf routine)
-   !   zdfkpp           ! KPP non-local tracer fluxes      (tra_kpp routine)
    USE trazdf           ! vertical mixing                  (tra_zdf routine)
    USE tranxt           ! time-stepping                    (tra_nxt routine)
@@ -43,4 +33,5 @@
    USE eosbn2           ! equation of state                (eos_bn2 routine)
 
+   USE divhor           ! horizontal divergence            (div_hor routine)
    USE dynadv           ! advection                        (dyn_adv routine)
    USE dynbfr           ! Bottom friction terms            (dyn_bfr routine)
@@ -51,5 +42,4 @@
    USE dynspg_oce       ! surface pressure gradient        (dyn_spg routine)
    USE dynspg           ! surface pressure gradient        (dyn_spg routine)
-   USE dynnept          ! simp. form of Neptune effect(dyn_nept_cor routine)
 
    USE dynnxt           ! time-stepping                    (dyn_nxt routine)
@@ -71,7 +61,6 @@
 
    USE ldfslp           ! iso-neutral slopes               (ldf_slp routine)
-   USE ldfeiv           ! eddy induced velocity coef.      (ldf_eiv routine)
-   USE ldftra_smag      ! Smagirinsky diffusion            (ldftra_smag routine)
-   USE ldfdyn_smag      ! Smagorinsky viscosity            (ldfdyn_smag routine) 
+   USE ldfdyn           ! lateral eddy viscosity coef.     (ldf_dyn routine)
+   USE ldftra           ! lateral eddy diffusive coef.     (ldf_tra routine)
 
    USE zdftmx           ! tide-induced vertical mixing     (zdf_tmx routine)
@@ -79,5 +68,4 @@
    USE zdftke           ! TKE vertical mixing              (zdf_tke routine)
    USE zdfgls           ! GLS vertical mixing              (zdf_gls routine)
-   USE zdfkpp           ! KPP vertical mixing              (zdf_kpp routine)
    USE zdfddm           ! double diffusion mixing          (zdf_ddm routine)
    USE zdfevd           ! enhanced vertical diffusion      (zdf_evd routine)
@@ -104,12 +92,20 @@
    USE asmbkg
    USE stpctl           ! time stepping control            (stp_ctl routine)
+   USE restart          ! ocean restart                    (rst_wri routine)
    USE prtctl           ! Print control                    (prt_ctl routine)
 
    USE diaobs           ! Observation operator
 
+   USE in_out_manager   ! I/O manager
+   USE iom              !
+   USE lbclnk
    USE timing           ! Timing
 
+#if defined key_iomput
+   USE xios
+#endif
 #if defined key_agrif
    USE agrif_opa_sponge ! Momemtum and tracers sponges
+   USE agrif_opa_update ! Update (2-way nesting)
 #endif
 #if defined key_top
@@ -117,5 +113,5 @@
 #endif
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/daymod.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/daymod.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/daymod.F90	(revision 5901)
@@ -45,5 +45,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: daymod.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -71,4 +71,9 @@
       !!----------------------------------------------------------------------
       !
+      ! max number of seconds between each restart
+      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
+         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
+            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
+      ENDIF
       ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0
       IF( MOD( rday     , rdttra(1) ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
@@ -80,15 +85,8 @@
       ndt05   = NINT(0.5 * rdttra(1))
 
-      ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
-      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
-      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
-      IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
-      !
-      IF(lwp) THEN
-         WRITE(numout,*) ' *** Info used values : '
-         WRITE(numout,*) '   date ndastp                                      : ', ndastp
-         WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
-         WRITE(numout,*)
-      ENDIF
+      ! ==> clem: here we read the ocean restart for the date (only if it exists)
+      !           It is not clean and another solution should be found
+      CALL day_rst( nit000, 'READ' )
+      ! ==>
 
       ! set the calendar from ndastp (read in restart file and namelist)
@@ -131,5 +129,5 @@
 
       ! control print
-      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
+      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
            &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week
 
@@ -246,9 +244,4 @@
                nday_year = 1
                nsec_year = ndt05
-               IF( nsec1jan000 >= 2 * (2**30 - nsecd * nyear_len(1) / 2 ) ) THEN   ! test integer 4 max value
-                  CALL ctl_stop( 'The number of seconds between Jan. 1st 00h of nit000 year and Jan. 1st 00h ',   &
-                     &           'of the current year is exceeding the INTEGER 4 max VALUE: 2^31-1 -> 68.09 years in seconds', &
-                     & 'You must do a restart at higher frequency (or remove this STOP and recompile everything in I8)' )
-               ENDIF
                nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
                IF( nleapy == 1 )   CALL day_mth
@@ -285,4 +278,98 @@
       !
    END SUBROUTINE day
+
+
+   SUBROUTINE day_rst( kt, cdrw )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE ts_rst  ***
+      !!
+      !!  ** Purpose : Read or write calendar in restart file:
+      !!
+      !!  WRITE(READ) mode:
+      !!       kt        : number of time step since the begining of the experiment at the
+      !!                   end of the current(previous) run
+      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
+      !!                   end of the current(previous) run (REAL -> keep fractions of day)
+      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
+      !!
+      !!   According to namelist parameter nrstdt,
+      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
+      !!       nrstdt = 1  we verify that nit000 is equal to the last
+      !!                   time step of previous run + 1.
+      !!       In both those options, the  exact duration of the experiment
+      !!       since the beginning (cumulated duration of all previous restart runs)
+      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
+      !!       This is valid is the time step has remained constant.
+      !!
+      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
+      !!                    has been stored in the restart file.
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      !
+      REAL(wp) ::   zkt, zndastp
+      !!----------------------------------------------------------------------
+
+      IF( TRIM(cdrw) == 'READ' ) THEN
+
+         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN
+            ! Get Calendar informations
+            CALL iom_get( numror, 'kt', zkt )   ! last time-step of previous run
+            IF(lwp) THEN
+               WRITE(numout,*) ' *** Info read in restart : '
+               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
+               WRITE(numout,*) ' *** restart option'
+               SELECT CASE ( nrstdt )
+               CASE ( 0 )   ;   WRITE(numout,*) ' nrstdt = 0 : no control of nit000'
+               CASE ( 1 )   ;   WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)'
+               CASE ( 2 )   ;   WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart'
+               END SELECT
+               WRITE(numout,*)
+            ENDIF
+            ! Control of date
+            IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 )                                         &
+                 &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 &
+                 &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
+            ! define ndastp and adatrj
+            IF ( nrstdt == 2 ) THEN
+               ! read the parameters correspondting to nit000 - 1 (last time step of previous run)
+               CALL iom_get( numror, 'ndastp', zndastp )
+               ndastp = NINT( zndastp )
+               CALL iom_get( numror, 'adatrj', adatrj  )
+            ELSE
+               ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+               ! note this is wrong if time step has changed during run
+            ENDIF
+         ELSE
+            ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+            ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+         ENDIF
+         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) ' *** Info used values : '
+            WRITE(numout,*) '   date ndastp                                      : ', ndastp
+            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
+            WRITE(numout,*)
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+         !
+         IF( kt == nitrst ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file  kt =', kt
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+         ENDIF
+         ! calendar control
+         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step
+         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date
+         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since
+         !                                                                     ! the begining of the run [s]
+      ENDIF
+      !
+   END SUBROUTINE day_rst
    !!======================================================================
 END MODULE daymod
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/diawri.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/diawri.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/diawri.F90	(revision 5901)
@@ -26,7 +26,4 @@
    USE dom_oce         ! ocean space and time domain
    USE zdf_oce         ! ocean vertical physics
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldfdyn_oce      ! ocean dynamics: lateral physics
-   USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv
    USE sol_oce         ! solver variables
    USE sbc_oce         ! Surface boundary condition: ocean fields
@@ -70,5 +67,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 5901)
@@ -42,5 +42,4 @@
    USE step_oce        ! module used in the ocean time stepping module
    USE sbc_oce         ! surface boundary condition: ocean
-   USE cla             ! cross land advection               (tra_cla routine)
    USE domcfg          ! domain configuration               (dom_cfg routine)
    USE daymod          ! calendar
@@ -50,9 +49,19 @@
    USE step            ! NEMO time-stepping                 (stp     routine)
    USE lib_mpp         ! distributed memory computing
+#if defined key_nosignedzero
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#endif
 #if defined key_iomput
    USE xios
 #endif
+   USE cpl_oasis3
    USE sbcssm
-   USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges 
+   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
+   USE icbstp          ! handle bergs, calving, themodynamics and transport
+#if defined key_bdy
+   USE bdyini          ! open boundary cond. setting       (bdy_init routine). clem: mandatory for LIM3
+   USE bdydta          ! open boundary cond. setting   (bdy_dta_init routine). clem: mandatory for LIM3
+#endif
+   USE bdy_par
 
    IMPLICIT NONE
@@ -66,5 +75,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id: nemogcm.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -96,5 +105,12 @@
       !                            !-----------------------!
 #if defined key_agrif
-      CALL Agrif_Declare_Var       ! AGRIF: set the meshes
+      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM
+      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA 
+# if defined key_top
+      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP
+# endif
+# if defined key_lim2
+      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM
+# endif
 #endif
       ! check that all process are still there... If some process have an error,
@@ -118,4 +134,7 @@
          IF( lk_mpp )   CALL mpp_max( nstop )
       END DO
+      !
+      IF( ln_icebergs )   CALL icb_end( nitend )
+
       !                            !------------------------!
       !                            !==  finalize the run  ==!
@@ -136,8 +155,14 @@
       !
       CALL nemo_closefile
+      !
 #if defined key_iomput
       CALL xios_finalize                ! end mpp communications with xios
+      IF( lk_oasis ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS
 #else
-      IF( lk_mpp )   CALL mppstop       ! end mpp communications
+      IF( lk_oasis ) THEN 
+         CALL cpl_finalize              ! end coupling and mpp communications with OASIS
+      ELSE
+         IF( lk_mpp )   CALL mppstop    ! end mpp communications
+      ENDIF
 #endif
       !
@@ -154,18 +179,28 @@
       INTEGER ::   ilocal_comm   ! local integer      
       INTEGER ::   ios
-
       CHARACTER(len=80), DIMENSION(16) ::   cltxt
-      !!
+      CHARACTER(len=80) ::   clname
+      !
       NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
          &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
          &             nn_bench, nn_timing
       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
-         &             jpizoom, jpjzoom, jperio
-      !!----------------------------------------------------------------------
+         &             jpizoom, jpjzoom, jperio, ln_use_jattr
+      !!----------------------------------------------------------------------
+      !
       cltxt = ''
       !
       !                             ! Open reference namelist and configuration namelist files
-      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
-      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      IF( lk_oasis ) THEN 
+         CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         cxios_context = 'sas'
+         clname = 'output.namelist_sas.dyn'
+      ELSE
+         CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         cxios_context = 'nemo'
+         clname = 'output.namelist.dyn'
+   ENDIF
       !
       REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark
@@ -186,4 +221,21 @@
 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
 
+! Force values for AGRIF zoom (cf. agrif_user.F90)
+#if defined key_agrif
+   IF( .NOT. Agrif_Root() ) THEN
+      jpiglo  = nbcellsx + 2 + 2*nbghostcells
+      jpjglo  = nbcellsy + 2 + 2*nbghostcells
+      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
+      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
+      jpidta  = jpiglo
+      jpjdta  = jpjglo
+      jpizoom = 1
+      jpjzoom = 1
+      nperio  = 0
+      jperio  = 0
+      ln_use_jattr = .false.
+   ENDIF
+#endif
+      !
       !                             !--------------------------------------------!
       !                             !  set communicator & select the local node  !
@@ -193,10 +245,22 @@
 #if defined key_iomput
       IF( Agrif_Root() ) THEN
-         CALL  xios_initialize( "nemo",return_comm=ilocal_comm )
-      ENDIF
-      narea = mynode ( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection
+         IF( lk_oasis ) THEN
+            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis 
+            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios
+         ELSE
+            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )        ! nemo local communicator given by xios
+         ENDIF
+      ENDIF
+      narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection
 #else
-      ilocal_comm = 0
-      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )        ! Nodes selection (control print return in cltxt)
+      IF( lk_oasis ) THEN
+         IF( Agrif_Root() ) THEN
+            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis
+         ENDIF
+         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt)
+      ELSE
+         ilocal_comm = 0
+         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
+      ENDIF
 #endif
       narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
@@ -229,10 +293,12 @@
       ! than variables
       IF( Agrif_Root() ) THEN
+#if defined key_nemocice_decomp
+         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim.
+         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 
+#else
          jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim.
-#if defined key_nemocice_decomp
-         jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 
-#else
          jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
 #endif
+      ENDIF
          jpk = jpkdta                                             ! third dim
          jpim1 = jpi-1                                            ! inner domain indices
@@ -240,9 +306,12 @@
          jpkm1 = jpk-1                                            !   "           "
          jpij  = jpi*jpj                                          !  jpi x j
-      ENDIF
 
       IF(lwp) THEN                            ! open listing units
          !
-         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         IF( lk_oasis ) THEN
+            CALL ctl_opn( numout,   'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         ELSE
+            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         ENDIF
          !
          WRITE(numout,*)
@@ -250,5 +319,5 @@
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.4  (2011) '
+         WRITE(numout,*) '                  version 3.6  (2015) '
          WRITE(numout,*) '             StandAlone Surface version (SAS) '
          WRITE(numout,*)
@@ -287,9 +356,14 @@
 
       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
-                            CALL flush(numout)
-
                             CALL day_init   ! model calendar (using both namelist and restart infos)
 
                             CALL sbc_init   ! Forcings : surface module 
+                            
+      ! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from  
+      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. 
+      !           This is not clean and should be changed in the future. 
+      IF( lk_bdy        )   CALL     bdy_init
+      IF( lk_bdy        )   CALL bdy_dta_init
+      ! ==>
       
       IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
@@ -348,4 +422,5 @@
          WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
          WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio   
+         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
       ENDIF
       !                             ! Parameter control
@@ -396,4 +471,8 @@
       ENDIF
       !
+      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
+         &                                               'f2003 standard. '                              ,  &
+         &                                               'Compile with key_nosignedzero enabled' )
+      !
    END SUBROUTINE nemo_ctl
 
@@ -435,14 +514,37 @@
       USE diawri    , ONLY: dia_wri_alloc
       USE dom_oce   , ONLY: dom_oce_alloc
-      USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
-      !
-      INTEGER :: ierr,ierr4
+#if defined key_bdy   
+      USE bdy_oce   , ONLY: bdy_oce_alloc
+      USE oce         ! clem: mandatory for LIM3 because needed for bdy arrays
+#else
+      USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
+#endif
+      !
+      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6
+      INTEGER :: jpm
       !!----------------------------------------------------------------------
       !
       ierr =        dia_wri_alloc   ()
       ierr = ierr + dom_oce_alloc   ()          ! ocean domain
-      ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             &
-         &      snwice_fmass(jpi,jpj), STAT= ierr4 )
-      ierr = ierr + ierr4
+#if defined key_bdy
+      ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization)
+      ierr = ierr + oce_alloc       ()          ! (tsn...)
+#endif
+
+#if ! defined key_bdy
+       ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             &
+         &      snwice_fmass(jpi,jpj)  , STAT= ierr1 )
+      !
+      ! lim code currently uses surface temperature and salinity in tsn array for initialisation
+      ! and ub, vb arrays in ice dynamics, so allocate enough of arrays to use
+      ! clem: should not be needed. To be checked out
+      jpm = MAX(jp_tem, jp_sal)
+      ALLOCATE( tsn(jpi,jpj,1,jpm)  , STAT=ierr2 )
+      ALLOCATE( ub(jpi,jpj,1)       , STAT=ierr3 )
+      ALLOCATE( vb(jpi,jpj,1)       , STAT=ierr4 )
+      ALLOCATE( tsb(jpi,jpj,1,jpm)  , STAT=ierr5 )
+      ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 )
+      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 
+#endif
       !
       IF( lk_mpp    )   CALL mpp_sum( ierr )
@@ -469,9 +571,9 @@
       INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
       !!----------------------------------------------------------------------
-
+      !
       ierr = 0
-
+      !
       CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
-
+      !
       IF( nfact <= 1 ) THEN
          WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
@@ -515,5 +617,5 @@
       INTEGER, PARAMETER :: ntest = 14
       INTEGER :: ilfax(ntest)
-
+      !
       ! lfax contains the set of allowed factors.
       data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  &
@@ -600,16 +702,16 @@
           !loop over the other north-fold processes to find the processes
           !managing the points belonging to the sxT-dxT range
-          DO jn = jpnij - jpni +1, jpnij
-             IF ( njmppt(jn) == njmppmax ) THEN
+  
+          DO jn = 1, jpni
                 !sxT is the first point (in the global domain) of the jn
                 !process
-                sxT = nimppt(jn)
+                sxT = nfiimpp(jn, jpnj)
                 !dxT is the last point (in the global domain) of the jn
                 !process
-                dxT = nimppt(jn) + nlcit(jn) - 1
+                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
                 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
                    nsndto = nsndto + 1
-                   isendto(nsndto) = jn
-                ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN
+                     isendto(nsndto) = jn
+                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
                    nsndto = nsndto + 1
                    isendto(nsndto) = jn
@@ -618,6 +720,18 @@
                    isendto(nsndto) = jn
                 END IF
-             END IF
           END DO
+          nfsloop = 1
+          nfeloop = nlci
+          DO jn = 2,jpni-1
+           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
+              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
+                 nfsloop = nldi
+              ENDIF
+              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
+                 nfeloop = nlei
+              ENDIF
+           ENDIF
+        END DO
+
       ENDIF
       l_north_nogather = .TRUE.
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90	(revision 5901)
@@ -36,26 +36,25 @@
    PUBLIC   sbc_ssm        ! called by sbc
 
-   CHARACTER(len=100)   ::   cn_dir     = './'    !: Root directory for location of ssm files
-   LOGICAL              ::   ln_3d_uv   = .true.  !: specify whether input velocity data is 3D
-   INTEGER  , SAVE      ::   nfld_3d
-   INTEGER  , SAVE      ::   nfld_2d
-
-   INTEGER  , PARAMETER ::   jpfld_3d = 4   ! maximum number of files to read
-   INTEGER  , PARAMETER ::   jpfld_2d = 1   ! maximum number of files to read
-   INTEGER  , SAVE      ::   jf_tem         ! index of temperature
-   INTEGER  , SAVE      ::   jf_sal         ! index of salinity
-   INTEGER  , SAVE      ::   jf_usp         ! index of u velocity component
-   INTEGER  , SAVE      ::   jf_vsp         ! index of v velocity component
-   INTEGER  , SAVE      ::   jf_ssh         ! index of sea surface height
+   CHARACTER(len=100)   ::   cn_dir        !: Root directory for location of ssm files
+   LOGICAL              ::   ln_3d_uve     !: specify whether input velocity data is 3D
+   LOGICAL              ::   ln_read_frq   !: specify whether we must read frq or not
+   LOGICAL              ::   l_initdone = .false.
+   INTEGER     ::   nfld_3d
+   INTEGER     ::   nfld_2d
+
+   INTEGER     ::   jf_tem         ! index of temperature
+   INTEGER     ::   jf_sal         ! index of salinity
+   INTEGER     ::   jf_usp         ! index of u velocity component
+   INTEGER     ::   jf_vsp         ! index of v velocity component
+   INTEGER     ::   jf_ssh         ! index of sea surface height
+   INTEGER     ::   jf_e3t         ! index of first T level thickness
+   INTEGER     ::   jf_frq         ! index of fraction of qsr absorbed in the 1st T level
 
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d  ! structure of input fields (file information, fields read)
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_2d  ! structure of input fields (file information, fields read)
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OFF 3.3 , NEMO Consortium (2010)
-   !! $Id: sbcssm.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -86,10 +85,12 @@
       IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==!
       ! 
-      IF( ln_3d_uv ) THEN
+      IF( ln_3d_uve ) THEN
          ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
          ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
+         IF( lk_vvl )   e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity 
       ELSE
          ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
          ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
+         IF( lk_vvl )   e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity 
       ENDIF
       !
@@ -97,13 +98,14 @@
       sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1)    ! salinity
       ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height
-      !
-      tsn(:,:,1,jp_tem) = sst_m(:,:)
-      tsn(:,:,1,jp_sal) = sss_m(:,:)
+      IF( ln_read_frq )   frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height
+      !
       IF ( nn_ice == 1 ) THEN
+         tsn(:,:,1,jp_tem) = sst_m(:,:)
+         tsn(:,:,1,jp_sal) = sss_m(:,:)
          tsb(:,:,1,jp_tem) = sst_m(:,:)
          tsb(:,:,1,jp_sal) = sss_m(:,:)
       ENDIF
-      ub (:,:,1       ) = ssu_m(:,:)
-      vb (:,:,1       ) = ssv_m(:,:)
+      ub (:,:,1) = ssu_m(:,:)
+      vb (:,:,1) = ssv_m(:,:)
 
       IF(ln_ctl) THEN                  ! print control
@@ -113,4 +115,16 @@
          CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m   - : ', mask1=vmask, ovlap=1   )
          CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m   - : ', mask1=tmask, ovlap=1   )
+         IF( lk_vvl      )   CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m   - : ', mask1=tmask, ovlap=1   )
+         IF( ln_read_frq )   CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m   - : ', mask1=tmask, ovlap=1   )
+      ENDIF
+      !
+      IF( l_initdone ) THEN          !   Mean value at each nn_fsbc time-step   !
+         CALL iom_put( 'ssu_m', ssu_m )
+         CALL iom_put( 'ssv_m', ssv_m )
+         CALL iom_put( 'sst_m', sst_m )
+         CALL iom_put( 'sss_m', sss_m )
+         CALL iom_put( 'ssh_m', ssh_m )
+         IF( lk_vvl      )   CALL iom_put( 'e3t_m', e3t_m )
+         IF( ln_read_frq )   CALL iom_put( 'frq_m', frq_m )
       ENDIF
       !
@@ -138,8 +152,11 @@
       TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_2d       ! array of namelist information on the fields to read
       TYPE(FLD_N) :: sn_tem, sn_sal                     ! information about the fields to be read
-      TYPE(FLD_N) :: sn_usp, sn_vsp, sn_ssh
-      !
-      NAMELIST/namsbc_sas/cn_dir, ln_3d_uv, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh
-      !!----------------------------------------------------------------------
+      TYPE(FLD_N) :: sn_usp, sn_vsp
+      TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq
+      !
+      NAMELIST/namsbc_sas/cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq
+      !!----------------------------------------------------------------------
+      
+      IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN
       
       REWIND( numnam_ref )              ! Namelist namsbc_sas in reference namelist : Input fields
@@ -159,7 +176,8 @@
          WRITE(numout,*) '~~~~~~~~~~~ '
          WRITE(numout,*) '   Namelist namsbc_sas'
+         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve
+         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq
          WRITE(numout,*)
       ENDIF
-      
       !
       !! switch off stuff that isn't sensible with a standalone module
@@ -170,8 +188,4 @@
          ln_apr_dyn = .FALSE.
       ENDIF
-      IF( ln_dm2dc ) THEN
-         IF( lwp ) WRITE(numout,*) 'No diurnal cycle needed with StandAlone Surface scheme'
-         ln_dm2dc = .FALSE.
-      ENDIF
       IF( ln_rnf ) THEN
          IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme'
@@ -190,23 +204,22 @@
          nn_closea = 0
       ENDIF
-
       ! 
       !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and
       !! when we have other 3d arrays that we need to read in
       !! so if a new field is added i.e. jf_new, just give it the next integer in sequence
-      !! for the corresponding dimension (currently if ln_3d_uv is true, 4 for 2d and 3 for 3d,
-      !! alternatively if ln_3d_uv is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,
+      !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d,
+      !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,
       !! and the rest of the logic should still work
       !
-      jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3
-      !
-      IF( ln_3d_uv ) THEN
-         jf_usp = 1 ; jf_vsp = 2
-         nfld_3d  = 2
-         nfld_2d  = 3
+      jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4   ! default 2D fields index
+      !
+      IF( ln_3d_uve ) THEN
+         jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3      ! define 3D fields index
+         nfld_3d  = 2 + COUNT( (/lk_vvl/) )        ! number of 3D fields to read
+         nfld_2d  = 3 + COUNT( (/ln_read_frq/) )   ! number of 2D fields to read
       ELSE
-         jf_usp = 4 ; jf_vsp = 5
-         nfld_3d  = 0
-         nfld_2d  = 5
+         jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/lk_vvl/) )   ! update 2D fields index
+         nfld_3d  = 0                                                              ! no 3D fields to read
+         nfld_2d  = 5 + COUNT( (/lk_vvl/) ) + COUNT( (/ln_read_frq/) )             ! number of 2D fields to read
       ENDIF
 
@@ -216,8 +229,7 @@
             CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' )   ;   RETURN
          ENDIF
-         IF( ln_3d_uv ) THEN
-            slf_3d(jf_usp) = sn_usp
-            slf_3d(jf_vsp) = sn_vsp
-         ENDIF
+         slf_3d(jf_usp) = sn_usp
+         slf_3d(jf_vsp) = sn_vsp
+         IF( lk_vvl )   slf_3d(jf_e3t) = sn_e3t
       ENDIF
 
@@ -228,9 +240,12 @@
          ENDIF
          slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh
-         IF( .NOT. ln_3d_uv ) THEN
+         IF( ln_read_frq )   slf_2d(jf_frq) = sn_frq
+         IF( .NOT. ln_3d_uve ) THEN
             slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp
-         ENDIF
-      ENDIF
-      !
+            IF( lk_vvl )   slf_2d(jf_e3t) = sn_e3t
+         ENDIF
+      ENDIF
+      !
+      ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false. 
       IF( nfld_3d > 0 ) THEN
          ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure
@@ -265,23 +280,12 @@
       ENDIF
       !
-      ! lim code currently uses surface temperature and salinity in tsn array for initialisation
-      ! and ub, vb arrays in ice dynamics
-      ! so allocate enough of arrays to use
-      !
-      ierr3 = 0
-      jpm = MAX(jp_tem, jp_sal)
-      ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 )
-      ALLOCATE( ub(jpi,jpj,1)     , STAT=ierr1 )
-      ALLOCATE( vb(jpi,jpj,1)     , STAT=ierr2 )
-      IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 )
-      ierr = ierr0 + ierr1 + ierr2 + ierr3
-      IF( ierr > 0 ) THEN
-         CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays')
-      ENDIF
-      !
       ! finally tidy up
 
       IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr )
       IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr )
+
+      CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in limistate
+      IF( .NOT. ln_read_frq )   frq_m(:,:) = 1.
+      l_initdone = .TRUE.
       !
    END SUBROUTINE sbc_ssm_init
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/step.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/step.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/step.F90	(revision 5901)
@@ -17,4 +17,6 @@
    USE dom_oce          ! ocean space and time domain variables 
    USE in_out_manager   ! I/O manager
+   USE sbc_oce
+   USE sbccpl
    USE iom              !
    USE lbclnk
@@ -36,4 +38,9 @@
    USE timing           ! Timing            
 
+   USE bdy_par          ! clem: mandatory for LIM3
+#if defined key_bdy
+   USE bdydta           ! clem: mandatory for LIM3
+#endif
+
    IMPLICIT NONE
    PRIVATE
@@ -46,5 +53,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: step.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -72,11 +79,19 @@
       kstp = nit000 + Agrif_Nb_Step()
 # if defined key_iomput
-      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( "nemo" )
+      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context )
 # endif   
 #endif   
-      IF( kstp == nit000 )   CALL iom_init( "nemo" )       ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
+      IF( kstp == nit000 )   CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
       IF( kstp /= nit000 )   CALL day( kstp )             ! Calendar (day was already called at nit000 in day_init)
-                             CALL iom_setkt( kstp, "nemo" )       ! say to iom that we are at time step kstp
+                             CALL iom_setkt( kstp - nit000 + 1, cxios_context )   ! tell iom we are at time step kstp
 
+      ! ==> clem: open boundaries is mandatory for LIM3 because ice BDY is not decoupled from  
+      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
+      !           From SAS: ocean bdy data are wrong  (but we do not care) and ice bdy data are OK.  
+      !           This is not clean and should be changed in the future. 
+#if defined key_bdy
+      IF( lk_bdy     )       CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries
+#endif
+      ! ==>
                              CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
 
@@ -86,6 +101,13 @@
                                                           ! need to keep the same interface 
                              CALL stp_ctl( kstp, indic )
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Coupled mode
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( lk_oasis    )  CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges if OASIS-coupled ice
+
 #if defined key_iomput
-      IF( kstp == nitend )   CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF
+      IF( kstp == nitend .OR. indic < 0 ) THEN 
+                             CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
+      ENDIF
 #endif
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/stpctl.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/stpctl.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/SAS_SRC/stpctl.F90	(revision 5901)
@@ -28,5 +28,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: stpctl.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/C14b/trcice_c14b.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/C14b/trcice_c14b.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/C14b/trcice_c14b.F90	(revision 5901)
@@ -0,0 +1,47 @@
+MODULE trcice_c14b
+   !!======================================================================
+   !!                         ***  MODULE trcice_c14b  ***
+   !!======================================================================
+#if defined key_c14b
+   !!----------------------------------------------------------------------
+   !!   'key_c14b'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! trc_ice_c14b       : MY_TRC model main routine
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ice_ini_c14b       ! called by trcice.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcice_c14b.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ice_ini_c14b
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ice_c14b  ***
+      !!
+      !!----------------------------------------------------------------------
+      !
+      !
+   END SUBROUTINE trc_ice_ini_c14b
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MY_TRC model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ice_ini_c14b             ! Empty routine
+   END SUBROUTINE trc_ice_ini_c14b
+#endif
+
+   !!======================================================================
+END MODULE trcice_c14b
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90	(revision 5901)
@@ -50,9 +50,8 @@
 
    !! * Substitutions
-#  include "top_substitute.h90"
-
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90	(revision 5901)
@@ -6,5 +6,5 @@
    !! History :   1.0  !  2009-05 (C. Ethe)  Original code
    !!----------------------------------------------------------------------
-#if defined key_top && key_c14b && defined key_iomput
+#if defined key_top && defined key_c14b && defined key_iomput
    !!----------------------------------------------------------------------
    !!   'key_c14b'                                           c14b model
@@ -20,5 +20,4 @@
    PUBLIC trc_wri_c14b 
 
-#  include "top_substitute.h90"
 CONTAINS
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90	(revision 5901)
@@ -0,0 +1,53 @@
+MODULE trcice_cfc
+   !!======================================================================
+   !!                         ***  MODULE trcice_cfc  ***
+   !! TOP :   Main module of the MY_TRC tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+#if defined key_cfc
+   !!----------------------------------------------------------------------
+   !!   'key_cfc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! trc_ice_cfc       : MY_TRC model main routine
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ice_ini_cfc       ! called by trcice.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcice_cfc.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ice_ini_cfc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ice_cfc  ***
+      !!
+      !! ** Purpose :   main routine of MY_TRC model
+      !!
+      !! ** Method  : -
+      !!----------------------------------------------------------------------
+      !
+      !
+   END SUBROUTINE trc_ice_ini_cfc
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MY_TRC model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ice_ini_cfc             ! Empty routine
+   END SUBROUTINE trc_ice_ini_cfc
+#endif
+
+   !!======================================================================
+END MODULE trcice_cfc
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90	(revision 5901)
@@ -51,5 +51,5 @@
 
    !! * Substitutions
-#  include "top_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90	(revision 5901)
@@ -6,5 +6,5 @@
    !! History :   1.0  !  2009-05 (C. Ethe)  Original code
    !!----------------------------------------------------------------------
-#if defined key_top && key_cfc && defined key_iomput
+#if defined key_top && defined key_cfc && defined key_iomput
    !!----------------------------------------------------------------------
    !!   'key_cfc'                                           cfc model
@@ -20,5 +20,4 @@
    PUBLIC trc_wri_cfc 
 
-#  include "top_substitute.h90"
 CONTAINS
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90	(revision 5901)
@@ -0,0 +1,46 @@
+MODULE trcice_my_trc
+   !!======================================================================
+   !!                         ***  MODULE trcice_my_trc  ***
+   !!----------------------------------------------------------------------
+#if defined key_my_trc
+   !!----------------------------------------------------------------------
+   !!   'key_my_trc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! trc_ice_my_trc       : MY_TRC model main routine
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ice_ini_my_trc       ! called by trcice.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcice_my_trc.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ice_ini_my_trc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ice_my_trc  ***
+      !!
+      !!----------------------------------------------------------------------
+      !
+      !
+   END SUBROUTINE trc_ice_ini_my_trc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MY_TRC model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ice_ini_my_trc             ! Empty routine
+   END SUBROUTINE trc_ice_ini_my_trc
+#endif
+
+   !!======================================================================
+END MODULE trcice_my_trc
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90	(revision 5901)
@@ -42,8 +42,12 @@
 
       IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: initialisation of MY_TRC model'
+      IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: passive tracer unit vector'
+      IF(lwp) WRITE(numout,*) ' To check conservation : '
+      IF(lwp) WRITE(numout,*) '   1 - No sea-ice model '
+      IF(lwp) WRITE(numout,*) '   2 - No runoff ' 
+      IF(lwp) WRITE(numout,*) '   3 - precipitation and evaporation equal to 1 : E=P=1 ' 
       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
       
-      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 0.
+      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 1.
       !
    END SUBROUTINE trc_ini_my_trc
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 5901)
@@ -46,5 +46,5 @@
       INTEGER ::   jn   ! dummy loop index
       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrmyt
-!!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('trc_sms_my_trc')
@@ -55,10 +55,4 @@
 
       IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt )
-
-      WHERE( (glamt <= 170) .AND. (glamt >= 160) .AND. (gphit <= -74) .AND. (gphit >=-75.6) )
-        trn(:,:,1,jpmyt1) = 1._wp
-        trb(:,:,1,jpmyt1) = 1._wp
-        tra(:,:,1,jpmyt1) = 0._wp
-      END WHERE
 
       IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90	(revision 5901)
@@ -6,5 +6,5 @@
    !! History :   1.0  !  2009-05 (C. Ethe)  Original code
    !!----------------------------------------------------------------------
-#if defined key_top && key_my_trc && defined key_iomput
+#if defined key_top && defined key_my_trc && defined key_iomput
    !!----------------------------------------------------------------------
    !!   'key_my_trc'                                           my_trc model
@@ -20,5 +20,4 @@
    PUBLIC trc_wri_my_trc 
 
-#  include "top_substitute.h90"
 CONTAINS
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90	(revision 5901)
@@ -59,9 +59,10 @@
    REAL(wp) ::   fdbod      ! zooplankton mortality fraction that goes to detritus
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p2zbio.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -599,3 +600,3 @@
 
    !!======================================================================
-END MODULE  p2zbio
+END MODULE p2zbio
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90	(revision 5901)
@@ -41,9 +41,10 @@
    REAL(wp)                                ::   areacot   !: surface coastal area
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: trcexp.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90	(revision 5901)
@@ -40,9 +40,9 @@
    REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: trcopt.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -89,5 +89,8 @@
 
       !                                          ! surface irradiance
-      zpar0m (:,:)   = qsr   (:,:) * 0.43        ! ------------------
+      !                                          ! ------------------
+      IF( ln_dm2dc ) THEN   ;   zpar0m(:,:) = qsr_mean(:,:) * 0.43
+      ELSE                  ;   zpar0m(:,:) = qsr     (:,:) * 0.43
+      ENDIF
       zpar100(:,:)   = zpar0m(:,:) * 0.01
       zparr  (:,:,1) = zpar0m(:,:) * 0.5
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90	(revision 5901)
@@ -34,9 +34,9 @@
    REAL(wp), PUBLIC ::   xhr         ! coeff for martin''s remineralisation profile
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p2z_sed.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90	(revision 5901)
@@ -32,5 +32,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p2zsms.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -84,3 +84,3 @@
 
    !!======================================================================
-END MODULE  p2zsms
+END MODULE p2zsms
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90	(revision 5901)
@@ -34,6 +34,6 @@
    PUBLIC  p4z_bio    
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -44,5 +44,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_bio ( kt, jnt )
+   SUBROUTINE p4z_bio ( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_bio  ***
@@ -54,10 +54,6 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kt, jnt
-      INTEGER  ::  ji, jj, jk, jn
-      REAL(wp) ::  ztra
-#if defined key_kriest
-      REAL(wp) ::  zcoef1, zcoef2
-#endif
+      INTEGER, INTENT(in) :: kt, knt
+      INTEGER             :: ji, jj, jk, jn
       CHARACTER (len=25) :: charout
 
@@ -80,54 +76,21 @@
 
           
-      CALL p4z_opt  ( kt, jnt )     ! Optic: PAR in the water column
-      CALL p4z_sink ( kt, jnt )     ! vertical flux of particulate organic matter
-      CALL p4z_fechem(kt, jnt )     ! Iron chemistry/scavenging
-      CALL p4z_lim  ( kt, jnt )     ! co-limitations by the various nutrients
-      CALL p4z_prod ( kt, jnt )     ! phytoplankton growth rate over the global ocean. 
+      CALL p4z_opt  ( kt, knt )     ! Optic: PAR in the water column
+      CALL p4z_sink ( kt, knt )     ! vertical flux of particulate organic matter
+      CALL p4z_fechem(kt, knt )     ! Iron chemistry/scavenging
+      CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients
+      CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean. 
       !                             ! (for each element : C, Si, Fe, Chl )
       CALL p4z_mort ( kt      )     ! phytoplankton mortality
-      !                             ! zooplankton sources/sinks routines 
-      CALL p4z_micro( kt, jnt )           ! microzooplankton
-      CALL p4z_meso ( kt, jnt )           ! mesozooplankton
-      CALL p4z_rem  ( kt, jnt )     ! remineralization terms of organic matter+scavenging of Fe
+     !                             ! zooplankton sources/sinks routines 
+      CALL p4z_micro( kt, knt )           ! microzooplankton
+      CALL p4z_meso ( kt, knt )           ! mesozooplankton
+      CALL p4z_rem  ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe
       !                             ! test if tracers concentrations fall below 0.
-      xnegtr(:,:,:) = 1.e0
-      DO jn = jp_pcs0, jp_pcs1
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( ( trn(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
-                     ztra             = ABS( trn(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
-
-                     xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra )
-                  ENDIF
-              END DO
-            END DO
-         END DO
-      END DO
-      !                                ! where at least 1 tracer concentration becomes negative
-      !                                ! 
-      DO jn = jp_pcs0, jp_pcs1
-         trn(:,:,:,jn) = trn(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
-      END DO
-
-
-      tra(:,:,:,:) = 0.e0
-
-#if defined key_kriest
-      ! 
-      zcoef1 = 1.e0 / xkr_massp 
-      zcoef2 = 1.e0 / xkr_massp / 1.1
-      DO jk = 1,jpkm1
-         trn(:,:,jk,jpnum) = MAX(  trn(:,:,jk,jpnum), trn(:,:,jk,jppoc) * zcoef1 / xnumm(jk)  )
-         trn(:,:,jk,jpnum) = MIN(  trn(:,:,jk,jpnum), trn(:,:,jk,jppoc) * zcoef2              )
-      END DO
-#endif
-
-      !
+      !                                                             !
       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('bio ')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -146,4 +109,3 @@
 
    !!======================================================================
-END MODULE  p4zbio
-
+END MODULE p4zbio
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90	(revision 5901)
@@ -164,9 +164,9 @@
    REAL(wp) :: devk55  = 0.3692E-3      
 
-   !!* Substitution
-#include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p4zche.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -195,7 +195,5 @@
       ! CHEMICAL CONSTANTS - SURFACE LAYER
       ! ----------------------------------
-!CDIR NOVERRCHK
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             !                             ! SET ABSOLUTE TEMPERATURE
@@ -227,9 +225,6 @@
       ! OXYGEN SOLUBILITY - DEEP OCEAN
       ! -------------------------------
-!CDIR NOVERRCHK
       DO jk = 1, jpk
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
               ztkel = tsn(ji,jj,jk,jp_tem) + 273.16
@@ -252,9 +247,6 @@
       ! CHEMICAL CONSTANTS - DEEP OCEAN
       ! -------------------------------
-!CDIR NOVERRCHK
       DO jk = 1, jpk
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
 
@@ -396,3 +388,3 @@
 
    !!======================================================================
-END MODULE  p4zche
+END MODULE p4zche
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90	(revision 5901)
@@ -39,6 +39,6 @@
    REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -48,5 +48,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_fechem( kt, jnt )
+   SUBROUTINE p4z_fechem( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_fechem  ***
@@ -62,5 +62,5 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
       !
       INTEGER  ::   ji, jj, jk, jic
@@ -101,5 +101,5 @@
       ! -------------------------------------------------
       IF( ln_ligvar ) THEN
-         ztotlig(:,:,:) =  0.09 * trn(:,:,:,jpdoc) * 1E6 + ligand * 1E9
+         ztotlig(:,:,:) =  0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9
          ztotlig(:,:,:) =  MIN( ztotlig(:,:,:), 10. )
       ELSE
@@ -113,9 +113,6 @@
          ! Chemistry is supposed to be fast enough to be at equilibrium
          ! ------------------------------------------------------------
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   ! Calculate ligand concentrations : assume 2/3rd of excess goes to
@@ -127,5 +124,5 @@
                   zionic = 19.9201 * tsn(ji,jj,jk,jp_sal) / ( 1000. - 1.00488 * tsn(ji,jj,jk,jp_sal) + rtrn )
                   zph    = -LOG10( MAX( hi(ji,jj,jk), rtrn) )
-                  zoxy   = trn(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 )
+                  zoxy   = trb(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 )
                   ! Fe2+ oxydation rate from Santana-Casiano et al. (2005)
                   zkox   = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tsn(ji,jj,jk,jp_tem) + 273.15 )  &
@@ -137,5 +134,5 @@
                   zkph1 = zkph2 / 5.
                   ! pass the dfe concentration from PISCES
-                  ztfe = trn(ji,jj,jk,jpfer) * 1e9
+                  ztfe = trb(ji,jj,jk,jpfer) * 1e9
                   ! ----------------------------------------------------------
                   ! ANALYTICAL SOLUTION OF ROOTS OF THE FE3+ EQUATION
@@ -195,14 +192,11 @@
          ! Chemistry is supposed to be fast enough to be at equilibrium
          ! ------------------------------------------------------------
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   zTL1(ji,jj,jk) = ztotlig(ji,jj,jk)
                   zkeq           = fekeq(ji,jj,jk)
                   zfesatur       = zTL1(ji,jj,jk) * 1E-9
-                  ztfe           = trn(ji,jj,jk,jpfer) 
+                  ztfe           = trb(ji,jj,jk,jpfer) 
                   ! Fe' is the root of a 2nd order polynom
                   zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               &
@@ -210,5 +204,5 @@
                      &               + 4. * ztfe * zkeq) ) / ( 2. * zkeq )
                   zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9
-                  zFeL1(ji,jj,jk) = MAX( 0., trn(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) )
+                  zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) )
               END DO
             END DO
@@ -216,11 +210,9 @@
          !
       ENDIF
-
+      !
       zdust = 0.         ! if no dust available
-!CDIR NOVERRCHK
+      !
       DO jk = 1, jpkm1
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                zstep = xstep
@@ -240,7 +232,7 @@
                ENDIF
 #if defined key_kriest
-               ztrc   = ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi) ) * 1.e6 
+               ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 
 #else
-               ztrc   = ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi) ) * 1.e6 
+               ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 
 #endif
                IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s
@@ -251,7 +243,7 @@
                ! to later allocate scavenged iron to the different organic pools
                ! ---------------------------------------------------------
-               zdenom1 = xlam1 * trn(ji,jj,jk,jppoc) / zlam1b
+               zdenom1 = xlam1 * trb(ji,jj,jk,jppoc) / zlam1b
 #if ! defined key_kriest
-               zdenom2 = xlam1 * trn(ji,jj,jk,jpgoc) / zlam1b
+               zdenom2 = xlam1 * trb(ji,jj,jk,jpgoc) / zlam1b
 #endif
 
@@ -262,6 +254,6 @@
                zlamfac = MIN( 1.  , zlamfac )
                zdep    = MIN( 1., 1000. / fsdept(ji,jj,jk) )
-               zlam1b  = xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) )
-               zcoag   = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trn(ji,jj,jk,jpfer)
+               zlam1b  = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) )
+               zcoag   = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer)
 
                !  Compute the coagulation of colloidal iron. This parameterization 
@@ -269,6 +261,6 @@
                !  It requires certainly some more work as it is very poorly constrained.
                !  ----------------------------------------------------------------
-               zlam1a  = ( 0.369  * 0.3 * trn(ji,jj,jk,jpdoc) + 102.4  * trn(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
-                   &   + ( 114.   * 0.3 * trn(ji,jj,jk,jpdoc) + 5.09E3 * trn(ji,jj,jk,jppoc) )
+               zlam1a  = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
+                   &   + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) + 5.09E3 * trb(ji,jj,jk,jppoc) )
                zaggdfea = zlam1a * zstep * zfecoll
 #if defined key_kriest
@@ -278,5 +270,5 @@
                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea + zaggdfeb
 #else
-               zlam1b = 3.53E3 *   trn(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
+               zlam1b = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
                zaggdfeb = zlam1b * zstep * zfecoll
                !
@@ -292,12 +284,12 @@
       !  ----------------------------------------
       IF( ln_fechem ) THEN
-          biron(:,:,:) = MAX( 0., trn(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 )
+          biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 )
       ELSE
-          biron(:,:,:) = trn(:,:,:,jpfer) 
+          biron(:,:,:) = trb(:,:,:,jpfer) 
       ENDIF
 
       !  Output of some diagnostics variables
       !     ---------------------------------
-      IF( lk_iomput .AND. jnt == nrdttrc ) THEN
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
          IF( iom_use("Fe3")    )  CALL iom_put("Fe3"    , zFe3   (:,:,:)       * tmask(:,:,:) )   ! Fe3+
          IF( iom_use("FeL1")   )  CALL iom_put("FeL1"   , zFeL1  (:,:,:)       * tmask(:,:,:) )   ! FeL1
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90	(revision 5901)
@@ -59,14 +59,14 @@
    REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion 
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p4zflx.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE p4z_flx ( kt )
+   SUBROUTINE p4z_flx ( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_flx  ***
@@ -81,5 +81,5 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt   !
+      INTEGER, INTENT(in) ::   kt, knt   !
       !
       INTEGER  ::   ji, jj, jm, iind, iindm1
@@ -101,5 +101,5 @@
       !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2
 
-      IF( kt /= nit000 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs
+      IF( kt /= nit000 .AND. knt == 1 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs
 
       IF( ln_co2int ) THEN 
@@ -122,7 +122,5 @@
 
       DO jm = 1, 10
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
 
@@ -130,7 +128,7 @@
                zbot  = borat(ji,jj,1)
                zfact = rhop(ji,jj,1) / 1000. + rtrn
-               zdic  = trn(ji,jj,1,jpdic) / zfact
+               zdic  = trb(ji,jj,1,jpdic) / zfact
                zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact
-               zalka = trn(ji,jj,1,jptal) / zfact
+               zalka = trb(ji,jj,1,jptal) / zfact
 
                ! CALCULATE [ALK]([CO3--], [HCO3-])
@@ -155,7 +153,5 @@
       ! -------------------------------------------
 
-!CDIR NOVERRCHK
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) )
@@ -184,13 +180,13 @@
             zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)   ! (mol/L) * (m/s)
             zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ?
-            oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000.
+            oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000.
             ! compute the trend
-            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1)
+            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / fse3t(ji,jj,1)
 
             ! Compute O2 flux 
             zfld16 = atcox * patm(ji,jj) * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s)
-            zflu16 = trn(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj)
+            zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj)
             zoflx(ji,jj) = zfld16 - zflu16
-            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) / fse3t(ji,jj,1)
+            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / fse3t(ji,jj,1)
          END DO
       END DO
@@ -207,8 +203,8 @@
       ENDIF
 
-      IF( lk_iomput ) THEN
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
          CALL wrk_alloc( jpi, jpj, zw2d )  
          IF( iom_use( "Cflx"  ) )  THEN
-            zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) / rfact
+            zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r
             CALL iom_put( "Cflx"     , zw2d ) 
          ENDIF
@@ -226,5 +222,5 @@
          ENDIF
          IF( iom_use( "Dpo2" ) )  THEN
-           zw2d(:,:) = ( atcox * patm(:,:) - trn(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1)
+           zw2d(:,:) = ( atcox * patm(:,:) - trb(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1)
            CALL iom_put( "Dpo2"  , zw2d )
          ENDIF
@@ -235,5 +231,5 @@
       ELSE
          IF( ln_diatrc ) THEN
-            trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) / rfact 
+            trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) * rfact2r 
             trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1) 
             trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1) 
@@ -400,3 +396,3 @@
 
    !!======================================================================
-END MODULE  p4zflx
+END MODULE p4zflx
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90	(revision 5901)
@@ -26,5 +26,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p4zint.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -56,5 +56,5 @@
       DO ji = 1, jpi
          DO jj = 1, jpj
-            zvar = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil)
+            zvar = trb(ji,jj,1,jpsil) * trb(ji,jj,1,jpsil)
             xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 )
          END DO
@@ -81,3 +81,3 @@
 
    !!======================================================================
-END MODULE  p4zint
+END MODULE p4zint
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90	(revision 5901)
@@ -52,6 +52,5 @@
    REAL(wp) ::  xcoef2   = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5
    REAL(wp) ::  xcoef3   = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5 
-   !!* Substitution
-#  include "top_substitute.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -62,5 +61,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_lim( kt, jnt )
+   SUBROUTINE p4z_lim( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_lim  ***
@@ -72,10 +71,10 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in)  :: kt, jnt
+      INTEGER, INTENT(in)  :: kt, knt
       !
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim
       REAL(wp) ::   zconcd, zconcd2, zconcn, zconcn2
-      REAL(wp) ::   z1_trndia, z1_trnphy, ztem1, ztem2, zetot1, zetot2
+      REAL(wp) ::   z1_trbdia, z1_trbphy, ztem1, ztem2, zetot1, zetot2
       REAL(wp) ::   zdenom, zratio, zironmin
       REAL(wp) ::   zconc1d, zconc1dnh4, zconc0n, zconc0nnh4   
@@ -90,37 +89,37 @@
                ! Tuning of the iron concentration to a minimum level that is set to the detection limit
                !-------------------------------------
-               zno3    = trn(ji,jj,jk,jpno3) / 40.e-6
+               zno3    = trb(ji,jj,jk,jpno3) / 40.e-6
                zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 )
                zferlim = MIN( zferlim, 7e-11 )
-               trn(ji,jj,jk,jpfer) = MAX( trn(ji,jj,jk,jpfer), zferlim )
+               trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim )
 
                ! Computation of a variable Ks for iron on diatoms taking into account
                ! that increasing biomass is made of generally bigger cells
                !------------------------------------------------
-               zconcd   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia )
-               zconcd2  = trn(ji,jj,jk,jpdia) - zconcd
-               zconcn   = MAX( 0.e0 , trn(ji,jj,jk,jpphy) - xsizephy )
-               zconcn2  = trn(ji,jj,jk,jpphy) - zconcn
-               z1_trnphy   = 1. / ( trn(ji,jj,jk,jpphy) + rtrn )
-               z1_trndia   = 1. / ( trn(ji,jj,jk,jpdia) + rtrn )
-
-               concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trndia )
-               zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trndia )
-               zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trndia )
-
-               concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trnphy )
-               zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trnphy )
-               zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trnphy )
+               zconcd   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
+               zconcd2  = trb(ji,jj,jk,jpdia) - zconcd
+               zconcn   = MAX( 0.e0 , trb(ji,jj,jk,jpphy) - xsizephy )
+               zconcn2  = trb(ji,jj,jk,jpphy) - zconcn
+               z1_trbphy   = 1. / ( trb(ji,jj,jk,jpphy) + rtrn )
+               z1_trbdia   = 1. / ( trb(ji,jj,jk,jpdia) + rtrn )
+
+               concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia )
+               zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia )
+               zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia )
+
+               concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy )
+               zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy )
+               zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy )
 
                ! Michaelis-Menten Limitation term for nutrients Small bacteria
                ! -------------------------------------------------------------
-               zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * trn(ji,jj,jk,jpno3) + concbno3 * trn(ji,jj,jk,jpnh4) )
-               xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concbnh4 * zdenom
-               xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * concbno3 * zdenom
+               zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * trb(ji,jj,jk,jpno3) + concbno3 * trb(ji,jj,jk,jpnh4) )
+               xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * concbnh4 * zdenom
+               xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * concbno3 * zdenom
                !
                zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
-               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concbnh4 )
-               zlim3    = trn(ji,jj,jk,jpfer) / ( concbfe + trn(ji,jj,jk,jpfer) )
-               zlim4    = trn(ji,jj,jk,jpdoc) / ( xkdoc   + trn(ji,jj,jk,jpdoc) )
+               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbnh4 )
+               zlim3    = trb(ji,jj,jk,jpfer) / ( concbfe + trb(ji,jj,jk,jpfer) )
+               zlim4    = trb(ji,jj,jk,jpdoc) / ( xkdoc   + trb(ji,jj,jk,jpdoc) )
                xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
                xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4
@@ -128,12 +127,12 @@
                ! Michaelis-Menten Limitation term for nutrients Small flagellates
                ! -----------------------------------------------
-               zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trn(ji,jj,jk,jpno3) + zconc0n * trn(ji,jj,jk,jpnh4) )
-               xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom
-               xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc0n    * zdenom
+               zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trb(ji,jj,jk,jpno3) + zconc0n * trb(ji,jj,jk,jpnh4) )
+               xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom
+               xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc0n    * zdenom
                !
                zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
-               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc0nnh4 )
-               zratio   = trn(ji,jj,jk,jpnfe) * z1_trnphy 
-               zironmin = xcoef1 * trn(ji,jj,jk,jpnch) * z1_trnphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk)
+               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc0nnh4 )
+               zratio   = trb(ji,jj,jk,jpnfe) * z1_trbphy 
+               zironmin = xcoef1 * trb(ji,jj,jk,jpnch) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk)
                zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim )
                xnanopo4(ji,jj,jk) = zlim2
@@ -143,13 +142,13 @@
                !   Michaelis-Menten Limitation term for nutrients Diatoms
                !   ----------------------------------------------
-               zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trn(ji,jj,jk,jpno3) + zconc1d * trn(ji,jj,jk,jpnh4) )
-               xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom
-               xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc1d    * zdenom
+               zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trb(ji,jj,jk,jpno3) + zconc1d * trb(ji,jj,jk,jpnh4) )
+               xdiatno3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom
+               xdiatnh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc1d    * zdenom
                !
                zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk)
-               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc1dnh4  )
-               zlim3    = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi(ji,jj) )
-               zratio   = trn(ji,jj,jk,jpdfe) * z1_trndia
-               zironmin = xcoef1 * trn(ji,jj,jk,jpdch) * z1_trndia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk)
+               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc1dnh4  )
+               zlim3    = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) )
+               zratio   = trb(ji,jj,jk,jpdfe) * z1_trbdia
+               zironmin = xcoef1 * trb(ji,jj,jk,jpdch) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk)
                zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim )
                xdiatpo4(ji,jj,jk) = zlim2
@@ -166,16 +165,16 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zlim1 =  ( trn(ji,jj,jk,jpno3) * concnnh4 + trn(ji,jj,jk,jpnh4) * concnno3 )    &
-                  &   / ( concnno3 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + concnno3 * trn(ji,jj,jk,jpnh4) ) 
-               zlim2  = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 )
-               zlim3  = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) +  5.E-11   )
+               zlim1 =  ( trb(ji,jj,jk,jpno3) * concnnh4 + trb(ji,jj,jk,jpnh4) * concnno3 )    &
+                  &   / ( concnno3 * concnnh4 + concnnh4 * trb(ji,jj,jk,jpno3) + concnno3 * trb(ji,jj,jk,jpnh4) ) 
+               zlim2  = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnnh4 )
+               zlim3  = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) +  5.E-11   )
                ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) )
                ztem2  = tsn(ji,jj,jk,jp_tem) - 10.
-               zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) 
-               zetot2 = 30. / ( 30. + etot(ji,jj,jk) ) 
+               zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) ) 
+               zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) ) 
 
                xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  &
                   &                       * ztem1 / ( 0.1 + ztem1 )                     &
-                  &                       * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. )  &
+                  &                       * MAX( 1., trb(ji,jj,jk,jpphy) * 1.e6 / 2. )  &
                   &                       * zetot1 * zetot2               &
                   &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         &
@@ -188,5 +187,5 @@
       !
       !
-      IF( lk_iomput .AND. jnt == nrdttrc ) THEN        ! save output diagnostics
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN        ! save output diagnostics
         IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht
         IF( iom_use( "LNnut"   ) ) CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
@@ -265,3 +264,3 @@
 
    !!======================================================================
-END MODULE  p4zlim
+END MODULE p4zlim
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90	(revision 5901)
@@ -48,5 +48,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_lys( kt )
+   SUBROUTINE p4z_lys( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_lys  ***
@@ -59,10 +59,9 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
       INTEGER  ::   ji, jj, jk, jn
       REAL(wp) ::   zalk, zdic, zph, zah2
       REAL(wp) ::   zdispot, zfact, zcalcon, zalka, zaldi
       REAL(wp) ::   zomegaca, zexcess, zexcess0
-      REAL(wp) ::   zrfact2
       CHARACTER (len=25) :: charout
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss   
@@ -81,14 +80,11 @@
       DO jn = 1, 5                               !  BEGIN OF ITERATION
          !
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   zfact = rhop(ji,jj,jk) / 1000. + rtrn
                   zph  = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+]
-                  zdic  = trn(ji,jj,jk,jpdic) / zfact
-                  zalka = trn(ji,jj,jk,jptal) / zfact
+                  zdic  = trb(ji,jj,jk,jpdic) / zfact
+                  zalka = trb(ji,jj,jk,jptal) / zfact
                   ! CALCULATE [ALK]([CO3--], [HCO3-])
                   zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) )
@@ -130,5 +126,5 @@
                !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE
                !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION)
-               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal)
+               zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal)
 # if defined key_degrad
                zdispot = zdispot * facvol(ji,jj,jk)
@@ -136,6 +132,6 @@
               !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3],
               !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION
-              zcaldiss(ji,jj,jk)  = zdispot / rmtss  ! calcite dissolution
-              zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) * rfact
+              zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution
+              zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk)
               !
               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk)
@@ -147,9 +143,9 @@
       !
 
-      IF( lk_iomput ) THEN
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
          IF( iom_use( "PH"     ) ) CALL iom_put( "PH"    , -1. * LOG10( hi(:,:,:) )          * tmask(:,:,:) )
          IF( iom_use( "CO3"    ) ) CALL iom_put( "CO3"   , zco3(:,:,:) * 1.e+3               * tmask(:,:,:) )
          IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", aksp(:,:,:) * 1.e+3 / calcon      * tmask(:,:,:) )
-         IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) )
+         IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r   * tmask(:,:,:) )
       ELSE
          trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:)
@@ -224,3 +220,3 @@
 #endif 
    !!======================================================================
-END MODULE  p4zlys
+END MODULE p4zlys
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90	(revision 5901)
@@ -50,6 +50,4 @@
    REAL(wp), PUBLIC ::  grazflux     !: mesozoo flux feeding rate
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -60,5 +58,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_meso( kt, jnt )
+   SUBROUTINE p4z_meso( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_meso  ***
@@ -68,5 +66,5 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
       INTEGER  :: ji, jj, jk
       REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam
@@ -97,5 +95,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zcompam   = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
+               zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
 # if defined key_degrad
                zstep     = xstep * facvol(ji,jj,jk)
@@ -107,5 +105,5 @@
                !  Respiration rates of both zooplankton
                !  -------------------------------------
-               zrespz2   = resrat2 * zfact * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) )  &
+               zrespz2   = resrat2 * zfact * trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  &
                   &      + resrat2 * zfact * 3. * nitrfac(ji,jj,jk)
 
@@ -113,14 +111,14 @@
                !  no real reason except that it seems to be more stable and may mimic predation
                !  ---------------------------------------------------------------
-               ztortz2   = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes)
+               ztortz2   = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes)
                !
-               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )
-               zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )
+               zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )
+               zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )
                ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone
                ! it is to predation by mesozooplankton
                ! -------------------------------------------------------------------------------
-               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) &
+               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) &
                   &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) )
-               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )
+               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )
 
                zfood     = xprefc * zcompadi + xprefz * zcompaz + xprefp * zcompaph + xprefpoc * zcompapoc 
@@ -128,5 +126,5 @@
                zdenom    = zfoodlim / ( xkgraz2 + zfoodlim )
                zdenom2   = zdenom / ( zfood + rtrn )
-               zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpmes) 
+               zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) 
 
                zgrazd    = zgraze2  * xprefc   * zcompadi  * zdenom2 
@@ -135,7 +133,7 @@
                zgrazpoc  = zgraze2  * xprefpoc * zcompapoc * zdenom2 
 
-               zgraznf   = zgrazn   * trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn)
-               zgrazf    = zgrazd   * trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn)
-               zgrazpof  = zgrazpoc * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn)
+               zgraznf   = zgrazn   * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn)
+               zgrazf    = zgrazd   * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn)
+               zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn)
 
                !  Mesozooplankton flux feeding on GOC
@@ -144,10 +142,10 @@
 # if ! defined key_kriest
                zgrazffeg = grazflux  * zstep * wsbio4(ji,jj,jk)      &
-               &           * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)
-               zgrazfffg = zgrazffeg * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)
+               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)
+               zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
 # endif
                zgrazffep = grazflux  * zstep *  wsbio3(ji,jj,jk)     &
-               &           * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)
-               zgrazfffp = zgrazffep * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)
+               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes)
+               zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
               !
 # if ! defined key_kriest
@@ -158,10 +156,10 @@
               ! diatoms based aggregates are more prone to fractionation
               ! since they are more porous (marine snow instead of fecal pellets)
-              zratio    = trn(ji,jj,jk,jpgsi) / ( trn(ji,jj,jk,jpgoc) + rtrn )
+              zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn )
               zratio2   = zratio * zratio
               zfrac     = zproport * grazflux  * zstep * wsbio4(ji,jj,jk)      &
-               &          * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)          &
+               &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          &
                &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) )
-              zfracfe   = zfrac * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)
+              zfracfe   = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
 
               zgrazffep = zproport * zgrazffep
@@ -215,8 +213,8 @@
                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz
                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn
-               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trn(ji,jj,jk,jpnch) / ( trn(ji,jj,jk,jpphy) + rtrn )
-               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn )
+               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf
                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf
@@ -231,5 +229,5 @@
                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
 #if defined key_kriest
-              znumpoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )
+              znumpoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )
               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortzgoc - zgrazpoc - zgrazffep + zgrapoc2
               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc + zgrapoc2 * xkr_dmeso      &
@@ -248,5 +246,5 @@
       END DO
       !
-      IF( lk_iomput .AND. jnt == nrdttrc ) THEN
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
          CALL wrk_alloc( jpi, jpj, jpk, zw3d )
          IF( iom_use( "GRAZ2" ) ) THEN
@@ -340,3 +338,3 @@
 
    !!======================================================================
-END MODULE  p4zmeso
+END MODULE p4zmeso
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90	(revision 5901)
@@ -49,6 +49,4 @@
 
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -59,5 +57,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_micro( kt, jnt )
+   SUBROUTINE p4z_micro( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_micro  ***
@@ -68,5 +66,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::  kt  ! ocean time step
-      INTEGER, INTENT(in) ::  jnt 
+      INTEGER, INTENT(in) ::  knt 
       !
       INTEGER  :: ji, jj, jk
@@ -90,5 +88,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )
+               zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )
                zstep   = xstep
 # if defined key_degrad
@@ -99,5 +97,5 @@
                !  Respiration rates of both zooplankton
                !  -------------------------------------
-               zrespz = resrat * zfact * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) )  &
+               zrespz = resrat * zfact * trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  &
                   &   + resrat * zfact * 3. * nitrfac(ji,jj,jk)
 
@@ -105,9 +103,9 @@
                !  no real reason except that it seems to be more stable and may mimic predation.
                !  ---------------------------------------------------------------
-               ztortz = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo)
-
-               zcompadi  = MIN( MAX( ( trn(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )
-               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )
-               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )
+               ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo)
+
+               zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )
+               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )
+               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )
                
                !     Microzooplankton grazing
@@ -117,5 +115,5 @@
                zdenom    = zfoodlim / ( xkgraz + zfoodlim )
                zdenom2   = zdenom / ( zfood + rtrn )
-               zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpzoo) 
+               zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) 
 
                zgrazp    = zgraze  * xpref2p * zcompaph  * zdenom2 
@@ -123,7 +121,7 @@
                zgrazsd   = zgraze  * xpref2d * zcompadi  * zdenom2 
 
-               zgrazpf   = zgrazp  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)
-               zgrazmf   = zgrazm  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)
-               zgrazsf   = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)
+               zgrazpf   = zgrazp  * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn)
+               zgrazmf   = zgrazm  * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
+               zgrazsf   = zgrazsd * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn)
                !
                zgraztot  = zgrazp  + zgrazm  + zgrazsd 
@@ -165,8 +163,8 @@
                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp
                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd
-               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp  * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)
-               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trn(ji,jj,jk,jpdsi)/(trn(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trn(ji,jj,jk,jpdsi)/(trn(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp  * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
+               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf
                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf
@@ -184,5 +182,5 @@
 #if defined key_kriest
                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zmortz * xkr_dmicro &
-                                                         - zgrazm * trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )
+                                                         - zgrazm * trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )
 #endif
             END DO
@@ -190,5 +188,5 @@
       END DO
       !
-      IF( lk_iomput .AND. jnt == nrdttrc ) THEN
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
          CALL wrk_alloc( jpi, jpj, jpk, zw3d )
          IF( iom_use( "GRAZ1" ) ) THEN
@@ -273,3 +271,3 @@
 
    !!======================================================================
-END MODULE  p4zmicro
+END MODULE p4zmicro
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90	(revision 5901)
@@ -35,9 +35,7 @@
 
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p4zmort.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -85,5 +83,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
+               zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
                zstep    = xstep
 # if defined key_degrad
@@ -94,5 +92,5 @@
                !     due to turbulence is negligible. Mortality is also set
                !     to 0
-               zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trn(ji,jj,jk,jpphy)
+               zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trb(ji,jj,jk,jpphy)
                !     Squared mortality of Phyto similar to a sedimentation term during
                !     blooms (Doney et al. 1996)
@@ -102,5 +100,5 @@
                !     increased when nutrients are limiting phytoplankton growth
                !     as observed for instance in case of iron limitation.
-               ztortp = mprat * xstep * zcompaph / ( xkmort + trn(ji,jj,jk,jpphy) ) * zsizerat
+               ztortp = mprat * xstep * zcompaph / ( xkmort + trb(ji,jj,jk,jpphy) ) * zsizerat
 
                zmortp = zrespp + ztortp
@@ -108,6 +106,6 @@
                !   Update the arrays TRA which contains the biological sources and sinks
 
-               zfactfe = trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+rtrn)
-               zfactch = trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)
+               zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn)
+               zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp
                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch
@@ -172,5 +170,5 @@
             DO ji = 1, jpi
 
-               zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1e-9), 0. )
+               zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1e-9), 0. )
 
                !    Aggregation term for diatoms is increased in case of nutrient
@@ -186,9 +184,9 @@
                zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
                zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
-               zrespp2 = 1.e6 * zstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia)
+               zrespp2 = 1.e6 * zstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia)
 
                !     Phytoplankton mortality. 
                !     ------------------------
-               ztortp2 = mprat2 * zstep * trn(ji,jj,jk,jpdia)  / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 
+               ztortp2 = mprat2 * zstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi 
 
                zmortp2 = zrespp2 + ztortp2
@@ -196,7 +194,7 @@
                !   Update the arrays tra which contains the biological sources and sinks
                !   ---------------------------------------------------------------------
-               zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn )
-               zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )
-               zfactsi = trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
+               zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2 
                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch
@@ -277,3 +275,3 @@
 
    !!======================================================================
-END MODULE  p4zmort
+END MODULE p4zmort
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90	(revision 5901)
@@ -35,4 +35,5 @@
    REAL(wp) :: parlux      !: Fraction of shortwave as PAR
    REAL(wp) :: xparsw                 !: parlux/3
+   REAL(wp) :: xsi0r                 !:  1. /rn_si0
 
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_par      ! structure of input par
@@ -42,5 +43,7 @@
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat   !: PAR for phyto, nano and diat 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy      !: PAR over 24h in case of diurnal cycle
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy           !: averaged PAR in the mixed layer
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr  !: wavelength (Red-Green-Blue)
 
    INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m)
@@ -48,6 +51,6 @@
    REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption
    
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -57,5 +60,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_opt( kt, jnt )
+   SUBROUTINE p4z_opt( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_opt  ***
@@ -67,12 +70,12 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt, jnt   ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step
       !
       INTEGER  ::   ji, jj, jk
       INTEGER  ::   irgb
-      REAL(wp) ::   zchl, zxsi0r
+      REAL(wp) ::   zchl
       REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp, zetmp1, zetmp2
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zekg, zekr, zekb, ze0, ze1, ze2, ze3
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3
       !!---------------------------------------------------------------------
       !
@@ -80,120 +83,73 @@
       !
       ! Allocate temporary workspace
-      CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2 ) 
-      CALL wrk_alloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 )
-
-      IF( jnt == 1 .AND. ln_varpar ) CALL p4z_optsbc( kt )
+      CALL wrk_alloc( jpi, jpj,      zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+      CALL wrk_alloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 )
+
+      IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt )
 
       !     Initialisation of variables used to compute PAR
       !     -----------------------------------------------
-      ze1(:,:,jpk) = 0._wp
-      ze2(:,:,jpk) = 0._wp
-      ze3(:,:,jpk) = 0._wp
-
+      ze1(:,:,:) = 0._wp
+      ze2(:,:,:) = 0._wp
+      ze3(:,:,:) = 0._wp
       !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
       DO jk = 1, jpkm1                         !  --------------------------------------------------------
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
-               zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6
+               zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6
                zchl = MIN(  10. , MAX( 0.05, zchl )  )
                irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
                !                                                         
-               zekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)
-               zekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)
-               zekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)
+               ekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)
+               ekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)
+               ekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)
             END DO
          END DO
       END DO
-
-
       !                                        !* Photosynthetically Available Radiation (PAR)
       !                                        !  --------------------------------------
-
-      IF( ln_varpar ) THEN
-         ze1(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekb(:,:,1) )
-         ze2(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekg(:,:,1) )
-         ze3(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekr(:,:,1) )
+      IF( l_trcdm2dc ) THEN                     !  diurnal cycle
+         ! 1% of qsr to compute euphotic layer
+         zqsr100(:,:) = 0.01 * qsr_mean(:,:)     !  daily mean qsr
+         !
+         CALL p4z_opt_par( kt, qsr_mean, ze1, ze2, ze3 ) 
+         !
+         DO jk = 1, nksrp      
+            etot_ndcy(:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk)
+            enano    (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
+            ediat    (:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
+         END DO
+         !
+         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 
+         !
+         DO jk = 1, nksrp      
+            etot(:,:,jk) =  ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
+         END DO
+         !
       ELSE
-         ze1(:,:,1) = xparsw         * qsr(:,:) * EXP( -0.5 * zekb(:,:,1) )
-         ze2(:,:,1) = xparsw         * qsr(:,:) * EXP( -0.5 * zekg(:,:,1) )
-         ze3(:,:,1) = xparsw         * qsr(:,:) * EXP( -0.5 * zekr(:,:,1) )
-      ENDIF
-
-!CDIR NOVERRCHK
-      DO jj = 1, jpj
-!CDIR NOVERRCHK
-         DO ji = 1, jpi
-            zc1 = ze1(ji,jj,1)
-            zc2 = ze2(ji,jj,1) 
-            zc3 = ze3(ji,jj,1)
-            etot (ji,jj,1) = (       zc1 +        zc2 +       zc3 )
-            enano(ji,jj,1) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 )
-            ediat(ji,jj,1) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 )
-         END DO
-      END DO
-
-    
-      DO jk = 2, nksrp      
-!CDIR NOVERRCHK
-         DO jj = 1, jpj
-!CDIR NOVERRCHK
-            DO ji = 1, jpi
-               zc1 = ze1(ji,jj,jk-1) * EXP( -0.5 * ( zekb(ji,jj,jk-1) + zekb(ji,jj,jk) ) )
-               zc2 = ze2(ji,jj,jk-1) * EXP( -0.5 * ( zekg(ji,jj,jk-1) + zekg(ji,jj,jk) ) )
-               zc3 = ze3(ji,jj,jk-1) * EXP( -0.5 * ( zekr(ji,jj,jk-1) + zekr(ji,jj,jk) ) )
-               ze1  (ji,jj,jk) = zc1
-               ze2  (ji,jj,jk) = zc2
-               ze3  (ji,jj,jk) = zc3
-               etot (ji,jj,jk) = (       zc1 +        zc2 +       zc3 )
-               enano(ji,jj,jk) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 )
-               ediat(ji,jj,jk) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 )
-            END DO
-         END DO
-      END DO
+         ! 1% of qsr to compute euphotic layer
+         zqsr100(:,:) = 0.01 * qsr(:,:)
+         !
+         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 
+         !
+         DO jk = 1, nksrp      
+            etot (:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk)
+            enano(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
+            ediat(:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
+         END DO
+         etot_ndcy(:,:,:) =  etot(:,:,:) 
+      ENDIF
+
 
       IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics)
          !                                     !  ------------------------
-         zxsi0r = 1.e0 / rn_si0
-         !
-         ze0(:,:,1) = rn_abs * qsr(:,:)
-         !                                                    ! surface value : separation in R-G-B + near surface
-         IF( ln_varpar ) THEN
-            ze0(:,:,1) = ( 1. - 3. * par_varsw(:,:) ) * qsr(:,:)
-            ze1(:,:,1) = par_varsw(:,:)               * qsr(:,:)         
-            ze2(:,:,1) = par_varsw(:,:)               * qsr(:,:)
-            ze3(:,:,1) = par_varsw(:,:)               * qsr(:,:)
-         ELSE
-            ze0(:,:,1) = ( 1. - 3. * xparsw )  * qsr(:,:)
-            ze1(:,:,1) = xparsw                * qsr(:,:)         
-            ze2(:,:,1) = xparsw                * qsr(:,:)
-            ze3(:,:,1) = xparsw                * qsr(:,:)
-         ENDIF
+         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 )
+         !
          etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1)
-         !
-         !
          DO jk = 2, nksrp + 1
-!CDIR NOVERRCHK
-            DO jj = 1, jpj
-!CDIR NOVERRCHK
-               DO ji = 1, jpi
-                  zc0 = ze0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * zxsi0r )
-                  zc1 = ze1(ji,jj,jk-1) * EXP( -zekb(ji,jj,jk-1 ) )
-                  zc2 = ze2(ji,jj,jk-1) * EXP( -zekg(ji,jj,jk-1 ) )
-                  zc3 = ze3(ji,jj,jk-1) * EXP( -zekr(ji,jj,jk-1 ) )
-                  ze0(ji,jj,jk) = zc0
-                  ze1(ji,jj,jk) = zc1
-                  ze2(ji,jj,jk) = zc2
-                  ze3(ji,jj,jk) = zc3
-                  etot3(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk)
-              END DO
-              !
-            END DO
-            !
-        END DO
-        !
-      ENDIF
-
+            etot3(:,:,jk) =  ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk)
+         END DO
+         !                                     !  ------------------------
+      ENDIF
       !                                        !* Euphotic depth and level
       neln(:,:) = 1                            !  ------------------------
@@ -203,7 +159,7 @@
          DO jj = 1, jpj
            DO ji = 1, jpi
-              IF( etot(ji,jj,jk) * tmask(ji,jj,jk) >= 0.0043 * qsr(ji,jj) )  THEN
+              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.43 * zqsr100(ji,jj) )  THEN
                  neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer
-                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mxl_trc_zint
+                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
                  heup(ji,jj) = fsdepw(ji,jj,jk+1)      ! Euphotic layer depth
               ENDIF
@@ -211,22 +167,21 @@
         END DO
       END DO
- 
+      !
       heup(:,:) = MIN( 300., heup(:,:) )
-
       !                                        !* mean light over the mixed layer
       zdepmoy(:,:)   = 0.e0                    !  -------------------------------
-      zetmp  (:,:)   = 0.e0
       zetmp1 (:,:)   = 0.e0
       zetmp2 (:,:)   = 0.e0
+      zetmp3 (:,:)   = 0.e0
+      zetmp4 (:,:)   = 0.e0
 
       DO jk = 1, nksrp
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
-                  zetmp  (ji,jj) = zetmp  (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk)
-                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk)
-                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk)
+                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * fse3t(ji,jj,jk) ! remineralisation
+                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * fse3t(ji,jj,jk) ! production
+                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * fse3t(ji,jj,jk) ! production
+                  zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * fse3t(ji,jj,jk) ! production
                   zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk)
                ENDIF
@@ -235,35 +190,36 @@
       END DO
       !
-      emoy(:,:,:) = etot(:,:,:)
+      emoy(:,:,:) = etot(:,:,:)       ! remineralisation
+      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle 
       !
       DO jk = 1, nksrp
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
                   z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
-                  emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep
-                  enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep
-                  ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep
+                  emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep
+                  zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep
+                  enano(ji,jj,jk) = zetmp3(ji,jj) * z1_dep
+                  ediat(ji,jj,jk) = zetmp4(ji,jj) * z1_dep
                ENDIF
             END DO
          END DO
       END DO
-
+      !
       IF( lk_iomput ) THEN
-        IF( jnt == nrdttrc  ) THEN
-           IF( iom_use( "Heup" ) ) CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht
-           IF( iom_use( "PAR"  ) ) CALL iom_put( "PAR" , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
+        IF( knt == nrdttrc ) THEN
+           IF( iom_use( "Heup"  ) ) CALL iom_put( "Heup" , heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht
+           IF( iom_use( "PARDM" ) ) CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
+           IF( iom_use( "PAR"   ) ) CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
         ENDIF
       ELSE
          IF( ln_diatrc ) THEN        ! save output diagnostics
-            trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)  
+            trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)
             trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:)
          ENDIF
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2 )
-      CALL wrk_dealloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 )
+      CALL wrk_dealloc( jpi, jpj,      zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zpar,  ze0, ze1, ze2, ze3 )
       !
       IF( nn_timing == 1 )  CALL timing_stop('p4z_opt')
@@ -271,7 +227,71 @@
    END SUBROUTINE p4z_opt
 
-   SUBROUTINE p4z_optsbc( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine p4z_optsbc  ***
+   SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0 ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  routine p4z_opt_par  ***
+      !!
+      !! ** purpose :   compute PAR of each wavelength (Red-Green-Blue)
+      !!                for a given shortwave radiation
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT(in)                                       ::  kt            !   ocean time-step
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in)              ::  pqsr          !   shortwave
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::  pe1 , pe2 , pe3   !  PAR ( R-G-B)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL ::  pe0  
+      !! * local variables
+      INTEGER    ::   ji, jj, jk     ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj)     ::  zqsr          !   shortwave
+      !!----------------------------------------------------------------------
+
+      !  Real shortwave
+      IF( ln_varpar ) THEN  ;  zqsr(:,:) = par_varsw(:,:) * pqsr(:,:)
+      ELSE                  ;  zqsr(:,:) = xparsw         * pqsr(:,:)
+      ENDIF
+      !
+      IF( PRESENT( pe0 ) ) THEN     !  W-level
+         !
+         pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:)    !   ( 1 - 3 * alpha ) * q
+         pe1(:,:,1) = zqsr(:,:)         
+         pe2(:,:,1) = zqsr(:,:)
+         pe3(:,:,1) = zqsr(:,:)
+         !
+         DO jk = 2, nksrp + 1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * xsi0r )
+                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) )
+                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) )
+                  pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr(ji,jj,jk-1 ) )
+               END DO
+              !
+            END DO
+            !
+         END DO
+        !
+      ELSE   ! T- level
+        !
+        pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) )
+        pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) )
+        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) )
+        !
+        DO jk = 2, nksrp      
+           DO jj = 1, jpj
+              DO ji = 1, jpi
+                 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) )
+                 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) )
+                 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) )
+              END DO
+           END DO
+        END DO    
+        !
+      ENDIF
+      ! 
+   END SUBROUTINE p4z_opt_par
+
+
+   SUBROUTINE p4z_opt_sbc( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine p4z_opt_sbc  ***
       !!
       !! ** purpose :   read and interpolate the variable PAR fraction
@@ -284,5 +304,5 @@
       !!----------------------------------------------------------------------
       !! * arguments
-      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      INTEGER ,                INTENT(in) ::   kt     ! ocean time step
 
       !! * local declarations
@@ -297,5 +317,5 @@
          IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN
             CALL fld_read( kt, 1, sf_par )
-            par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) )/3.0
+            par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0
          ENDIF
       ENDIF
@@ -303,5 +323,5 @@
       IF( nn_timing == 1 )  CALL timing_stop('p4z_optsbc')
       !
-   END SUBROUTINE p4z_optsbc
+   END SUBROUTINE p4z_opt_sbc
 
    SUBROUTINE p4z_opt_init
@@ -347,4 +367,5 @@
       !
       xparsw = parlux / 3.0
+      xsi0r  = 1.e0 / rn_si0
       !
       ! Variable PAR at the surface of the ocean
@@ -372,8 +393,12 @@
       IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m'
       !
-                         etot (:,:,:) = 0._wp
-                         enano(:,:,:) = 0._wp
-                         ediat(:,:,:) = 0._wp
-      IF( ln_qsr_bio )   etot3(:,:,:) = 0._wp
+                         ekr      (:,:,:) = 0._wp
+                         ekb      (:,:,:) = 0._wp
+                         ekg      (:,:,:) = 0._wp
+                         etot     (:,:,:) = 0._wp
+                         etot_ndcy(:,:,:) = 0._wp
+                         enano    (:,:,:) = 0._wp
+                         ediat    (:,:,:) = 0._wp
+      IF( ln_qsr_bio )   etot3    (:,:,:) = 0._wp
       ! 
       IF( nn_timing == 1 )  CALL timing_stop('p4z_opt_init')
@@ -386,5 +411,7 @@
       !!                     ***  ROUTINE p4z_opt_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( enano(jpi,jpj,jpk), ediat(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 
+      ALLOCATE( ekb(jpi,jpj,jpk)      , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk),   &
+        &       enano(jpi,jpj,jpk)    , ediat(jpi,jpj,jpk), &
+        &       etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 
          !
       IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.')
@@ -402,3 +429,3 @@
 
    !!======================================================================
-END MODULE  p4zopt
+END MODULE p4zopt
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90	(revision 5901)
@@ -54,7 +54,6 @@
    REAL(wp) :: texcret2               !: 1 - excret2        
 
-
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -64,5 +63,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_prod( kt , jnt )
+   SUBROUTINE p4z_prod( kt , knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_prod  ***
@@ -74,5 +73,5 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) :: kt, jnt
+      INTEGER, INTENT(in) :: kt, knt
       !
       INTEGER  ::   ji, jj, jk
@@ -129,19 +128,17 @@
       END DO
 
-      IF( ln_newprod ) THEN
-         ! Impact of the day duration on phytoplankton growth
-         DO jk = 1, jpkm1
-            DO jj = 1 ,jpj
-               DO ji = 1, jpi
-                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
-                     zval = MAX( 1., zstrn(ji,jj) )
-                     zval = 1.5 * zval / ( 12. + zval )
-                     zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval
-                     zprdia(ji,jj,jk) = zprbio(ji,jj,jk)
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      ENDIF
+      ! Impact of the day duration on phytoplankton growth
+      DO jk = 1, jpkm1
+         DO jj = 1 ,jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  zval = MAX( 1., zstrn(ji,jj) )
+                  zval = 1.5 * zval / ( 12. + zval )
+                  zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval
+                  zprdia(ji,jj,jk) = zprbio(ji,jj,jk)
+               ENDIF
+            END DO
+         END DO
+      END DO
 
       ! Maximum light intensity
@@ -150,24 +147,21 @@
 
       IF( ln_newprod ) THEN
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   ! Computation of the P-I slope for nanos and diatoms
-                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                       ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
                       zadap       = xadap * ztn / ( 2.+ ztn )
-                      zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia )
-                      zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp
+                      zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
+                      zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp
                       znanotot    = enano(ji,jj,jk) * zstrn(ji,jj)
                       zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj)
                       !
                       zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap  * EXP( -znanotot ) )  &
-                         &                   * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn)
+                         &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn)
                       !
-                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn )   &
-                         &                   * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn)
+                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   &
+                         &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn)
 
                       ! Computation of production function for Carbon
@@ -188,38 +182,37 @@
          END DO
       ELSE
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
 
                   ! Computation of the P-I slope for nanos and diatoms
-                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                       ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
                       zadap       = ztn / ( 2.+ ztn )
-                      zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia )
-                      zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp
+                      zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
+                      zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp
+                      znanotot    = enano(ji,jj,jk) * zstrn(ji,jj)
+                      zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj)
                       !
-                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * EXP( -0.21 * enano(ji,jj,jk) ) )
-                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp)  / ( trn(ji,jj,jk,jpdia) + rtrn )
-
-                      zpislopen =  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)                &
-                        &          / ( trn(ji,jj,jk,jpphy) * 12.                  + rtrn )   &
+                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * EXP( -znanotot ) )
+                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp)  / ( trb(ji,jj,jk,jpdia) + rtrn )
+
+                      zpislopen =  zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch)                &
+                        &          / ( trb(ji,jj,jk,jpphy) * 12.                  + rtrn )   &
                         &          / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
 
-                      zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)                &
-                        &          / ( trn(ji,jj,jk,jpdia) * 12.                  + rtrn )   &
+                      zpislope2n = zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch)                &
+                        &          / ( trb(ji,jj,jk,jpdia) * 12.                  + rtrn )   &
                         &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
 
                       ! Computation of production function for Carbon
                       !  ---------------------------------------------
-                      zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) )
-                      zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) )
+                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot ) )
+                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) )
 
                       !  Computation of production function for Chlorophyll
                       !--------------------------------------------------
-                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) * zstrn(ji,jj) ) )
-                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) )
+                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) )
+                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) )
                   ENDIF
                END DO
@@ -231,9 +224,6 @@
       !  Computation of a proxy of the N/C ratio
       !  ---------------------------------------
-!CDIR NOVERRCHK
       DO jk = 1, jpkm1
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   &
@@ -252,5 +242,5 @@
             DO ji = 1, jpi
 
-                IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                    !    Si/C of diatoms
                    !    ------------------------
@@ -258,8 +248,8 @@
                    !    Si/C is arbitrariliy increased for very high Si concentrations
                    !    to mimic the very high ratios observed in the Southern Ocean (silpot2)
-                  zlim  = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 )
+                  zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 )
                   zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
                   zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0
-                  zsiborn = trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil)
+                  zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil)
                   IF (gphit(ji,jj) < -30 ) THEN
                     zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
@@ -296,16 +286,13 @@
 
       ! Computation of the various production terms 
-!CDIR NOVERRCHK
       DO jk = 1, jpkm1
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
-               IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                   !  production terms for nanophyto.
-                  zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2
+                  zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2
                   zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
                   !
-                  zratio = trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn )
+                  zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn )
                   zratio = zratio / fecnm 
                   zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
@@ -313,10 +300,10 @@
                   &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    &
                   &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  &
-                  &             * zmax * trn(ji,jj,jk,jpphy) * rfact2
+                  &             * zmax * trb(ji,jj,jk,jpphy) * rfact2
                   !  production terms for diatomees
-                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2
+                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2
                   zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
                   !
-                  zratio = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )
+                  zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
                   zratio = zratio / fecdm 
                   zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
@@ -324,5 +311,5 @@
                   &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    &
                   &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  &
-                  &             * zmax * trn(ji,jj,jk,jpdia) * rfact2
+                  &             * zmax * trb(ji,jj,jk,jpdia) * rfact2
                ENDIF
             END DO
@@ -331,9 +318,6 @@
 
       IF( ln_newprod ) THEN
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
@@ -341,5 +325,5 @@
                      zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj)
                   ENDIF
-                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                      !  production terms for nanophyto. ( chlorophyll )
                      znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
@@ -359,23 +343,20 @@
          END DO
       ELSE
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
-                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                      !  production terms for nanophyto. ( chlorophyll )
-                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
-                     zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trn(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk)
+                     znanotot = enano(ji,jj,jk)
+                     zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trb(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk)
                      zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk)
                      zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 144. * zprod            &
-                     &                    / ( zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) * znanotot +rtrn )
+                     &                    / ( zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) * znanotot +rtrn )
                      !  production terms for diatomees ( chlorophyll )
-                     zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
-                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trn(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk)
+                     zdiattot = ediat(ji,jj,jk)
+                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trb(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk)
                      zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk)
                      zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 144. * zprod             &
-                     &                    / ( zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zdiattot +rtrn )
+                     &                    / ( zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) * zdiattot +rtrn )
                   ENDIF
                END DO
@@ -414,9 +395,9 @@
 
     ! Total primary production per year
-    IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. jnt == nrdttrc )  )  &
+    IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  &
          & tpp = glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
 
     IF( lk_iomput ) THEN
-       IF( jnt == nrdttrc ) THEN
+       IF( knt == nrdttrc ) THEN
           CALL wrk_alloc( jpi, jpj,      zw2d )
           CALL wrk_alloc( jpi, jpj, jpk, zw3d )
@@ -629,3 +610,3 @@
 
    !!======================================================================
-END MODULE  p4zprod
+END MODULE p4zprod
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90	(revision 5901)
@@ -50,6 +50,6 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   -
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -59,5 +59,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_rem( kt, jnt )
+   SUBROUTINE p4z_rem( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_rem  ***
@@ -68,5 +68,5 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
       !
       INTEGER  ::   ji, jj, jk
@@ -104,5 +104,5 @@
                zdep = MAX( hmld(ji,jj), heup(ji,jj) )
                IF( fsdept(ji,jj,jk) < zdep ) THEN
-                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trn(ji,jj,jk,jpzoo) + 2.* trn(ji,jj,jk,jpmes) ), 4.e-6 )
+                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 )
                   ztempbac(ji,jj)   = zdepbac(ji,jj,jk)
                ELSE
@@ -119,6 +119,6 @@
             DO ji = 1, jpi
                ! denitrification factor computed from O2 levels
-               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trn(ji,jj,jk,jpoxy) )    &
-                  &                                / ( oxymin + trn(ji,jj,jk,jpoxy) )  )
+               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trb(ji,jj,jk,jpoxy) )    &
+                  &                                / ( oxymin + trb(ji,jj,jk,jpoxy) )  )
                nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )
             END DO
@@ -140,10 +140,10 @@
                ! Ammonification in oxic waters with oxygen consumption
                ! -----------------------------------------------------
-               zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc) 
-               zolimi(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) 
+               zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 
+               zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) 
                ! Ammonification in suboxic waters with denitrification
                ! -------------------------------------------------------
-               denitr(ji,jj,jk)  = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   &
-                  &                     zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  )
+               denitr(ji,jj,jk)  = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit,   &
+                  &                     zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  )
                !
                zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) )
@@ -165,6 +165,6 @@
                ! below 2 umol/L. Inhibited at strong light 
                ! ----------------------------------------------------------
-               zonitr  =nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) ) 
-               denitnh4(ji,jj,jk) = nitrif * zstep * trn(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 
+               zonitr  =nitrif * zstep * trb(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) ) 
+               denitnh4(ji,jj,jk) = nitrif * zstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 
                ! Update of the tracers trends
                ! ----------------------------
@@ -192,5 +192,5 @@
                ! ----------------------------------------------------------
                zbactfer = 10.e-6 *  rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk)             &
-                  &              * trn(ji,jj,jk,jpfer) / ( 2.5E-10 + trn(ji,jj,jk,jpfer) )    &
+                  &              * trb(ji,jj,jk,jpfer) / ( 2.5E-10 + trb(ji,jj,jk,jpfer) )    &
                   &              * zdepprod(ji,jj,jk) * zdepbac(ji,jj,jk)
 #if defined key_kriest
@@ -228,11 +228,11 @@
                ! means a disaggregation constant about 0.5 the value in oxic zones
                ! -----------------------------------------------------------------
-               zorem  = zremip * trn(ji,jj,jk,jppoc)
-               zofer  = zremip * trn(ji,jj,jk,jpsfe)
+               zorem  = zremip * trb(ji,jj,jk,jppoc)
+               zofer  = zremip * trb(ji,jj,jk,jpsfe)
 #if ! defined key_kriest
-               zorem2 = zremip * trn(ji,jj,jk,jpgoc)
-               zofer2 = zremip * trn(ji,jj,jk,jpbfe)
+               zorem2 = zremip * trb(ji,jj,jk,jpgoc)
+               zofer2 = zremip * trb(ji,jj,jk,jpbfe)
 #else
-               zorem2 = zremip * trn(ji,jj,jk,jpnum)
+               zorem2 = zremip * trb(ji,jj,jk,jpnum)
 #endif
 
@@ -272,5 +272,5 @@
                ! Remineralization rate of BSi depedant on T and saturation
                ! ---------------------------------------------------------
-               zsatur   = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn )
+               zsatur   = ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn )
                zsatur   = MAX( rtrn, zsatur )
                zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37
@@ -287,5 +287,5 @@
                zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. )
                zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil
-               zosil    = zsiremin * trn(ji,jj,jk,jpgsi)
+               zosil    = zsiremin * trb(ji,jj,jk,jpgsi)
                !
                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil
@@ -315,5 +315,5 @@
       END DO
 
-      IF( jnt == nrdttrc ) THEN
+      IF( knt == nrdttrc ) THEN
           CALL wrk_alloc( jpi, jpj, jpk, zw3d )
           zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90	(revision 5901)
@@ -81,9 +81,10 @@
 
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header:$ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -117,5 +118,9 @@
          IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN
             CALL fld_read( kt, 1, sf_dust )
-            dust(:,:) = sf_dust(1)%fnow(:,:,1)
+            IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN
+               dust(:,:) = sf_dust(1)%fnow(:,:,1)
+            ELSE
+               dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) )
+            ENDIF
          ENDIF
       ENDIF
@@ -136,5 +141,5 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zcoef = ryyss * cvol(ji,jj,1) 
+                  zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
                   rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    &
                      &              * 1.E3        / ( 12. * zcoef + rtrn )
@@ -187,4 +192,6 @@
       INTEGER  :: ierr, ierr1, ierr2, ierr3
       INTEGER  :: ios                 ! Local integer output status for namelist read
+      INTEGER  :: ik50                !  last level where depth less than 50 m
+      INTEGER  :: isrow             ! index for ORCA1 starting row
       REAL(wp) :: zexpide, zdenitide, zmaskt
       REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep 
@@ -216,4 +223,13 @@
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp )
       IF(lwm) WRITE ( numonp, nampissbc )
+
+      IF ( ( nn_ice_tr >= 0 ) .AND. ln_ironice ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) ' ln_ironice incompatible with nn_ice_tr = ', nn_ice_tr
+            WRITE(numout,*) ' Specify your sea ice iron concentration in nampisice instead '
+            WRITE(numout,*) ' ln_ironice is forced to .FALSE. '
+            ln_ironice = .FALSE.
+         ENDIF
+      ENDIF
 
       IF(lwp) THEN
@@ -247,4 +263,11 @@
       ENDIF
 
+      ! set the number of level over which river runoffs are applied 
+      ! online configuration : computed in sbcrnf
+      IF( lk_offline ) THEN
+        nk_rnf(:,:) = 1
+        h_rnf (:,:) = fsdept(:,:,1)
+      ENDIF
+
       ! dust input from the atmosphere
       ! ------------------------------
@@ -358,5 +381,4 @@
          rivalkinput = 0._wp
       END IF 
-
       ! nutrient input from dust
       ! ------------------------
@@ -410,5 +432,12 @@
          CALL iom_close( numiron )
          !
-         DO jk = 1, 5
+         ik50 = 5        !  last level where depth less than 50 m
+         DO jk = jpkm1, 1, -1
+            IF( gdept_1d(jk) > 50. )  ik50 = jk - 1
+         END DO
+         IF (lwp) WRITE(numout,*)
+         IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1)
+         IF (lwp) WRITE(numout,*)
+         DO jk = 1, ik50
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1
@@ -421,30 +450,7 @@
             END DO
          END DO
-         IF( cp_cfg == 'orca' .AND. jp_cfg == 2 ) THEN
-            ii0 = 176   ;   ii1 =  176        ! Southern Island : Kerguelen
-            ij0 =  37   ;   ij1 =   37  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 = 119   ;   ii1 =  119        ! South Georgia
-            ij0 =  29   ;   ij1 =   29  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 = 111   ;   ii1 =  111        ! Falklands
-            ij0 =  35   ;   ij1 =   35  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 = 168   ;   ii1 =  168        ! Crozet
-            ij0 =  40   ;   ij1 =   40  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 = 119   ;   ii1 =  119        ! South Orkney
-            ij0 =  28   ;   ij1 =   28  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 = 140   ;   ii1 =  140        ! Bouvet Island
-            ij0 =  33   ;   ij1 =   33  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 = 178   ;   ii1 =  178        ! Prince edwards
-            ij0 =  34   ;   ij1 =   34  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 =  43   ;   ii1 =   43        ! Balleny islands
-            ij0 =  21   ;   ij1 =   21  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-         ENDIF
+         !
          CALL lbc_lnk( zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
+         !
          DO jk = 1, jpk
             DO jj = 1, jpj
@@ -514,3 +520,3 @@
 
    !!======================================================================
-END MODULE  p4zsbc
+END MODULE p4zsbc
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90	(revision 5901)
@@ -21,5 +21,4 @@
    USE p4zopt          !  optical model
    USE p4zlim          !  Co-limitations of differents nutrients
-   USE p4zrem          !  Remineralisation of organic matter
    USE p4zsbc          !  External source of nutrients 
    USE p4zint          !  interpolation and computation of various fields
@@ -30,22 +29,23 @@
    PRIVATE
 
-   PUBLIC   p4z_sed   
+   PUBLIC   p4z_sed  
+   PUBLIC   p4z_sed_alloc
+ 
 
    !! * Module variables
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot    !: Nitrogen fixation 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: sdenit     !: Nitrate reduction in the sediments
    REAL(wp) :: r1_rday                  !: inverse of rday
 
-   INTEGER ::  numnit  
-
-
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header:$ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE p4z_sed( kt, jnt )
+   SUBROUTINE p4z_sed( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_sed  ***
@@ -58,5 +58,5 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
       INTEGER  ::   ji, jj, jk, ikt
 #if ! defined key_sed
@@ -69,25 +69,20 @@
       REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep, zwstpoc
       REAL(wp) ::  ztrfer, ztrpo4, zwdust, zlight
-      REAL(wp) ::  zrdenittot, zsdenittot, znitrpottot
       !
       CHARACTER (len=25) :: charout
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpdep, zsidep, zwork1, zwork2, zwork3, zwork4
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpdep, zsidep, zwork1, zwork2, zwork3
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zdenit2d, zironice, zbureff
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zwsbio3, zwsbio4, zwscal
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: znitrpot, zirondep, zsoufer
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zirondep, zsoufer
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('p4z_sed')
       !
-      IF( kt == nittrc000 .AND. jnt == 1 )  THEN
-         r1_rday  = 1. / rday
-         IF( ln_check_mass .AND. lwp)  &
-           &  CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
-      ENDIF
+      IF( kt == nittrc000 .AND. knt == 1 )   r1_rday  = 1. / rday
       !
       ! Allocate temporary workspace
-      CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zwork4, zbureff )
+      CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
       CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
-      CALL wrk_alloc( jpi, jpj, jpk, znitrpot, zsoufer )
+      CALL wrk_alloc( jpi, jpj, jpk, zsoufer )
 
       zdenit2d(:,:) = 0.e0
@@ -96,5 +91,4 @@
       zwork2  (:,:) = 0.e0
       zwork3  (:,:) = 0.e0
-      zwork4  (:,:) = 0.e0
 
       ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al.
@@ -108,5 +102,5 @@
                zdep    = rfact2 / fse3t(ji,jj,1)
                zwflux  = fmmflx(ji,jj) / 1000._wp
-               zfminus = MIN( 0._wp, -zwflux ) * trn(ji,jj,1,jpfer) * zdep
+               zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep
                zfplus  = MAX( 0._wp, -zwflux ) * icefeinput * zdep
                zironice(ji,jj) =  zfplus + zfminus
@@ -114,7 +108,7 @@
          END DO
          !
-         trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + zironice(:,:) 
+         tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:) 
          ! 
-         IF( lk_iomput .AND. jnt == nrdttrc .AND. iom_use( "Ironice" ) )   &
+         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) )   &
             &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice
          !
@@ -144,10 +138,10 @@
          END DO
          !                                              ! Iron solubilization of particles in the water column
-         trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + zpdep   (:,:)
-         trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + zsidep  (:,:)
-         trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + zirondep(:,:,:) 
+         tra(:,:,1,jppo4) = tra(:,:,1,jppo4) + zpdep   (:,:)
+         tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep  (:,:)
+         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:) 
          ! 
          IF( lk_iomput ) THEN
-            IF( jnt == nrdttrc ) THEN
+            IF( knt == nrdttrc ) THEN
                 IF( iom_use( "Irondep" ) )   &
                 &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron
@@ -167,10 +161,16 @@
       ! ----------------------------------------------------------
       IF( ln_river ) THEN
-         trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivdip(:,:) * rfact2
-         trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + rivdin(:,:) * rfact2
-         trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + rivdic(:,:) * 5.e-5 * rfact2
-         trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + rivdsi(:,:) * rfact2
-         trn(:,:,1,jpdic) = trn(:,:,1,jpdic) + rivdic(:,:) * rfact2
-         trn(:,:,1,jptal) = trn(:,:,1,jptal) + ( rivalk(:,:) - rno3 * rivdin(:,:) ) * rfact2
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, nk_rnf(ji,jj)
+                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) +  rivdip(ji,jj) * rfact2
+                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) +  rivdin(ji,jj) * rfact2
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) +  rivdic(ji,jj) * 5.e-5 * rfact2
+                  tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) +  rivdsi(ji,jj) * rfact2
+                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +  rivdic(ji,jj) * rfact2
+                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) +  ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2
+               ENDDO
+            ENDDO
+         ENDDO
       ENDIF
       
@@ -178,6 +178,6 @@
       ! ----------------------------------------------------------
       IF( ln_ndepo ) THEN
-         trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + nitdep(:,:) * rfact2
-         trn(:,:,1,jptal) = trn(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2
+         tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2
+         tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2
       ENDIF
 
@@ -185,7 +185,7 @@
       ! ------------------------------------------------------
       IF( ln_ironsed ) THEN
-         trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
+         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
          !
-         IF( lk_iomput .AND. jnt == nrdttrc .AND. iom_use( "Ironsed" ) )   &
+         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   &
             &   CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments
       ENDIF
@@ -194,7 +194,7 @@
       ! ------------------------------------------------------
       IF( ln_hydrofe ) THEN
-         trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
+         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
          !
-         IF( lk_iomput .AND. jnt == nrdttrc .AND. iom_use( "HYDR" ) )   &
+         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) )   &
             &   CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
       ENDIF
@@ -222,12 +222,12 @@
               ikt = mbkt(ji,jj)
 # if defined key_kriest
-              zflx =    trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)    * 1E3 * 1E6 / 1E4
+              zflx =    trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)    * 1E3 * 1E6 / 1E4
 # else
-              zflx = (  trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
-                &     + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4
+              zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
+                &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4
 #endif
               zflx  = LOG10( MAX( 1E-3, zflx ) )
-              zo2   = LOG10( MAX( 10. , trn(ji,jj,ikt,jpoxy) * 1E6 ) )
-              zno3  = LOG10( MAX( 1.  , trn(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
+              zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) )
+              zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
               zdep  = LOG10( fsdepw(ji,jj,ikt+1) )
               zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    &
@@ -235,6 +235,6 @@
               zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) )
               !
-              zflx = (  trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
-                &     + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
+              zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
+                &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
               zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2
            ENDIF
@@ -251,14 +251,14 @@
                ikt = mbkt(ji,jj) 
 # if defined key_kriest
-               zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwscal (ji,jj)
-               zwork2(ji,jj) = trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)
+               zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwscal (ji,jj)
+               zwork2(ji,jj) = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)
 # else
-               zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj)
-               zwork2(ji,jj) = trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
+               zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj)
+               zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
 # endif
                ! For calcite, burial efficiency is made a function of saturation
                zfactcal      = MIN( excess(ji,jj,ikt), 0.2 )
                zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
-               zwork3(ji,jj) = trn(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal
+               zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal
             ENDIF
          END DO
@@ -279,23 +279,23 @@
          DO ji = 1, jpi
             ikt  = mbkt(ji,jj)
-            zdep = xstep / fse3t(ji,jj,ikt)
+            zdep = xstep / fse3t(ji,jj,ikt) 
             zws4 = zwsbio4(ji,jj) * zdep
             zwsc = zwscal (ji,jj) * zdep
 # if defined key_kriest
-            zsiloss = trn(ji,jj,ikt,jpgsi) * zws4
+            zsiloss = trb(ji,jj,ikt,jpgsi) * zws4
 # else
-            zsiloss = trn(ji,jj,ikt,jpgsi) * zwsc
+            zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc
 # endif
-            zcaloss = trn(ji,jj,ikt,jpcal) * zwsc
+            zcaloss = trb(ji,jj,ikt,jpcal) * zwsc
             !
-            trn(ji,jj,ikt,jpgsi) = trn(ji,jj,ikt,jpgsi) - zsiloss
-            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zcaloss
+            tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss
+            tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss
 #if ! defined key_sed
-            trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zsiloss * zrivsil 
+            tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil 
             zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
             zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
             zrivalk  =  1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn )
-            trn(ji,jj,ikt,jptal) =  trn(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
-            trn(ji,jj,ikt,jpdic) =  trn(ji,jj,ikt,jpdic) + zcaloss * zrivalk
+            tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
+            tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk
 #endif
          END DO
@@ -304,20 +304,20 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            ikt     = mbkt(ji,jj)
-            zdep    = xstep / fse3t(ji,jj,ikt)
+            ikt  = mbkt(ji,jj)
+            zdep = xstep / fse3t(ji,jj,ikt) 
             zws4 = zwsbio4(ji,jj) * zdep
             zws3 = zwsbio3(ji,jj) * zdep
             zrivno3 = 1. - zbureff(ji,jj)
 # if ! defined key_kriest
-            trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - trn(ji,jj,ikt,jpgoc) * zws4
-            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zws3
-            trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * zws4
-            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zws3
-            zwstpoc              =  trn(ji,jj,ikt,jpgoc) * zws4 + trn(ji,jj,ikt,jppoc) * zws3 
+            tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4 
+            tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
+            tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4
+            tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
+            zwstpoc              = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3
 # else
-            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - trn(ji,jj,ikt,jpnum) * zws4
-            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zws3
-            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zws3
-            zwstpoc = trn(ji,jj,ikt,jppoc) * zws3 
+            tra(ji,jj,ikt,jpnum) = tra(ji,jj,ikt,jpnum) - trb(ji,jj,ikt,jpnum) * zws4 
+            tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
+            tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
+            zwstpoc = trb(ji,jj,ikt,jppoc) * zws3 
 # endif
 
@@ -325,16 +325,16 @@
             ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification
             ! in the sediments and just above the sediments. Not very clever, but simpliest option.
-            zpdenit  = MIN( 0.5 * ( trn(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
+            zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
             z1pdenit = zwstpoc * zrivno3 - zpdenit
-            zolimit = MIN( ( trn(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
-            zdenitt = MIN(  0.5 * ( trn(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )
-            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt
-            trn(ji,jj,ikt,jppo4) = trn(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt
-            trn(ji,jj,ikt,jpnh4) = trn(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt
-            trn(ji,jj,ikt,jpno3) = trn(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)
-            trn(ji,jj,ikt,jpoxy) = trn(ji,jj,ikt,jpoxy) - zolimit * o2ut
-            trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )
-            trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt
-            zwork4(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)
+            zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
+            zdenitt = MIN(  0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )
+            tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt
+            tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt
+            tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt
+            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)
+            tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut
+            tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )
+            tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt
+            sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)
 #endif
          END DO
@@ -356,7 +356,7 @@
 #endif
                ztrfer = biron(ji,jj,jk)       / ( concfediaz + biron(ji,jj,jk)       )
-               ztrpo4 = trn  (ji,jj,jk,jppo4) / ( concnnh4   + trn  (ji,jj,jk,jppo4) ) 
-               zlight =  ( 1.- EXP( -etot(ji,jj,jk) / diazolight ) ) 
-               znitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday )   &
+               ztrpo4 = trb  (ji,jj,jk,jppo4) / ( concnnh4   + trb  (ji,jj,jk,jppo4) ) 
+               zlight =  ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) 
+               nitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday )   &
                  &         *  zfact * MIN( ztrfer, ztrpo4 ) * zlight
                zsoufer(ji,jj,jk) = zlight * 2E-11 / (2E-11 + biron(ji,jj,jk))
@@ -370,39 +370,23 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zfact = znitrpot(ji,jj,jk) * nitrfix
-               trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) +             zfact
-               trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3      * zfact
-               trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + o2nit     * zfact 
-               trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trn(ji,jj,jk,jppo4) ) &
-               &                     * 0.002 * trn(ji,jj,jk,jpdoc) * rfact2 / rday
-               trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday
+               zfact = nitrpot(ji,jj,jk) * nitrfix
+               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) +             zfact
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3      * zfact
+               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit     * zfact 
+               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) &
+               &                     * 0.002 * trb(ji,jj,jk,jpdoc) * xstep
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep
            END DO
          END DO 
       END DO
 
-      ! Global budget of N SMS : denitrification in the water column and in the sediment
-      !                          nitrogen fixation by the diazotrophs
-      ! --------------------------------------------------------------------------------
-      zrdenittot   = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
-      zsdenittot   = glob_sum ( zwork4(:,:)   * e1e2t(:,:) )
-      znitrpottot  = glob_sum ( znitrpot(:,:,:) * nitrfix              * cvol(:,:,:) )
-      zfact = 1.e+3 * rfact2r * rno3 * 14. / 1.e12 * ryyss   ! conversion molC/l/kt ----> TgN/m3/year
-      !
-      IF( ln_check_mass .AND. ( kt == nitend .AND. jnt == nrdttrc ) .AND. ( lwp )  )  &
-         &  WRITE(numnit,9100) ndastp, znitrpottot * zfact  , &
-         &                             zrdenittot  * zfact  , &
-         &                             zsdenittot  * zfact
-      !
       IF( lk_iomput ) THEN
-         IF( jnt == nrdttrc ) THEN
+         IF( knt == nrdttrc ) THEN
             zfact = 1.e+3 * rfact2r * rno3  !  conversion from molC/l/kt  to molN/m3/s
-            IF( iom_use("Nfix"   ) ) CALL iom_put( "Nfix"  , znitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) )  ! nitrogen fixation 
-            IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", zwork4(:,:) * zfact * tmask(:,:,1) )  ! Nitrate reduction in the sediments
-            IF( iom_use("tnfix"  ) ) CALL iom_put( "tnfix"  , znitrpottot * zfact  )               ! Global  nitrogen fixation
-            IF( iom_use("tdenit" ) ) CALL iom_put( "tdenit" , zrdenittot  * zfact  )               ! Total denitrification
+            IF( iom_use("Nfix"   ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) )  ! nitrogen fixation 
             IF( iom_use("INTNFIX") ) THEN   ! nitrogen fixation rate in ocean ( vertically integrated )
                zwork1(:,:) = 0.
                DO jk = 1, jpkm1
-                 zwork1(:,:) = zwork1(:,:) + znitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk)
+                 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk)
                ENDDO
                CALL iom_put( "INTNFIX" , zwork1 ) 
@@ -411,5 +395,5 @@
       ELSE
          IF( ln_diatrc )  &
-            &  trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
+            &  trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
       ENDIF
       !
@@ -417,10 +401,10 @@
          WRITE(charout, fmt="('sed ')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zwork4, zbureff )
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
       CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
-      CALL wrk_dealloc( jpi, jpj, jpk, znitrpot, zsoufer )
+      CALL wrk_dealloc( jpi, jpj, jpk, zsoufer )
       !
       IF( nn_timing == 1 )  CALL timing_stop('p4z_sed')
@@ -429,4 +413,16 @@
       !
    END SUBROUTINE p4z_sed
+
+
+   INTEGER FUNCTION p4z_sed_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_sed_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( nitrpot(jpi,jpj,jpk), sdenit(jpi,jpj), STAT=p4z_sed_alloc )
+      !
+      IF( p4z_sed_alloc /= 0 )   CALL ctl_warn('p4z_sed_alloc: failed to allocate arrays')
+      !
+   END FUNCTION p4z_sed_alloc
+
 
 #else
@@ -440,3 +436,3 @@
 
    !!======================================================================
-END MODULE  p4zsed
+END MODULE p4zsed
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90	(revision 5901)
@@ -65,6 +65,6 @@
 #endif
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -79,5 +79,5 @@
    !!----------------------------------------------------------------------
 
-   SUBROUTINE p4z_sink ( kt, jnt )
+   SUBROUTINE p4z_sink ( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_sink  ***
@@ -88,5 +88,5 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kt, jnt
+      INTEGER, INTENT(in) :: kt, knt
       INTEGER  ::   ji, jj, jk, jit
       INTEGER  ::   iiter1, iiter2
@@ -199,15 +199,15 @@
                zfact = zstep * xdiss(ji,jj,jk)
                !  Part I : Coagulation dependent on turbulence
-               zagg1 = 25.9  * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)
-               zagg2 = 4452. * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)
+               zagg1 = 25.9  * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
+               zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
 
                ! Part II : Differential settling
 
                !  Aggregation of small into large particles
-               zagg3 =  47.1 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)
-               zagg4 =  3.3  * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)
+               zagg3 =  47.1 * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
+               zagg4 =  3.3  * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
 
                zagg   = zagg1 + zagg2 + zagg3 + zagg4
-               zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn )
+               zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn )
 
                ! Aggregation of DOC to POC : 
@@ -215,12 +215,12 @@
                ! 2nd term is shear aggregation of DOC-POC
                ! 3rd term is differential settling of DOC-POC
-               zaggdoc  = ( ( 0.369 * 0.3 * trn(ji,jj,jk,jpdoc) + 102.4 * trn(ji,jj,jk,jppoc) ) * zfact       &
-               &            + 2.4 * zstep * trn(ji,jj,jk,jppoc) ) * 0.3 * trn(ji,jj,jk,jpdoc)
+               zaggdoc  = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       &
+               &            + 2.4 * zstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc)
                ! transfer of DOC to GOC : 
                ! 1st term is shear aggregation
                ! 2nd term is differential settling 
-               zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trn(ji,jj,jk,jpgoc) * 0.3 * trn(ji,jj,jk,jpdoc)
+               zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc)
                ! tranfer of DOC to POC due to brownian motion
-               zaggdoc3 =  ( 5095. * trn(ji,jj,jk,jppoc) + 114. * 0.3 * trn(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trn(ji,jj,jk,jpdoc)
+               zaggdoc3 =  ( 5095. * trb(ji,jj,jk,jppoc) + 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trb(ji,jj,jk,jpdoc)
 
                !  Update the trends
@@ -237,9 +237,9 @@
 
      ! Total carbon export per year
-     IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. jnt == nrdttrc )  )  &
+     IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  &
         &   t_oce_co2_exp = glob_sum( ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * e1e2t(:,:) * tmask(:,:,1) )
      !
      IF( lk_iomput ) THEN
-       IF( jnt == nrdttrc ) THEN
+       IF( knt == nrdttrc ) THEN
           CALL wrk_alloc( jpi, jpj,      zw2d )
           CALL wrk_alloc( jpi, jpj, jpk, zw3d )
@@ -328,5 +328,5 @@
    !!----------------------------------------------------------------------
 
-   SUBROUTINE p4z_sink ( kt, jnt )
+   SUBROUTINE p4z_sink ( kt, knt )
       !!---------------------------------------------------------------------
       !!                ***  ROUTINE p4z_sink  ***
@@ -338,5 +338,5 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) :: kt, jnt
+      INTEGER, INTENT(in) :: kt, knt
       !
       INTEGER  :: ji, jj, jk, jit, niter1, niter2
@@ -373,5 +373,5 @@
             DO ji = 1, jpi
                IF( tmask(ji,jj,jk) /= 0.e0 ) THEN
-                  znum = trn(ji,jj,jk,jppoc) / ( trn(ji,jj,jk,jpnum) + rtrn ) / xkr_massp
+                  znum = trb(ji,jj,jk,jppoc) / ( trb(ji,jj,jk,jpnum) + rtrn ) / xkr_massp
                   ! -------------- To avoid sinking speed over 50 m/day -------
                   znum  = MIN( xnumm(jk), znum )
@@ -435,5 +435,5 @@
                IF( tmask(ji,jj,jk) /= 0.e0 ) THEN
 
-                  znum = trn(ji,jj,jk,jppoc)/(trn(ji,jj,jk,jpnum)+rtrn) / xkr_massp
+                  znum = trb(ji,jj,jk,jppoc)/(trb(ji,jj,jk,jpnum)+rtrn) / xkr_massp
                   !-------------- To avoid sinking speed over 50 m/day -------
                   znum  = min(xnumm(jk),znum)
@@ -453,10 +453,10 @@
                   !    ----------------------------------------------
 
-                  zagg1 =  0.163 * trn(ji,jj,jk,jpnum)**2               &
+                  zagg1 =  0.163 * trb(ji,jj,jk,jpnum)**2               &
                      &            * 2.*( (zfm-1.)*(zfm*xkr_mass_max**3-xkr_mass_min**3)    &
                      &            * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min)    &
                      &            * (zfm*xkr_mass_max**2-xkr_mass_min**2)                  &
                      &            * (zeps-1.)**2/(zdiv2*zdiv3)) 
-                  zagg2 =  2*0.163*trn(ji,jj,jk,jpnum)**2*zfm*                       &
+                  zagg2 =  2*0.163*trb(ji,jj,jk,jpnum)**2*zfm*                       &
                      &                   ((xkr_mass_max**3+3.*(xkr_mass_max**2          &
                      &                    *xkr_mass_min*(zeps-1.)/zdiv2                 &
@@ -466,5 +466,5 @@
                      &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))    
 
-                  zagg3 =  0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3  
+                  zagg3 =  0.163*trb(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3  
                   
                  !    Aggregation of small into large particles
@@ -472,5 +472,5 @@
                  !    ----------------------------------------------
 
-                  zagg4 =  2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       &
+                  zagg4 =  2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2*                       &
                      &                 xkr_wsbio_min*(zeps-1.)**2                         &
                      &                 *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4)      &
@@ -479,5 +479,5 @@
                      &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )   
 
-                  zagg5 =   2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2                         &
+                  zagg5 =   2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2                         &
                      &                 *(zeps-1.)*zfm*xkr_wsbio_min                        &
                      &                 *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2)         &
@@ -489,5 +489,5 @@
                   !     ------------------------------------
 
-                  zfract = 2.*3.141*0.125*trn(ji,jj,jk,jpmes)*12./0.12/0.06**3*trn(ji,jj,jk,jpnum)  &
+                  zfract = 2.*3.141*0.125*trb(ji,jj,jk,jpmes)*12./0.12/0.06**3*trb(ji,jj,jk,jpnum)  &
                     &      * (0.01/xkr_mass_min)**(1.-zeps)*0.1**2  &
                     &      * 10000.*xstep
@@ -496,8 +496,8 @@
                   !     --------------------------------------
 
-                  zaggdoc = 0.83 * trn(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc)   &
-                     &        + 0.005 * 231. * trn(ji,jj,jk,jpdoc) * xstep * trn(ji,jj,jk,jpdoc)
-                  zaggdoc1 = 271. * trn(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  &
-                     &  + 0.02 * 16706. * trn(ji,jj,jk,jppoc) * xstep * trn(ji,jj,jk,jpdoc)
+                  zaggdoc = 0.83 * trb(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc)   &
+                     &        + 0.005 * 231. * trb(ji,jj,jk,jpdoc) * xstep * trb(ji,jj,jk,jpdoc)
+                  zaggdoc1 = 271. * trb(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  &
+                     &  + 0.02 * 16706. * trb(ji,jj,jk,jppoc) * xstep * trb(ji,jj,jk,jpdoc)
 
 # if defined key_degrad
@@ -514,5 +514,5 @@
                   zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi )
                   !
-                  znumdoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )
+                  znumdoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )
                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc + zaggdoc1
                   tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zfract + zaggdoc / xkr_massp - zagg
@@ -528,5 +528,5 @@
      !
      IF( lk_iomput ) THEN
-        IF( jnt == nrdttrc ) THEN
+        IF( knt == nrdttrc ) THEN
           CALL wrk_alloc( jpi, jpj,      zw2d )
           CALL wrk_alloc( jpi, jpj, jpk, zw3d )
@@ -800,5 +800,5 @@
       ztraz(:,:,:) = 0.e0
       zakz (:,:,:) = 0.e0
-      ztrb (:,:,:) = trn(:,:,:,jp_tra)
+      ztrb (:,:,:) = trb(:,:,:,jp_tra)
 
       DO jk = 1, jpkm1
@@ -815,5 +815,5 @@
          !  first guess of the slopes interior values
          DO jk = 2, jpkm1
-            ztraz(:,:,jk) = ( trn(:,:,jk-1,jp_tra) - trn(:,:,jk,jp_tra) ) * tmask(:,:,jk)
+            ztraz(:,:,jk) = ( trb(:,:,jk-1,jp_tra) - trb(:,:,jk,jp_tra) ) * tmask(:,:,jk)
          END DO
          ztraz(:,:,1  ) = 0.0
@@ -846,5 +846,5 @@
                   zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1)
                   zew   = zwsink2(ji,jj,jk+1)
-                  psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep
+                  psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep
                END DO
             END DO
@@ -859,5 +859,5 @@
                DO ji = 1, jpi
                   zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
-                  trn(ji,jj,jk,jp_tra) = trn(ji,jj,jk,jp_tra) + zflx
+                  trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx
                END DO
             END DO
@@ -875,5 +875,5 @@
       END DO
 
-      trn(:,:,:,jp_tra) = ztrb(:,:,:)
+      trb(:,:,:,jp_tra) = ztrb(:,:,:)
       psinkflx(:,:,:)   = 2. * psinkflx(:,:,:)
       !
@@ -913,3 +913,3 @@
 
    !!======================================================================
-END MODULE  p4zsink
+END MODULE p4zsink
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90	(revision 5901)
@@ -24,4 +24,5 @@
    USE p4zsed          !  Sedimentation
    USE p4zint          !  time interpolation
+   USE p4zrem          !  remineralisation
    USE iom             !  I/O manager
    USE trd_oce         !  Ocean trends variables
@@ -36,6 +37,11 @@
    PUBLIC   p4z_sms        ! called in p4zsms.F90
 
-   REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget
-   INTEGER ::  numco2, numnut  !: logical unit for co2 budget
+   REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget
+   REAL(wp) :: xfact1, xfact2, xfact3
+   INTEGER ::  numco2, numnut, numnit  !: logical unit for co2 budget
+
+   !!* Array used to indicate negative tracer values
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     !: ???
+
 
    !!----------------------------------------------------------------------
@@ -61,20 +67,17 @@
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
       !!
-      INTEGER ::   jnt, jn, jl
+      INTEGER ::   ji, jj, jk, jnt, jn, jl
+      REAL(wp) ::  ztra
+#if defined key_kriest
+      REAL(wp) ::  zcoef1, zcoef2
+#endif
       CHARACTER (len=25) :: charout
-      REAL(wp), POINTER, DIMENSION(:,:,:,:)  :: ztrdpis
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('p4z_sms')
       !
-      IF( l_trdtrc )  THEN
-         CALL wrk_alloc( jpi, jpj, jpk, jp_pisces, ztrdpis ) 
-         DO jn = 1, jp_pisces
-            jl = jn + jp_pcs0 - 1
-            ztrdpis(:,:,:,jn) = trn(:,:,:,jl)
-         ENDDO
-      ENDIF
-      !
       IF( kt == nittrc000 ) THEN
+        !
+        ALLOCATE( xnegtr(jpi,jpj,jpk) )
         !
         CALL p4z_che                              ! initialize the chemical constants
@@ -88,4 +91,26 @@
       IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers
       !
+      !                                                                    !   set time step size (Euler/Leapfrog)
+      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN   ;    rfact = rdttrc(1)     !  at nittrc000
+      ELSEIF( kt <= nittrc000 + nn_dttrc )                          THEN   ;    rfact = 2. * rdttrc(1)   ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog)
+      ENDIF
+      !
+      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN
+         rfactr  = 1. / rfact
+         rfact2  = rfact / FLOAT( nrdttrc )
+         rfact2r = 1. / rfact2
+         xstep = rfact2 / rday         ! Time step duration for biology
+         IF(lwp) WRITE(numout,*) 
+         IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdttra(1)
+         IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN
+         DO jn = jp_pcs0, jp_pcs1              !   SMS on tracer without Asselin time-filter
+            trb(:,:,:,jn) = trn(:,:,:,jn)
+         END DO
+      ENDIF
+      !
       IF( ndayflxtr /= nday_year ) THEN      ! New days
          !
@@ -105,28 +130,57 @@
       DO jnt = 1, nrdttrc          ! Potential time splitting if requested
          !
-         CALL p4z_bio (kt, jnt)    ! Biology
-         CALL p4z_sed (kt, jnt)    ! Sedimentation
-         !
+         CALL p4z_bio( kt, jnt )   ! Biology
+         CALL p4z_sed( kt, jnt )   ! Sedimentation
+         CALL p4z_lys( kt, jnt )   ! Compute CaCO3 saturation
+         CALL p4z_flx( kt, jnt )   ! Compute surface fluxes
+         !
+         xnegtr(:,:,:) = 1.e0
          DO jn = jp_pcs0, jp_pcs1
-            trb(:,:,:,jn) = trn(:,:,:,jn)
-         ENDDO
-         !
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
+                        ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
+                        xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra )
+                     ENDIF
+                 END DO
+               END DO
+            END DO
+         END DO
+         !                                ! where at least 1 tracer concentration becomes negative
+         !                                ! 
+         DO jn = jp_pcs0, jp_pcs1
+           trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
+         END DO
+        !
+         DO jn = jp_pcs0, jp_pcs1
+            tra(:,:,:,jn) = 0._wp
+         END DO
+         !
+         IF( ln_top_euler ) THEN
+            DO jn = jp_pcs0, jp_pcs1
+               trn(:,:,:,jn) = trb(:,:,:,jn)
+            END DO
+         ENDIF
       END DO
 
-      IF( l_trdtrc )  THEN
-         DO jn = 1, jp_pisces
-            jl = jn + jp_pcs0 - 1
-            ztrdpis(:,:,:,jn) = ( ztrdpis(:,:,:,jn) - trn(:,:,:,jl) ) * rfact2r
-         ENDDO
-      ENDIF
-      CALL p4z_lys( kt )             ! Compute CaCO3 saturation
-      CALL p4z_flx( kt )             ! Compute surface fluxes
-
-      DO jn = jp_pcs0, jp_pcs1
-        CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
-        CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
-        CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )
+#if defined key_kriest
+      ! 
+      zcoef1 = 1.e0 / xkr_massp 
+      zcoef2 = 1.e0 / xkr_massp / 1.1
+      DO jk = 1,jpkm1
+         trb(:,:,jk,jpnum) = MAX(  trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef1 / xnumm(jk)  )
+         trb(:,:,jk,jpnum) = MIN(  trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef2              )
       END DO
       !
+#endif
+      !
+      !
+      IF( l_trdtrc ) THEN
+         DO jn = jp_pcs0, jp_pcs1
+           CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
+         END DO
+      END IF
+      !
       IF( lk_sed ) THEN 
          !
@@ -134,5 +188,5 @@
          !
          DO jn = jp_pcs0, jp_pcs1
-           CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
+           CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
          END DO
          !
@@ -141,13 +195,5 @@
       IF( lrst_trc )  CALL p4z_rst( kt, 'WRITE' )  !* Write PISCES informations in restart file 
       !
-      IF( l_trdtrc ) THEN
-         DO jn = 1, jp_pisces
-            jl = jn + jp_pcs0 - 1
-             ztrdpis(:,:,:,jn) = ztrdpis(:,:,:,jn) + tra(:,:,:,jl)
-             CALL trd_trc( ztrdpis(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
-          END DO
-          CALL wrk_dealloc( jpi, jpj, jpk, jp_pisces, ztrdpis ) 
-      END IF
-      !
+
       IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt ) ! Mass conservation checking
 
@@ -280,7 +326,7 @@
                ztmas   = tmask(ji,jj,jk)
                ztmas1  = 1. - tmask(ji,jj,jk)
-               zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  )
-               zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
-               zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk )
+               zcaralk = trb(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  )
+               zco3    = ( zcaralk - trb(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
+               zbicarb = ( 2. * trb(ji,jj,jk,jpdic) - zcaralk )
                hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
             END DO
@@ -361,5 +407,6 @@
       REAL(wp) ::  silmean = 91.51     ! mean value of silicate
       !
-      REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum
+      REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn
+      REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb
       !!---------------------------------------------------------------------
 
@@ -374,23 +421,44 @@
          zarea          = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6              
 
-         zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
-         zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
-         zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
-         zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
+         zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
+         zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
+         zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
+         zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
  
-         IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum
-         trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum
-
-         IF(lwp) WRITE(numout,*) '       PO4  mean : ', zpo4sum
-         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum
-
-         IF(lwp) WRITE(numout,*) '       NO3  mean : ', zno3sum
-         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum
-
-         IF(lwp) WRITE(numout,*) '       SiO3 mean : ', zsilsum
-         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum )
-         !
-      ENDIF
-
+         IF(lwp) WRITE(numout,*) '       TALKN mean : ', zalksumn
+         trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn
+
+         IF(lwp) WRITE(numout,*) '       PO4N  mean : ', zpo4sumn
+         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn
+
+         IF(lwp) WRITE(numout,*) '       NO3N  mean : ', zno3sumn
+         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn
+
+         IF(lwp) WRITE(numout,*) '       SiO3N mean : ', zsilsumn
+         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )
+         !
+         !
+         IF( .NOT. ln_top_euler ) THEN
+            zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
+            zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
+            zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
+            zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
+ 
+            IF(lwp) WRITE(numout,*) ' '
+            IF(lwp) WRITE(numout,*) '       TALKB mean : ', zalksumb
+            trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb
+
+            IF(lwp) WRITE(numout,*) '       PO4B  mean : ', zpo4sumb
+            trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb
+
+            IF(lwp) WRITE(numout,*) '       NO3B  mean : ', zno3sumb
+            trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb
+
+            IF(lwp) WRITE(numout,*) '       SiO3B mean : ', zsilsumb
+            trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )
+        ENDIF
+        !
+      ENDIF
+        !
    END SUBROUTINE p4z_dmp
 
@@ -404,7 +472,12 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER , INTENT( in ) ::   kt      ! ocean time-step index      
-      REAL(wp)               ::  zfact       
-      !!
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot
+      CHARACTER(LEN=100)   ::   cltxt
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
+      INTEGER :: jk
+      !!----------------------------------------------------------------------
+
+      !
       !!---------------------------------------------------------------------
 
@@ -413,7 +486,15 @@
             CALL ctl_opn( numco2, 'carbon.budget'  , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
             CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+            CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+            xfact1 = rfact2r * 12. / 1.e15 * ryyss    ! conversion molC/kt --> PgC/yr
+            xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss   ! conversion molC/l/s ----> TgN/m3/yr
+            xfact3 = 1.e+3 * rfact2r * rno3   ! conversion molC/l/kt ----> molN/m3/s
+            cltxt='time-step   Alkalinity        Nitrate        Phosphorus         Silicate           Iron'
+            IF( lwp ) WRITE(numnut,*)  TRIM(cltxt)
+            IF( lwp ) WRITE(numnut,*) 
          ENDIF
       ENDIF
 
+      !
       IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
          !   Compute the budget of NO3, ALK, Si, Fer
@@ -431,5 +512,18 @@
       ENDIF
       !
-      IF( iom_use( "psiltot" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+      IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
+         po4budget = glob_sum( (   trn(:,:,:,jppo4)                     &
+            &                    + trn(:,:,:,jpphy) + trn(:,:,:,jpdia)  &
+            &                    + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  &
+            &                    + trn(:,:,:,jppoc)                     &
+#if ! defined key_kriest
+            &                    + trn(:,:,:,jpgoc)                     &
+#endif
+            &                    + trn(:,:,:,jpdoc)                     ) * cvol(:,:,:)  )
+         po4budget = po4budget / areatot
+         CALL iom_put( "ppo4tot", po4budget )
+      ENDIF
+      !
+      IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
          silbudget = glob_sum( (   trn(:,:,:,jpsil) + trn(:,:,:,jpgsi)  &
             &                    + trn(:,:,:,jpdsi)                     ) * cvol(:,:,:)  )
@@ -439,5 +533,5 @@
       ENDIF
       !
-      IF( iom_use( "palktot" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+      IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
          alkbudget = glob_sum( (   trn(:,:,:,jpno3) * rno3              &
             &                    + trn(:,:,:,jptal)                     &
@@ -448,5 +542,5 @@
       ENDIF
       !
-      IF( iom_use( "pfertot" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+      IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
          ferbudget = glob_sum( (   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe)  &
             &                    + trn(:,:,:,jpdfe)                     &
@@ -462,19 +556,45 @@
       ENDIF
       !
+
+      ! Global budget of N SMS : denitrification in the water column and in the sediment
+      !                          nitrogen fixation by the diazotrophs
+      ! --------------------------------------------------------------------------------
+      IF( iom_use( "tnfix" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+         znitrpottot  = glob_sum ( nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
+         CALL iom_put( "tnfix"  , znitrpottot * 1.e+3 * rno3 )  ! Global  nitrogen fixation molC/l  to molN/m3 
+      ENDIF
+      !
+      IF( iom_use( "tdenit" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+         zrdenittot   = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
+         CALL iom_put( "tdenit"  , zrdenittot * 1.e+3 * rno3 )  ! Total denitrification molC/l to molN/m3 
+      ENDIF
+      !
+      IF( iom_use( "Sdenit" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+         zsdenittot   = glob_sum ( sdenit(:,:) * e1e2t(:,:) )
+         CALL iom_put( "Sdenit", sdenit(:,:) * xfact3 * tmask(:,:,1) )  ! Nitrate reduction in the sediments
+      ENDIF
+
       IF( ln_check_mass .AND. kt == nitend ) THEN   ! Compute the budget of NO3, ALK, Si, Fer
-         zfact = rfact2r * 12. / 1.e15 * ryyss    ! conversion molC/kt --> PgC/year
          t_atm_co2_flx  = t_atm_co2_flx / glob_sum( e1e2t(:,:) )
-         t_oce_co2_flx  = t_oce_co2_flx         * zfact * (-1 )
-         tpp            = tpp           * 1000. * zfact
-         t_oce_co2_exp  = t_oce_co2_exp * 1000. * zfact
+         t_oce_co2_flx  = t_oce_co2_flx         * xfact1 * (-1 )
+         tpp            = tpp           * 1000. * xfact1
+         t_oce_co2_exp  = t_oce_co2_exp * 1000. * xfact1
          IF( lwp ) WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp
-         IF( lwp ) WRITE(numnut,9500) ndastp, alkbudget        * 1.e+06, &
+         IF( lwp ) WRITE(numnut,9100) ndastp, alkbudget        * 1.e+06, &
              &                                no3budget * rno3 * 1.e+06, &
+             &                                po4budget * po4r * 1.e+06, &
              &                                silbudget        * 1.e+06, &
              &                                ferbudget        * 1.e+09
+         !
+         IF( lwp ) WRITE(numnit,9200) ndastp, znitrpottot * xfact2  , &
+         &                             zrdenittot  * xfact2  , &
+         &                             zsdenittot  * xfact2
+
       ENDIF
       !
  9000  FORMAT(i8,f10.5,e18.10,f10.5,f10.5)
- 9500  FORMAT(i8,4e18.10)
+ 9100  FORMAT(i8,5e18.10)
+ 9200  FORMAT(i8,3f10.5)
+
        !
    END SUBROUTINE p4z_chk_mass
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90	(revision 5901)
@@ -7,4 +7,5 @@
    !!        !  06-12  (C. Ethe)  Orignal
    !!----------------------------------------------------------------------
+   !! $Id$
 #if defined key_sed
    !! Domain characteristics
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90	(revision 5901)
@@ -160,4 +160,5 @@
    INTEGER, PUBLIC ::  numsed = 27    ! units
 
+   !! $Id$
 CONTAINS
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90	(revision 5901)
@@ -23,4 +23,5 @@
    REAL(wp) :: eps = 1.e-13
 
+   !! $Id$
 CONTAINS
 
@@ -438,4 +439,5 @@
    !! MODULE sedbtb  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_adv( kt )         ! Empty routine
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90	(revision 5901)
@@ -29,5 +29,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limtab.F90,v 1.2 2005/03/27 18:34:42 opalod Exp $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90	(revision 5901)
@@ -12,4 +12,5 @@
 
 
+   !! $Id$
 CONTAINS
    
@@ -77,4 +78,5 @@
    !! MODULE sedbtb  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_btb( kt )         ! Empty routine
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90	(revision 5901)
@@ -163,4 +163,5 @@
    DATA Ddsw / 999.842594 , 6.793952E-2 , -9.095290E-3, 1.001685E-4, -1.120083E-6, 6.536332E-9/
 
+   !! $Id$
 CONTAINS
 
@@ -559,4 +560,5 @@
    !! MODULE sedchem  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_chem( kt )         ! Empty routine
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90	(revision 5901)
@@ -23,4 +23,5 @@
    !!----------------------------------------------------------------------
 
+   !! $Id$
 CONTAINS
 
@@ -188,4 +189,5 @@
    !! MODULE sedco3  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_co3( kt )         ! Empty routine
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90	(revision 5901)
@@ -20,4 +20,5 @@
    REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC ::  dens_mol_wgt  ! molecular density 
 
+   !! $Id$
 CONTAINS
    
@@ -530,4 +531,5 @@
    !! MODULE seddsr  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_dsr ( kt )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90	(revision 5901)
@@ -28,4 +28,5 @@
 #endif
 
+   !! $Id$
 CONTAINS
 
@@ -268,4 +269,5 @@
    !! MODULE seddta  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_dta ( kt )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90	(revision 5901)
@@ -55,4 +55,5 @@
    PUBLIC sed_init          ! routine called by opa.F90
 
+   !! $Id$
 CONTAINS
 
@@ -856,4 +857,5 @@
    !!   Dummy module :                      NO Sediment model
    !!----------------------------------------------------------------------
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_ini              ! Empty routine
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90	(revision 5901)
@@ -22,4 +22,5 @@
 
 
+   !! $Id$
  CONTAINS
 
@@ -257,4 +258,5 @@
    !! MODULE sedmat  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_mat         ! Empty routine
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90	(revision 5901)
@@ -36,4 +36,5 @@
    REAL(wp)  :: src13ca  
 
+   !! $Id$
 CONTAINS
 
@@ -311,4 +312,5 @@
    !! MODULE sedmbc :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_mbc( kt )         ! Empty routine
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90	(revision 5901)
@@ -17,4 +17,5 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .TRUE.     !: sediment flag
 
+   !! $Id$
 CONTAINS
 
@@ -47,4 +48,5 @@
    !!======================================================================
    LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .FALSE.     !: sediment flag
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_model( kt )         ! Empty routine
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90	(revision 5901)
@@ -25,4 +25,5 @@
    
    
+   !! $Id$
 CONTAINS
 
@@ -270,4 +271,5 @@
    !! MODULE sedrst :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_rst_read                      ! Empty routines
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90	(revision 5901)
@@ -12,4 +12,5 @@
    PUBLIC sed_sfc
 
+   !! $Id$
 CONTAINS
 
@@ -67,4 +68,5 @@
    !! MODULE sedsfc  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_sfc ( kt )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90	(revision 5901)
@@ -23,4 +23,5 @@
    PUBLIC sed_stp  ! called by step.F90
 
+   !! $Id$
 CONTAINS
 
@@ -69,4 +70,5 @@
    !! MODULE sedstp  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_stp( kt )         ! Empty routine
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90	(revision 5901)
@@ -25,4 +25,5 @@
    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext51
 
+   !! $Id$
 CONTAINS
 
@@ -264,4 +265,5 @@
    !! MODULE sedwri  :   Dummy module
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_wri( kt )         ! Empty routine
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90	(revision 5901)
@@ -63,10 +63,10 @@
    INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: (big) Silicate Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: Diatoms Silicate Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpnum = 15    !: Big iron particles Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpsfe = 16    !: number of particulate organic phosphate concentration
    INTEGER, PUBLIC, PARAMETER ::   jpdfe = 17    !: Diatoms iron Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 18    !: Diatoms Silicate Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 18    !: (big) Silicate Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpnfe = 19    !: Nano iron Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpnch = 20    !: Nano Chlorophyll Concentration
@@ -102,5 +102,5 @@
    INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: (big) Silicate Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: Diatoms Silicate Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpbfe = 15    !: Big iron particles Concentration
@@ -108,5 +108,5 @@
    INTEGER, PUBLIC, PARAMETER ::   jpsfe = 17    !: Small iron particles Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpdfe = 18    !: Diatoms iron Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 19    !: Diatoms Silicate Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 19    !: (big) Silicate Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpnfe = 20    !: Nano iron Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpnch = 21    !: Nano Chlorophyll Concentration
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90	(revision 5901)
@@ -106,7 +106,4 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates
 
-   !!* Array used to indicate negative tracer values
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     !: ???
-
 #if defined key_kriest
    !!*  Kriest parameter for aggregation
@@ -131,5 +128,5 @@
       !!----------------------------------------------------------------------
       USE lib_mpp , ONLY: ctl_warn
-      INTEGER ::   ierr(6)        ! Local variables
+      INTEGER ::   ierr(5)        ! Local variables
       !!----------------------------------------------------------------------
       ierr(:) = 0
@@ -162,6 +159,4 @@
       ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk) ,    STAT=ierr(5) )
          !
-      !* Array used to indicate negative tracer values  
-      ALLOCATE( xnegtr(jpi,jpj,jpk)  ,                           STAT=ierr(6) )
 #endif
       !
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90	(revision 5901)
@@ -0,0 +1,306 @@
+MODULE trcice_pisces
+   !!======================================================================
+   !!                         ***  MODULE trcice_pisces  ***
+   !! TOP :   initialisation of the PISCES biochemical model
+   !!======================================================================
+   !! History :  3.5  ! 2013    (M. Vancoppenolle, O. Aumont, G. Madec), original code
+   !! Comment ! probably not properly done when the second particle export
+   !! scheme (kriest) is used
+   !!----------------------------------------------------------------------
+#if defined key_pisces || defined key_pisces_reduced
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !! trc_ice_pisces   : PISCES fake sea ice model setting
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE par_pisces      ! PISCES parameters
+   USE oce_trc         ! Shared variables between ocean and passive tracers
+   USE trc             ! Passive tracers common variables 
+   USE phycst          ! Ocean physics parameters
+   USE sms_pisces      ! PISCES Source Minus Sink variables
+   USE in_out_manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ice_ini_pisces ! called by trcini.F90 module
+
+CONTAINS
+
+
+   SUBROUTINE trc_ice_ini_pisces
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_ini_pisces ***
+      !!
+      !! ** Purpose :   Initialisation of the PISCES biochemical model
+      !!----------------------------------------------------------------------
+
+      IF( lk_p4z ) THEN  ;   CALL p4z_ice_ini   !  PISCES
+      ELSE               ;   CALL p2z_ice_ini   !  LOBSTER
+      ENDIF
+
+   END SUBROUTINE trc_ice_ini_pisces
+
+
+   SUBROUTINE p4z_ice_ini
+
+#if defined key_pisces 
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE p4z_ice_ini ***
+      !!
+      !! ** Purpose :   PISCES fake sea ice model setting
+      !!    Method  :   Assign prescribe values to tracer concentrations in sea ice
+      !!
+      !! For levitating sea ice, constant ocean tracer concentrations also have to be defined. 
+      !! This is done specifically for Global, Arctic, Antarctic and Baltic regions
+      !! 
+      !! Sea ice concentrations are by default prescribed as follows
+      !!  trc_i = zratio * trc_o
+      !!
+      !! This formulation is modulated by the namelist parameter trc_ice_ratio
+      !!
+      !! trc_ice_ratio  * betw 0 and 1: prescribed ice/ocean tracer concentration ratio
+      !!                * -1 => the ice-ocean tracer concentration ratio follows the
+      !!                         ice-ocean salinity ratio
+      !!                * -2 => no ice-ocean tracer concentration is used
+      !!                        instead, the tracer concentration in sea ice 
+      !!                        is prescribed to trc_ice_prescr
+      !! 
+      !! cn_trc_o  specifies which disinctions are made for prescribed tracer concentration
+      !!                * 'GL' use global ocean values making distinction for Baltic Sea only
+      !!                * 'AA' use Arctic/Antarctic contrasted values, + Baltic
+      !!
+      !!----------------------------------------------------------------------
+
+                                        !--- Dummy variables
+      REAL(wp), DIMENSION(jp_pisces,2)  :: zratio  ! effective ice-ocean tracer cc ratio
+      REAL(wp), DIMENSION(jp_pisces,4)  :: zpisc   ! prescribes concentration 
+      !                                            !  1:global, 2:Arctic, 3:Antarctic, 4:Baltic
+
+      REAL(wp), DIMENSION(2) :: zrs  ! ice-ocean salinity ratio, 1 - global, 2- Baltic
+      REAL(wp) :: zsice_bal          ! prescribed ice salinity in the Baltic
+      REAL(wp) :: zsoce_bal          ! prescribed ocean salinity in the Baltic
+      REAL(wp) :: zfeoce_glo         ! prescribed iron concentration in the global ocean
+      REAL(wp) :: zfeoce_bal         ! prescribed iron concentration in the global ocean
+      INTEGER  :: jn                 ! dummy loop index
+
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ice_ini_pisces: Prescribed sea ice biogeochemistry '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~'
+
+      !--------------------------------------------
+      ! Initialize ocean prescribed concentrations
+      !--------------------------------------------
+      ! values taken from a 500 yr equilibrium run
+      ! used only in the levitating sea ice case with virtual salt / tracer
+      ! fluxes
+
+      !--- Global values
+      zpisc(jpdic,1) =  1.99e-3_wp 
+      zpisc(jpdoc,1) =  2.04e-5_wp 
+      zpisc(jptal,1) =  2.31e-3_wp 
+      zpisc(jpoxy,1) =  2.47e-4_wp
+      zpisc(jpcal,1) =  1.04e-8_wp
+      zpisc(jppo4,1) =  5.77e-7_wp / po4r 
+      zpisc(jppoc,1) =  1.27e-6_wp  
+#  if ! defined key_kriest
+      zpisc(jpgoc,1) =  5.23e-8_wp  
+      zpisc(jpbfe,1) =  9.84e-13_wp 
+#  else
+      zpisc(jpnum,1) = 0. ! could not get this value since did not use it
+#  endif
+      zpisc(jpsil,1) =  7.36e-6_wp  
+      zpisc(jpdsi,1) =  1.07e-7_wp 
+      zpisc(jpgsi,1) =  1.53e-8_wp
+      zpisc(jpphy,1) =  9.57e-8_wp
+      zpisc(jpdia,1) =  4.24e-7_wp
+      zpisc(jpzoo,1) =  6.07e-7_wp
+      zpisc(jpmes,1) =  3.44e-7_wp
+      zpisc(jpfer,1) =  4.06e-10_wp
+      zpisc(jpsfe,1) =  2.51e-11_wp
+      zpisc(jpdfe,1) =  6.57e-12_wp
+      zpisc(jpnfe,1) =  1.76e-11_wp
+      zpisc(jpnch,1) =  1.67e-7_wp
+      zpisc(jpdch,1) =  1.02e-7_wp
+      zpisc(jpno3,1) =  5.79e-6_wp / rno3 
+      zpisc(jpnh4,1) =  3.22e-7_wp / rno3
+
+      !--- Arctic specificities (dissolved inorganic & DOM)
+      zpisc(jpdic,2) =  1.98e-3_wp 
+      zpisc(jpdoc,2) =  6.00e-6_wp 
+      zpisc(jptal,2) =  2.13e-3_wp 
+      zpisc(jpoxy,2) =  3.65e-4_wp  
+      zpisc(jpcal,2) =  1.50e-9_wp  
+      zpisc(jppo4,2) =  4.09e-7_wp / po4r 
+      zpisc(jppoc,2) =  4.05e-7_wp  
+#  if ! defined key_kriest
+      zpisc(jpgoc,2) =  2.84e-8_wp  
+      zpisc(jpbfe,2) =  7.03e-13_wp 
+#  else
+      zpisc(jpnum,2) =  0.00e-00_wp 
+#  endif
+      zpisc(jpsil,2) =  6.87e-6_wp  
+      zpisc(jpdsi,2) =  1.73e-7_wp 
+      zpisc(jpgsi,2) =  7.93e-9_wp
+      zpisc(jpphy,2) =  5.25e-7_wp  
+      zpisc(jpdia,2) =  7.75e-7_wp 
+      zpisc(jpzoo,2) =  3.34e-7_wp
+      zpisc(jpmes,2) =  2.49e-7_wp  
+      zpisc(jpfer,2) =  1.43e-9_wp 
+      zpisc(jpsfe,2) =  2.21e-11_wp 
+      zpisc(jpdfe,2) =  2.04e-11_wp 
+      zpisc(jpnfe,2) =  1.75e-11_wp 
+      zpisc(jpnch,2) =  1.46e-07_wp 
+      zpisc(jpdch,2) =  2.36e-07_wp 
+      zpisc(jpno3,2) =  3.51e-06_wp / rno3 
+      zpisc(jpnh4,2) =  6.15e-08_wp / rno3 
+
+      !--- Antarctic specificities (dissolved inorganic & DOM)
+      zpisc(jpdic,3) =  2.20e-3_wp  
+      zpisc(jpdoc,3) =  7.02e-6_wp  
+      zpisc(jptal,3) =  2.37e-3_wp  
+      zpisc(jpoxy,3) =  3.42e-4_wp  
+      zpisc(jpcal,3) =  3.17e-9_wp  
+      zpisc(jppo4,3) =  1.88e-6_wp / po4r  
+      zpisc(jppoc,3) =  1.13e-6_wp  
+#  if ! defined key_kriest
+      zpisc(jpgoc,3) =  2.89e-8_wp  
+      zpisc(jpbfe,3) =  5.63e-13_wp 
+#  else
+      zpisc(jpnum,3) =  0.00e-00_wp 
+#  endif
+      zpisc(jpsil,3) =  4.96e-5_wp  
+      zpisc(jpdsi,3) =  5.63e-7_wp 
+      zpisc(jpgsi,3) =  5.35e-8_wp
+      zpisc(jpphy,3) =  8.10e-7_wp  
+      zpisc(jpdia,3) =  5.77e-7_wp 
+      zpisc(jpzoo,3) =  6.68e-7_wp
+      zpisc(jpmes,3) =  3.55e-7_wp  
+      zpisc(jpfer,3) =  1.62e-10_wp
+      zpisc(jpsfe,3) =  2.29e-11_wp 
+      zpisc(jpdfe,3) =  8.75e-12_wp
+      zpisc(jpnfe,3) =  1.48e-11_wp 
+      zpisc(jpnch,3) =  2.02e-7_wp  
+      zpisc(jpdch,3) =  1.60e-7_wp  
+      zpisc(jpno3,3) =  2.64e-5_wp / rno3  
+      zpisc(jpnh4,3) =  3.39e-7_wp / rno3  
+
+      !--- Baltic Sea particular case for ORCA configurations
+      zpisc(jpdic,4) = 1.14e-3_wp
+      zpisc(jpdoc,4) = 1.06e-5_wp
+      zpisc(jptal,4) = 1.16e-3_wp
+      zpisc(jpoxy,4) = 3.71e-4_wp
+      zpisc(jpcal,4) = 1.51e-9_wp
+      zpisc(jppo4,4) = 2.85e-9_wp / po4r
+      zpisc(jppoc,4) = 4.84e-7_wp
+#  if ! defined key_kriest
+      zpisc(jpgoc,4) = 1.05e-8_wp
+      zpisc(jpbfe,4) = 4.97e-13_wp
+#  else
+      zpisc(jpnum,4) = 0. ! could not get this value
+#  endif
+      zpisc(jpsil,4) = 4.91e-5_wp
+      zpisc(jpdsi,4) = 3.25e-7_wp
+      zpisc(jpgsi,4) = 1.93e-8_wp
+      zpisc(jpphy,4) = 6.64e-7_wp
+      zpisc(jpdia,4) = 3.41e-7_wp
+      zpisc(jpzoo,4) = 3.83e-7_wp
+      zpisc(jpmes,4) = 0.225e-6_wp
+      zpisc(jpfer,4) = 2.45e-9_wp
+      zpisc(jpsfe,4) = 3.89e-11_wp
+      zpisc(jpdfe,4) = 1.33e-11_wp
+      zpisc(jpnfe,4) = 2.62e-11_wp
+      zpisc(jpnch,4) = 1.17e-7_wp
+      zpisc(jpdch,4) = 9.69e-8_wp
+      zpisc(jpno3,4) = 5.36e-5_wp / rno3
+      zpisc(jpnh4,4) = 7.18e-7_wp / rno3
+ 
+      DO jn = jp_pcs0, jp_pcs1
+         IF( cn_trc_o(jn) == 'GL ' ) trc_o(:,:,jn) = zpisc(jn,1)  ! Global case
+         IF( cn_trc_o(jn) == 'AA ' ) THEN 
+            WHERE( gphit(:,:) >= 0._wp ) ; trc_o(:,:,jn) = zpisc(jn,2) ; END WHERE ! Arctic 
+            WHERE( gphit(:,:) <  0._wp ) ; trc_o(:,:,jn) = zpisc(jn,3) ; END WHERE ! Antarctic 
+         ENDIF
+         IF( cp_cfg == "orca" ) THEN     !  Baltic Sea particular case for ORCA configurations
+             WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
+                    54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
+                    trc_o(:,:,jn) = zpisc(jn,4)
+            END WHERE
+         ENDIF 
+      ENDDO
+
+
+
+      !-----------------------------
+      ! Assign ice-ocean cc ratios 
+      !-----------------------------
+      ! 0 means zero concentration in sea ice
+      ! 1 means same concentration in the sea ice as in the ocean
+
+      ! Ice ocean salinity ratio
+      zsoce_bal   = 4. ; zsice_bal   = 2. !! Baltic ocean and sea ice salinities
+      zrs(1) = sice / soce                !! ice-ocean salinity ratio, global case
+      zrs(2) = zsice_bal / zsoce_bal      !! ice-ocean salinity ratio, Baltic case
+
+      DO jn = jp_pcs0, jp_pcs1
+         IF( trc_ice_ratio(jn) >= 0._wp )  zratio(jn,:) = trc_ice_ratio(jn)
+         IF( trc_ice_ratio(jn) == -1._wp ) zratio(jn,:) = zrs(:)
+         IF( trc_ice_ratio(jn) == -2._wp ) zratio(jn,:) = -9999.99_wp
+      END DO
+
+      !-------------------------------
+      ! Sea ice tracer concentrations
+      !-------------------------------
+      DO jn = jp_pcs0, jp_pcs1
+         !-- Everywhere but in the Baltic
+         IF ( trc_ice_ratio(jn) >= -1._wp ) THEN ! no prescribed conc. ; typically everything but iron) 
+            trc_i(:,:,jn) = zratio(jn,1) * trc_o(:,:,jn) 
+         ELSE                                    ! prescribed concentration
+            trc_i(:,:,jn) = trc_ice_prescr(jn)
+         ENDIF
+       
+         !-- Baltic
+         IF( cp_cfg == "orca" ) THEN  ! Baltic treated seperately for ORCA configs
+            IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN ! no prescribed conc. ; typically everything but iron) 
+               WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
+                      54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
+                     trc_i(:,:,jn) = zratio(jn,2) * trc_o(:,:,jn) 
+               END WHERE
+            ELSE                                 ! prescribed tracer concentration in ice
+               WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
+                   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
+                     trc_i(:,:,jn) = trc_ice_prescr(jn)
+               END WHERE
+            ENDIF ! trc_ice_ratio
+         ENDIF
+      !
+      END DO ! jn
+#endif
+
+   END SUBROUTINE p4z_ice_ini
+
+   SUBROUTINE p2z_ice_ini
+#if defined key_pisces_reduced 
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE p2z_ice_ini ***
+      !!
+      !! ** Purpose :   Initialisation of the LOBSTER biochemical model
+      !!----------------------------------------------------------------------
+#endif
+   END SUBROUTINE p2z_ice_ini
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                            No PISCES biochemical model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ice_ini_pisces         ! Empty routine
+   END SUBROUTINE trc_ice_ini_pisces
+#endif
+
+   !!======================================================================
+END MODULE trcice_pisces
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 5901)
@@ -27,6 +27,4 @@
    PUBLIC   trc_ini_pisces   ! called by trcini.F90 module
 
-
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -71,12 +69,13 @@
       USE p4zmort         !  Mortality terms for phytoplankton
       USE p4zlys          !  Calcite saturation
+      USE p4zsed          !  Sedimentation & burial
       !
       REAL(wp), SAVE :: sco2   =  2.312e-3_wp
-      REAL(wp), SAVE :: alka0  =  2.423e-3_wp
+      REAL(wp), SAVE :: alka0  =  2.426e-3_wp
       REAL(wp), SAVE :: oxyg0  =  177.6e-6_wp 
-      REAL(wp), SAVE :: po4    =  2.174e-6_wp 
+      REAL(wp), SAVE :: po4    =  2.165e-6_wp 
       REAL(wp), SAVE :: bioma0 =  1.000e-8_wp  
-      REAL(wp), SAVE :: silic1 =  91.65e-6_wp  
-      REAL(wp), SAVE :: no3    =  31.04e-6_wp * 7.625_wp
+      REAL(wp), SAVE :: silic1 =  91.51e-6_wp  
+      REAL(wp), SAVE :: no3    =  30.9e-6_wp * 7.625_wp
       !
       INTEGER  ::  ji, jj, jk, ierr
@@ -97,4 +96,5 @@
       ierr = ierr +  p4z_rem_alloc()
       ierr = ierr +  p4z_flx_alloc()
+      ierr = ierr +  p4z_sed_alloc()
       !
       IF( lk_mpp    )   CALL mpp_sum( ierr )
@@ -107,13 +107,4 @@
       CALL p4z_sms_init       !  Maint routine
       !                                            ! Time-step
-      rfact   = rdttrc(1)                          ! ---------
-      rfactr  = 1. / rfact
-      rfact2  = rfact / FLOAT( nrdttrc )
-      rfact2r = 1. / rfact2
-
-      IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdttra(1)
-      IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2
-
-
 
       ! Set biological ratios
@@ -165,6 +156,4 @@
       END IF
 
-      ! Time step duration for biology
-      xstep = rfact2 / rday
 
       CALL p4z_sink_init      !  vertical flux of particulate organic matter
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90	(revision 5901)
@@ -21,5 +21,7 @@
    PUBLIC trc_wri_pisces 
 
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+
 CONTAINS
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 5901)
@@ -4,6 +4,7 @@
    !! Ocean passive tracers:  advection trend 
    !!==============================================================================
-   !! History :  2.0  !  05-11  (G. Madec)  Original code
-   !!            3.0  !  10-06  (C. Ethe)   Adapted to passive tracers
+   !! History :  2.0  !  2005-11  (G. Madec)  Original code
+   !!            3.0  !  2010-06  (C. Ethe)   Adapted to passive tracers
+   !!            3.7  !  2014-05  (G. Madec, C. Ethe)  Add 2nd/4th order cases for CEN and FCT schemes 
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -11,28 +12,50 @@
    !!   '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 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      ! 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 traadv_mle      ! ML eddy induced velocity  (tra_adv_mle    routine)
-   USE ldftra_oce      ! lateral diffusion coefficient on tracers
-   USE prtctl_trc      ! Print control
+   !!   trc_adv       : compute ocean tracer advection trend
+   !!   trc_adv_ini   : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE oce_trc        ! ocean dynamics and active tracers
+   USE trc            ! ocean passive tracers variables
+   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine)
+   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine)
+   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine)
+   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine)
+   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine)
+   USE traadv_mle     ! ML eddy induced velocity  (tra_adv_mle  routine)
+   USE ldftra         ! lateral diffusion coefficient on tracers
+   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
+   !
+   USE prtctl_trc     ! Print control
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   trc_adv          ! routine called by step module
-   PUBLIC   trc_adv_alloc    ! routine called by nemogcm module
-
-   INTEGER ::   nadv   ! choice of the type of advection scheme
+   PUBLIC   trc_adv       
+   PUBLIC   trc_adv_alloc 
+   PUBLIC   trc_adv_ini  
+
+   !                            !!* Namelist namtrc_adv *
+   LOGICAL ::   ln_trcadv_cen    ! centered scheme flag
+   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme
+   LOGICAL ::   ln_trcadv_fct    ! FCT scheme flag
+   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme
+   INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping
+   LOGICAL ::   ln_trcadv_mus    ! MUSCL scheme flag
+   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths
+   LOGICAL ::   ln_trcadv_ubs    ! UBS scheme flag
+   INTEGER ::      nn_ubs_v             ! =2/4 : vertical choice of the order of UBS scheme
+   LOGICAL ::   ln_trcadv_qck    ! QUICKEST scheme flag
+
+   !                                        ! choices of advection scheme:
+   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection
+   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme
+   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
+   INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping
+   INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme
+   INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme
+   INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme
+
+   INTEGER ::              nadv             ! chosen advection scheme
+   !
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra
    !                                                    ! except at nitrrc000 (=rdttra) if neuler=0
@@ -42,5 +65,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! NEMO/TOP 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -52,9 +75,9 @@
       !!                  ***  ROUTINE trc_adv_alloc  ***
       !!----------------------------------------------------------------------
-
+      !
       ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc )
-
+      !
       IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')
-
+      !
    END FUNCTION trc_adv_alloc
 
@@ -68,89 +91,65 @@
       !! ** Method  : - Update the tracer with the advection term following nadv
       !!----------------------------------------------------------------------
-      !!
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !
-      INTEGER ::   jk 
+      INTEGER ::   jk   ! dummy loop index
       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          ! initialisation & control of options
-
-      IF( ln_top_euler) THEN
-         r2dt(:) =  rdttrc(:)              ! = rdttrc (use Euler time stepping)
-      ELSE
-         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
-      ENDIF
-
-      !                                                   ! effective transport
+      IF( nn_timing == 1 )   CALL timing_start('trc_adv')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn )
+      !
+      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
+      ENDIF
+      !                                               !==  effective transport  ==!
       DO jk = 1, jpkm1
-         !                                                ! eulerian transport only
-         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)
+         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                   ! eulerian transport
          zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk)
          zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
-         !
       END DO
       !
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections
          zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
          zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
       ENDIF
       !
-      zun(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
-      zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
-      zwn(:,:,jpk) = 0._wp                                                     ! 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' )
-      !
-      IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )    ! add the mle transport (if necessary)
-      !
-      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
-      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   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD 
-      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups )   !  MUSCL 
-      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2 
-      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS 
-      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   ( 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, ln_trcadv_msc_ups  )          
-         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')
-         !
+      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
+         &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport
+      !
+      IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport
+      !
+      zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom
+      zvn(:,:,jpk) = 0._wp
+      zwn(:,:,jpk) = 0._wp
+      !
+      !
+      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
+      !
+      CASE ( np_CEN )                                    ! Centered : 2nd / 4th order
+         CALL tra_adv_cen    ( kt, nittrc000,'TRC',       zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v )
+      CASE ( np_FCT )                                    ! FCT      : 2nd / 4th order
+         CALL tra_adv_fct    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v )
+      CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting
+         CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra        , nn_fct_zts )
+      CASE ( np_MUS )                                    ! MUSCL
+         CALL tra_adv_mus    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups ) 
+      CASE ( np_UBS )                                    ! UBS
+         CALL tra_adv_ubs    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra        , nn_ubs_v   )
+      CASE ( np_QCK )                                    ! QUICKEST
+         CALL tra_adv_qck    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra                     )
+      !
       END SELECT
-
-      !                                              ! print mean trends (used for debugging)
-      IF( ln_ctl )   THEN
+      !                  
+      IF( ln_ctl )   THEN                             !== print mean trends (used for debugging)
          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 )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zun, zvn, zwn )
       !
       IF( nn_timing == 1 )  CALL timing_stop('trc_adv')
@@ -159,7 +158,7 @@
 
 
-   SUBROUTINE trc_adv_ctl
+   SUBROUTINE trc_adv_ini
       !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_adv_ctl  ***
+      !!                  ***  ROUTINE trc_adv_ini  ***
       !!                
       !! ** Purpose : Control the consistency between namelist options for 
@@ -167,38 +166,108 @@
       !!----------------------------------------------------------------------
       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
-
+      INTEGER ::  ios                 ! Local integer output status for namelist read
+      !!
+      NAMELIST/namtrc_adv/ ln_trcadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN
+         &                 ln_trcadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT
+         &                 ln_trcadv_mus,                     ln_mus_ups,   &   ! MUSCL
+         &                 ln_trcadv_ubs,           nn_ubs_v,               &   ! UBS
+         &                 ln_trcadv_qck                                        ! QCK
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnat_ref )              !  namtrc_adv in reference namelist 
+      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! namtrc_adv in configuration namelist
+      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_adv )
+
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers'
+         WRITE(numout,*) '      centered scheme                           ln_trcadv_cen = ', ln_trcadv_cen
+         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v
+         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_trcadv_fct = ', ln_trcadv_fct
+         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v
+         WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts
+         WRITE(numout,*) '      MUSCL scheme                              ln_trcadv_mus = ', ln_trcadv_mus
+         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups
+         WRITE(numout,*) '      UBS scheme                                ln_trcadv_ubs = ', ln_trcadv_ubs
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v
+         WRITE(numout,*) '      QUICKEST scheme                           ln_trcadv_qck = ', ln_trcadv_qck
+      ENDIF
+      !
+
+      ioptio = 0                       !==  Parameter control  ==!
+      IF( ln_trcadv_cen )   ioptio = ioptio + 1
+      IF( ln_trcadv_fct )   ioptio = ioptio + 1
+      IF( ln_trcadv_mus )   ioptio = ioptio + 1
+      IF( ln_trcadv_ubs )   ioptio = ioptio + 1
+      IF( ln_trcadv_qck )   ioptio = ioptio + 1
+
+      !
+      IF( ioptio == 0 ) THEN
+         nadv = np_NO_adv
+         CALL ctl_warn( 'trc_adv_init: You are running without tracer advection.' )
+      ENDIF
       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( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &
+                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN
+        CALL ctl_stop( 'trc_adv_init: CEN scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   &
+                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN
+        CALL ctl_stop( 'trc_adv_init: FCT scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) THEN
+         IF( nn_fct_h == 4 ) THEN
+            nn_fct_h = 2
+            CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' )
+         ENDIF
+         IF( lk_vvl ) THEN
+            CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' )
+         ENDIF
+         IF( nn_fct_zts == 1 )   CALL ctl_warn( 'trc_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' )
+      ENDIF
+      IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN
+        CALL ctl_stop( 'trc_adv_init: UBS scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN
+         CALL ctl_warn( 'trc_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
+      ENDIF
+      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities
+         IF(  ln_trcadv_cen .AND. nn_cen_v /= 4    .OR.   &                            ! NO 4th order with ISF
+            & ln_trcadv_fct .AND. nn_fct_v /= 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' )
+      ENDIF
+      !
+      !                                !==  used advection scheme  ==!
+      !                                      ! set nadv
+      IF( ln_trcadv_cen                      )   nadv = np_CEN
+      IF( ln_trcadv_fct                      )   nadv = np_FCT
+      IF( ln_trcadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts
+      IF( ln_trcadv_mus                      )   nadv = np_MUS
+      IF( ln_trcadv_ubs                      )   nadv = np_UBS
+      IF( ln_trcadv_qck                      )   nadv = np_QCK
+      !
       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
+         IF( nadv == np_NO_adv  )   WRITE(numout,*) '         NO passive tracer advection'
+         IF( nadv == np_CEN     )   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
+            &                                                                        ' Vertical   order: ', nn_cen_v
+         IF( nadv == np_FCT     )   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
+            &                                                                       ' Vertical   order: ', nn_fct_v
+         IF( nadv == np_FCT_zts )   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping'
+         IF( nadv == np_MUS     )   WRITE(numout,*) '         MUSCL    scheme is used'
+         IF( nadv == np_UBS     )   WRITE(numout,*) '         UBS      scheme is used'
+         IF( nadv == np_QCK     )   WRITE(numout,*) '         QUICKEST scheme is used'
+      ENDIF
+      !
+   END SUBROUTINE trc_adv_ini
    
 #else
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90	(revision 5901)
@@ -22,5 +22,4 @@
    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              ! 
    USE prtctl_trc          ! Print control for debbuging
@@ -30,7 +29,4 @@
    PUBLIC   trc_bbl       !  routine called by step.F90
 
-
-   !! * Substitutions
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 5901)
@@ -18,5 +18,4 @@
    USE oce_trc         ! ocean dynamics and tracers variables
    USE trc             ! ocean passive tracers variables
-   USE trcnam_trp      ! passive tracers transport namelist variables
    USE trcdta
    USE tradmp
@@ -24,11 +23,16 @@
    USE trdtra
    USE trd_oce
+   USE iom
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC trc_dmp            ! routine called by step.F90
-   PUBLIC trc_dmp_clo        ! routine called by step.F90
-   PUBLIC trc_dmp_alloc      ! routine called by nemogcm.F90
+   PUBLIC trc_dmp      
+   PUBLIC trc_dmp_clo   
+   PUBLIC trc_dmp_alloc  
+   PUBLIC trc_dmp_ini    
+
+   INTEGER , PUBLIC ::   nn_zdmp_tr    ! = 0/1/2 flag for damping in the mixed layer
+   CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr    !File containing restoration coefficient
 
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1)
@@ -39,8 +43,9 @@
 
    !! * Substitutions
-#  include "top_substitute.h90"
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -89,8 +94,4 @@
       IF( nn_timing == 1 )  CALL timing_start('trc_dmp')
       !
-      ! 0. Initialization (first time-step only)
-      !    --------------
-      IF( kt == nittrc000 ) CALL trc_dmp_init
-
       IF( l_trdtrc )   CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )   ! temporary save of trends
       !
@@ -125,5 +126,5 @@
                      DO jj = 2, jpjm1
                         DO ji = fs_2, fs_jpim1   ! vector opt.
-                           IF( avt(ji,jj,jk) <= 5.e-4 )  THEN 
+                           IF( avt(ji,jj,jk) <= 5.e-4_wp )  THEN 
                               ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
                               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
@@ -170,4 +171,66 @@
    END SUBROUTINE trc_dmp
 
+   SUBROUTINE trc_dmp_ini
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_dmp_ini  ***
+      !! 
+      !! ** Purpose :   Initialization for the newtonian damping 
+      !!
+      !! ** Method  :   read the nammbf namelist and check the parameters
+      !!              called by trc_dmp at the first timestep (nittrc000)
+      !!----------------------------------------------------------------------
+      !
+      INTEGER ::  ios                 ! Local integer output status for namelist read
+      INTEGER :: imask  !local file handle
+      !
+      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init')
+      !
+
+      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping
+      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909)
+909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping
+      READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910)
+910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_dmp )
+
+      IF(lwp) THEN                       ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter'
+         WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)'
+         WRITE(numout,*) '      Restoration coeff file    cn_resto_tr = ', cn_resto_tr
+      ENDIF
+      !
+      IF( lzoom .AND. .NOT.lk_c1d )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries
+      SELECT CASE ( nn_zdmp_tr )
+      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column'
+      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)'
+      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
+      CASE DEFAULT
+         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr
+         CALL ctl_stop(ctmp1)
+      END SELECT
+
+      IF( .NOT.lk_c1d ) THEN
+         IF( .NOT. ln_tradmp )   &
+            &   CALL ctl_stop( 'passive trace damping need ln_tradmp to compute damping coef.' )
+         !
+         !                          ! Read damping coefficients from file
+         !Read in mask from file
+         CALL iom_open ( cn_resto_tr, imask)
+         CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr)
+         CALL iom_close( imask )
+         !
+      ENDIF
+      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init')
+      !
+   END SUBROUTINE trc_dmp_ini
+
    SUBROUTINE trc_dmp_clo( kt )
       !!---------------------------------------------------------------------
@@ -184,5 +247,6 @@
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
       !
-      INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indicesa
+      INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa
+      INTEGER :: isrow                                      ! local index
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace
 
@@ -200,4 +264,13 @@
             !
             SELECT CASE ( jp_cfg )
+            !                                           ! =======================
+            CASE ( 1 )                                  ! eORCA_R1 configuration
+            !                                           ! =======================
+            isrow = 332 - jpjglo
+            !
+                                                        ! Caspian Sea
+            nctsi1(1)   = 332  ; nctsj1(1)   = 243 - isrow
+            nctsi2(1)   = 344  ; nctsj2(1)   = 275 - isrow
+            !                                        
             !                                           ! =======================
             CASE ( 2 )                                  !  ORCA_R2 configuration
@@ -292,47 +365,4 @@
 
 
-   SUBROUTINE trc_dmp_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_dmp_init  ***
-      !! 
-      !! ** Purpose :   Initialization for the newtonian damping 
-      !!
-      !! ** Method  :   read the nammbf namelist and check the parameters
-      !!              called by trc_dmp at the first timestep (nittrc000)
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init')
-      !
-      SELECT CASE ( nn_hdmp_tr )
-      CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only'
-      CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp_tr, ' degrees'
-      CASE DEFAULT
-         WRITE(ctmp1,*) '          bad flag value for nn_hdmp_tr = ', nn_hdmp_tr
-         CALL ctl_stop(ctmp1)
-      END SELECT
-
-      IF( lzoom )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries
-      SELECT CASE ( nn_zdmp_tr )
-      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column'
-      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)'
-      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
-      CASE DEFAULT
-         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr
-         CALL ctl_stop(ctmp1)
-      END SELECT
-
-      IF( .NOT. ln_tradmp )   &
-         &   CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' )
-      !
-      !                          ! Damping coefficients initialization
-      IF( lzoom ) THEN   ;   CALL dtacof_zoom( restotr )
-      ELSE               ;   CALL dtacof( nn_hdmp_tr, rn_surf_tr, rn_bot_tr, rn_dep_tr,  &
-                             &            nn_file_tr, 'TRC'     , restotr                )
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init')
-      !
-   END SUBROUTINE trc_dmp_init
-
 #else
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 5901)
@@ -4,6 +4,7 @@
    !! 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
+   !! History :  1.0  ! 2005-11  (G. Madec)  Original code
+   !!            3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!            3.7  ! 2014-03  (G. Madec)  LDF simplification
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -11,20 +12,17 @@
    !!   '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      ! lateral mixing            (tra_ldf_iso routine)
-   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
-   USE traldf_lap      ! lateral mixing            (tra_ldf_lap routine)
-   USE trd_oce
-   USE trdtra
+   !!   trc_ldf      : update the tracer trend with the lateral diffusion
+   !!   trc_ldf_ini  : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE trc           ! ocean passive tracers variables
+   USE oce_trc       ! ocean dynamics and active tracers
+   USE ldfslp        ! lateral diffusion: iso-neutral slope
+   USE traldf_lap    ! lateral diffusion: laplacian iso-level            operator  (tra_ldf_lap   routine)
+   USE traldf_iso    ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso   routine)
+   USE traldf_triad  ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_triad routine)
+   USE traldf_blp    ! lateral diffusion (iso-level lap/blp)                       (tra_ldf_lap   routine)
+   USE trd_oce       ! trends: ocean variables
+   USE trdtra        ! trends manager: tracers 
+   !
    USE prtctl_trc      ! Print control
 
@@ -32,17 +30,28 @@
    PRIVATE
 
-   PUBLIC   trc_ldf    ! called by step.F90
-   !                                                 !!: ** lateral mixing namelist (nam_trcldf) **
-   REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient
+   PUBLIC   trc_ldf    
+   PUBLIC   trc_ldf_ini   
+   !
+   LOGICAL , PUBLIC ::   ln_trcldf_lap       !:   laplacian operator
+   LOGICAL , PUBLIC ::   ln_trcldf_blp       !: bilaplacian operator
+   LOGICAL , PUBLIC ::   ln_trcldf_lev       !: iso-level   direction
+   LOGICAL , PUBLIC ::   ln_trcldf_hor       !: horizontal  direction (rotation to geopotential)
+   LOGICAL , PUBLIC ::   ln_trcldf_iso       !: iso-neutral direction (standard)
+   LOGICAL , PUBLIC ::   ln_trcldf_triad     !: iso-neutral direction (triad)
+   REAL(wp), PUBLIC ::   rn_ahtrc_0          !:   laplacian diffusivity coefficient for passive tracer [m2/s]
+   REAL(wp), PUBLIC ::   rn_bhtrc_0          !: bilaplacian      -          --     -       -   [m4/s]
+   !
+                                                 !!: ** lateral mixing namelist (nam_trcldf) **
+   REAL(wp) ::  rldf    ! 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)
+   !! NEMO/TOP 3.7 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -58,4 +67,5 @@
       INTEGER            :: jn
       CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zahu, zahv
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
       !!----------------------------------------------------------------------
@@ -63,44 +73,31 @@
       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 )
+         CALL wrk_alloc( jpi,jpj,jpk,jptra,   ztrtrd )
          ztrtrd(:,:,:,:)  = tra(:,:,:,:)
       ENDIF
-
-      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
-      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, 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     ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 )
-                       ENDIF
-      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, 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   ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, 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     ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, 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, gtrui, gtrvi, 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' )
+      !
+      !                                        !* set the lateral diffusivity coef. for passive tracer      
+      CALL wrk_alloc( jpi,jpj,jpk,   zahu, zahv )
+      zahu(:,:,:) = rldf * ahtu(:,:,:)
+      zahv(:,:,:) = rldf * ahtv(:,:,:)
+
+      SELECT CASE ( nldf )                     !* compute lateral mixing trend and add it to the general trend
+      !
+      CASE ( np_lap   )                               ! iso-level laplacian
+         CALL tra_ldf_lap  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb,      tra, jptra,  1   )
+         !
+      CASE ( np_lap_i )                               ! laplacian : standard iso-neutral operator (Madec)
+         CALL tra_ldf_iso  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   )
+         !
+      CASE ( np_lap_it )                              ! laplacian : triad iso-neutral operator (griffies)
+         CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   )
+         !
+      CASE ( np_blp , np_blp_i , np_blp_it )          ! bilaplacian: all operator (iso-level, -neutral)
+         CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb     , tra, jptra, nldf )
+         !
       END SELECT
       !
-      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+      IF( l_trdtrc )   THEN                    ! save the horizontal diffusive trends for further diagnostics
         DO jn = 1, jptra
            ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
@@ -109,9 +106,11 @@
         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
+      !                                        ! 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
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zahu, zahv )
       !
       IF( nn_timing == 1 )   CALL timing_stop('trc_ldf')
@@ -120,13 +119,11 @@
 
 
-   SUBROUTINE ldf_ctl
+   SUBROUTINE trc_ldf_ini
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ldf_ctl  ***
       !!
-      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
+      !! ** Purpose :   Define the operator for the lateral 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
@@ -134,129 +131,139 @@
       !!      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
-            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
-      ELSE
-         rldf_rat = rn_ahtrc_0 / rn_aht_0
-      END IF
-      !  Define the lateral mixing oparator for tracers
-      ! ===============================================
-
-      !                               ! control the input
+      INTEGER ::   ioptio, ierr   ! temporary integers
+      INTEGER ::   ios            ! Local integer output status for namelist read
+      !
+      NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp,                                  &
+         &                 ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad,  &
+         &                 rn_ahtrc_0   , rn_bhtrc_0
+      !!----------------------------------------------------------------------
+      REWIND( numnat_ref )              !  namtrc_ldf in reference namelist 
+      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              !  namtrc_ldf in configuration namelist 
+      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_ldf )
+
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_ldf_ini : lateral tracer diffusive operator'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)'
+         WRITE(numout,*) '      operator'
+         WRITE(numout,*) '           laplacian                 ln_trcldf_lap   = ', ln_trcldf_lap
+         WRITE(numout,*) '         bilaplacian                 ln_trcldf_blp   = ', ln_trcldf_blp
+         WRITE(numout,*) '      direction of action'
+         WRITE(numout,*) '         iso-level                   ln_trcldf_lev   = ', ln_trcldf_lev
+         WRITE(numout,*) '         horizontal (geopotential)   ln_trcldf_hor   = ', ln_trcldf_hor
+         WRITE(numout,*) '         iso-neutral (standard)      ln_trcldf_iso   = ', ln_trcldf_iso
+         WRITE(numout,*) '         iso-neutral (triad)         ln_trcldf_triad = ', ln_trcldf_triad
+         WRITE(numout,*) '      diffusivity coefficient'
+         WRITE(numout,*) '           laplacian                 rn_ahtrc_0      = ', rn_ahtrc_0
+         WRITE(numout,*) '         bilaplacian                 rn_bhtrc_0      = ', rn_bhtrc_0
+      ENDIF
+      !      
+      !                                ! control the namelist parameters
       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
+      IF( ln_trcldf_lap )   ioptio = ioptio + 1
+      IF( ln_trcldf_blp )   ioptio = ioptio + 1
+      IF( ioptio >  1   )   CALL ctl_stop( 'trc_ldf_ctl: use ONE or NONE of the 2 lap/bilap operator type on tracer' )
+      IF( ioptio == 0   )   nldf = np_no_ldf   ! No lateral diffusion
+      
+      IF( ln_trcldf_lap .AND. ln_trcldf_blp )   CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' )
+      IF( ln_trcldf_blp .AND. ln_trcldf_lap )   CALL ctl_stop( 'trc_ldf_ctl:   laplacian should be used on both TRC and TRA' )
+      
       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)' )
+      IF( ln_trcldf_lev )   ioptio = ioptio + 1
+      IF( ln_trcldf_hor )   ioptio = ioptio + 1
+      IF( ln_trcldf_iso )   ioptio = ioptio + 1
+      IF( ioptio /= 1   )   CALL ctl_stop( 'trc_ldf_ctl: 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_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_trcldf_lev   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation)
+            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate with partial step
+            IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed 
+            IF ( ln_trcldf_hor   )   nldf = np_lap     ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! s-coordinate
+            IF ( ln_trcldf_lev   )   nldf = np_lap     ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = np_lap_it  ! horizontal (   rotation)       !!gm   a checker....
+            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         !                                ! diffusivity ratio: passive / active tracers 
+         IF( ABS(rn_aht_0) < 2._wp*TINY(1.e0) ) THEN
+            IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0) ) THEN
+               rldf = 1.0_wp
+            ELSE
+               CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' )
+            ENDIF
+         ELSE
+            rldf = rn_ahtrc_0 / rn_aht_0
+         ENDIF
+      ENDIF
+      !
+      IF( ln_trcldf_blp ) 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 ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate with partial step
+            IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed 
+            IF ( ln_trcldf_hor   )   nldf = np_blp     ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! s-coordinate
+            IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = np_blp_it  ! horizontal (   rotation)       !!gm   a checker....
+            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         !                                ! diffusivity ratio: passive / active tracers 
+         IF( ABS(rn_bht_0) < 2._wp*TINY(1.e0) ) THEN
+            IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1.e0) ) THEN
+               rldf = 1.0_wp
+            ELSE
+               CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' )
+            ENDIF
+         ELSE
+            rldf = SQRT(  ABS( rn_bhtrc_0 / rn_bht_0 )  )
+         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 )   &
+      IF( ln_ldfeiv .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( .NOT.l_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require l_ldfslp' )
+      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
-            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
-      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
+         IF( nldf == np_no_ldf )   WRITE(numout,*) '          NO lateral diffusion'
+         IF( nldf == np_lap    )   WRITE(numout,*) '          laplacian iso-level operator'
+         IF( nldf == np_lap_i  )   WRITE(numout,*) '          Rotated laplacian operator (standard)'
+         IF( nldf == np_lap_it )   WRITE(numout,*) '          Rotated laplacian operator (triad)'
+         IF( nldf == np_blp    )   WRITE(numout,*) '          bilaplacian iso-level operator'
+         IF( nldf == np_blp_i  )   WRITE(numout,*) '          Rotated bilaplacian operator (standard)'
+         IF( nldf == np_blp_it )   WRITE(numout,*) '          Rotated bilaplacian operator (triad)'
+      ENDIF
+      !
+   END SUBROUTINE trc_ldf_ini
 #else
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90	(revision 5891)
+++ 	(revision )
@@ -1,206 +1,0 @@
-MODULE trcnam_trp
-   !!======================================================================
-   !!                       ***  MODULE  trcnam_trp  ***
-   !! TOP :   namelist read options for transport
-   !!======================================================================
-   !! History :   1.0  !  2004-03  (C. Ethe)  Original code
-   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!   trc_nam_trp  : read the passive tracer namelist for transport
-   !!----------------------------------------------------------------------
-   USE trc                 ! passive tracers variables
-   USE in_out_manager      ! ocean dynamics and active tracers variables
-   USE lib_mpp           ! distributed memory computing library
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   trc_nam_trp    ! routine called by step module
- 
-   !                                        !!: ** Advection (namtrc_adv) **
-   LOGICAL , PUBLIC ::   ln_trcadv_cen2      ! 2nd order centered scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_tvd       ! TVD scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_muscl     ! MUSCL scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_muscl2    ! MUSCL2 scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_ubs       ! UBS scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_qck       ! QUICKEST scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_msc_ups   ! use upstream scheme within muscl
-
-
-   !                                        !!: ** lateral mixing namelist (nam_trcldf) **
-   LOGICAL , PUBLIC ::   ln_trcldf_diff      !: flag of perform or not the lateral diff.
-   LOGICAL , PUBLIC ::   ln_trcldf_lap       !: laplacian operator
-   LOGICAL , PUBLIC ::   ln_trcldf_bilap     !: bilaplacian operator
-   LOGICAL , PUBLIC ::   ln_trcldf_level     !: iso-level direction
-   LOGICAL , PUBLIC ::   ln_trcldf_hor       !: horizontal (geopotential) direction
-   LOGICAL , PUBLIC ::   ln_trcldf_iso       !: iso-neutral direction
-   REAL(wp), PUBLIC ::   rn_ahtrc_0          !: diffusivity coefficient for passive tracer (m2/s)
-   REAL(wp), PUBLIC ::   rn_ahtrb_0          !: background diffusivity coefficient for passive tracer (m2/s)
-
-   !                                        !!: ** Treatment of Negative concentrations ( nam_trcrad )
-   LOGICAL , PUBLIC ::   ln_trcrad           !: flag to artificially correct negative concentrations
-
-   !                                        !!: ** Vertical diffusion (nam_trczdf) **
-   LOGICAL , PUBLIC ::   ln_trczdf_exp       !: explicit vertical diffusion scheme flag
-   INTEGER , PUBLIC ::   nn_trczdf_exp       !: number of sub-time step (explicit time stepping)
-
-   !                                                 !!: ** newtonian damping namelist (nam_trcdmp) **
-   !                          !!* Namelist namtrc_dmp : passive tracer newtonian damping *
-   INTEGER , PUBLIC ::   nn_hdmp_tr    ! = 0/-1/'latitude' for damping over passive tracer
-   INTEGER , PUBLIC ::   nn_zdmp_tr    ! = 0/1/2 flag for damping in the mixed layer
-   REAL(wp), PUBLIC ::   rn_surf_tr    ! surface time scale for internal damping        [days]
-   REAL(wp), PUBLIC ::   rn_bot_tr     ! bottom time scale for internal damping         [days]
-   REAL(wp), PUBLIC ::   rn_dep_tr     ! depth of transition between rn_surf and rn_bot [meters]
-   INTEGER , PUBLIC ::   nn_file_tr    ! = 1 create a damping.coeff NetCDF file
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_nam_trp
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_nam_trp  ***
-      !!                
-      !! ** Purpose :   Read Namelist for tracer transport option
-      !!----------------------------------------------------------------------
-      INTEGER ::  ios                 ! Local integer output status for namelist read
-      NAMELIST/namtrc_adv/ ln_trcadv_cen2 , ln_trcadv_tvd   ,    &
-         &                 ln_trcadv_muscl, ln_trcadv_muscl2,    &
-         &                 ln_trcadv_ubs  , ln_trcadv_qck, ln_trcadv_msc_ups
-
-      NAMELIST/namtrc_ldf/ ln_trcldf_diff , ln_trcldf_lap  ,     &
-         &                 ln_trcldf_bilap, ln_trcldf_level,     &
-         &                 ln_trcldf_hor  , ln_trcldf_iso  , rn_ahtrc_0, rn_ahtrb_0
-      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp
-      NAMELIST/namtrc_rad/ ln_trcrad
-      NAMELIST/namtrc_dmp/ nn_hdmp_tr, nn_zdmp_tr, rn_surf_tr, &
-        &                  rn_bot_tr , rn_dep_tr , nn_file_tr
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' trc_nam_trp: read namelist for tracer transport'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
-
-      REWIND( numnat_ref )              ! Namelist namtrc_adv in reference namelist : Tracer advection scheme
-      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp )
-
-      REWIND( numnat_cfg )              ! Namelist namtrc_adv in configuration namelist : Tracer advection scheme
-      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp )
-      IF(lwm) WRITE ( numont, namtrc_adv )
-
-      IF(lwp) THEN                    ! Namelist print
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_adv_ctl : choice/control of the tracer advection scheme'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers'
-         WRITE(numout,*) '      2nd order advection scheme     ln_trcadv_cen2   = ', ln_trcadv_cen2
-         WRITE(numout,*) '      TVD advection scheme           ln_trcadv_tvd    = ', ln_trcadv_tvd
-         WRITE(numout,*) '      MUSCL  advection scheme        ln_trcadv_muscl  = ', ln_trcadv_muscl
-         WRITE(numout,*) '      MUSCL2 advection scheme        ln_trcadv_muscl2 = ', ln_trcadv_muscl2
-         WRITE(numout,*) '      UBS    advection scheme        ln_trcadv_ubs    = ', ln_trcadv_ubs
-         WRITE(numout,*) '      QUICKEST advection scheme      ln_trcadv_qck    = ', ln_trcadv_qck
-      ENDIF
-      !
-      REWIND( numnat_ref )              ! Namelist namtrc_ldf in reference namelist : Tracer lateral diffusive operator
-      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903)
-903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp )
-
-      REWIND( numnat_cfg )              ! Namelist namtrc_ldf in configuration namelist : Tracer lateral diffusive operator
-      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 )
-904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp )
-      IF(lwm) WRITE ( numont, namtrc_ldf )
-
-      IF(lwp) THEN                    ! Namelist print
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc:ldf_ctl : lateral tracer diffusive operator'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)'
-         WRITE(numout,*) '      perform lateral diffusion or not                   ln_trcldf_diff  = ', ln_trcldf_diff
-         WRITE(numout,*) '      laplacian operator                                 ln_trcldf_lap   = ', ln_trcldf_lap
-         WRITE(numout,*) '      bilaplacian operator                               ln_trcldf_bilap = ', ln_trcldf_bilap
-         WRITE(numout,*) '      iso-level                                          ln_trcldf_level = ', ln_trcldf_level
-         WRITE(numout,*) '      horizontal (geopotential)                          ln_trcldf_hor   = ', ln_trcldf_hor
-         WRITE(numout,*) '      iso-neutral                                        ln_trcldf_iso   = ', ln_trcldf_iso
-         WRITE(numout,*) '      diffusivity coefficient                                 rn_ahtrc_0 = ', rn_ahtrc_0
-         WRITE(numout,*) '      background hor. diffusivity                             rn_ahtrb_0 = ', rn_ahtrb_0
-      ENDIF
-
-      !                                ! Vertical mixing
-      REWIND( numnat_ref )              ! Namelist namtrc_zdf in reference namelist : Tracer vertical mixing
-      READ  ( numnat_ref, namtrc_zdf, IOSTAT = ios, ERR = 905)
-905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in reference namelist', lwp )
-
-      REWIND( numnat_cfg )              ! Namelist namtrc_zdf in configuration namelist : Tracer vertical mixing
-      READ  ( numnat_cfg, namtrc_zdf, IOSTAT = ios, ERR = 906 )
-906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in configuration namelist', lwp )
-      IF(lwm) WRITE ( numont, namtrc_zdf )
-
-      IF(lwp) THEN                     !   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namtrc_zdf : set vertical diffusion parameters'
-         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp
-         WRITE(numout,*) '      number of time step              nn_trczdf_exp = ', nn_trczdf_exp
-      ENDIF
-
-      !
-      REWIND( numnat_ref )              ! Namelist namtrc_rad in reference namelist : Tracer negative concentrations
-      READ  ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907)
-907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp )
-
-      REWIND( numnat_cfg )              ! Namelist namtrc_rad in configuration namelist : Tracer negative concentrations
-      READ  ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 )
-908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp )
-      IF(lwm) WRITE ( numont, namtrc_rad )
-
-      IF(lwp) THEN                     !   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namtrc_rad : treatment of negative concentrations'
-         WRITE(numout,*) '      correct artificially negative concen. or not ln_trcrad = ', ln_trcrad
-      ENDIF
-
-
-      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping
-      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909)
-909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp )
-
-      REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping
-      READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910)
-910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp )
-      IF(lwm) WRITE ( numont, namtrc_dmp )
-
-      IF(lwp) THEN                       ! Namelist print
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping'
-         WRITE(numout,*) '~~~~~~~'
-         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter'
-         WRITE(numout,*) '      tracer damping option          nn_hdmp_tr = ', nn_hdmp_tr
-         WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)'
-         WRITE(numout,*) '      surface time scale (days)      rn_surf_tr = ', rn_surf_tr
-         WRITE(numout,*) '      bottom time scale (days)       rn_bot_tr  = ', rn_bot_tr
-         WRITE(numout,*) '      depth of transition (meters)   rn_dep_tr  = ', rn_dep_tr
-         WRITE(numout,*) '      create a damping.coeff file    nn_file_tr = ', nn_file_tr
-      ENDIF
-      !
-   END SUBROUTINE trc_nam_trp
-   
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                                         No TOP model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_nam_trp              ! Empty routine
-   END SUBROUTINE trc_nam_trp
-#endif
-
-  !!======================================================================
-END MODULE trcnam_trp
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 5901)
@@ -102,4 +102,7 @@
       ENDIF
 
+#if defined key_agrif
+      CALL Agrif_trc                   ! AGRIF zoom boundaries
+#endif
       ! Update after tracer on domain lateral boundaries
       DO jn = 1, jptra
@@ -111,12 +114,9 @@
 !!      CALL bdy_trc( kt )               ! BDY open boundaries
 #endif
-#if defined key_agrif
-      CALL Agrif_trc                   ! AGRIF zoom boundaries
-#endif
 
 
       ! set time step size (Euler/Leapfrog)
       IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler)
-      ELSEIF( kt <= nittrc000 + 1 )            THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog)
+      ELSEIF( kt <= nittrc000 + nn_dttrc )     THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog)
       ENDIF
 
@@ -137,6 +137,7 @@
       ELSE
          ! Leap-Frog + Asselin filter time stepping
-         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl) 
-         ELSE                ;   CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level 
+         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      &
+           &                                                                sbc_trc, sbc_trc_b, jptra )      ! variable volume level (vvl) 
+         ELSE                ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )      ! fixed    volume level 
          ENDIF
       ENDIF
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 5901)
@@ -22,8 +22,9 @@
    PRIVATE
 
-   PUBLIC trc_rad         ! routine called by trcstp.F90
-
-   !! * Substitutions
-#  include "top_substitute.h90"
+   PUBLIC trc_rad     
+   PUBLIC trc_rad_ini  
+
+   LOGICAL , PUBLIC ::   ln_trcrad           !: flag to artificially correct negative concentrations
+
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -76,4 +77,32 @@
       !
    END SUBROUTINE trc_rad
+
+   SUBROUTINE trc_rad_ini
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trc _rad_ini ***
+      !!
+      !! ** Purpose : read  namelist options 
+      !!----------------------------------------------------------------------
+      INTEGER ::  ios                 ! Local integer output status for namelist read
+      NAMELIST/namtrc_rad/ ln_trcrad
+      !!----------------------------------------------------------------------
+
+      !
+      REWIND( numnat_ref )              ! namtrc_rad in reference namelist 
+      READ  ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907)
+907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! namtrc_rad in configuration namelist 
+      READ  ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 )
+908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_rad )
+
+      IF(lwp) THEN                     !   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrc_rad : treatment of negative concentrations'
+         WRITE(numout,*) '      correct artificially negative concen. or not ln_trcrad = ', ln_trcrad
+      ENDIF
+      !
+   END SUBROUTINE trc_rad_ini
 
    SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv )
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 5901)
@@ -19,4 +19,5 @@
    USE trc             ! ocean  passive tracers variables
    USE prtctl_trc      ! Print control for debbuging
+   USE iom
    USE trd_oce
    USE trdtra
@@ -27,6 +28,9 @@
    PUBLIC   trc_sbc   ! routine called by step.F90
 
+   REAL(wp) ::   r2dt  !  time-step at surface
+
    !! * Substitutions
-#  include "top_substitute.h90"
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -60,9 +64,11 @@
       INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
       !
-      INTEGER  ::   ji, jj, jn           ! dummy loop indices
-      REAL(wp) ::   zsrau, zse3t   ! temporary scalars
+      INTEGER  ::   ji, jj, jn                                     ! dummy loop indices
+      REAL(wp) ::   zse3t, zrtrn, zratio, zfact                    ! temporary scalars
+      REAL(wp) ::   zswitch, zftra, zcd, zdtra, ztfx, ztra         ! temporary scalars
       CHARACTER (len=22) :: charout
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zsfx
       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd
+
       !!---------------------------------------------------------------------
       !
@@ -72,4 +78,23 @@
                       CALL wrk_alloc( jpi, jpj,      zsfx   )
       IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )
+      !
+      zrtrn = 1.e-15_wp
+
+      SELECT CASE( nn_ice_embd )         ! levitating or embedded sea-ice option
+         CASE( 0    )   ;   zswitch = 1  ! (0) standard levitating sea-ice : salt exchange only
+         CASE( 1, 2 )   ;   zswitch = 0  ! (1) levitating sea-ice: salt and volume exchange but no pressure effect                                
+      !                                  ! (2) embedded sea-ice : salt and volume fluxes and pressure
+      END SELECT
+
+      IF( ln_top_euler) THEN
+         r2dt =  rdttrc(1)              ! = rdttrc (use Euler time stepping)
+      ELSE
+         IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
+            r2dt = rdttrc(1)           ! = rdttrc (restarting with Euler time stepping)
+         ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
+            r2dt = 2. * rdttrc(1)       ! = 2 rdttrc (leapfrog)
+         ENDIF
+      ENDIF
+
 
       IF( kt == nittrc000 ) THEN
@@ -77,4 +102,25 @@
          IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition'
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
+
+         IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file
+            iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN
+            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file'
+            zfact = 0.5_wp
+            DO jn = 1, jptra
+               CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc
+            END DO
+         ELSE                                         ! No restart or restart not found: Euler forward time stepping
+           zfact = 1._wp
+           sbc_trc_b(:,:,:) = 0._wp
+         ENDIF
+      ELSE                                         ! Swap of forcing fields
+         IF( ln_top_euler ) THEN
+            zfact = 1._wp
+            sbc_trc_b(:,:,:) = 0._wp
+         ELSE
+            zfact = 0.5_wp
+            sbc_trc_b(:,:,:) = sbc_trc(:,:,:)
+         ENDIF
+         !
       ENDIF
 
@@ -90,16 +136,47 @@
 
       ! 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
+
+         IF ( nn_ice_tr == -1 ) THEN  ! No tracers in sea ice (null concentration in sea ice)
+
+            DO jj = 2, jpj
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn)
+               END DO
+            END DO
+
+         ELSE
+
+            DO jj = 2, jpj
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zse3t = 1. / fse3t(ji,jj,1)
+                  ! tracer flux at the ice/ocean interface (tracer/m2/s)
+                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice
+                  zcd   =   trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting,
+                                                               ! only used in the levitating sea ice case
+                  ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux
+                  ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux
+                  ztfx  = zftra + zswitch * zcd                ! net tracer flux (+C/D if no ice/ocean mass exchange)
+   
+                  zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) 
+                  IF ( zdtra < 0. ) THEN
+                     zratio = -zdtra * zse3t * r2dt / ( trn(ji,jj,1,jn) + zrtrn )
+                     zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise
+                  ENDIF
+                  sbc_trc(ji,jj,jn) =  zdtra 
+               END DO
+            END DO
+         ENDIF
+         !                                       Concentration dilution effect on tracers due to evaporation & precipitation 
          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
+               zse3t = zfact / fse3t(ji,jj,1)
+               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t
             END DO
          END DO
-         
+         !
          IF( l_trdtrc ) THEN
             ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
@@ -109,4 +186,17 @@
       END DO                                                     ! tracer loop
       !                                                          ! ===========
+
+      !                                           Write in the tracer restar  file
+      !                                          *******************************
+      IF( lrst_trc ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         DO jn = 1, jptra
+            CALL iom_rstput( kt, nitrst, numrtw, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc(:,:,jn) )
+         END DO
+      ENDIF
+      !
       IF( ln_ctl )   THEN
          WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 5901)
@@ -15,8 +15,6 @@
    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          ! bottom boundary layer               (trc_bbl routine)
    USE trcbbl          ! 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)
@@ -38,6 +36,4 @@
    PUBLIC   trc_trp    ! called by trc_stp
 
-   !! * Substitutions
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -48,5 +44,5 @@
 CONTAINS
 
-   SUBROUTINE trc_trp( kstp )
+   SUBROUTINE trc_trp( kt )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE trc_trp  ***
@@ -57,5 +53,5 @@
       !!              - Update the passive tracers
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index
+      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index
       !! ---------------------------------------------------------------------
       !
@@ -64,32 +60,34 @@
       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
-         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends
-         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( .NOT. lk_offline .AND. lk_zdfkpp )    &
-            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
+                                CALL trc_sbc    ( kt )      ! surface boundary condition
+         IF( lk_trabbl )        CALL trc_bbl    ( kt )      ! advective (and/or diffusive) bottom boundary layer scheme
+         IF( ln_trcdmp )        CALL trc_dmp    ( kt )      ! internal damping trends
+         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt )      ! internal damping trends on closed seas only
+                                CALL trc_adv    ( kt )      ! horizontal & vertical advection 
+         !                                                         ! Partial top/bottom cell: GRADh( trb )  
+         IF( ln_zps ) THEN
+           IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom
+           ELSE                 ; CALL zps_hde    ( kt, jptra, trb, gtru, gtrv )                                      !  only bottom
+           ENDIF
+         ENDIF
+         !                                                      
+                                CALL trc_ldf    ( kt )      ! lateral mixing
 #if defined key_agrif
-         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge
+         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc       ! tracers sponge
 #endif
-                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
-                                CALL trc_nxt( kstp )            ! tracer fields at next time step     
-         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations
+                                CALL trc_zdf    ( kt )      ! vertical mixing and after tracer fields
+                                CALL trc_nxt    ( kt )      ! tracer fields at next time step     
+         IF( ln_trcrad )        CALL trc_rad    ( kt )      ! Correct artificial negative concentrations
 
 #if defined key_agrif
-      IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )   ! Update tracer at AGRIF zoom boundaries : children only
+         IF( .NOT.Agrif_Root()) CALL Agrif_Update_Trc( kt ) ! 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
-                                                                ! tracers at the bottom ocean level
          !
       ELSE                                               ! 1D vertical configuration
-                                CALL trc_sbc( kstp )            ! surface boundary condition
-         IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
-            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
-                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
-                                CALL trc_nxt( kstp )            ! tracer fields at next time step     
-          IF( ln_trcrad )       CALL trc_rad( kstp )            ! Correct artificial negative concentrations
+                                CALL trc_sbc( kt )            ! surface boundary condition
+         IF( ln_trcdmp )        CALL trc_dmp( kt )            ! internal damping trends
+                                CALL trc_zdf( kt )            ! vertical mixing and after tracer fields
+                                CALL trc_nxt( kt )            ! tracer fields at next time step     
+          IF( ln_trcrad )       CALL trc_rad( kt )            ! Correct artificial negative concentrations
          !
       END IF
@@ -104,7 +102,7 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE trc_trp( kstp )              ! Empty routine
-      INTEGER, INTENT(in) ::   kstp
-      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kstp
+   SUBROUTINE trc_trp( kt )              ! Empty routine
+      INTEGER, INTENT(in) ::   kt
+      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt
    END SUBROUTINE trc_trp
 #endif
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90	(revision 5901)
@@ -11,21 +11,26 @@
    !!   'key_top'                                                TOP models
    !!----------------------------------------------------------------------
-   !!   trc_ldf     : update the tracer trend with the lateral diffusion
-   !!       ldf_ctl : initialization, namelist read, and parameters control
+   !!   trc_zdf      : update the tracer trend with the lateral diffusion
+   !!   trc_zdf_ini  : 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      ! vertical diffusion: implicit (tra_zdf_imp     routine)
-   USE trd_oce
-   USE trdtra
-   USE prtctl_trc      ! Print control
+   USE trc           ! ocean passive tracers variables
+   USE oce_trc       ! ocean dynamics and active tracers
+   USE trd_oce       ! trends: ocean variables
+   USE trazdf_exp    ! vertical diffusion: explicit (tra_zdf_exp     routine)
+   USE trazdf_imp    ! vertical diffusion: implicit (tra_zdf_imp     routine)
+   USE trcldf        ! passive tracers: lateral diffusion
+   USE trdtra        ! trends manager: tracers 
+   USE prtctl_trc    ! Print control
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   trc_zdf          ! called by step.F90 
-   PUBLIC   trc_zdf_alloc    ! called by nemogcm.F90 
+   PUBLIC   trc_zdf         ! called by step.F90 
+   PUBLIC   trc_zdf_ini     ! called by nemogcm.F90 
+   PUBLIC   trc_zdf_alloc   ! called by nemogcm.F90 
+   
+   !                                        !!** Vertical diffusion (nam_trczdf) **
+   LOGICAL , PUBLIC ::   ln_trczdf_exp       !: explicit vertical diffusion scheme flag
+   INTEGER , PUBLIC ::   nn_trczdf_exp       !: number of sub-time step (explicit time stepping)
 
    INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used
@@ -39,5 +44,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! NEMO/TOP 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -71,14 +76,8 @@
       IF( nn_timing == 1 )  CALL timing_start('trc_zdf')
       !
-      IF( kt == nittrc000 )   CALL zdf_ctl          ! initialisation & control of options
-
-      IF( ln_top_euler) THEN
-         r2dt(:) =  rdttrc(:)              ! = rdttrc (use Euler time stepping)
-      ELSE
-         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
+      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
       ENDIF
 
@@ -89,14 +88,6 @@
 
       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( 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( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme          
-
       END SELECT
 
@@ -121,7 +112,7 @@
 
 
-   SUBROUTINE zdf_ctl
+   SUBROUTINE trc_zdf_ini
       !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE zdf_ctl  ***
+      !!                 ***  ROUTINE trc_zdf_ini  ***
       !!
       !! ** Purpose :   Choose the vertical mixing scheme
@@ -132,30 +123,41 @@
       !!      NB: The implicit scheme is required when using : 
       !!             - rotated lateral mixing operator
-      !!             - TKE, GLS or KPP vertical mixing scheme
+      !!             - TKE, GLS 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
+      INTEGER ::  ios                 ! Local integer output status for namelist read
+      !!
+      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnat_ref )             ! namtrc_zdf in reference namelist 
+      READ  ( numnat_ref, namtrc_zdf, IOSTAT = ios, ERR = 905)
+905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in reference namelist', lwp )
+      !
+      REWIND( numnat_cfg )             ! namtrc_zdf in configuration namelist 
+      READ  ( numnat_cfg, namtrc_zdf, IOSTAT = ios, ERR = 906 )
+906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_zdf )
+      !
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrc_zdf : set vertical diffusion  parameters'
+         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp
+         WRITE(numout,*) '      number of time step              nn_trczdf_exp = ', nn_trczdf_exp
       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.' )
+      !                                ! Define the vertical tracer physics scheme
+      IF( ln_trczdf_exp ) THEN   ;   nzdf = 0     ! explicit scheme
+      ELSE                       ;   nzdf = 1     ! implicit scheme
       ENDIF
 
-      ! Test: esopa
-      IF( lk_esopa )    nzdf = -1                      ! All schemes used
+      !                                ! 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 
+                                         nzdf = 1      ! TKE or GLS physics       
+#endif
+      IF( ln_trczdf_exp .AND. nzdf == 1 )  & 
+         CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS vertical scheme ', &
+            &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' )
 
       IF(lwp) THEN
@@ -163,10 +165,10 @@
          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
+      !
+   END SUBROUTINE trc_zdf_ini
+   
 #else
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90	(revision 5901)
@@ -8,5 +8,5 @@
    !!                 !  07-06  (C. Deltel)  key_gyre : do not call lbc_lnk
    !!----------------------------------------------------------------------
-#if   defined key_top && ( defined key_trdmxl_trc   ||   defined key_esopa )
+#if   defined key_top   &&   defined key_trdmxl_trc
    !!----------------------------------------------------------------------
    !!   'key_trdmxl_trc'                      mixed layer trend diagnostics
@@ -24,5 +24,4 @@
    USE zdfddm  , ONLY : avs  ! salinity vertical diffusivity coeff. at w-point
 # endif
-   USE trcnam_trp        ! passive tracers transport namelist variables
    USE trdtrc_oce    ! definition of main arrays used for trends computations
    USE in_out_manager    ! I/O manager
@@ -67,9 +66,9 @@
 
    !! * Substitutions
-#  include "top_substitute.h90"
+#  include "domzgr_substitute.h90"
 #  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header:  $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90	(revision 5901)
@@ -23,5 +23,5 @@
    !!---------------------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmxl_rst.F90,v 1.6 2006/11/14 09:46:13 opalod Exp $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!---------------------------------------------------------------------------------
@@ -39,5 +39,6 @@
       !
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
-      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
+      CHARACTER(LEN=50)   ::   clname   ! output restart file name
+      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file
       CHARACTER (len=35) :: charout
       INTEGER :: jl,  jk, jn               ! loop indice
@@ -51,6 +52,8 @@
          ENDIF
          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_trc_out)
-         IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  '//clname
-         CALL iom_open( clname, nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib )
+         clpath = TRIM(cn_trcrst_outdir)
+         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+         IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  'TRIM(clpath)//TRIM(clname)
+         CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib )
       ENDIF
 
@@ -133,4 +136,5 @@
       INTEGER ::  jlibalt = jprstlib
       LOGICAL ::  llok
+      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file
       !!-----------------------------------------------------------------------------
       
@@ -141,12 +145,15 @@
       ENDIF
       
+      clpath = TRIM(cn_trcrst_indir)
+      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+
       IF ( jprstlib == jprstdimg ) THEN
         ! eventually read netcdf file (monobloc)  for restarting on different number of processors
         ! if {cn_trdrst_trc_in}.nc exists, then set jlibalt to jpnf90
-        INQUIRE( FILE = TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok )
+        INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok )
         IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
       ENDIF
 
-      CALL iom_open( cn_trdrst_trc_in, inum, kiolib = jlibalt ) 
+      CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum, kiolib = jlibalt ) 
       
       IF( ln_trdmxl_trc_instant ) THEN 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90	(revision 5901)
@@ -14,5 +14,4 @@
    !!----------------------------------------------------------------------
    USE trc               ! tracer definitions (trn, trb, tra, etc.)
-   USE trcnam_trp
    USE trd_oce
    USE trdtrc_oce       ! definition of main arrays used for trends computations
@@ -29,9 +28,7 @@
    PUBLIC trd_trc
 
-   !! * Substitutions
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header:  $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90	(revision 5901)
@@ -4,5 +4,5 @@
    !! Ocean trends :   set tracer and momentum trend variables
    !!======================================================================
-#if defined key_top   ||   defined key_esopa
+#if defined key_top
    !!----------------------------------------------------------------------
    !!   'key_top'                                                TOP models
@@ -30,5 +30,5 @@
 # endif
 
-# if defined key_trdmxl_trc   ||   defined key_esopa
+# if defined key_trdmxl_trc
    !!----------------------------------------------------------------------
    !!   'key_trdmxl_trc'                     mixed layer trends diagnostics
@@ -118,5 +118,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmxl_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 5901)
@@ -11,6 +11,6 @@
    !!   'key_top'                                                TOP models
    !!----------------------------------------------------------------------
-
-   !* Domain size *
+   !
+   !                                            !* Domain size *
    USE par_oce , ONLY :   jpi      =>   jpi        !: first  dimension of grid --> i 
    USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j  
@@ -20,34 +20,16 @@
    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    
- 
-   !* 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 
+   USE in_out_manager                           !* IO manager *
+   USE wrk_nemo                                 !* Memory Allocation *
+   USE timing                                   !* Timing * 
+   USE lib_mpp                                  !* MPP library                         
+   USE lib_fortran                              !* Fortran utilities                         
+   USE lbclnk                                   !* Lateral boundary conditions                         
+   USE phycst                                   !* physical constants *
+   USE c1d                                      !* 1D configuration
+   USE dom_oce                                  !* model domain *
 
    USE domvvl, ONLY : un_td, vn_td          !: thickness diffusion transport
@@ -56,6 +38,4 @@
 
    !* ocean fields: here now and after fields *
-   USE oce , ONLY :   ua      =>    ua      !: i-horizontal velocity (m s-1) 
-   USE oce , ONLY :   va      =>    va      !: j-horizontal velocity (m s-1)
    USE oce , ONLY :   un      =>    un      !: i-horizontal velocity (m s-1) 
    USE oce , ONLY :   vn      =>    vn      !: j-horizontal velocity (m s-1)
@@ -66,15 +46,11 @@
    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 oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s)
+   USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]   
+   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]   
+   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]   
 #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]
-   USE oce , ONLY :   hdivb   =>    hdivb   !: horizontal divergence (1/s)
-   USE oce , ONLY :   rotb    =>    rotb    !: relative vorticity    [s-1]
-   USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]   
-   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]   
-   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]   
-   USE oce , ONLY :   l_traldf_rot => l_traldf_rot  !: rotated laplacian operator for lateral diffusion
 
    !* surface fluxes *
@@ -87,7 +63,9 @@
    USE sbc_oce , ONLY :   fmmflx     =>    fmmflx     !: freshwater budget: volume flux               [Kg/m2/s]
    USE sbc_oce , ONLY :   rnf        =>    rnf        !: river runoff   [Kg/m2/s]
-   USE sbc_oce , ONLY :   ln_dm2dc   =>    ln_dm2dc   !: Daily mean to Diurnal Cycle short wave (qsr) 
+   USE sbc_oce , ONLY :   ln_dm2dc   =>    ln_dm2dc   !: Diurnal Cycle 
+   USE sbc_oce , ONLY :   ncpl_qsr_freq   =>   ncpl_qsr_freq   !: qsr coupling frequency per days from atmospher
    USE sbc_oce , ONLY :   ln_rnf     =>    ln_rnf     !: runoffs / runoff mouths
    USE sbc_oce , ONLY :   fr_i       =>    fr_i       !: ice fraction (between 0 to 1)
+   USE sbc_oce , ONLY :   nn_ice_embd => nn_ice_embd  !: flag for  levitating/embedding sea-ice in the ocean
    USE traqsr  , ONLY :   rn_abs     =>    rn_abs     !: fraction absorbed in the very near surface
    USE traqsr  , ONLY :   rn_si0     =>    rn_si0     !: very near surface depth of extinction
@@ -96,21 +74,31 @@
    USE sbcrnf  , ONLY :   rnfmsk_z   =>    rnfmsk_z   !: mixed adv scheme in runoffs vicinity (vert.)
    USE sbcrnf  , ONLY :   h_rnf      =>    h_rnf      !: river runoff   [Kg/m2/s]
+   USE sbcrnf  , ONLY :   nk_rnf     =>    nk_rnf     !: depth of runoff in model level
 
    USE trc_oce
 
+!!gm : I don't understand this as ldftra (where everything is defined) is used by TRC in all cases (ON/OFF-line)
+!!gm   so the following lines should be removed....   logical should be the one of TRC namelist
+!!gm   In case off coarsening....  the ( ahtu, ahtv, aeiu, aeiv) arrays are needed that's all.
    !* lateral diffusivity (tracers) *
-   USE ldftra_oce , ONLY :  rldf     =>   rldf        !: multiplicative coef. for lateral diffusivity
-   USE ldftra_oce , ONLY :  rn_aht_0 =>   rn_aht_0    !: horizontal eddy diffusivity for tracers (m2/s)
-   USE ldftra_oce , ONLY :  aht0     =>   aht0        !: horizontal eddy diffusivity for tracers (m2/s)
-   USE ldftra_oce , ONLY :  ahtb0    =>   ahtb0       !: background eddy diffusivity for isopycnal diff. (m2/s)
-   USE ldftra_oce , ONLY :  ahtu     =>   ahtu        !: lateral diffusivity coef. at u-points 
-   USE ldftra_oce , ONLY :  ahtv     =>   ahtv        !: lateral diffusivity coef. at v-points 
-   USE ldftra_oce , ONLY :  ahtw     =>   ahtw        !: lateral diffusivity coef. at w-points 
-   USE ldftra_oce , ONLY :  ahtt     =>   ahtt        !: lateral diffusivity coef. at t-points
-   USE ldftra_oce , ONLY :  aeiv0    =>   aeiv0       !: eddy induced velocity coefficient (m2/s) 
-   USE ldftra_oce , ONLY :  aeiu     =>   aeiu        !: eddy induced velocity coef. at u-points (m2/s)   
-   USE ldftra_oce , ONLY :  aeiv     =>   aeiv        !: eddy induced velocity coef. at v-points (m2/s) 
-   USE ldftra_oce , ONLY :  aeiw     =>   aeiw        !: eddy induced velocity coef. at w-points (m2/s) 
-   USE ldftra_oce , ONLY :  lk_traldf_eiv  =>  lk_traldf_eiv     !: eddy induced velocity flag
+   USE ldftra , ONLY :  rn_aht_0     =>   rn_aht_0     !:   laplacian lateral eddy diffusivity [m2/s]
+   USE ldftra , ONLY :  rn_bht_0     =>   rn_bht_0     !: bilaplacian lateral eddy diffusivity [m4/s]
+   USE ldftra , ONLY :  ahtu         =>   ahtu         !: lateral diffusivity coef. at u-points 
+   USE ldftra , ONLY :  ahtv         =>   ahtv         !: lateral diffusivity coef. at v-points 
+   USE ldftra , ONLY :  rn_aeiv_0    =>   rn_aeiv_0    !: eddy induced velocity coefficient (m2/s) 
+   USE ldftra , ONLY :  aeiu         =>   aeiu         !: eddy induced velocity coef. at u-points (m2/s)   
+   USE ldftra , ONLY :  aeiv         =>   aeiv         !: eddy induced velocity coef. at v-points (m2/s) 
+   USE ldftra , ONLY :  ln_ldfeiv    =>   ln_ldfeiv    !: eddy induced velocity flag
+     
+!!gm this should be : ln_trcldf_triad (TRC namelist)
+   USE ldfslp , ONLY :  ln_traldf_triad => ln_traldf_triad   !: triad scheme (Griffies et al.)
+
+   !* direction of lateral diffusion *
+   USE ldfslp , ONLY :   l_ldfslp  =>  l_ldfslp       !: slopes flag
+   USE ldfslp , ONLY :   uslp       =>   uslp         !: i-slope at u-point
+   USE ldfslp , ONLY :   vslp       =>   vslp         !: j-slope at v-point
+   USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-slope at w-point
+   USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-slope at w-point
+!!gm end 
 
    !* vertical diffusion *
@@ -126,13 +114,5 @@
    USE zdfmxl , ONLY :   hmlpt       =>   hmlpt       !: mixed layer depth at t-points (m)
 
-   !* direction of lateral diffusion *
-   USE ldfslp , ONLY :   lk_ldfslp  =>  lk_ldfslp     !: slopes flag
-# if   defined key_ldfslp
-   USE ldfslp , ONLY :   uslp       =>   uslp         !: i-direction slope at u-, w-points
-   USE ldfslp , ONLY :   vslp       =>   vslp         !: j-direction slope at v-, w-points
-   USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-direction slope at u-, w-points
-   USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-direction slope at v-, w-points
-# endif
-
+   USE diaar5 , ONLY :   lk_diaar5  =>   lk_diaar5
 #else
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/top_substitute.h90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/top_substitute.h90	(revision 5891)
+++ 	(revision )
@@ -1,17 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                    ***  top_substitute.h90   ***
-   !!----------------------------------------------------------------------
-   !! ** purpose : Statement function file: to be include in all passive tracer modules
-   !!----------------------------------------------------------------------
-   !! History :   1.0  !  2004-03 (C. Ethe) Original code
-   !!             2.0  !  2007-12 (C. Ethe, G. Madec) new architecture
-   !!----------------------------------------------------------------------
-#  include "domzgr_substitute.h90"
-#  include "ldfeiv_substitute.h90"
-#  include "ldftra_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 5901)
@@ -34,7 +34,13 @@
    REAL(wp), PUBLIC                                                ::  areatot        !: total volume 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  cvol           !: volume correction -degrad option- 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: traceur concentration for now time step
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: traceur concentration for next time step
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: traceur concentration for before time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: tracer concentration for now time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: tracer concentration for next time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: tracer concentration for before time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc_b      !: Before sbc fluxes for tracers
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc        !: Now sbc fluxes for tracers
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_i          !: prescribed tracer concentration in sea ice for SBC
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_o          !: prescribed tracer concentration in ocean for SBC
+   INTEGER             , PUBLIC                                    ::  nn_ice_tr      !: handling of sea ice tracers
 
    !! interpolated gradient
@@ -44,4 +50,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrui          !: hor. gradient at u-points at top    ocean level
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrvi          !: hor. gradient at v-points at top    ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)             ::  qsr_mean        !: daily mean qsr
    
    !! passive tracers  (input and output)
@@ -54,5 +61,7 @@
    INTEGER             , PUBLIC                                    ::  nn_rsttr       !: control of the time step ( 0 or 1 ) for pass. tr.
    CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input)
+   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_indir  !: restart input directory
    CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output)
+   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_outdir  !: restart output directory
    REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step
    LOGICAL             , PUBLIC                                    ::  ln_top_euler  !: boolean term for euler integration 
@@ -61,4 +70,17 @@
    LOGICAL             , PUBLIC                                    ::  ln_trcdmp_clo  !: internal damping flag on closed seas
    INTEGER             , PUBLIC                                    ::  nittrc000       !: first time step of passive tracers model
+   LOGICAL             , PUBLIC                                    ::  l_trcdm2dc     !: Diurnal cycle for TOP
+
+   !! Information for the ice module for tracers
+   !! ------------------------------------------
+   TYPE TRC_I_NML                    !--- Ice tracer namelist structure
+         REAL(wp)         :: trc_ratio  ! ice-ocean trc ratio
+         REAL(wp)         :: trc_prescr ! prescribed ice trc cc
+         CHARACTER(len=2) :: ctrc_o     ! choice of ocean trc cc
+   END TYPE
+
+   REAL(wp), DIMENSION(jptra), PUBLIC         :: trc_ice_ratio, & ! ice-ocean tracer ratio
+                                                 trc_ice_prescr   ! prescribed ice trc cc
+   CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc
 
    !! information for outputs
@@ -121,10 +143,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s]
 # endif
-#if defined key_ldfslp
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_tm    !: i-direction slope at u-, w-points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpj_tm    !: j-direction slope at u-, w-points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm     !: j-direction slope at u-, w-points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vslp_tm     !: j-direction slope at u-, w-points
-#endif
 #if defined key_trabbl
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points
@@ -161,8 +177,4 @@
 #endif
    !
-#if defined key_ldfslp
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_temp, wslpj_temp, uslp_temp, vslp_temp    !: hold current values 
-#endif
-   ! 
 # if defined key_zdfddm
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp      !: salinity vertical diffusivity coeff. at w-point   [m/s]
@@ -172,5 +184,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3.1 , NEMO Consortium (2010)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -185,9 +197,11 @@
       !
       ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &  
+         &      trc_i(jpi,jpj,jptra)  , trc_o(jpi,jpj,jptra)                          ,       &
          &      gtru (jpi,jpj,jptra)  , gtrv (jpi,jpj,jptra)                          ,       &
          &      gtrui(jpi,jpj,jptra)  , gtrvi(jpi,jpj,jptra)                          ,       &
+         &      sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra)                      ,       &  
          &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       &
          &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       & 
-         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)                             ,  STAT = trc_alloc  )  
+         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,  STAT = trc_alloc  )  
 
       IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays')
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcbc.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcbc.F90	(revision 5901)
@@ -44,5 +44,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: trcdta.F90 2977 2011-10-22 13:46:41Z cetlod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcdia.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcdia.F90	(revision 5901)
@@ -51,6 +51,4 @@
    INTEGER  ::   nhoritb   !:  id for horizontal mesh
 
-   !! * Substitutions
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 5901)
@@ -223,4 +223,9 @@
                            sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1)
                         ENDIF
+                        ik = mikt(ji,jj)
+                        IF( ik > 1 ) THEN
+                           zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
+                           sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik+1)
+                        ENDIF
                      END DO
                   END DO
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcice.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcice.F90	(revision 5901)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcice.F90	(revision 5901)
@@ -0,0 +1,73 @@
+MODULE trcice
+   !!======================================================================
+   !!                         ***  MODULE trcice  ***
+   !! TOP :   Manage the communication between TOP and sea ice
+   !!======================================================================
+   !! History :  3.5  ! 2013    (M. Vancoppenolle, O. Aumont, G. Madec), original code
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_ice   :  Call the appropriate sea ice tracer subroutine
+   !!----------------------------------------------------------------------
+
+   USE oce_trc         ! shared variables between ocean and passive tracers
+   USE trc             ! passive tracers common variables
+   USE trcice_cfc      ! CFC      initialisation
+   USE trcice_pisces   ! PISCES   initialisation
+   USE trcice_c14b     ! C14 bomb initialisation
+   USE trcice_my_trc   ! MY_TRC   initialisation
+   
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   trc_ice_ini ! called by trc_nam
+
+CONTAINS
+   
+   SUBROUTINE trc_ice_ini
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ice_ini ***
+      !!
+      !! ** Purpose :   Initialization of the ice module for tracers
+      !!
+      !! ** Method  : - 
+      !!            
+      !!---------------------------------------------------------------------
+      ! --- Variable declarations --- !
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_ice_ini : Initialize sea ice tracer boundary condition'
+         WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+
+      IF( nn_timing == 1 )  CALL timing_start('trc_ice_ini')
+
+      !
+      trc_i(:,:,:) = 0.0d0 ! by default
+      trc_o(:,:,:) = 0.0d0 ! by default
+
+      IF ( nn_ice_tr == 1 ) THEN
+         IF( lk_pisces  )    CALL trc_ice_ini_pisces       ! PISCES  bio-model
+         IF( lk_cfc     )    CALL trc_ice_ini_cfc          ! CFC     tracers
+         IF( lk_c14b    )    CALL trc_ice_ini_c14b         ! C14 bomb  tracer
+         IF( lk_my_trc  )    CALL trc_ice_ini_my_trc       ! MY_TRC  tracers
+      ENDIF
+
+      IF( nn_timing == 1 )   CALL timing_stop('trc_ice_ini')
+      !
+   END SUBROUTINE trc_ice_ini
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ice_ini                   ! Dummy routine   
+   END SUBROUTINE trc_ice_ini
+#endif
+
+   !!======================================================================
+END MODULE trcice
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcini.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 5901)
@@ -18,17 +18,12 @@
    USE oce_trc         ! shared variables between ocean and passive tracers
    USE trc             ! passive tracers common variables
-   USE trcrst          ! passive tracers restart
    USE trcnam          ! Namelist read
-   USE trcini_cfc      ! CFC      initialisation
-   USE trcini_pisces   ! PISCES   initialisation
-   USE trcini_c14b     ! C14 bomb initialisation
-   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 prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
    USE trcsub          ! variables to substep passive tracers
+   USE trcrst
    USE lib_mpp         ! distribued memory computing library
    USE sbc_oce
+   USE trcice          ! tracers in sea ice
  
    IMPLICIT NONE
@@ -58,8 +53,4 @@
       !!                or read data or analytical formulation
       !!---------------------------------------------------------------------
-      INTEGER ::   jk, jn, jl    ! dummy loop indices
-      CHARACTER (len=25) :: charout
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace
-      !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )   CALL timing_start('trc_init')
@@ -69,16 +60,10 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~'
 
-      CALL top_alloc()              ! allocate TOP arrays
-
-#if defined key_offline
-      ltrcdm2dc = .FALSE.
-#endif
-
-      IF( ltrcdm2dc )CALL ctl_warn( ' Diurnal cycle on physics but not in PISCES or LOBSTER ' )
-
-      IF( nn_cla == 1 )   &
-         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' )
-
-      CALL trc_nam      ! read passive tracers namelists
+      !
+      CALL top_alloc()   ! allocate TOP arrays
+      !
+      CALL trc_ini_ctl   ! control 
+      !
+      CALL trc_nam       ! read passive tracers namelists
       !
       IF(lwp) WRITE(numout,*)
@@ -87,5 +72,49 @@
       !
       IF(lwp) WRITE(numout,*)
-                                                              ! masked grid volume
+      !
+      CALL trc_ini_sms   ! SMS
+      !
+      CALL trc_ini_trp   ! passive tracers transport
+      !
+      CALL trc_ice_ini   ! Tracers in sea ice
+      !
+      IF( lwp )  &
+         &  CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea )
+      !
+      CALL trc_ini_state  !  passive tracers initialisation : from a restart or from clim
+      !
+      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers
+      !
+      CALL trc_ini_inv   ! Inventories
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_init')
+      !
+   END SUBROUTINE trc_init
+
+
+   SUBROUTINE trc_ini_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_ctl  ***
+      !! ** Purpose :        Control  + ocean volume
+      !!----------------------------------------------------------------------
+      INTEGER ::   jk    ! dummy loop indices
+      !
+      ! Define logical parameter ton control dirunal cycle in TOP
+      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 )
+      l_trcdm2dc = l_trcdm2dc  .AND. .NOT. lk_offline
+      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   &
+         &                           'Computation of a daily mean shortwave for some biogeochemical models ' )
+      !
+   END SUBROUTINE trc_ini_ctl
+
+
+   SUBROUTINE trc_ini_inv
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_stat  ***
+      !! ** Purpose :      passive tracers inventories at initialsation phase
+      !!----------------------------------------------------------------------
+      INTEGER ::  jk, jn    ! dummy loop indices
+      CHARACTER (len=25) :: charout
+      !!----------------------------------------------------------------------
       !                                                              ! masked grid volume
       DO jk = 1, jpk
@@ -95,18 +124,89 @@
       !                                                              ! total volume of the ocean 
       areatot = glob_sum( cvol(:,:,:) )
-
+      !
+      trai(:) = 0._wp                                                   ! initial content of all tracers
+      DO jn = 1, jptra
+         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
+      END DO
+
+      IF(lwp) THEN               ! control print
+         WRITE(numout,*)
+         WRITE(numout,*)
+         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra
+         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot
+         WRITE(numout,*) '          *** Total inital content of all tracers '
+         WRITE(numout,*)
+         DO jn = 1, jptra
+            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
+         ENDDO
+         WRITE(numout,*)
+      ENDIF
+      IF(lwp) WRITE(numout,*)
+      IF(ln_ctl) THEN            ! print mean trends (used for debugging)
+         CALL prt_ctl_trc_init
+         WRITE(charout, FMT="('ini ')")
+         CALL prt_ctl_trc_info( charout )
+         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+      ENDIF
+9000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
+      !
+   END SUBROUTINE trc_ini_inv
+
+
+   SUBROUTINE trc_ini_sms
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_sms  ***
+      !! ** Purpose :   SMS initialisation
+      !!----------------------------------------------------------------------
+      USE trcini_cfc      ! CFC      initialisation
+      USE trcini_pisces   ! PISCES   initialisation
+      USE trcini_c14b     ! C14 bomb initialisation
+      USE trcini_my_trc   ! MY_TRC   initialisation
+      !!----------------------------------------------------------------------
       IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model
       IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers
       IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer
       IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers
-
-      IF( lwp ) THEN
-         !
-         CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea )
-         !
-      ENDIF
-
+      !
+   END SUBROUTINE trc_ini_sms
+
+   SUBROUTINE trc_ini_trp
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_trp  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!----------------------------------------------------------------------
+      USE trcdmp , ONLY:  trc_dmp_ini
+      USE trcadv , ONLY:  trc_adv_ini
+      USE trcldf , ONLY:  trc_ldf_ini
+      USE trczdf , ONLY:  trc_zdf_ini
+      USE trcrad , ONLY:  trc_rad_ini
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_trcdmp )  CALL  trc_dmp_ini          ! damping
+                       CALL  trc_adv_ini          ! advection
+                       CALL  trc_ldf_ini          ! lateral diffusion
+                       CALL  trc_zdf_ini          ! vertical diffusion
+                       CALL  trc_rad_ini          ! positivity of passive tracers 
+      !
+   END SUBROUTINE trc_ini_trp
+
+
+   SUBROUTINE trc_ini_state
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_state ***
+      !! ** Purpose :          Initialisation of passive tracer concentration 
+      !!----------------------------------------------------------------------
+      USE zpshde          ! partial step: hor. derivative   (zps_hde routine)
+      USE trcrst          ! passive tracers restart
+      USE trcdta          ! initialisation from files
+      !
+      INTEGER ::   jk, jn, jl    ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace
+      !!----------------------------------------------------------------------
+      !
       IF( ln_trcdta )      CALL trc_dta_init(jptra)
-
 
       IF( ln_rsttr ) THEN
@@ -143,40 +243,6 @@
  
       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( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers
-      !
-
-      trai(:) = 0._wp                                                   ! initial content of all tracers
-      DO jn = 1, jptra
-         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
-      END DO
-
-      IF(lwp) THEN               ! control print
-         WRITE(numout,*)
-         WRITE(numout,*)
-         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra
-         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot
-         WRITE(numout,*) '          *** Total inital content of all tracers '
-         WRITE(numout,*)
-         DO jn = 1, jptra
-            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
-         ENDDO
-         WRITE(numout,*)
-      ENDIF
-      IF(lwp) WRITE(numout,*)
-      IF(ln_ctl) THEN            ! print mean trends (used for debugging)
-         CALL prt_ctl_trc_init
-         WRITE(charout, FMT="('ini ')")
-         CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
-      ENDIF
-9000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('trc_init')
-      !
-   END SUBROUTINE trc_init
+      !                                                         ! Partial top/bottom cell: GRADh(trn)
+   END SUBROUTINE trc_ini_state
 
 
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 5901)
@@ -20,5 +20,4 @@
    USE oce_trc           ! shared variables between ocean and passive tracers
    USE trc               ! passive tracers common variables
-   USE trcnam_trp        ! Transport namelist
    USE trcnam_pisces     ! PISCES namelist
    USE trcnam_cfc        ! CFC SMS namelist
@@ -35,14 +34,10 @@
    PUBLIC trc_nam      ! called in trcini
 
-   !! * Substitutions
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
-
 
    SUBROUTINE trc_nam
@@ -57,26 +52,19 @@
       !!---------------------------------------------------------------------
       INTEGER  ::   jn                  ! dummy loop indice
-      !                                        !   Parameters of the run 
-      IF( .NOT. lk_offline ) CALL trc_nam_run
-      
-      !                                        !  passive tracer informations
-      CALL trc_nam_trc
-      
-      !                                        !   Parameters of additional diagnostics
-      CALL trc_nam_dia
-
-      !                                        !   namelist of transport
-      CALL trc_nam_trp
-
-
-      IF( ln_rsttr )                      ln_trcdta = .FALSE.   ! restart : no need of clim data
-      !
-      IF( ln_trcdmp .OR. ln_trcdmp_clo )  ln_trcdta = .TRUE.   ! damping : need to have clim data
-      !
-      IF( .NOT.ln_trcdta ) THEN
-         ln_trc_ini(:) = .FALSE.
-      ENDIF
-
-     IF(lwp) THEN                   ! control print
+      !                                  
+      IF( .NOT.lk_offline )   CALL trc_nam_run     ! Parameters of the run 
+      !               
+                              CALL trc_nam_trc     ! passive tracer informations
+      !                                        
+                              CALL trc_nam_dia     ! Parameters of additional diagnostics
+      !                                      
+      !
+      IF( ln_rsttr                     )   ln_trcdta     = .FALSE.   ! restart : no need of clim data
+      !
+      IF( ln_trcdmp .OR. ln_trcdmp_clo )   ln_trcdta     = .TRUE.   ! damping : need to have clim data
+      !
+      IF( .NOT.ln_trcdta               )   ln_trc_ini(:) = .FALSE.
+
+      IF(lwp) THEN                   ! control print
          WRITE(numout,*)
          WRITE(numout,*) ' Namelist : namtrc'
@@ -147,4 +135,8 @@
 
 
+      ! Call the ice module for tracers
+      ! -------------------------------
+                                  CALL trc_nam_ice
+
       ! namelist of SMS
       ! ---------------      
@@ -167,4 +159,5 @@
    END SUBROUTINE trc_nam
 
+
    SUBROUTINE trc_nam_run
       !!---------------------------------------------------------------------
@@ -175,11 +168,9 @@
       !!---------------------------------------------------------------------
       NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, &
-        &                  cn_trcrst_in, cn_trcrst_out
-
+        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out
+      !
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-
-      !!---------------------------------------------------------------------
-
-
+      !!---------------------------------------------------------------------
+      !
       IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'
       IF(lwp) WRITE(numout,*) '~~~~~~~'
@@ -216,4 +207,56 @@
 
 
+   SUBROUTINE trc_nam_ice
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_nam_ice ***
+      !!
+      !! ** Purpose :   Read the namelist for the ice effect on tracers
+      !!
+      !! ** Method  : -
+      !!
+      !!---------------------------------------------------------------------
+      INTEGER :: jn      ! dummy loop indices
+      INTEGER :: ios     ! Local integer output status for namelist read
+      !
+      TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer
+      !!
+      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer
+      !!---------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      ENDIF
+
+      IF( nn_timing == 1 )  CALL timing_start('trc_nam_ice')
+
+      !
+      REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data
+      READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901)
+ 901  IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp )
+
+      REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients
+      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 )
+ 902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp )
+
+      IF( lwp ) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr
+         WRITE(numout,*) ' '
+      ENDIF
+
+      ! Assign namelist stuff
+      DO jn = 1, jptra
+         trc_ice_ratio(jn)  = sn_tri_tracer(jn)%trc_ratio
+         trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr
+         cn_trc_o      (jn) = sn_tri_tracer(jn)%ctrc_o
+      END DO
+
+      IF( nn_timing == 1 )   CALL timing_stop('trc_nam_ice')
+      !
+   END SUBROUTINE trc_nam_ice
+
+
    SUBROUTINE trc_nam_trc
       !!---------------------------------------------------------------------
@@ -223,15 +266,14 @@
       !!
       !!---------------------------------------------------------------------
-      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput
-      !!
-      NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo
-  
       INTEGER  ::   ios                 ! Local integer output status for namelist read
       INTEGER  ::   jn                  ! dummy loop indice
+      !
+      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput
+      !!
+      NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo
       !!---------------------------------------------------------------------
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'
       IF(lwp) WRITE(numout,*) '~~~~~~~'
-
 
       REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables
@@ -251,6 +293,6 @@
          ln_trc_wri(jn) =       sn_tracer(jn)%llsave
       END DO
-      
-    END SUBROUTINE trc_nam_trc
+      !
+   END SUBROUTINE trc_nam_trc
 
 
@@ -265,5 +307,7 @@
       !!                ( (PISCES, CFC, MY_TRC )
       !!---------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
       INTEGER ::  ierr
+      !!
 #if defined key_trdmxl_trc  || defined key_trdtrc
       NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, &
@@ -272,6 +316,4 @@
 #endif
       NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio
-
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
       !!---------------------------------------------------------------------
 
@@ -339,6 +381,6 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
-END MODULE  trcnam
+END MODULE trcnam
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 5901)
@@ -25,5 +25,4 @@
    USE oce_trc
    USE trc
-   USE trcnam_trp
    USE iom
    USE daymod
@@ -37,5 +36,5 @@
 
    !! * Substitutions
-#  include "top_substitute.h90"
+#  include "domzgr_substitute.h90"
    
 CONTAINS
@@ -51,4 +50,5 @@
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
       CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
+      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file
       !!----------------------------------------------------------------------
       !
@@ -56,8 +56,13 @@
          IF( kt == nittrc000 ) THEN
             lrst_trc = .FALSE.
-            nitrst = nitend
-         ENDIF
-
-         IF( MOD( kt - 1, nstock ) == 0 ) THEN
+            IF( ln_rst_list ) THEN
+               nrst_lst = 1
+               nitrst = nstocklist( nrst_lst )
+            ELSE
+               nitrst = nitend
+            ENDIF
+         ENDIF
+
+         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
             ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
             nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
@@ -79,6 +84,9 @@
          IF(lwp) WRITE(numout,*)
          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
-         IF(lwp) WRITE(numout,*) '             open trc restart.output NetCDF file: '//clname
-         CALL iom_open( clname, numrtw, ldwrt = .TRUE., kiolib = jprstlib )
+         clpath = TRIM(cn_trcrst_outdir)
+         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+         IF(lwp) WRITE(numout,*) &
+             '             open trc restart.output NetCDF file: ',TRIM(clpath)//clname
+         CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib )
          lrst_trc = .TRUE.
       ENDIF
@@ -140,4 +148,8 @@
           lrst_trc = .FALSE.
 #endif
+          IF( lk_offline .AND. ln_rst_list ) THEN
+             nrst_lst = nrst_lst + 1
+             nitrst = nstocklist( nrst_lst )
+          ENDIF
       ENDIF
       !
@@ -190,39 +202,36 @@
            ! eventually read netcdf file (monobloc)  for restarting on different number of processors
            ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 
-           INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
+           INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
            IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
          ENDIF
 
-         CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt )
-
-         CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
-
-         IF(lwp) THEN
-            WRITE(numout,*) ' *** Info read in restart : '
-            WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
-            WRITE(numout,*) ' *** restart option'
-            SELECT CASE ( nn_rsttr )
-            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
-            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
-            CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
-            END SELECT
-            WRITE(numout,*)
-         ENDIF
-         ! Control of date 
-         IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
-            &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
-            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
-         IF( lk_offline ) THEN      ! set the date in offline mode
-            ! Check dynamics and tracer time-step consistency and force Euler restart if changed
-            IF( iom_varid( numrtr, 'rdttrc1', ldstop = .FALSE. ) > 0 )   THEN
-               CALL iom_get( numrtr, 'rdttrc1', zrdttrc1 )
-               IF( zrdttrc1 /= rdt * nn_dttrc )   neuler = 0
-            ENDIF
-            !                          ! define ndastp and adatrj
-            IF( nn_rsttr == 2 ) THEN
+         IF( ln_rsttr ) THEN
+            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
+            CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
+
+            IF(lwp) THEN
+               WRITE(numout,*) ' *** Info read in restart : '
+               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
+               WRITE(numout,*) ' *** restart option'
+               SELECT CASE ( nn_rsttr )
+               CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
+               CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
+               CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
+               END SELECT
+               WRITE(numout,*)
+            ENDIF
+            ! Control of date 
+            IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
+               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
+               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
+         ENDIF
+         !
+         IF( lk_offline ) THEN    
+            !                                          ! set the date in offline mode
+            IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
                CALL iom_get( numrtr, 'ndastp', zndastp ) 
                ndastp = NINT( zndastp )
                CALL iom_get( numrtr, 'adatrj', adatrj  )
-            ELSE
+             ELSE
                ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
                adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
@@ -235,4 +244,8 @@
               WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
               WRITE(numout,*)
+            ENDIF
+            !
+            IF( ln_rsttr )  THEN   ;    neuler = 1
+            ELSE                   ;    neuler = 0
             ENDIF
             !
@@ -265,4 +278,5 @@
       INTEGER  :: jk, jn
       REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
       !!----------------------------------------------------------------------
 
@@ -273,6 +287,10 @@
       ENDIF
       !
-      DO jn = 1, jptra
-         ztraf = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) )
+      DO jk = 1, jpk
+         zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
+      END DO
+      !
+      DO jn = 1, jptra
+         ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )
          zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
          zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
@@ -306,5 +324,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 5901)
@@ -75,3 +75,3 @@
 
    !!======================================================================
-END MODULE  trcsms
+END MODULE trcsms
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 5901)
@@ -30,4 +30,10 @@
    PUBLIC   trc_stp    ! called by step
 
+   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr ! save qsr during TOP time-step
+   REAL(wp) :: rdt_sampl
+   INTEGER  :: nb_rec_per_days
+   INTEGER  :: isecfst, iseclast
+   LOGICAL  :: llnew
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -54,5 +60,4 @@
       CHARACTER (len=25)    ::  charout 
 
-      REAL(wp), DIMENSION(:,:), POINTER ::   zqsr_tmp ! save qsr during TOP time-step
       !!-------------------------------------------------------------------
       !
@@ -68,12 +73,6 @@
          areatot         = glob_sum( cvol(:,:,:) )
       ENDIF
-      !    
-      IF( ltrcdm2dc ) THEN
-         ! When Diurnal cycle, core bulk and LIM2  are activated, put daily mean qsr in qsr for TOP/biogeochemistery time-step
-         ! and save qsr with diurnal cycle in qsr_tmp
-         CALL wrk_alloc( jpi,jpj, zqsr_tmp )
-         zqsr_tmp(:,:) = qsr     (:,:)
-         qsr     (:,:) = qsr_mean(:,:)    
-      ENDIF
+      !
+      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt )
       !    
       IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping
@@ -106,10 +105,4 @@
       ENDIF
       !
-      IF( ltrcdm2dc ) THEN
-         ! put back qsr with diurnal cycle in qsr
-         qsr(:,:) = zqsr_tmp(:,:)
-         CALL wrk_dealloc( jpi,jpj, zqsr_tmp )
-      ENDIF
-      !
       ztrai = 0._wp                                                   !  content of all tracers
       DO jn = 1, jptra
@@ -122,4 +115,60 @@
       !
    END SUBROUTINE trc_stp
+
+   SUBROUTINE trc_mean_qsr( kt )
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE trc_mean_qsr  ***
+      !!
+      !! ** Purpose :  Compute daily mean qsr for biogeochemical model in case
+      !!               of diurnal cycle
+      !!
+      !! ** Method  : store in TOP the qsr every hour ( or every time-step the latter 
+      !!              is greater than 1 hour ) and then, compute the  mean with 
+      !!              a moving average over 24 hours. 
+      !!              In coupled mode, the sampling is done at every coupling frequency 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt
+      INTEGER  :: jn
+
+      IF( kt == nittrc000 ) THEN
+         IF( ln_cpl )  THEN  
+            rdt_sampl = 86400. / ncpl_qsr_freq
+            nb_rec_per_days = ncpl_qsr_freq
+         ELSE  
+            rdt_sampl = MAX( 3600., rdt * nn_dttrc )
+            nb_rec_per_days = INT( 86400 / rdt_sampl )
+         ENDIF
+         !
+         IF( lwp ) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_days
+            WRITE(numout,*) 
+         ENDIF
+         !
+         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) )
+         DO jn = 1, nb_rec_per_days
+            qsr_arr(:,:,jn) = qsr(:,:)
+         ENDDO
+         qsr_mean(:,:) = qsr(:,:)
+         !
+         isecfst  = nsec_year + nsec1jan000   !   number of seconds between Jan. 1st 00h of nit000 year and the middle of time step
+         iseclast = isecfst
+         !
+      ENDIF
+      !
+      iseclast = nsec_year + nsec1jan000
+      llnew   = ( iseclast - isecfst )  > INT( rdt_sampl )   !   new shortwave to store
+      IF( kt /= nittrc000 .AND. llnew ) THEN
+          IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, &
+             &                      ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours '
+          isecfst = iseclast
+          DO jn = 1, nb_rec_per_days - 1
+             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
+          ENDDO
+          qsr_arr (:,:,nb_rec_per_days) = qsr(:,:)
+          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days
+      ENDIF
+      !
+   END SUBROUTINE trc_mean_qsr
 
 #else
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 5901)
@@ -25,5 +25,5 @@
    USE zdf_oce
    USE domvvl
-   USE divcur          ! hor. divergence and curl      (div & cur routines)
+   USE divhor          ! horizontal divergence            (div_hor routine)
    USE sbcrnf, ONLY: h_rnf, nk_rnf   ! River runoff 
    USE bdy_oce
@@ -44,9 +44,13 @@
    REAL(wp)  :: r1_ndttrcp1   !    1 / (nn_dttrc+1) 
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !                                                       !* iso-neutral slopes (if l_ldfslp=T)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_temp, vslp_temp, wslpi_temp, wslpj_temp   !: hold current values 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm  , vslp_tm  , wslpi_tm  , wslpj_tm     !: time mean 
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: trcstp.F90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -93,10 +97,10 @@
           avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)  
 # endif
-#if defined key_ldfslp
-          wslpi_tm(:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:)
-          wslpj_tm(:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:)
-          uslp_tm (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:)
-          vslp_tm (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:)
-#endif
+         IF( l_ldfslp ) THEN
+            uslp_tm (:,:,:)      = uslp_tm (:,:,:)        + uslp (:,:,:)
+            vslp_tm (:,:,:)      = vslp_tm (:,:,:)        + vslp (:,:,:)
+            wslpi_tm(:,:,:)      = wslpi_tm(:,:,:)        + wslpi(:,:,:)
+            wslpj_tm(:,:,:)      = wslpj_tm(:,:,:)        + wslpj(:,:,:)
+         ENDIF
 # if defined key_trabbl
           IF( nn_bbl_ldf == 1 ) THEN
@@ -131,10 +135,8 @@
          avs_temp   (:,:,:)      = avs   (:,:,:)
 # endif
-#if defined key_ldfslp
-         wslpi_temp (:,:,:)      = wslpi (:,:,:)
-         wslpj_temp (:,:,:)      = wslpj (:,:,:)
-         uslp_temp  (:,:,:)      = uslp  (:,:,:)
-         vslp_temp  (:,:,:)      = vslp  (:,:,:)
-#endif
+         IF( l_ldfslp ) THEN
+            uslp_temp  (:,:,:)   = uslp  (:,:,:)   ;   wslpi_temp (:,:,:)   = wslpi (:,:,:)
+            vslp_temp  (:,:,:)   = vslp  (:,:,:)   ;   wslpj_temp (:,:,:)   = wslpj (:,:,:)
+         ENDIF
 # if defined key_trabbl
           IF( nn_bbl_ldf == 1 ) THEN
@@ -160,8 +162,5 @@
          wndm_temp  (:,:)        = wndm  (:,:)
          !                                    !  Variables reset in trc_sub_ssh
-         rotn_temp  (:,:,:)      = rotn  (:,:,:)
          hdivn_temp (:,:,:)      = hdivn (:,:,:)
-         rotb_temp  (:,:,:)      = rotb  (:,:,:)
-         hdivb_temp (:,:,:)      = hdivb (:,:,:)
          !
          ! 2. Create averages and reassign variables
@@ -175,10 +174,10 @@
          avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)  
 # endif
-#if defined key_ldfslp
-         wslpi_tm (:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
-         wslpj_tm (:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
-         uslp_tm  (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:) 
-         vslp_tm  (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:)
-#endif
+         IF( l_ldfslp ) THEN
+            uslp_tm  (:,:,:)     = uslp_tm (:,:,:)        + uslp (:,:,:) 
+            vslp_tm  (:,:,:)     = vslp_tm (:,:,:)        + vslp (:,:,:)
+            wslpi_tm (:,:,:)     = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
+            wslpj_tm (:,:,:)     = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
+         ENDIF
 # if defined key_trabbl
           IF( nn_bbl_ldf == 1 ) THEN
@@ -255,17 +254,18 @@
                   tsn  (ji,jj,jk,jp_sal) = tsn_tm  (ji,jj,jk,jp_sal) * z1_ne3t
                   rhop (ji,jj,jk)        = rhop_tm (ji,jj,jk)        * z1_ne3t
+!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w
                   avt  (ji,jj,jk)        = avt_tm  (ji,jj,jk)        * z1_ne3w
 # if defined key_zdfddm
                   avs  (ji,jj,jk)        = avs_tm  (ji,jj,jk)        * z1_ne3w
 # endif
-#if defined key_ldfslp
-                  wslpi(ji,jj,jk)        = wslpi_tm(ji,jj,jk) 
-                  wslpj(ji,jj,jk)        = wslpj_tm(ji,jj,jk)
-                  uslp (ji,jj,jk)        = uslp_tm (ji,jj,jk)
-                  vslp (ji,jj,jk)        = vslp_tm (ji,jj,jk)
-#endif
-               ENDDO
-            ENDDO
-         ENDDO
+               END DO
+            END DO
+         END DO
+         IF( l_ldfslp ) THEN
+            wslpi(:,:,:)        = wslpi_tm(:,:,:) 
+            wslpj(:,:,:)        = wslpj_tm(:,:,:)
+            uslp (:,:,:)        = uslp_tm (:,:,:)
+            vslp (:,:,:)        = vslp_tm (:,:,:)
+         ENDIF
          !
          CALL trc_sub_ssh( kt )         ! after ssh & vertical velocity
@@ -276,4 +276,5 @@
       !
    END SUBROUTINE trc_sub_stp
+
 
    SUBROUTINE trc_sub_ini
@@ -304,14 +305,15 @@
       tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)  
       rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:)  
+!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w
       avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:)  
 # if defined key_zdfddm
       avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)  
 # endif
-#if defined key_ldfslp
-      wslpi_tm(:,:,:)        = wslpi(:,:,:)
-      wslpj_tm(:,:,:)        = wslpj(:,:,:)
-      uslp_tm (:,:,:)        = uslp (:,:,:)
-      vslp_tm (:,:,:)        = vslp (:,:,:)
-#endif
+      IF( l_ldfslp ) THEN
+         wslpi_tm(:,:,:)     = wslpi(:,:,:)
+         wslpj_tm(:,:,:)     = wslpj(:,:,:)
+         uslp_tm (:,:,:)     = uslp (:,:,:)
+         vslp_tm (:,:,:)     = vslp (:,:,:)
+      ENDIF
       sshn_tm  (:,:) = sshn  (:,:) 
       rnf_tm   (:,:) = rnf   (:,:) 
@@ -365,10 +367,10 @@
       avs   (:,:,:)   =  avs_temp   (:,:,:)
 # endif
-#if defined key_ldfslp
-      wslpi (:,:,:)   =  wslpi_temp (:,:,:)
-      wslpj (:,:,:)   =  wslpj_temp (:,:,:)
-      uslp  (:,:,:)   =  uslp_temp  (:,:,:)
-      vslp  (:,:,:)   =  vslp_temp  (:,:,:)
-#endif
+      IF( l_ldfslp ) THEN
+         wslpi (:,:,:)=  wslpi_temp (:,:,:)
+         wslpj (:,:,:)=  wslpj_temp (:,:,:)
+         uslp  (:,:,:)=  uslp_temp  (:,:,:)
+         vslp  (:,:,:)=  vslp_temp  (:,:,:)
+      ENDIF
       sshn  (:,:)     =  sshn_temp  (:,:)
       sshb  (:,:)     =  sshb_temp  (:,:)
@@ -396,9 +398,5 @@
       !
       hdivn (:,:,:)   =  hdivn_temp (:,:,:)
-      rotn  (:,:,:)   =  rotn_temp  (:,:,:)
-      hdivb (:,:,:)   =  hdivb_temp (:,:,:)
-      rotb  (:,:,:)   =  rotb_temp  (:,:,:)
       !                                      
-
       ! Start new averages
          un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:) 
@@ -411,10 +409,10 @@
          avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)  
 # endif
-#if defined key_ldfslp
+      IF( l_ldfslp ) THEN
+         uslp_tm (:,:,:)        = uslp (:,:,:)
+         vslp_tm (:,:,:)        = vslp (:,:,:)
          wslpi_tm(:,:,:)        = wslpi(:,:,:) 
          wslpj_tm(:,:,:)        = wslpj(:,:,:)
-         uslp_tm (:,:,:)        = uslp (:,:,:)
-         vslp_tm (:,:,:)        = vslp (:,:,:)
-#endif
+      ENDIF
       !
       sshb_hold  (:,:) = sshn  (:,:)
@@ -487,5 +485,5 @@
       ENDIF
       !
-      CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity
+      CALL div_hor( kt )                              ! Horizontal divergence & Relative vorticity
       !
       z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
@@ -551,8 +549,4 @@
          &      sshn_temp(jpi,jpj)          ,  sshb_temp(jpi,jpj) ,      &
          &      ssha_temp(jpi,jpj)          ,                           &
-#if defined key_ldfslp
-         &      wslpi_temp(jpi,jpj,jpk)     ,  wslpj_temp(jpi,jpj,jpk),  &
-         &      uslp_temp(jpi,jpj,jpk)      ,  vslp_temp(jpi,jpj,jpk),   &
-#endif
 #if defined key_trabbl
          &      ahu_bbl_temp(jpi,jpj)       ,  ahv_bbl_temp(jpi,jpj),    &
@@ -569,5 +563,4 @@
 # endif
          &      hdivn_temp(jpi,jpj,jpk)     ,  hdivb_temp(jpi,jpj,jpk),  &
-         &      rotn_temp(jpi,jpj,jpk)      ,  rotb_temp(jpi,jpj,jpk),   &
          &      un_tm(jpi,jpj,jpk)          ,  vn_tm(jpi,jpj,jpk)  ,     &
          &      avt_tm(jpi,jpj,jpk)                                ,     &
@@ -577,16 +570,20 @@
          &      emp_b_hold(jpi,jpj)         ,                            &
          &      hmld_tm(jpi,jpj)            ,  qsr_tm(jpi,jpj) ,         &
-#if defined key_ldfslp
-         &      wslpi_tm(jpi,jpj,jpk)       ,  wslpj_tm(jpi,jpj,jpk),    &
-         &      uslp_tm(jpi,jpj,jpk)        ,  vslp_tm(jpi,jpj,jpk),     &
-#endif
 #if defined key_trabbl
          &      ahu_bbl_tm(jpi,jpj)         ,  ahv_bbl_tm(jpi,jpj),      &
          &      utr_bbl_tm(jpi,jpj)         ,  vtr_bbl_tm(jpi,jpj),      &
 #endif
-         &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) ,       &
-         &                                    STAT=trc_sub_alloc )  
+         &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) , STAT=trc_sub_alloc )  
+      !
       IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate arrays')
-
+      !
+      IF( l_ldfslp ) THEN
+         ALLOCATE( uslp_temp(jpi,jpj,jpk)   ,  wslpi_temp(jpi,jpj,jpk),      &
+            &      vslp_temp(jpi,jpj,jpk)   ,  wslpj_temp(jpi,jpj,jpk),      &
+            &      uslp_tm  (jpi,jpj,jpk)   ,  wslpi_tm  (jpi,jpj,jpk),      &
+            &      vslp_tm  (jpi,jpj,jpk)   ,  wslpj_tm  (jpi,jpj,jpk),  STAT=trc_sub_alloc )
+      ENDIF
+      !
+      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate ldf_slp arrays')
       !
    END FUNCTION trc_sub_alloc
Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 5891)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 5901)
@@ -26,7 +26,4 @@
 
    PUBLIC trc_wri      
-
-   !! * Substitutions
-#  include "top_substitute.h90"
 
 CONTAINS
