Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 7351)
@@ -2,6 +2,5 @@
    !!==============================================================================
    !!                       ***  MODULE  eosbn2  ***
-   !! Ocean diagnostic variable : equation of state - in situ and potential density
-   !!                                               - Brunt-Vaisala frequency
+   !! Equation Of Seawater : in situ density - Brunt-Vaisala frequency
    !!==============================================================================
    !! History :  OPA  ! 1989-03  (O. Marti)  Original code
@@ -26,33 +25,33 @@
 
    !!----------------------------------------------------------------------
-   !!   eos            : generic interface of the equation of state
-   !!   eos_insitu     : Compute the in situ density
-   !!   eos_insitu_pot : Compute the insitu and surface referenced potential volumic mass
-   !!   eos_insitu_2d  : Compute the in situ density for 2d fields
-   !!   bn2            : Compute the Brunt-Vaisala frequency
-   !!   eos_rab        : generic interface of in situ thermal/haline expansion ratio 
-   !!   eos_rab_3d     : compute in situ thermal/haline expansion ratio
-   !!   eos_rab_2d     : compute in situ thermal/haline expansion ratio for 2d fields
-   !!   eos_fzp_2d     : freezing temperature for 2d fields
-   !!   eos_fzp_0d     : freezing temperature for scalar
-   !!   eos_init       : set eos parameters (namelist)
+   !!   eos           : generic interface of the equation of state
+   !!   eos_insitu    : Compute the in situ density
+   !!   eos_insitu_pot: Compute the insitu and surface referenced potential volumic mass
+   !!   eos_insitu_2d : Compute the in situ density for 2d fields
+   !!   bn2           : Compute the Brunt-Vaisala frequency
+   !!   eos_rab       : generic interface of in situ thermal/haline expansion ratio 
+   !!   eos_rab_3d    : compute in situ thermal/haline expansion ratio
+   !!   eos_rab_2d    : compute in situ thermal/haline expansion ratio for 2d fields
+   !!   eos_fzp_2d    : freezing temperature for 2d fields
+   !!   eos_fzp_0d    : freezing temperature for scalar
+   !!   eos_init      : set eos parameters (namelist)
    !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE stopar         ! Stochastic T/S fluctuations
+   USE stopts         ! Stochastic T/S fluctuations
    !
-   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)  
-   USE prtctl          ! Print control
-   USE wrk_nemo        ! Memory Allocation
+   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)  
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
    USE lbclnk         ! ocean lateral boundary conditions
-   USE timing          ! Timing
-   USE stopar          ! Stochastic T/S fluctuations
-   USE stopts          ! Stochastic T/S fluctuations
+   USE timing         ! Timing
 
    IMPLICIT NONE
    PRIVATE
 
-   !                   !! * Interface
+   !                  !! * Interface
    INTERFACE eos
       MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
@@ -75,10 +74,18 @@
    PUBLIC   eos_init       ! called by istate module
 
-   !                                !!* Namelist (nameos) *
-   INTEGER , PUBLIC ::   nn_eos     ! = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
-   LOGICAL , PUBLIC ::   ln_useCT   ! determine if eos_pt_from_ct is used to compute sst_m
-
-   !                                   !!!  simplified eos coefficients
-   ! default value: Vallis 2006
+   !                               !!** Namelist nameos **
+   LOGICAL , PUBLIC ::   ln_TEOS10   ! determine if eos_pt_from_ct is used to compute sst_m
+   LOGICAL , PUBLIC ::   ln_EOS80   ! determine if eos_pt_from_ct is used to compute sst_m
+   LOGICAL , PUBLIC ::   ln_SEOS   ! determine if eos_pt_from_ct is used to compute sst_m
+
+   ! Parameters
+   LOGICAL , PUBLIC    ::   l_useCT         ! =T in ln_TEOS10=T (i.e. use eos_pt_from_ct to compute sst_m), =F otherwise
+   INTEGER , PUBLIC    ::   neos            ! Identifier for equation of state used
+
+   INTEGER , PARAMETER ::   np_teos10 = -1  ! parameter for using TEOS10
+   INTEGER , PARAMETER ::   np_eos80  =  0  ! parameter for using EOS80
+   INTEGER , PARAMETER ::   np_seos   = 1   ! parameter for using Simplified Equation of state
+
+   !                               !!!  simplified eos coefficients (default value: Vallis 2006)
    REAL(wp) ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff. 
    REAL(wp) ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff. 
@@ -172,5 +179,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -187,5 +193,5 @@
       !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
       !!       potential temperature and salinity using an equation of state
-      !!       defined through the namelist parameter nn_eos.
+      !!       selected in the nameos namelist
       !!
       !! ** Method  :   prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0
@@ -197,11 +203,11 @@
       !!                rau0   reference density            kg/m^3
       !!
-      !!     nn_eos = -1 : polynomial TEOS-10 equation of state is used for rho(t,s,z).
+      !!     ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z).
       !!         Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celcius, sa=35.5 g/kg
       !!
-      !!     nn_eos =  0 : polynomial EOS-80 equation of state is used for rho(t,s,z).
+      !!     ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z).
       !!         Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celcius, sp=35.5 psu
       !!
-      !!     nn_eos =  1 : simplified equation of state
+      !!     ln_seos : simplified equation of state
       !!              prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0
       !!              linear case function of T only: rn_alpha<>0, other coefficients = 0
@@ -227,7 +233,7 @@
       IF( nn_timing == 1 )   CALL timing_start('eos-insitu')
       !
-      SELECT CASE( nn_eos )
-      !
-      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==!
+      SELECT CASE( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
          !
          DO jk = 1, jpkm1
@@ -269,5 +275,5 @@
          END DO
          !
-      CASE( 1 )                !==  simplified EOS  ==!
+      CASE( np_seos )                !==  simplified EOS  ==!
          !
          DO jk = 1, jpkm1
@@ -303,6 +309,6 @@
       !! ** Purpose :   Compute the in situ density (ratio rho/rau0) and the
       !!      potential volumic mass (Kg/m3) from potential temperature and
-      !!      salinity fields using an equation of state defined through the
-      !!     namelist parameter nn_eos.
+      !!      salinity fields using an equation of state selected in the
+      !!     namelist.
       !!
       !! ** Action  : - prd  , the in situ density (no units)
@@ -325,7 +331,7 @@
       IF( nn_timing == 1 )   CALL timing_start('eos-pot')
       !
-      SELECT CASE ( nn_eos )
-      !
-      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==!
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
          !
          ! Stochastic equation of state
@@ -433,5 +439,5 @@
          ENDIF
          
-      CASE( 1 )                !==  simplified EOS  ==!
+      CASE( np_seos )                !==  simplified EOS  ==!
          !
          DO jk = 1, jpkm1
@@ -470,5 +476,5 @@
       !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
       !!      potential temperature and salinity using an equation of state
-      !!      defined through the namelist parameter nn_eos. * 2D field case
+      !!      selected in the nameos namelist. * 2D field case
       !!
       !! ** Action  : - prd , the in situ density (no units) (unmasked)
@@ -489,7 +495,7 @@
       prd(:,:) = 0._wp
       !
-      SELECT CASE( nn_eos )
-      !
-      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==!
+      SELECT CASE( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
          !
          DO jj = 1, jpjm1
@@ -530,5 +536,5 @@
          CALL lbc_lnk( prd, 'T', 1. )                    ! Lateral boundary conditions
          !
-      CASE( 1 )                !==  simplified EOS  ==!
+      CASE( np_seos )                !==  simplified EOS  ==!
          !
          DO jj = 1, jpjm1
@@ -579,7 +585,7 @@
       IF( nn_timing == 1 )   CALL timing_start('rab_3d')
       !
-      SELECT CASE ( nn_eos )
-      !
-      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==!
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
          !
          DO jk = 1, jpkm1
@@ -587,5 +593,5 @@
                DO ji = 1, jpi
                   !
-                  zh  = fsdept(ji,jj,jk) * r1_Z0                                ! depth
+                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth
                   zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
                   zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
@@ -638,5 +644,5 @@
          END DO
          !
-      CASE( 1 )                  !==  simplified EOS  ==!
+      CASE( np_seos )                  !==  simplified EOS  ==!
          !
          DO jk = 1, jpkm1
@@ -645,5 +651,5 @@
                   zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
                   zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
-                  zh  = fsdept(ji,jj,jk)                 ! depth in meters at t-point
+                  zh  = gdept_n(ji,jj,jk)                ! depth in meters at t-point
                   ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask
                   !
@@ -660,5 +666,5 @@
       CASE DEFAULT
          IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
          nstop = nstop + 1
          !
@@ -671,4 +677,5 @@
       !
    END SUBROUTINE rab_3d
+
 
    SUBROUTINE rab_2d( pts, pdep, pab )
@@ -693,7 +700,7 @@
       pab(:,:,:) = 0._wp
       !
-      SELECT CASE ( nn_eos )
-      !
-      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==!
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
          !
          DO jj = 1, jpjm1
@@ -753,5 +760,5 @@
          CALL lbc_lnk( pab(:,:,jp_sal), 'T', 1. )                    
          !
-      CASE( 1 )                  !==  simplified EOS  ==!
+      CASE( np_seos )                  !==  simplified EOS  ==!
          !
          DO jj = 1, jpjm1
@@ -776,5 +783,5 @@
       CASE DEFAULT
          IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
          nstop = nstop + 1
          !
@@ -809,7 +816,7 @@
       pab(:) = 0._wp
       !
-      SELECT CASE ( nn_eos )
-      !
-      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==!
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )      !==  polynomial TEOS-10 / EOS-80 ==!
          !
          !
@@ -862,9 +869,9 @@
          !
          !
-      CASE( 1 )                  !==  simplified EOS  ==!
+      CASE( np_seos )                  !==  simplified EOS  ==!
          !
          zt    = pts(jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
          zs    = pts(jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
-         zh    = pdep                    ! depth at the partial step level
+         zh    = pdep                   ! depth at the partial step level
          !
          zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
@@ -876,5 +883,5 @@
       CASE DEFAULT
          IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
          nstop = nstop + 1
          !
@@ -913,6 +920,6 @@
          DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90
             DO ji = 1, jpi
-               zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   &
-                  &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 
+               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
+                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
                   !
                zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 
@@ -921,5 +928,5 @@
                pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     &
                   &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  &
-                  &            / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                  &            / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
             END DO
          END DO
@@ -1008,15 +1015,16 @@
       REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celcius]
       !
-      INTEGER  ::   ji, jj   ! dummy loop indices
-      REAL(wp) ::   zt, zs   ! local scalars
-      !!----------------------------------------------------------------------
-      !
-      SELECT CASE ( nn_eos )
-      !
-      CASE ( -1, 1 )                !==  CT,SA (TEOS-10 formulation) ==!
-         !
+      INTEGER  ::   ji, jj          ! dummy loop indices
+      REAL(wp) ::   zt, zs, z1_S0   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( neos )
+      !
+      CASE ( np_teos10, np_seos )      !==  CT,SA (TEOS-10 and S-EOS formulations) ==!
+         !
+         z1_S0 = 1._wp / 35.16504_wp
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zs= SQRT( ABS( psal(ji,jj) ) * r1_S0 )           ! square root salinity
+               zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 )           ! square root salinity
                ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
                   &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
@@ -1027,5 +1035,5 @@
          IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
          !
-      CASE ( 0 )                     !==  PT,SP (UNESCO formulation)  ==!
+      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==!
          !
          ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   &
@@ -1036,5 +1044,5 @@
       CASE DEFAULT
          IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
          nstop = nstop + 1
          !
@@ -1042,4 +1050,5 @@
       !
   END SUBROUTINE eos_fzp_2d
+
 
   SUBROUTINE eos_fzp_0d( psal, ptf, pdep )
@@ -1062,9 +1071,9 @@
       !!----------------------------------------------------------------------
       !
-      SELECT CASE ( nn_eos )
-      !
-      CASE ( -1, 1 )                !==  CT,SA (TEOS-10 formulation) ==!
-         !
-         zs  = SQRT( ABS( psal ) * r1_S0 )           ! square root salinity
+      SELECT CASE ( neos )
+      !
+      CASE ( np_teos10, np_seos )      !==  CT,SA (TEOS-10 and S-EOS formulations) ==!
+         !
+         zs  = SQRT( ABS( psal ) / 35.16504_wp )           ! square root salinity
          ptf = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
                   &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
@@ -1073,5 +1082,5 @@
          IF( PRESENT( pdep ) )   ptf = ptf - 7.53e-4 * pdep
          !
-      CASE ( 0 )                     !==  PT,SP (UNESCO formulation)  ==!
+      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==!
          !
          ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal )   &
@@ -1082,5 +1091,5 @@
       CASE DEFAULT
          IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
          nstop = nstop + 1
          !
@@ -1121,7 +1130,7 @@
       IF( nn_timing == 1 )   CALL timing_start('eos_pen')
       !
-      SELECT CASE ( nn_eos )
-      !
-      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==!
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
          !
          DO jk = 1, jpkm1
@@ -1129,5 +1138,5 @@
                DO ji = 1, jpi
                   !
-                  zh  = fsdept(ji,jj,jk) * r1_Z0                                ! depth
+                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth
                   zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
                   zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
@@ -1186,5 +1195,5 @@
          END DO
          !
-      CASE( 1 )                !==  Vallis (2006) simplified EOS  ==!
+      CASE( np_seos )                !==  Vallis (2006) simplified EOS  ==!
          !
          DO jk = 1, jpkm1
@@ -1193,5 +1202,5 @@
                   zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0)
                   zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0)
-                  zh  = fsdept(ji,jj,jk)               ! depth in meters  at t-point
+                  zh  = gdept_n(ji,jj,jk)              ! depth in meters  at t-point
                   ztm = tmask(ji,jj,jk)                ! tmask
                   zn  = 0.5_wp * zh * r1_rau0 * ztm
@@ -1208,5 +1217,5 @@
       CASE DEFAULT
          IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
          nstop = nstop + 1
          !
@@ -1227,6 +1236,7 @@
       !!----------------------------------------------------------------------
       INTEGER  ::   ios   ! local integer
-      !!
-      NAMELIST/nameos/ nn_eos, ln_useCT, rn_a0, rn_b0, rn_lambda1, rn_mu1,   &
+      INTEGER  ::   ioptio   ! local integer
+      !!
+      NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, rn_a0, rn_b0, rn_lambda1, rn_mu1,   &
          &                                             rn_lambda2, rn_mu2, rn_nu
       !!----------------------------------------------------------------------
@@ -1248,19 +1258,24 @@
          WRITE(numout,*) 'eos_init : equation of state'
          WRITE(numout,*) '~~~~~~~~'
-         WRITE(numout,*) '          Namelist nameos : set eos parameters'
-         WRITE(numout,*) '             flag for eq. of state and N^2  nn_eos   = ', nn_eos
-         IF( ln_useCT )   THEN
-            WRITE(numout,*) '             model uses Conservative Temperature'
-            WRITE(numout,*) '             Important: model must be initialized with CT and SA fields'
-         ELSE
-            WRITE(numout,*) '             model does not use Conservative Temperature'
-         ENDIF
+         WRITE(numout,*) '   Namelist nameos : Chosen the Equation Of Seawater (EOS)'
+         WRITE(numout,*) '      TEOS-10 : rho=F(Conservative Temperature, Absolute  Salinity, depth)   ln_TEOS10 = ', ln_TEOS10
+         WRITE(numout,*) '      EOS-80  : rho=F(Potential    Temperature, Practical Salinity, depth)   ln_EOS80  = ', ln_EOS80
+         WRITE(numout,*) '      S-EOS   : rho=F(Conservative Temperature, Absolute  Salinity, depth)   ln_SEOS   = ', ln_SEOS
       ENDIF
-      !
-      SELECT CASE( nn_eos )         ! check option
-      !
-      CASE( -1 )                       !==  polynomial TEOS-10  ==!
+
+      ! Check options for equation of state & set neos based on logical flags
+      ioptio = 0
+      IF( ln_TEOS10 ) THEN   ;   ioptio = ioptio+1   ;   neos = np_teos10   ;   ENDIF
+      IF( ln_EOS80  ) THEN   ;   ioptio = ioptio+1   ;   neos = np_eos80    ;   ENDIF
+      IF( ln_SEOS   ) THEN   ;   ioptio = ioptio+1   ;   neos = np_seos     ;   ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop("Exactly one equation of state option must be selected")
+      !
+      SELECT CASE( neos )         ! check option
+      !
+      CASE( np_teos10 )                       !==  polynomial TEOS-10  ==!
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          use of TEOS-10 equation of state (cons. temp. and abs. salinity)'
+         !
+         l_useCT = .TRUE.                          ! model temperature is Conservative temperature 
          !
          rdeltaS = 32._wp
@@ -1449,9 +1464,10 @@
          BPE002 = 1.7269476440e-04_wp
          !
-      CASE( 0 )                        !==  polynomial EOS-80 formulation  ==!
+      CASE( np_eos80 )                        !==  polynomial EOS-80 formulation  ==!
          !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          use of EOS-80 equation of state (pot. temp. and pract. salinity)'
          !
+         l_useCT = .FALSE.                         ! model temperature is Potential temperature
          rdeltaS = 20._wp
          r1_S0  = 1._wp/40._wp
@@ -1639,5 +1655,5 @@
          BPE002 = 5.3661089288e-04_wp
          !
-      CASE( 1 )                        !==  Simplified EOS     ==!
+      CASE( np_seos )                        !==  Simplified EOS     ==!
          IF(lwp) THEN
             WRITE(numout,*)
@@ -1654,7 +1670,8 @@
             WRITE(numout,*) '               Caution: rn_beta0=0 incompatible with ddm parameterization '
          ENDIF
-         !
-      CASE DEFAULT                     !==  ERROR in nn_eos  ==!
-         WRITE(ctmp1,*) '          bad flag value for nn_eos = ', nn_eos
+         l_useCT = .TRUE.          ! Use conservative temperature
+         !
+      CASE DEFAULT                     !==  ERROR in neos  ==!
+         WRITE(ctmp1,*) '          bad flag value for neos = ', neos, '. You should never see this error'
          CALL ctl_stop( ctmp1 )
          !
@@ -1665,4 +1682,13 @@
       r1_rcp      = 1._wp / rcp
       r1_rau0_rcp = 1._wp / rau0_rcp 
+      !
+      IF(lwp) THEN
+         IF( l_useCT )   THEN
+            WRITE(numout,*) '             model uses Conservative Temperature'
+            WRITE(numout,*) '             Important: model must be initialized with CT and SA fields'
+         ELSE
+            WRITE(numout,*) '             model does not use Conservative Temperature'
+         ENDIF
+      ENDIF
       !
       IF(lwp) WRITE(numout,*)
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 7351)
@@ -27,5 +27,4 @@
    USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
    USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
-   USE c1d            ! 1D vertical configuration
    !
    USE in_out_manager ! I/O manager
@@ -69,5 +68,4 @@
    
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -102,7 +100,7 @@
       !    
       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
-         r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping)
+         r2dt = rdt                                 ! = rdt (restarting with Euler time stepping)
       ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
-         r2dtra(:) = 2._wp * rdttra(:)                   ! = 2 rdttra (leapfrog)
+         r2dt = 2._wp * rdt                         ! = 2 rdt (leapfrog)
       ENDIF
       !
@@ -152,17 +150,17 @@
          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 )
+         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, 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 )
+         CALL tra_adv_fct_zts( kt, nit000, 'TRA', r2dt, 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 ) 
+         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, 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   )
+         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, 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                     )
+         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     )
       !
       END SELECT
       !
-      !                                              ! print mean trends (used for debugging)
+      !                                         ! print mean trends (used for debugging)
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               &
          &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
@@ -192,14 +190,13 @@
       !
       !                                !==  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 )
+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
       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 )
-
+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
          WRITE(numout,*)
@@ -220,5 +217,5 @@
          WRITE(numout,*) '      QUICKEST scheme                           ln_traadv_qck = ', ln_traadv_qck
       ENDIF
-
+      !
       ioptio = 0                       !==  Parameter control  ==!
       IF( ln_traadv_cen )   ioptio = ioptio + 1
@@ -232,6 +229,5 @@
          CALL ctl_warn( 'tra_adv_init: You are running without tracer advection.' )
       ENDIF
-      IF( (ioptio /= 1).AND. (.NOT. lk_c1d ) ) & 
-        CALL ctl_stop( 'tra_adv_init: Choose ONE advection scheme in namelist namtra_adv' )
+      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
@@ -248,5 +244,5 @@
             CALL ctl_stop( 'tra_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' )
          ENDIF
-         IF( lk_vvl ) THEN
+         IF( .NOT.ln_linssh ) THEN
             CALL ctl_stop( 'tra_adv_init: vertical sub-timestepping not allow in non-linear free surface' )
          ENDIF
@@ -260,6 +256,6 @@
       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' )
+         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
       !
@@ -272,16 +268,18 @@
       IF( ln_traadv_ubs                      )   nadv = np_UBS
       IF( ln_traadv_qck                      )   nadv = np_QCK
-
+      !
       IF(lwp) THEN                           ! Print the choice
          WRITE(numout,*)
-         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'
+         SELECT CASE ( nadv )
+         CASE( np_NO_adv  )   ;   WRITE(numout,*) '         NO T-S advection'
+         CASE( np_CEN     )   ;   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
+            &                                                                     ' Vertical   order: ', nn_cen_v
+         CASE( np_FCT     )   ;   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
+            &                                                                      ' Vertical   order: ', nn_fct_v
+         CASE( np_FCT_zts )   ;   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping'
+         CASE( np_MUS     )   ;   WRITE(numout,*) '         MUSCL    scheme is used'
+         CASE( np_UBS     )   ;   WRITE(numout,*) '         UBS      scheme is used'
+         CASE( np_QCK     )   ;   WRITE(numout,*) '         QUICKEST scheme is used'
+         END SELECT
       ENDIF
       !
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90	(revision 7351)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                     ***  MODULE  traadv_cen  ***
-   !! Ocean  tracers:  horizontal & vertical advective trend (2nd/4th order centered)
+   !! Ocean  tracers:   advective trend (2nd/4th order centered)
    !!======================================================================
    !! History :  3.7  ! 2014-05  (G. Madec)  original code
@@ -8,21 +8,21 @@
 
    !!----------------------------------------------------------------------
-   !!   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
+   !!   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
+   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
@@ -34,5 +34,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -53,13 +52,12 @@
       !! ** 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
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
       !!----------------------------------------------------------------------
       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
@@ -90,13 +88,13 @@
       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
+      !                    
+      zwz(:,:, 1 ) = 0._wp       ! surface & bottom vertical flux set to zero for all tracers
+      zwz(:,:,jpk) = 0._wp
       !
       DO jn = 1, kjpt            !==  loop over the tracers  ==!
          !
-         SELECT CASE( kn_cen_h )          !--  Horizontal fluxes  --!
-         !
-         CASE(  2  )                               ! 2nd order centered
+         SELECT CASE( kn_cen_h )       !--  Horizontal fluxes  --!
+         !
+         CASE(  2  )                         !* 2nd order centered
             DO jk = 1, jpkm1
                DO jj = 1, jpjm1
@@ -108,9 +106,9 @@
             END DO
             !
-         CASE(  4  )                               ! 4th order centered
-            ztu(:,:,jpk) = 0._wp                            ! Bottom value : flux set to zero
+         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 jk = 1, jpkm1                       ! masked gradient
+               DO jj = 2, jpjm1
                   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)
@@ -121,5 +119,5 @@
             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 jk = 1, jpkm1                       ! Horizontal advective fluxes
                DO jj = 2, jpjm1
                   DO ji = 1, fs_jpim1   ! vector opt.
@@ -140,9 +138,7 @@
          END SELECT
          !
-         !                             !==  Vertical fluxes  ==!
-         !
-         SELECT CASE( kn_cen_v )             !* interior fluxes
-         !
-         CASE(  2  )                               ! 2nd order centered
+         SELECT CASE( kn_cen_v )       !--  Vertical fluxes  --!   (interior)
+         !
+         CASE(  2  )                         !* 2nd order centered
             DO jk = 2, jpk
                DO jj = 2, jpjm1
@@ -153,6 +149,6 @@
             END DO
             !
-         CASE(  4  )                               ! 4th order centered
-            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )         ! 4th order compact interpolation of T at w-point
+         CASE(  4  )                         !* 4th order compact
+            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )      ! ztw = interpolated value of T at w-point
             DO jk = 2, jpkm1
                DO jj = 2, jpjm1
@@ -165,9 +161,9 @@
          END SELECT
          !
-         IF(.NOT.lk_vvl ) THEN               !* top value   (only in linear free surf. as zwz is multiplied by wmask)
+         IF( ln_linssh ) THEN                !* top value   (linear free surf. only 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 
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn) 
                   END DO
                END DO   
@@ -183,9 +179,9 @@
                      &             - (  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) )
+                     &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                END DO
             END DO
          END DO
-         !                                 ! trend diagnostics
+         !                             ! 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) )
@@ -193,8 +189,8 @@
             CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )
          END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         !                             ! "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(:,:,:) )
+           IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) )
          ENDIF
          !
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90	(revision 7351)
@@ -39,5 +39,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -53,14 +52,15 @@
       !!                  ***  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
+      !! **  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 
+      !!               - on the vertical the 4th order is a compact scheme 
       !!               - corrected flux (monotonic correction) 
       !!
-      !! ** Action : - update (pta) with the now advective tracer trends
-      !!             - send the trends for further diagnostics
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
       !!----------------------------------------------------------------------
       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
@@ -70,5 +70,5 @@
       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)                             , INTENT(in   ) ::   p2dt            ! 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
@@ -76,5 +76,5 @@
       !
       INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices  
-      REAL(wp) ::   z2dtt, ztra                              ! local scalar
+      REAL(wp) ::   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   !   -      -
@@ -101,12 +101,11 @@
       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
+      !                          ! surface & bottom value : flux set to zero one for all
+      zwz(:,:, 1 ) = 0._wp            
       zwx(:,:,jpk) = 0._wp   ;   zwy(:,:,jpk) = 0._wp    ;    zwz(:,:,jpk) = 0._wp
       !
       zwi(:,:,:) = 0._wp        
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
+      !
+      DO jn = 1, kjpt            !==  loop over the tracers  ==!
          !
          !        !==  upstream advection with initial mass fluxes & intermediate update  ==!
@@ -126,5 +125,5 @@
          END DO
          !                    !* upstream tracer flux in the k direction *!
-         DO jk = 2, jpkm1         ! Interior value ( multiplied by wmask)
+         DO jk = 2, jpkm1        ! Interior value ( multiplied by wmask)
             DO jj = 1, jpj
                DO ji = 1, jpi
@@ -135,6 +134,5 @@
             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_linssh ) 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
@@ -149,15 +147,13 @@
          !               
          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
+                  !                             ! 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)
+                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
+                  !                             ! update and guess with monotonic sheme
+                  pta(ji,jj,jk,jn) =                     pta(ji,jj,jk,jn) +        ztra   / e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
+                  zwi(ji,jj,jk)    = ( e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk)
                END DO
             END DO
@@ -166,5 +162,5 @@
          !                
          IF( l_trd )  THEN             ! trend diagnostics (contribution of upstream fluxes)
-            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+            ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:)
          END IF
          !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
@@ -174,10 +170,9 @@
          ENDIF
          !
-         !
          !        !==  anti-diffusive flux : high order minus low order  ==!
          !
-         SELECT CASE( kn_fct_h )         !* horizontal anti-diffusive fluxes
-         !
-         CASE(  2  )                         ! 2nd order centered
+         SELECT CASE( kn_fct_h )    !* horizontal anti-diffusive fluxes
+         !
+         CASE(  2  )                   !- 2nd order centered
             DO jk = 1, jpkm1
                DO jj = 1, jpjm1
@@ -189,9 +184,9 @@
             END DO
             !
-         CASE(  4  )                         ! 4th order centered
-            zltu(:,:,jpk) = 0._wp                            ! Bottom value : flux set to zero
+         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 jk = 1, jpkm1                 ! Laplacian
+               DO jj = 1, jpjm1                    ! 1st 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)
@@ -199,5 +194,5 @@
                   END DO
                END DO
-               DO jj = 2, jpjm1                                   ! 
+               DO jj = 2, jpjm1                    ! 2nd derivative * 1/ 6
                   DO ji = fs_2, fs_jpim1   ! vector opt.
                      zltu(ji,jj,jk) = (  ztu(ji,jj,jk) + ztu(ji-1,jj,jk)  ) * r1_6
@@ -206,8 +201,7 @@
                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 jk = 1, jpkm1                 ! Horizontal advective fluxes
                DO jj = 1, jpjm1
                   DO ji = 1, fs_jpim1   ! vector opt.
@@ -221,9 +215,9 @@
             END DO         
             !
-         CASE(  41 )                         ! 4th order centered       ==>>   !!gm coding attempt   need to be tested
-            ztu(:,:,jpk) = 0._wp                             ! Bottom value : flux set to zero
+         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 jk = 1, jpkm1                 ! 1st derivative (gradient)
+               DO jj = 1, jpjm1
                   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)
@@ -234,5 +228,5 @@
             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 jk = 1, jpkm1                 ! Horizontal advective fluxes
                DO jj = 2, jpjm1
                   DO ji = 2, fs_jpim1   ! vector opt.
@@ -250,21 +244,19 @@
             !
          END SELECT
-         !                                !* vertical anti-diffusive fluxes
-         SELECT CASE( kn_fct_v )                ! Interior values (w-masked)
-         !
-         CASE(  2  )                                  ! 2nd order centered
+         !                      
+         SELECT CASE( kn_fct_v )    !* vertical anti-diffusive fluxes (w-masked interior values)
+         !
+         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
-            !
+                     zwz(ji,jj,jk) =  (  pwn(ji,jj,jk) * 0.5_wp * ( 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 )   ! zwt = COMPACT interpolation of T at w-point
             DO jk = 2, jpkm1
                DO jj = 2, jpjm1
@@ -276,15 +268,15 @@
             !
          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
+         IF( ln_linssh ) THEN    ! top ocean value: high order = upstream  ==>>  zwz=0
+            zwz(:,:,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked
+         ENDIF
          !
          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  ==!
          !
@@ -295,10 +287,10 @@
                      &                                   + 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)
+                     &                                * r1_e1e2t(ji,jj) / e3t_n(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
@@ -311,11 +303,11 @@
             CALL wrk_dealloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz )
          END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         !                    ! "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(:)
+           IF( jn == jp_tem )   htr_adv(:) = htr_adv(:) + ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )   str_adv(:) = str_adv(:) + ptr_sj( zwy(:,:,:) )
          ENDIF
          !
-      END DO
+      END DO                     ! end of tracer loop
       !
       CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )
@@ -348,5 +340,5 @@
       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)                             , INTENT(in   ) ::   p2dt            ! 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
@@ -354,10 +346,10 @@
       !
       REAL(wp), DIMENSION( jpk )                           ::   zts             ! length of sub-timestep for vertical advection
-      REAL(wp), DIMENSION( jpk )                           ::   zr_p2dt         ! reciprocal of tracer timestep
+      REAL(wp)                                             ::   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) ::   ztra            ! local scalar
       REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
       REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
@@ -371,5 +363,5 @@
       !
       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,         zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav )
       CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs )
       !
@@ -390,18 +382,17 @@
       zwi(:,:,:) = 0._wp
       z_rzts = 1._wp / REAL( kn_fct_zts, wp )
-      zr_p2dt(:) = 1._wp / p2dt(:)
+      zr_p2dt = 1._wp / p2dt
+      !
+      ! surface & Bottom value : flux set to zero for all tracers
+      zwz(:,:, 1 ) = 0._wp
+      zwx(:,:,jpk) = 0._wp   ;    zwz(:,:,jpk) = 0._wp
+      zwy(:,:,jpk) = 0._wp   ;    zwi(:,:,jpk) = 0._wp
       !
       !                                                          ! ===========
       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
+         !
+         ! Upstream advection with initial mass fluxes & intermediate update
+         DO jk = 1, jpkm1        ! upstream tracer flux in the i and j direction
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
@@ -416,7 +407,6 @@
             END DO
          END DO
-
-         ! upstream tracer flux in the k direction
-         DO jk = 2, jpkm1         ! Interior value
+         !                       ! upstream tracer flux in the k direction
+         DO jk = 2, jpkm1              ! Interior value
             DO jj = 1, jpj
                DO ji = 1, jpi
@@ -427,9 +417,6 @@
             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
+         IF( ln_linssh ) THEN          ! top value : linear free surface case only (as zwz is multiplied by wmask)
+            IF( ln_isfcav ) THEN             ! ice-shelf cavities: top value
                DO jj = 1, jpj
                   DO ji = 1, jpi
@@ -437,5 +424,5 @@
                   END DO
                END DO   
-            ELSE                             ! standard case
+            ELSE                             ! no cavities, surface value
                zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
             ENDIF
@@ -443,14 +430,13 @@
          !
          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
+                  !                             ! 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)
+                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   ) * r1_e1e2t(ji,jj)
+                  !                             ! update and guess with monotonic sheme
+                  pta(ji,jj,jk,jn) =                     pta(ji,jj,jk,jn) +        ztra   / e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
+                  zwi(ji,jj,jk)    = ( e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk)
                END DO
             END DO
@@ -497,10 +483,11 @@
             END DO
          END DO
-      
+         !
          !                                !* vertical anti-diffusive flux
          zwz_sav(:,:,:)   = zwz(:,:,:)
          ztrs   (:,:,:,1) = ptb(:,:,:,jn)
+         ztrs   (:,:,1,2) = ptb(:,:,1,jn)
+         ztrs   (:,:,1,3) = ptb(:,:,1,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
@@ -508,5 +495,5 @@
             IF( jl == 1 ) THEN                        ! Euler forward to kick things off
                jtb = 1   ;   jtn = 1   ;   jta = 2
-               zts(:) = p2dt(:) * z_rzts
+               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; 
@@ -514,5 +501,5 @@
             ELSEIF( jl == 2 ) THEN                    ! First leapfrog step
                jtb = 1   ;   jtn = 2   ;   jta = 3
-               zts(:) = 2._wp * p2dt(:) * z_rzts
+               zts(:) = 2._wp * p2dt * z_rzts
             ELSE                                      ! Shuffle pointers for subsequent leapfrog steps
                jtb = MOD(jtb,3) + 1
@@ -528,5 +515,5 @@
                END DO
             END DO
-            IF(.NOT.lk_vvl ) THEN                    ! top value (only in linear free surface case)
+            IF( ln_linssh ) THEN                    ! top value (only in linear free surface case)
                IF( ln_isfcav ) THEN                      ! ice-shelf cavities
                   DO jj = 1, jpj
@@ -535,5 +522,5 @@
                      END DO
                   END DO   
-               ELSE                                      ! standard case
+               ELSE                                      ! no ocean cavities
                   zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
                ENDIF
@@ -547,5 +534,5 @@
                      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) )
+                        &                         * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                   END DO
                END DO
@@ -557,5 +544,5 @@
             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)
+                  zwz(ji,jj,jk) = ( zwzts(ji,jj,jk) * zr_p2dt - zwz_sav(ji,jj,jk) ) * wmask(ji,jj,jk)
                END DO
             END DO
@@ -576,5 +563,5 @@
                   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) )
+                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                END DO
             END DO
@@ -623,5 +610,5 @@
       !!       in-space based differencing for fluid
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp)                         , INTENT(in   ) ::   p2dt            ! 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
@@ -629,5 +616,5 @@
       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) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars
       REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo
@@ -652,5 +639,4 @@
       DO jk = 1, jpkm1
          ikm1 = MAX(jk-1,1)
-         z2dtt = p2dt(jk)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -679,5 +665,5 @@
 
                ! up & down beta terms
-               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
+               zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt
                zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
                zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90	(revision 7351)
@@ -49,5 +49,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -125,5 +124,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zc = fse3t(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points
+               zc = e3t_n(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points
                zmld(ji,jj) = zmld(ji,jj) + zc
                zbm (ji,jj) = zbm (ji,jj) + zc * (rau0 - rhop(ji,jj,jk) ) * r1_rau0
@@ -157,5 +156,5 @@
       END SELECT
       !                                                ! convert density into buoyancy
-      zbm(:,:) = + grav * zbm(:,:) / MAX( fse3t(:,:,1), zmld(:,:) )
+      zbm(:,:) = + grav * zbm(:,:) / MAX( e3t_n(:,:,1), zmld(:,:) )
       !
       !
@@ -215,6 +214,6 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-               zcuw = 1._wp - ( fsdepw(ji+1,jj,jk) + fsdepw(ji,jj,jk) ) * zhu(ji,jj)
-               zcvw = 1._wp - ( fsdepw(ji,jj+1,jk) + fsdepw(ji,jj,jk) ) * zhv(ji,jj)
+               zcuw = 1._wp - ( gdepw_n(ji+1,jj,jk) + gdepw_n(ji,jj,jk) ) * zhu(ji,jj)
+               zcvw = 1._wp - ( gdepw_n(ji,jj+1,jk) + gdepw_n(ji,jj,jk) ) * zhv(ji,jj)
                zcuw = zcuw * zcuw
                zcvw = zcvw * zcvw
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90	(revision 7351)
@@ -41,5 +41,4 @@
    
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -62,6 +61,7 @@
       !!              ld_msc_ups=T : 
       !!
-      !! ** Action  : - update (ta,sa) with the now advective tracer trends
-      !!              - send trends to trdtra module for further diagnostcs
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
       !!
       !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
@@ -73,5 +73,5 @@
       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)                             , INTENT(in   ) ::   p2dt            ! 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
@@ -82,5 +82,5 @@
       REAL(wp) ::   zu, z0u, zzwx, zw    ! local scalars
       REAL(wp) ::   zv, z0v, zzwy, z0w   !   -      -
-      REAL(wp) ::   zdt, zalpha          !   -      -
+      REAL(wp) ::   zalpha               !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      - 
@@ -116,13 +116,12 @@
       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 jn = 1, kjpt            !==  loop over the tracers  ==!
+         !
+         !                          !* Horizontal advective fluxes
+         !
+         !                                !-- first guess of the slopes
+         zwx(:,:,jpk) = 0._wp                   ! bottom values
+         zwy(:,:,jpk) = 0._wp  
+         DO jk = 1, jpkm1                       ! interior values
             DO jj = 1, jpjm1      
                DO ji = 1, fs_jpim1   ! vector opt.
@@ -132,10 +131,10 @@
            END DO
          END DO
-         !
-         CALL lbc_lnk( zwx, 'U', -1. )                        ! lateral boundary conditions on zwx, zwy   (changed sign)
+         CALL lbc_lnk( zwx, 'U', -1. )          ! lateral boundary conditions   (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
+         !                                !-- Slopes of tracer
+         zslpx(:,:,jpk) = 0._wp                 ! bottom values
+         zslpy(:,:,jpk) = 0._wp
+         DO jk = 1, jpkm1                       ! interior values
             DO jj = 2, jpj
                DO ji = fs_2, jpi   ! vector opt.
@@ -148,5 +147,5 @@
          END DO
          !
-         DO jk = 1, jpkm1                                     ! Slopes limitation
+         DO jk = 1, jpkm1                 !-- Slopes limitation
             DO jj = 2, jpj
                DO ji = fs_2, jpi   ! vector opt.
@@ -161,7 +160,5 @@
          END DO
          !
-         !                                             !-- MUSCL horizontal advective fluxes
-         DO jk = 1, jpkm1                                     ! interior values
-            zdt  = p2dt(jk)
+         DO jk = 1, jpkm1                 !-- MUSCL horizontal advective fluxes
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -169,5 +166,5 @@
                   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) )
+                  zu  = z0u - 0.5 * pun(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u_n(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)
@@ -176,5 +173,5 @@
                   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) )
+                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v_n(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)
@@ -185,14 +182,14 @@
          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 jk = 1, jpkm1                 !-- Tracer 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-1,jj  ,jk  )       &
                   &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     &
-                  &                                   / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  &                                   * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                END DO
            END DO
          END DO        
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         !                                ! trend diagnostics
          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.   &
             &( cdtype == 'TRC' .AND. l_trdtrc )      )  THEN
@@ -200,19 +197,18 @@
             CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) )
          END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         !                                ! "Poleward" heat and salt transports
          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
-         ! -----------------------------
+         !
+         !                          !* 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(:,:,jpk) = 0._wp
+         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
@@ -220,12 +216,11 @@
             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
+                  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
+         DO jk = 2, jpkm1                 !-- Slopes limitation
+            DO jj = 1, jpj                      ! interior values
                DO ji = 1, jpi
                   zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
@@ -235,12 +230,10 @@
             END DO
          END DO
-         !                                !-- vertical advective flux
-         DO jk = 1, jpkm1                       ! interior values
-            zdt  = p2dt(jk)
+         DO jk = 1, jpk-2                 !-- vertical advective flux
             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) )
+                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w_n(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  )
@@ -249,9 +242,6 @@
             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)
+         IF( ln_linssh ) THEN                   ! top values, linear free surface only
+            IF( ln_isfcav ) THEN                      ! ice-shelf cavities (top of the ocean)
                DO jj = 1, jpj
                   DO ji = 1, jpi
@@ -259,22 +249,22 @@
                   END DO
                END DO   
-            ELSE                                             ! no cavities: only at the ocean surface
+            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 jk = 1, jpkm1                 !-- 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
+                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                                ! send 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
+      END DO                     ! end of tracer loop
       !
       CALL wrk_dealloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy )
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 7351)
@@ -38,5 +38,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -78,6 +77,7 @@
       !!            prevent the appearance of spurious numerical oscillations
       !!
-      !! ** Action : - update (pta) with the now advective tracer trends
-      !!             - save the trends 
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
       !!
       !! ** Reference : Leonard (1979, 1991)
@@ -87,5 +87,5 @@
       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)                             , INTENT(in   ) ::   p2dt            ! 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
@@ -105,9 +105,9 @@
       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
       !
-      ! I. The horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme
+      !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme
       CALL tra_adv_qck_i( kt, cdtype, p2dt, pun, ptb, ptn, pta, kjpt ) 
       CALL tra_adv_qck_j( kt, cdtype, p2dt, pvn, ptb, ptn, pta, kjpt ) 
 
-      ! II. The vertical fluxes are computed with the 2nd order centered scheme
+      !        ! vertical fluxes are computed with the 2nd order centered scheme
       CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt )
       !
@@ -125,5 +125,5 @@
       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)                             , INTENT(in   ) ::   p2dt       ! tracer time-step
       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun        ! i-velocity components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
@@ -131,5 +131,5 @@
       !!
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars
+      REAL(wp) ::   ztra, zbtr, zdir, zdx, zmsk   ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zfu, zfc, zfd
       !----------------------------------------------------------------------
@@ -166,10 +166,9 @@
          !
          DO jk = 1, jpkm1  
-            zdt =  p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.   
                   zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
-                  zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * fse3u(ji,jj,jk)
-                  zwx(ji,jj,jk)  = ABS( pun(ji,jj,jk) ) * zdt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+                  zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u_n(ji,jj,jk)
+                  zwx(ji,jj,jk)  = ABS( pun(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
                   zfc(ji,jj,jk)  = zdir * ptb(ji  ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn)  ! FC in the x-direction for T
                   zfd(ji,jj,jk)  = zdir * ptb(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptb(ji  ,jj,jk,jn)  ! FD in the x-direction for T
@@ -216,5 +215,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                   ! horizontal advective trends
                   ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) )
@@ -224,5 +223,5 @@
             END DO
          END DO
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         !                                 ! trend diagnostics
          IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )
          !
@@ -242,5 +241,5 @@
       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)                             , INTENT(in   ) ::   p2dt       ! tracer time-step
       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn        ! j-velocity components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
@@ -248,5 +247,5 @@
       !!
       INTEGER  :: ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars
+      REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk   ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwy, zfu, zfc, zfd
       !----------------------------------------------------------------------
@@ -289,10 +288,9 @@
          !
          DO jk = 1, jpkm1  
-            zdt =  p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.   
                   zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
-                  zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * fse3v(ji,jj,jk)
-                  zwy(ji,jj,jk)  = ABS( pvn(ji,jj,jk) ) * zdt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+                  zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v_n(ji,jj,jk)
+                  zwy(ji,jj,jk)  = ABS( pvn(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
                   zfc(ji,jj,jk)  = zdir * ptb(ji,jj  ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn)  ! FC in the x-direction for T
                   zfd(ji,jj,jk)  = zdir * ptb(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptb(ji,jj  ,jk,jn)  ! FD in the x-direction for T
@@ -340,5 +338,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                   ! horizontal advective trends
                   ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) )
@@ -348,5 +346,5 @@
             END DO
          END DO
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         !                                 ! trend diagnostics
          IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
@@ -381,7 +379,6 @@
       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
+      zwz(:,:, 1 ) = 0._wp       ! surface & bottom values set to zero for all tracers
+      zwz(:,:,jpk) = 0._wp
       !
       !                                                          ! ===========
@@ -396,5 +393,5 @@
             END DO
          END DO
-         IF(.NOT.lk_vvl ) THEN               !* top value   (only in linear free surf. as zwz is multiplied by wmask)
+         IF( ln_linssh ) 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
@@ -403,5 +400,5 @@
                   END DO
                END DO   
-            ELSE                                   ! no ice-shelf cavities (only ocean surface)
+            ELSE                                   ! no ocean cavities (only ocean surface)
                zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn)
             ENDIF
@@ -412,14 +409,14 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   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
-         END DO
-         !                                 ! Save the vertical advective trends for diagnostic
+                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                                 ! Send trends for diagnostic
          IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )
          !
       END DO
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zwz )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwz )
       !
    END SUBROUTINE tra_adv_cen2_k
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 7351)
@@ -35,5 +35,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -71,9 +70,11 @@
       !!                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).
+      !!                kn_ubs_v argument 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
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
       !!
       !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404. 
@@ -85,5 +86,5 @@
       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)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean transport components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
@@ -91,5 +92,5 @@
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   ztra, zbtr, zcoef, z2dtt                       ! local scalars
+      REAL(wp) ::   ztra, zbtr, zcoef                       ! local scalars
       REAL(wp) ::   zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk   !   -      -
       REAL(wp) ::   zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn    !   -      -
@@ -110,7 +111,7 @@
       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 (:,:, 1 ) = 0._wp      ! surface & bottom value : set to zero for all tracers
+      zltu(:,:,jpk) = 0._wp   ;   zltv(:,:,jpk) = 0._wp
       ztw (:,:,jpk) = 0._wp   ;   zti (:,:,jpk) = 0._wp
-      IF( lk_vvl )   ztw(:,:, 1 ) = 0._wp                   ! surface value: set to zero only in vvl case
       !
       !                                                          ! ===========
@@ -121,6 +122,6 @@
             DO jj = 1, jpjm1              ! First derivative (masked gradient)
                DO ji = 1, fs_jpim1   ! vector opt.
-                  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)
+                  zeeu = e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk)
+                  zeev = e1_e2v(ji,jj) * e3v_n(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) )
@@ -129,5 +130,5 @@
             DO jj = 2, jpjm1              ! Second derivative (divergence)
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zcoef = 1._wp / ( 6._wp * fse3t(ji,jj,jk) )
+                  zcoef = 1._wp / ( 6._wp * e3t_n(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
@@ -162,5 +163,5 @@
                   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(ji,jj,jk) )
+                     &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                END DO
             END DO
@@ -199,5 +200,5 @@
                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_linssh ) 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
@@ -212,10 +213,9 @@
             !
             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) )
+                     ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_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)
+                     zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
                   END DO
                END DO
@@ -233,5 +233,5 @@
             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
+            IF( ln_linssh )   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
@@ -246,5 +246,5 @@
                END DO
             END DO
-            IF(.NOT.lk_vvl )   ztw(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)     !!gm ISF & 4th COMPACT doesn't work
+            IF( ln_linssh )   ztw(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)     !!gm ISF & 4th COMPACT doesn't work
             !
          END SELECT
@@ -253,5 +253,5 @@
             DO jj = 2, jpjm1 
                DO ji = fs_2, fs_jpim1   ! vector opt.   
-                  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) )
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                END DO
             END DO
@@ -264,5 +264,5 @@
                      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) )
+                        &                              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                   END DO
                END DO
@@ -293,5 +293,5 @@
       !!       in-space based differencing for fluid
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   ), DIMENSION(jpk)          ::   p2dt   ! vertical profile of tracer time-step
+      REAL(wp), INTENT(in   )                          ::   p2dt   ! tracer time-step
       REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field
       REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field
@@ -300,5 +300,5 @@
       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) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn   ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo
       !!----------------------------------------------------------------------
@@ -349,5 +349,4 @@
       ! ---------------------------------------------------
       DO jk = 1, jpkm1
-         z2dtt = p2dt(jk)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -356,5 +355,5 @@
                zneg = MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
                ! up & down beta terms
-               zbt = e1e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
+               zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt
                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
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 7351)
@@ -12,20 +12,21 @@
 
    !!----------------------------------------------------------------------
-   !!   tra_bbc      : update the tracer trend at ocean bottom 
-   !!   tra_bbc_init : initialization of geothermal heat flux trend
+   !!   tra_bbc       : update the tracer trend at ocean bottom 
+   !!   tra_bbc_init  : initialization of geothermal heat flux trend
    !!----------------------------------------------------------------------
-   USE oce             ! ocean variables
-   USE dom_oce         ! domain: ocean
-   USE phycst          ! physical constants
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O manager
-   USE fldread         ! read input fields
-   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp           ! distributed memory computing library
-   USE prtctl          ! Print control
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   USE oce            ! ocean variables
+   USE dom_oce        ! domain: ocean
+   USE phycst         ! physical constants
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers 
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! xIOS 
+   USE fldread        ! read input fields
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -40,9 +41,8 @@
    REAL(wp)        ::   rn_geoflx_cst !  Constant value of geothermal heat flux
 
-   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh              ! structure of input qgh (file informations, fields read)
+   REAL(wp), PUBLIC , ALLOCATABLE, DIMENSION(:,:) ::   qgh_trd0   ! geothermal heating trend
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh   ! structure of input qgh (file informations, fields read)
  
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -68,6 +68,6 @@
       !!       Where Qsf is the geothermal heat flux.
       !!
-      !! ** Action  : - update the temperature trends (ta) with the trend of
-      !!                the ocean bottom boundary condition
+      !! ** Action  : - update the temperature trends with geothermal heating trend
+      !!              - send the trend for further diagnostics (ln_trdtra=T)
       !!
       !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
@@ -75,7 +75,6 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, ik    ! dummy loop indices
-      REAL(wp) ::   zqgh_trd      ! geothermal heat flux trend
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt
       !!----------------------------------------------------------------------
@@ -83,15 +82,12 @@
       IF( nn_timing == 1 )  CALL timing_start('tra_bbc')
       !
-      IF( l_trdtra )   THEN         ! Save ta and sa trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdt )
+      IF( l_trdtra )   THEN         ! Save the input temperature trend
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt )
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
       ENDIF
-      !
-      !                             !  Add the geothermal heat flux trend on temperature
+      !                             !  Add the geothermal trend on temperature
       DO jj = 2, jpjm1
          DO ji = 2, jpim1
-            ik = mbkt(ji,jj)
-            zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik)
-            tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd
+            tsa(ji,jj,mbkt(ji,jj),jp_tem) = tsa(ji,jj,mbkt(ji,jj),jp_tem) + qgh_trd0(ji,jj) / e3t_n(ji,jj,mbkt(ji,jj))
          END DO
       END DO
@@ -99,8 +95,8 @@
       CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. )
       !
-      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
+      IF( l_trdtra ) THEN        ! Send the trend for diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt )
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt )
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt )
       ENDIF
       !
@@ -127,6 +123,4 @@
       !! ** Action  : - read/fix the geothermal heat qgh_trd0
       !!----------------------------------------------------------------------
-      USE iom
-      !!
       INTEGER  ::   ji, jj              ! dummy loop indices
       INTEGER  ::   inum                ! temporary logical unit
@@ -139,14 +133,14 @@
       NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
       !!----------------------------------------------------------------------
-
+      !
       REWIND( numnam_ref )              ! Namelist nambbc in reference namelist : Bottom momentum boundary condition
       READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )
-
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )
+      !
       REWIND( numnam_cfg )              ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition
       READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, nambbc )
-
+      !
       IF(lwp) THEN                     ! Control print
          WRITE(numout,*)
@@ -159,5 +153,5 @@
          WRITE(numout,*)
       ENDIF
-
+      !
       IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
          !
@@ -190,5 +184,4 @@
             WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
             CALL ctl_stop( ctmp1 )
-            !
          END SELECT
          !
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 7351)
@@ -70,5 +70,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -112,5 +111,5 @@
       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl')
       !
-      IF( l_trdtra )   THEN                         !* Save ta and sa trends
+      IF( l_trdtra )   THEN                         !* Save the input trends
          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
@@ -132,5 +131,5 @@
          !
       END IF
-
+      !
       IF( nn_bbl_adv /= 0 ) THEN                    !* Advective bbl
          !
@@ -146,5 +145,5 @@
       END IF
 
-      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
@@ -211,5 +210,5 @@
                   &                + 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) )
+                  &             * r1_e1e2t(ji,jj) / e3t_n(ji,jj,ik)
             END DO
          END DO
@@ -263,15 +262,15 @@
                   !
                   !                                               ! up  -slope T-point (shelf bottom point)
-                  zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus)
+                  zbtr = r1_e1e2t(iis,jj) / e3t_n(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_e1e2t(iid,jj) / fse3t(iid,jj,jk)
+                     zbtr = r1_e1e2t(iid,jj) / e3t_n(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_e1e2t(iid,jj) / fse3t(iid,jj,ikud)
+                  zbtr = r1_e1e2t(iid,jj) / e3t_n(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 +284,15 @@
                   !
                   ! up  -slope T-point (shelf bottom point)
-                  zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs)
+                  zbtr = r1_e1e2t(ji,ijs) / e3t_n(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_e1e2t(ji,ijd) / fse3t(ji,ijd,jk)
+                     zbtr = r1_e1e2t(ji,ijd) / e3t_n(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_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd)
+                  zbtr = r1_e1e2t(ji,ijd) / e3t_n(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
@@ -302,8 +301,7 @@
             !
          END DO
-         !                                                  ! ===========
-      END DO                                                ! end tracer
-      !                                                     ! ===========
-      !
+         !                                                       ! ===========
+      END DO                                                     ! end tracer
+      !                                                          ! ===========
       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_adv')
       !
@@ -340,5 +338,5 @@
       INTEGER         , INTENT(in   ) ::   kit000   ! first time step index
       CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
-      !!
+      !
       INTEGER  ::   ji, jj                    ! dummy loop indices
       INTEGER  ::   ik                        ! local integers
@@ -365,5 +363,5 @@
             zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal)
             !
-            zdep(ji,jj) = fsdept(ji,jj,ik)               ! bottom T-level reference depth
+            zdep(ji,jj) = gdept_n(ji,jj,ik)              ! bottom T-level reference depth
             zub (ji,jj) = un(ji,jj,mbku(ji,jj))          ! bottom velocity
             zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj))
@@ -401,5 +399,5 @@
          !
       ENDIF
-
+      !
       !                                   !-------------------!
       IF( nn_bbl_adv /= 0 ) THEN          !   advective bbl   !
@@ -500,5 +498,5 @@
       INTEGER ::   ios                  !   -      -
       REAL(wp), POINTER, DIMENSION(:,:) :: zmbk
-      !!
+      !
       NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
       !!----------------------------------------------------------------------
@@ -506,14 +504,11 @@
       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_init')
       !
-      CALL wrk_alloc( jpi, jpj, zmbk )
-      !
-
       REWIND( numnam_ref )              ! Namelist nambbl in reference namelist : Bottom boundary layer scheme
       READ  ( numnam_ref, nambbl, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp )
-
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp )
+      !
       REWIND( numnam_cfg )              ! Namelist nambbl in configuration namelist : Bottom boundary layer scheme
       READ  ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, nambbl )
       !
@@ -545,6 +540,8 @@
       END DO
       ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
+      CALL wrk_alloc( jpi, jpj, zmbk )
       zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
       zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      CALL wrk_dealloc( jpi, jpj, zmbk )
 
                                         !* sign of grad(H) at u- and v-points
@@ -593,6 +590,4 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, zmbk )
-      !
       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init')
       !
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 7351)
@@ -31,4 +31,5 @@
    USE dtatsd         ! data: temperature & salinity
    USE zdfmxl         ! vertical physics: mixed layer depth
+   !
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
@@ -41,6 +42,6 @@
    PRIVATE
 
-   PUBLIC   tra_dmp      ! routine called by step.F90
-   PUBLIC   tra_dmp_init ! routine called by nemogcm.F90
+   PUBLIC   tra_dmp        ! called by step.F90
+   PUBLIC   tra_dmp_init   ! called by nemogcm.F90
 
    !                                           !!* Namelist namtra_dmp : T & S newtonian damping *
@@ -52,5 +53,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -89,5 +89,5 @@
       !!      below the well mixed layer (nlmdmp=2)
       !!
-      !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend
+      !! ** Action  : - tsa: tracer trends updated with the damping trend
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
@@ -100,5 +100,4 @@
       !
       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 ) 
@@ -139,5 +138,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
+                  IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
                      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) )
@@ -177,5 +176,5 @@
       !!----------------------------------------------------------------------
       INTEGER ::   ios, imask   ! local integers 
-      !!
+      !
       NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
       !!----------------------------------------------------------------------
@@ -229,3 +228,4 @@
    END SUBROUTINE tra_dmp_init
 
+   !!======================================================================
 END MODULE tradmp
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 7351)
@@ -12,18 +12,17 @@
 
    !!----------------------------------------------------------------------
-   !!   tra_ldf      : update the tracer trend with the lateral diffusion
-   !!   tra_ldf_init : initialization, namelist read, and parameters control
-   !!----------------------------------------------------------------------
-   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
+   !!   tra_ldf       : update the tracer trend with the lateral diffusion trend
+   !!   tra_ldf_init  : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   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_blp ! lateral diffusion: laplacian iso-level            operator  (tra_ldf_lap/_blp   routines)
+   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 trd_oce        ! trends: ocean variables
+   USE trdtra         ! ocean active tracers trends
    !
    USE prtctl         ! Print control
@@ -43,5 +42,4 @@
    
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -72,5 +70,4 @@
       !
       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   )
@@ -82,5 +79,5 @@
          CALL tra_ldf_blp  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb      , tsa, jpts, nldf )
       END SELECT
-
+      !
       IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
@@ -114,6 +111,6 @@
          WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator'
          WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtra_ldf already read in ldftra module'
-         WRITE(numout,*) '   see ldf_tra_init report for lateral mixing parameters'
+         WRITE(numout,*) '   Namelist namtra_ldf: already read in ldftra module'
+         WRITE(numout,*) '      see ldf_tra_init report for lateral mixing parameters'
          WRITE(numout,*)
       ENDIF
@@ -178,8 +175,10 @@
       ENDIF
       !
-      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' )
+      IF( ierr == 1 )   CALL ctl_stop( 'iso-level in z-partial step, not allowed' )
       IF( ln_ldfeiv .AND. .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) )                                    &
-           &            CALL ctl_stop( '          eddy induced velocity on tracers requires isopycnal',    &
-           &                                                                    ' laplacian diffusion' )
+           &            CALL ctl_stop( 'eddy induced velocity on tracers requires iso-neutral laplacian diffusion' )
+      IF( ln_isfcav .AND. ln_traldf_triad ) &
+           &            CALL ctl_stop( ' ice shelf cavity and traldf_triad not tested' )
+           !
       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 
@@ -187,11 +186,13 @@
       IF(lwp) THEN
          WRITE(numout,*)
-         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)'
+         SELECT CASE( nldf )
+         CASE( np_no_ldf )   ;   WRITE(numout,*) '   NO lateral diffusion'
+         CASE( np_lap    )   ;   WRITE(numout,*) '   laplacian iso-level operator'
+         CASE( np_lap_i  )   ;   WRITE(numout,*) '   Rotated laplacian operator (standard)'
+         CASE( np_lap_it )   ;   WRITE(numout,*) '   Rotated laplacian operator (triad)'
+         CASE( np_blp    )   ;   WRITE(numout,*) '   bilaplacian iso-level operator'
+         CASE( np_blp_i  )   ;   WRITE(numout,*) '   Rotated bilaplacian operator (standard)'
+         CASE( np_blp_it )   ;   WRITE(numout,*) '   Rotated bilaplacian operator (triad)'
+         END SELECT
       ENDIF
       !
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_blp.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_blp.F90	(revision 7350)
+++ 	(revision )
@@ -1,148 +1,0 @@
-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/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 7351)
@@ -14,21 +14,21 @@
 
    !!----------------------------------------------------------------------
-   !!   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
-   USE dom_oce         ! ocean space and time domain
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE zdf_oce         ! ocean vertical physics
-   USE ldftra          ! lateral diffusion: tracer eddy coefficients
-   USE ldfslp          ! iso-neutral slopes
-   USE diaptr          ! poleward transport diagnostics
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE zdf_oce        ! ocean vertical physics
+   USE ldftra         ! 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
-   USE phycst          ! physical constants
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   USE phycst         ! physical constants
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -38,5 +38,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -103,4 +102,5 @@
       !
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::  ikt
       INTEGER  ::  ierr             ! local integer
       REAL(wp) ::  zmsku, zahu_w, zabe1, zcof1, zcoef3   ! local scalars
@@ -127,8 +127,7 @@
          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)
+      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2dt =     rdt      ! at nit000   (Euler)
+      ELSE                                        ;   z2dt = 2.* rdt      !             (Leapfrog)
       ENDIF
       z1_2dt = 1._wp / z2dt
@@ -138,5 +137,4 @@
       ENDIF
          
-         
       !!----------------------------------------------------------------------
       !!   0 - calculate  ah_wslp2 and akz
@@ -149,7 +147,7 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   !
-                  zmsku = tmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
+                  zmsku = wmask(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)          &
+                  zmskv = wmask(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  )
                      !
@@ -183,5 +181,5 @@
                      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) )  )
+                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) )  )
                      END DO
                   END DO
@@ -191,5 +189,5 @@
                   DO jj = 1, jpjm1
                      DO ji = 1, fs_jpim1
-                        ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk)
+                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(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
@@ -228,5 +226,4 @@
             DO jj = 1, jpjm1              ! bottom correction (partial bottom cell)
                DO ji = 1, fs_jpim1   ! vector opt.
-!!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)
@@ -242,5 +239,5 @@
             ENDIF
          ENDIF
-
+         !
          !!----------------------------------------------------------------------
          !!   II - horizontal trend  (full)
@@ -255,26 +252,14 @@
             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.
-                  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)   &
-                     &             + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. )
-                  !
-                  zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
-                     &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )
+                  zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)
+                  zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)
+                  !
+                  zmsku = 1. / MAX(  wmask(ji+1,jj,jk  ) + wmask(ji,jj,jk+1)   &
+                     &             + wmask(ji+1,jj,jk+1) + wmask(ji,jj,jk  ), 1. )
+                  !
+                  zmskv = 1. / MAX(  wmask(ji,jj+1,jk  ) + wmask(ji,jj,jk+1)   &
+                     &             + wmask(ji,jj+1,jk+1) + wmask(ji,jj,jk  ), 1. )
                   !
                   zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
@@ -294,30 +279,27 @@
                   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)  )
+                     &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                END DO
             END DO
          END DO                                        !   End of slab  
 
-
          !!----------------------------------------------------------------------
          !!   III - vertical trend (full)
          !!----------------------------------------------------------------------
-         
+         !
          ztfw(1,:,:) = 0._wp     ;     ztfw(jpi,:,:) = 0._wp
-         
+         !
          ! Vertical fluxes
          ! ---------------
-         
-         ! Surface and bottom vertical fluxes set to zero
+         !                          ! Surface and bottom vertical fluxes set to zero
          ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp
          
-         ! interior (2=<jk=<jpk-1)
-         DO jk = 2, jpkm1
+         DO jk = 2, jpkm1           ! interior (2=<jk=<jpk-1)
             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)          &
+                  zmsku = wmask(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)          &
+                  zmskv = wmask(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  )
                      !
@@ -337,5 +319,4 @@
             END DO
          END DO
-         !
          !                                !==  add the vertical 33 flux  ==!
          IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
@@ -343,5 +324,5 @@
                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)   &
+                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)   &
                         &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             &
                         &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
@@ -358,5 +339,5 @@
                         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)
+                           &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)
                      END DO
                   END DO
@@ -366,5 +347,5 @@
                   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)                      &
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(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) )   )
@@ -379,5 +360,5 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   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)  )
+                     &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                END DO
             END DO
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 7350)
+++ 	(revision )
@@ -1,166 +1,0 @@
-MODULE traldf_lap
-   !!==============================================================================
-   !!                       ***  MODULE  traldf_lap  ***
-   !! Ocean tracers:  lateral diffusivity trend  (laplacian and bilaplacian)
-   !!==============================================================================
-   !! 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 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          ! lateral physics: eddy diffusivity
-   USE diaptr          ! poleward transport diagnostics
-   USE trc_oce         ! share passive tracers/Ocean variables
-   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 traldf.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 tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
-      &                                                    pgui, pgvi,   &
-      &                                        ptb , pta , kjpt, kpass ) 
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_ldf_lap  ***
-      !!                   
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   Second order diffusive operator evaluated using before
-      !!      fields (forward time scheme). The horizontal diffusive trends of 
-      !!      the tracer is given by:
-      !!          difft = 1/(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
-      !!
-      !! ** Action  : - Update pta arrays with the before iso-level 
-      !!                harmonic 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
-      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        ! 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) ::   zsign            ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('tra_ldf_lap')
-      !
-      IF( kt == nit000 .AND. lwp )  THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass
-         WRITE(numout,*) '~~~~~~~~~~~ '
-      ENDIF
-      !
-      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
-                  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
-         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.
-                     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
-         ENDIF
-         !
-         DO jk = 1, jpkm1              !== Second derivative (divergence) added to the general tracer trends  ==!
-            DO jj = 2, jpjm1
-               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  
-         !
-         !                             !== "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
-      !                             ! ==================
-      !
-      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/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90	(revision 7351)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90	(revision 7351)
@@ -0,0 +1,253 @@
+MODULE traldf_lap_blp
+   !!==============================================================================
+   !!                       ***  MODULE  traldf_lap_blp  ***
+   !! Ocean tracers:  lateral diffusivity trend  (laplacian and bilaplacian)
+   !!==============================================================================
+   !! History :  3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_lap   : tracer trend update with iso-level laplacian diffusive operator
+   !!   tra_ldf_blp   : tracer trend update with iso-level or iso-neutral bilaplacian operator
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE ldftra         ! lateral physics: eddy diffusivity
+   USE traldf_iso     ! iso-neutral lateral diffusion (standard operator)     (tra_ldf_iso   routine)
+   USE traldf_triad   ! iso-neutral lateral diffusion (triad    operator)     (tra_ldf_triad routine)
+   USE diaptr         ! poleward transport diagnostics
+   USE trc_oce        ! share passive tracers/Ocean variables
+   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   ! called by traldf.F90
+   PUBLIC   tra_ldf_blp   ! 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
+
+   !! * Substitutions
+#  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_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                    pgui, pgvi,   &
+      &                                        ptb , pta , kjpt, kpass ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_lap  ***
+      !!                   
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   Second order diffusive operator evaluated using before
+      !!      fields (forward time scheme). The horizontal diffusive trends of 
+      !!      the tracer is given by:
+      !!          difft = 1/(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
+      !!
+      !! ** Action  : - Update pta arrays with the before iso-level 
+      !!                harmonic 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
+      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        ! 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) ::   zsign            ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('tra_ldf_lap')
+      !
+      IF( kt == nit000 .AND. lwp )  THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass
+         WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+      !
+      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) * e3u_n(ji,jj,jk)   !!gm   * umask(ji,jj,jk) pah masked!
+               zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_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
+                  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
+         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.
+                     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
+         ENDIF
+         !
+         DO jk = 1, jpkm1              !== Second derivative (divergence) added to the general tracer trends  ==!
+            DO jj = 2, jpjm1
+               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) * e3t_n(ji,jj,jk) )
+               END DO
+            END DO
+         END DO  
+         !
+         !                             !== "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
+      !                             ! ==================
+      !
+      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
+   
+
+   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_lap_blp
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90	(revision 7351)
@@ -11,21 +11,21 @@
    !!   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 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
+   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
@@ -37,5 +37,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -113,8 +112,7 @@
          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)
+      IF( neuler == 0 .AND. kt == kit000 ) THEN   ;   z2dt =     rdt      ! at nit000   (Euler)
+      ELSE                                        ;   z2dt = 2.* rdt      !             (Leapfrog)
       ENDIF
       z1_2dt = 1._wp / z2dt
@@ -123,5 +121,5 @@
       ELSE                    ;   zsign = -1._wp
       ENDIF
-                  
+      !    
       !!----------------------------------------------------------------------
       !!   0 - calculate  ah_wslp2, akz, and optionally zpsi_uw, zpsi_vw
@@ -142,15 +140,15 @@
                   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)
+                        ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp)
+                        zbu   = e1e2u(ji,jj) * e3u_n(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 = zslope_skew + ( gdept_n(ji+1,jj,jk) - gdept_n(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
@@ -166,11 +164,11 @@
                   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)
+                        ze3wr = 1.0_wp / e3w_n(ji,jj+jp,jk+kp)
+                        zbv   = e1e2v(ji,jj) * e3v_n(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 = zslope_skew + ( gdept_n(ji,jj+1,jk) - gdept_n(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
@@ -193,5 +191,5 @@
                      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) )  )
+                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) )  )
                      END DO
                   END DO
@@ -201,5 +199,5 @@
                   DO jj = 1, jpjm1
                      DO ji = 1, fs_jpim1
-                        ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk)
+                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(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
@@ -250,5 +248,5 @@
             ENDIF
          ENDIF
-
+         !
          !!----------------------------------------------------------------------
          !!   II - horizontal trend  (full)
@@ -256,5 +254,4 @@
          !
          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)
@@ -274,10 +271,10 @@
                            ze1ur = r1_e1u(ji,jj)
                            zdxt  = zdit(ji,jj,jk) * ze1ur
-                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
+                           ze3wr = 1._wp / e3w_n(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)
+                           !
+                           zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(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)
@@ -290,5 +287,5 @@
                   END DO
                END DO
-
+               !
                DO jp = 0, 1
                   DO kp = 0, 1
@@ -297,9 +294,9 @@
                            ze2vr = r1_e2v(ji,jj)
                            zdyt  = zdjt(ji,jj,jk) * ze2vr
-                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)
+                           ze3wr = 1._wp / e3w_n(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)
+                           zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(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)
@@ -312,7 +309,7 @@
                   END DO
                END DO
-
+               !
             ELSE
-
+               !
                DO ip = 0, 1               !==  Horizontal & vertical fluxes
                   DO kp = 0, 1
@@ -321,14 +318,14 @@
                            ze1ur = r1_e1u(ji,jj)
                            zdxt  = zdit(ji,jj,jk) * ze1ur
-                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
+                           ze3wr = 1._wp / e3w_n(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)
+                           !
+                           zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(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
+                           IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew        ! aeit(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
@@ -337,5 +334,5 @@
                   END DO
                END DO
-
+               !
                DO jp = 0, 1
                   DO kp = 0, 1
@@ -344,13 +341,13 @@
                            ze2vr = r1_e2v(ji,jj)
                            zdyt  = zdjt(ji,jj,jk) * ze2vr
-                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)
+                           ze3wr = 1._wp / e3w_n(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)
+                           zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(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
+                           IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew        ! aeit(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
@@ -365,5 +362,5 @@
                   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)  )
+                     &                                        / (  e1e2t(ji,jj) * e3t_n(ji,jj,jk)  )
                END DO
             END DO
@@ -376,5 +373,5 @@
                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)   &
+                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(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) )
@@ -388,5 +385,5 @@
                   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)             &
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(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
@@ -397,5 +394,5 @@
                   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)                      &
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(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) )   )
@@ -410,5 +407,5 @@
                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) )
+                     &                                        / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
                END DO
             END DO
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 7351)
@@ -13,19 +13,19 @@
 
    !!----------------------------------------------------------------------
-   !!   tra_npc : apply the non penetrative convection scheme
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE zdf_oce         ! ocean vertical physics
-   USE trd_oce         ! ocean active tracer trends
-   USE trdtra          ! ocean active tracer trends
-   USE eosbn2          ! equation of state (eos routine)
+   !!   tra_npc       : apply the non penetrative convection scheme
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE zdf_oce        ! ocean vertical physics
+   USE trd_oce        ! ocean active tracer trends
+   USE trdtra         ! ocean active tracer trends
+   USE eosbn2         ! equation of state (eos routine)
    !
-   USE lbclnk          ! lateral boundary conditions (or mpp link)
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   USE lbclnk         ! lateral boundary conditions (or mpp link)
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -35,5 +35,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -55,5 +54,5 @@
       !!              (i.e. static stability computed locally)
       !!
-      !! ** Action  : - (ta,sa) after the application od the npc scheme
+      !! ** Action  : - tsa: after tracers with the application of the npc scheme
       !!              - send the associated trends for on-line diagnostics (l_trdtra=T)
       !!
@@ -115,9 +114,9 @@
                   zvts(:,jp_tem) = tsa(ji,jj,:,jp_tem)      ! temperature
                   zvts(:,jp_sal) = tsa(ji,jj,:,jp_sal)      ! salinity
-
+                  !
                   zvab(:,jp_tem)  = zab(ji,jj,:,jp_tem)     ! Alpha 
                   zvab(:,jp_sal)  = zab(ji,jj,:,jp_sal)     ! Beta  
                   zvn2(:)         = zn2(ji,jj,:)            ! N^2 
-                 
+                  !
                   IF( l_LB_debug ) THEN                  !LB debug:
                      lp_monitor_point = .FALSE.
@@ -126,5 +125,5 @@
                      lp_monitor_point = (narea == nncpu).AND.lp_monitor_point                      
                   ENDIF                                  !LB debug  end
-
+                  !
                   ikbot = mbkt(ji,jj)   ! ikbot: ocean bottom T-level
                   ikp = 1                  ! because N2 is irrelevant at the surface level (will start at ikp=2)
@@ -132,23 +131,23 @@
                   jiter  = 0
                   l_column_treated = .FALSE.
-                 
+                  !
                   DO WHILE ( .NOT. l_column_treated )
                      !
                      jiter = jiter + 1
-                    
+                     ! 
                      IF( jiter >= 400 ) EXIT
-                    
+                     !
                      l_bottom_reached = .FALSE.
-
+                     !
                      DO WHILE ( .NOT. l_bottom_reached )
-
+                        !
                         ikp = ikp + 1
-                       
+                        !
                         !! Testing level ikp for instability
                         !! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                         IF( zvn2(ikp) <  -zn2_zero ) THEN ! Instability found!
-
+                           !
                            ilayer = ilayer + 1    ! yet another instable portion of the water column found....
-
+                           !
                            IF( lp_monitor_point ) THEN 
                               WRITE(numout,*)
@@ -165,13 +164,12 @@
                               WRITE(numout,*)
                            ENDIF
-                           
-
+                           !
                            IF( jiter == 1 )   inpcc = inpcc + 1 
-
+                           !
                            IF( lp_monitor_point )   WRITE(numout, *) 'Negative N2 at ikp =',ikp,' for layer #', ilayer
-
+                           !
                            !! ikup is the uppermost point where mixing will start:
                            ikup = ikp - 1 ! ikup is always "at most at ikp-1", less if neutral levels overlying
-                           
+                           !
                            !! If the points above ikp-1 have N2 == 0 they must also be mixed:
                            IF( ikp > 2 ) THEN
@@ -184,7 +182,7 @@
                               END DO
                            ENDIF
-                           
+                           !
                            IF( ikup < 1 )   CALL ctl_stop( 'tra_npc :  PROBLEM #1')
-
+                           !
                            zsum_temp = 0._wp
                            zsum_sali = 0._wp
@@ -195,5 +193,5 @@
                            DO jk = ikup, ikbot      ! Inside the instable (and overlying neutral) portion of the column
                               !
-                              zdz       = fse3t(ji,jj,jk)
+                              zdz       = e3t_n(ji,jj,jk)
                               zsum_temp = zsum_temp + zvts(jk,jp_tem)*zdz
                               zsum_sali = zsum_sali + zvts(jk,jp_sal)*zdz
@@ -244,6 +242,6 @@
 
                               !! Interpolating alfa and beta at W point:
-                              zrw =  (fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk)) &
-                                 & / (fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk))
+                              zrw =  (gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk)) &
+                                 & / (gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk))
                               zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw
                               zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw
@@ -252,5 +250,5 @@
                               zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     &
                                  &            - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )  &
-                                 &       / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                                 &       / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
 
                               !! OR, faster  => just considering the vertical gradient of density
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 7351)
@@ -28,5 +28,5 @@
    USE sbc_oce         ! surface boundary condition: ocean
    USE sbcrnf          ! river runoffs
-   USE sbcisf          ! ice shelf melting/freezing
+   USE sbcisf          ! ice shelf melting
    USE zdf_oce         ! ocean vertical mixing
    USE domvvl          ! variable volume
@@ -56,7 +56,6 @@
    PUBLIC   tra_nxt_vvl   ! to be used in trcnxt
 
-
    !! * Substitutions
-#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO-Consortium (2010) 
@@ -86,11 +85,10 @@
       !!             domains (lk_agrif=T)
       !!
-      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
-      !!
+      !! ** Action  : - tsb & tsn ready for the next time step
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
       !!
-      INTEGER  ::   jk, jn    ! dummy loop indices
-      REAL(wp) ::   zfact     ! local scalars
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zfact            ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -106,5 +104,4 @@
       ! Update after tracer on domain lateral boundaries
       ! 
-      !
 #if defined key_agrif
       CALL Agrif_tra                     ! AGRIF zoom boundaries
@@ -119,6 +116,6 @@
  
       ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler)
-      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2._wp* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =     rdt      ! at nit000             (Euler)
+      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp* rdt   ! at nit000 or nit000+1 (Leapfrog)
       ENDIF
 
@@ -140,16 +137,22 @@
             END DO
          END DO
+         !
       ELSE                                            ! Leap-Frog + Asselin filter time stepping
          !
-         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa,   &
-           &                                                              sbc_tsc, sbc_tsc_b, jpts )  ! variable volume level (vvl) 
-         ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level 
+         IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nit000,      'TRA', tsb, tsn, tsa, jpts )  ! linear free surface 
+         ELSE                   ;   CALL tra_nxt_vvl( kt, nit000, rdt, 'TRA', tsb, tsn, tsa,   &
+           &                                                                sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
          ENDIF
+         !
+         DO jn = 1, jpts
+            CALL lbc_lnk( tsb(:,:,:,jn), 'T', 1._wp ) 
+            CALL lbc_lnk( tsn(:,:,:,jn), 'T', 1._wp )
+            CALL lbc_lnk( tsa(:,:,:,jn), 'T', 1._wp )
+         END DO
       ENDIF     
       !
-      ! trends computation
       IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
          DO jk = 1, jpkm1
-            zfact = 1._wp / r2dtra(jk)             
+            zfact = 1._wp / r2dt             
             ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
             ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
@@ -179,19 +182,18 @@
       !!              - swap tracer fields to prepare the next time_step.
       !!
-      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
-      !!              
-      !!----------------------------------------------------------------------
-      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)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
+      !! ** Action  : - tsb & tsn ready for the next time step
+      !!----------------------------------------------------------------------
+      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(inout) ::  ptb       ! before tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! 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) ::   ztn, ztd         ! local scalars
       !!----------------------------------------------------------------------
-
+      !
       IF( kt == kit000 )  THEN
          IF(lwp) WRITE(numout,*)
@@ -200,16 +202,14 @@
       ENDIF
       !
-      !
       DO jn = 1, kjpt
          !
          DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
                   ztn = ptn(ji,jj,jk,jn)                                    
-                  ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
-                  !
-                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn 
-                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta
-                  !
+                  ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn)  ! time laplacian on tracers
+                  !
+                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                      ! ptb <-- filtered ptn 
+                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                      ! ptn <-- pta
                END DO
            END DO
@@ -230,21 +230,21 @@
       !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
       !!              - swap tracer fields to prepare the next time_step.
-      !!                This can be summurized for tempearture as:
-      !!
-      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
-      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index
-      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step
-      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator)
-      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend
-      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content
-      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content
-
-      !!     
+      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
+      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
+      !!             tn  = ta 
+      !!
+      !! ** Action  : - tsb & tsn ready for the next time step
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
+      REAL(wp)                             , INTENT(in   ) ::  p2dt      ! time-step
+      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(inout) ::  ptb       ! before tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc   ! surface tracer content
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc_b ! before surface tracer content
+      !
       LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical
       INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
@@ -262,24 +262,20 @@
          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_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
+         ll_isf     = ln_isf           ! active  tracers case  and  ice shelf melting
+      ELSE                          ! passive tracers case
+         ll_traqsr  = .FALSE.          ! NO solar penetration
+         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ?  
+         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ?? 
       ENDIF
       !
       DO jn = 1, kjpt      
          DO jk = 1, jpkm1
-            zfact1 = atfp * p2dt(jk)
-            zfact2 = zfact1 / rau0
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ze3t_b = fse3t_b(ji,jj,jk)
-                  ze3t_n = fse3t_n(ji,jj,jk)
-                  ze3t_a = fse3t_a(ji,jj,jk)
+            zfact1 = atfp * p2dt
+            zfact2 = zfact1 * r1_rau0
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  ze3t_b = e3t_b(ji,jj,jk)
+                  ze3t_n = e3t_n(ji,jj,jk)
+                  ze3t_a = e3t_a(ji,jj,jk)
                   !                                         ! tracer content at Before, now and after
                   ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
@@ -299,14 +295,14 @@
                      ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
                   ENDIF
-
+                  !
                   ! 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) ) 
-
+                     !
                   ! 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)
-
+                     &                              * e3t_n(ji,jj,jk) / h_rnf(ji,jj)
+                     !
                   ! ice shelf
                   IF( ll_isf ) THEN
@@ -314,11 +310,11 @@
                      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)
+                               &                 * e3t_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)
+                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
                   END IF
-
+                  !
                   ze3t_f = 1.e0 / ze3t_f
                   ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 7351)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                       ***  MODULE  traqsr  ***
-   !! Ocean physics: solar radiation penetration in the top ocean levels
+   !! Ocean physics:   solar radiation penetration in the top ocean levels
    !!======================================================================
    !! History :  OPA  !  1990-10  (B. Blanke)  Original code
@@ -10,24 +10,28 @@
    !!             -   !  2005-11  (G. Madec) zco, zps, sco coordinate
    !!            3.2  !  2009-04  (G. Madec & NEMO team) 
-   !!            4.0  !  2012-05  (C. Rousset) store attenuation coef for use in ice model 
+   !!            3.6  !  2012-05  (C. Rousset) store attenuation coef for use in ice model 
+   !!            3.6  !  2015-12  (O. Aumont, J. Jouanno, C. Ethe) use vertical profile of chlorophyll
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  remove optimisation for fix volume 
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   tra_qsr      : trend due to the solar radiation penetration
-   !!   tra_qsr_init : solar radiation penetration initialization
+   !!   tra_qsr       : temperature trend due to the penetration of solar radiation 
+   !!   tra_qsr_init  : initialization of the qsr penetration 
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE trc_oce         ! share SMS/Ocean variables
+   USE oce            ! ocean dynamics and active tracers
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE trc_oce        ! share SMS/Ocean variables
    USE trd_oce        ! trends: ocean variables
    USE trdtra         ! trends manager: tracers
-   USE in_out_manager  ! I/O manager
-   USE phycst          ! physical constants
-   USE prtctl          ! Print control
-   USE iom             ! I/O manager
-   USE fldread         ! read input fields
-   USE restart         ! ocean restart
-   USE lib_mpp         ! MPP library
+   !
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE iom            ! I/O manager
+   USE fldread        ! read input fields
+   USE restart        ! ocean restart
+   USE lib_mpp        ! MPP library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
@@ -49,14 +53,20 @@
    REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands)
    REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands)
+   !
+   INTEGER , PUBLIC ::   nksr         !: levels below which the light cannot penetrate (depth larger than 391 m)
  
-   ! Module variables
-   REAL(wp) ::   xsi0r                           !: inverse of rn_si0
-   REAL(wp) ::   xsi1r                           !: inverse of rn_si1
+   INTEGER, PARAMETER ::   np_RGB  = 1   ! R-G-B     light penetration with constant Chlorophyll
+   INTEGER, PARAMETER ::   np_RGBc = 2   ! R-G-B     light penetration with Chlorophyll data
+   INTEGER, PARAMETER ::   np_2BD  = 3   ! 2 bands   light penetration
+   INTEGER, PARAMETER ::   np_BIO  = 4   ! bio-model light penetration
+   !
+   INTEGER  ::   nqsr    ! user choice of the type of light penetration
+   REAL(wp) ::   xsi0r   ! inverse of rn_si0
+   REAL(wp) ::   xsi1r   ! inverse of rn_si1
+   !
+   REAL(wp) , DIMENSION(3,61)           ::   rkrgb    ! tabulated attenuation coefficients for RGB absorption
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
-   INTEGER, PUBLIC ::   nksr              ! levels below which the light cannot penetrate ( depth larger than 391 m)
-   REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -72,5 +82,5 @@
       !!
       !! ** Purpose :   Compute the temperature trend due to the solar radiation
-      !!      penetration and add it to the general temperature trend.
+      !!              penetration and add it to the general temperature trend.
       !!
       !! ** Method  : The profile of the solar radiation within the ocean is defined
@@ -83,32 +93,30 @@
       !!      all heat which has not been absorbed in the above levels is put
       !!      in the last ocean level.
-      !!         In z-coordinate case, the computation is only done down to the
-      !!      level where I(k) < 1.e-15 W/m2. In addition, the coefficients 
-      !!      used for the computation are calculated one for once as they
-      !!      depends on k only.
+      !!         The computation is only done down to the level where 
+      !!      I(k) < 1.e-15 W/m2 (i.e. over the top nksr levels) . 
       !!
       !! ** Action  : - update ta with the penetrative solar radiation trend
-      !!              - save the trend in ttrd ('key_trdtra')
+      !!              - send  trend for further diagnostics (l_trdtra=T)
       !!
       !! Reference  : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
       !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
-      !!----------------------------------------------------------------------
-      !
+      !!              Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562
+      !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt     ! ocean time-step
       !
-      INTEGER  ::   ji, jj, jk           ! dummy loop indices
-      INTEGER  ::   irgb                 ! local integers
-      REAL(wp) ::   zchl, zcoef, zfact   ! local scalars
-      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         -
+      INTEGER  ::   ji, jj, jk               ! dummy loop indices
+      INTEGER  ::   irgb                     ! local integers
+      REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars
+      REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         -
       REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         -
-      REAL(wp) ::   zz0, zz1, z1_e3t     !    -         -
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr
+      REAL(wp) ::   zz0 , zz1                !    -         -
+      REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze
+      REAL(wp) ::   zlogc, zlogc2, zlogc3 
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zekb, zekg, zekr
       REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot, zchl3d
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_qsr')
-      !
-      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
       !
       IF( kt == nit000 ) THEN
@@ -116,223 +124,185 @@
          IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation'
          IF(lwp) WRITE(numout,*) '~~~~~~~'
-         IF( .NOT.ln_traqsr )   RETURN
-      ENDIF
-
-      IF( l_trdtra ) THEN      ! Save ta and sa trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdt ) 
+      ENDIF
+      !
+      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt ) 
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
       ENDIF
-
-      !                                        Set before qsr tracer content field
-      !                                        ***********************************
-      IF( kt == nit000 ) THEN                     ! Set the forcing field at nit000 - 1
-         !                                        ! -----------------------------------
-         qsr_hc(:,:,:) = 0.e0
-         !
-         IF( ln_rstart .AND.    &                    ! Restart: read in restart file
-              & iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN
-            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field red in the restart file'
-            zfact = 0.5e0
+      !
+      !                         !-----------------------------------!
+      !                         !  before qsr induced heat content  !
+      !                         !-----------------------------------!
+      IF( kt == nit000 ) THEN          !==  1st time step  ==!
+!!gm case neuler  not taken into account....
+         IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN    ! read in restart
+            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file'
+            z1_2 = 0.5_wp
             CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux
          ELSE                                           ! No restart or restart not found: Euler forward time stepping
-            zfact = 1.e0
-            qsr_hc_b(:,:,:) = 0.e0
+            z1_2 = 1._wp
+            qsr_hc_b(:,:,:) = 0._wp
          ENDIF
-      ELSE                                        ! Swap of forcing field
-         !                                        ! ---------------------
-         zfact = 0.5e0
+      ELSE                             !==  Swap of qsr heat content  ==!
+         z1_2 = 0.5_wp
          qsr_hc_b(:,:,:) = qsr_hc(:,:,:)
       ENDIF
-      !                                        Compute now qsr tracer content field
-      !                                        ************************************
-      
-      !                                           ! ============================================== !
-      IF( lk_qsr_bio .AND. ln_qsr_bio ) THEN      !  bio-model fluxes  : all vertical coordinates  !
-         !                                        ! ============================================== !
-         DO jk = 1, jpkm1
+      !
+      !                         !--------------------------------!
+      SELECT CASE( nqsr )       !  now qsr induced heat content  !
+      !                         !--------------------------------!
+      !
+      CASE( np_BIO )                   !==  bio-model fluxes  ==!
+         !
+         DO jk = 1, nksr
             qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
          END DO
-         !                                        Add to the general trend
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z1_e3t = zfact / fse3t(ji,jj,jk)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t
+         !
+      CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==!
+         !
+         CALL wrk_alloc( jpi,jpj,       zekb, zekg, zekr        ) 
+         CALL wrk_alloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d ) 
+         !
+         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll
+            CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step
+            DO jk = 1, nksr + 1
+               DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl
+                  DO ji = fs_2, fs_jpim1
+                     zchl    = sf_chl(1)%fnow(ji,jj,1)
+                     zCtot   = 40.6  * zchl**0.459
+                     zze     = 568.2 * zCtot**(-0.746)
+                     IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293)
+                     zpsi    = gdepw_n(ji,jj,jk) / zze
+                     !
+                     zlogc   = LOG( zchl )
+                     zlogc2  = zlogc * zlogc
+                     zlogc3  = zlogc * zlogc * zlogc
+                     zCb     = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3
+                     zCmax   = 0.299 - 0.289 * zlogc + 0.579 * zlogc2
+                     zpsimax = 0.6   - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3
+                     zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2
+                     zCze    = 1.12  * (zchl)**0.803 
+                     !
+                     zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) )
+                  END DO
+                  !
                END DO
             END DO
-         END DO
-         CALL iom_put( 'qsr3d', etot3 )   ! Shortwave Radiation 3D distribution
-         ! clem: store attenuation coefficient of the first ocean level
-         IF ( ln_qsr_ice ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF ( qsr(ji,jj) /= 0._wp ) THEN
-                     fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) )
-                  ELSE
-                     fraqsr_1lev(ji,jj) = 1.
-                  ENDIF
+         ELSE                                !* constant chrlorophyll
+           DO jk = 1, nksr + 1
+              zchl3d(:,:,jk) = 0.05 
+            ENDDO
+         ENDIF
+         !
+         zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               ze0(ji,jj,1) = rn_abs * qsr(ji,jj)
+               ze1(ji,jj,1) = zcoef  * qsr(ji,jj)
+               ze2(ji,jj,1) = zcoef  * qsr(ji,jj)
+               ze3(ji,jj,1) = zcoef  * qsr(ji,jj)
+               zea(ji,jj,1) =          qsr(ji,jj)
+            END DO
+         END DO
+         !
+         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) )
+                  irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
+                  zekb(ji,jj) = rkrgb(1,irgb)
+                  zekg(ji,jj) = rkrgb(2,irgb)
+                  zekr(ji,jj) = rkrgb(3,irgb)
                END DO
             END DO
-         ENDIF
-         !                                        ! ============================================== !
-      ELSE                                        !  Ocean alone : 
-         !                                        ! ============================================== !
-         !
-         !                                                ! ------------------------- !
-         IF( ln_qsr_rgb) THEN                             !  R-G-B  light penetration !
-            !                                             ! ------------------------- !
-            ! Set chlorophyl concentration
-            IF( nn_chldta == 1 .OR. lk_vvl ) THEN            !*  Variable Chlorophyll or ocean volume
-               !
-               IF( nn_chldta == 1 ) THEN                             !*  Variable Chlorophyll
-                  !
-                  CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step
-                  !         
-                  DO jj = 1, jpj                                         ! Separation in R-G-B depending of the surface Chl
-                     DO ji = 1, jpi
-                        zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) )
-                        irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
-                        zekb(ji,jj) = rkrgb(1,irgb)
-                        zekg(ji,jj) = rkrgb(2,irgb)
-                        zekr(ji,jj) = rkrgb(3,irgb)
-                     END DO
-                  END DO
-               ELSE                                            ! Variable ocean volume but constant chrlorophyll
-                  zchl = 0.05                                     ! constant chlorophyll
-                  irgb = NINT( 41 + 20.*LOG10( zchl ) + 1.e-15 )
-                  zekb(:,:) = rkrgb(1,irgb)                       ! Separation in R-G-B depending of the chlorophyll 
-                  zekg(:,:) = rkrgb(2,irgb)
-                  zekr(:,:) = rkrgb(3,irgb)
+
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * xsi0r       )
+                  zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekb(ji,jj) )
+                  zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekg(ji,jj) )
+                  zc3 = ze3(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekr(ji,jj) )
+                  ze0(ji,jj,jk) = zc0
+                  ze1(ji,jj,jk) = zc1
+                  ze2(ji,jj,jk) = zc2
+                  ze3(ji,jj,jk) = zc3
+                  zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, nksr                     !* now qsr induced heat content
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) )
+               END DO
+            END DO
+         END DO
+         !
+         CALL wrk_dealloc( jpi,jpj,        zekb, zekg, zekr        ) 
+         CALL wrk_dealloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d ) 
+         !
+      CASE( np_2BD  )            !==  2-bands fluxes  ==!
+         !
+         zz0 =        rn_abs   * r1_rau0_rcp      ! surface equi-partition in 2-bands
+         zz1 = ( 1. - rn_abs ) * r1_rau0_rcp
+         DO jk = 1, nksr                          ! solar heat absorbed at T-point in the top 400m 
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zc0 = zz0 * EXP( -gdepw_n(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk  )*xsi1r )
+                  zc1 = zz0 * EXP( -gdepw_n(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk+1)*xsi1r )
+                  qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) ) 
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      !                          !-----------------------------!
+      DO jk = 1, nksr            !  update to the temp. trend  !
+         DO jj = 2, jpjm1        !-----------------------------!
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
+                  &                 + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      IF( ln_qsr_ice ) THEN      ! sea-ice: store the 1st ocean level attenuation coefficient
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) )
+               ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
                ENDIF
-               !
-               zcoef  = ( 1. - rn_abs ) / 3.e0                        ! equi-partition in R-G-B
-               ze0(:,:,1) = rn_abs  * qsr(:,:)
-               ze1(:,:,1) = zcoef * qsr(:,:)
-               ze2(:,:,1) = zcoef * qsr(:,:)
-               ze3(:,:,1) = zcoef * qsr(:,:)
-               zea(:,:,1) =         qsr(:,:)
-               !
-               DO jk = 2, nksr+1
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r     )
-                        zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) )
-                        zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) )
-                        zc3 = ze3(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekr(ji,jj) )
-                        ze0(ji,jj,jk) = zc0
-                        ze1(ji,jj,jk) = zc1
-                        ze2(ji,jj,jk) = zc2
-                        ze3(ji,jj,jk) = zc3
-                        zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk)
-                     END DO
-                  END DO
-               END DO
-               ! clem: store attenuation coefficient of the first ocean level
-               IF ( ln_qsr_ice ) THEN
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     )
-                        zzc1 = zcoef  * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) )
-                        zzc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) )
-                        zzc3 = zcoef  * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) )
-                        fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2  + zzc3  ) * tmask(ji,jj,2) 
-                     END DO
-                  END DO
-               ENDIF
-               !
-               DO jk = 1, nksr                                        ! compute and add qsr trend to ta
-                  qsr_hc(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) )
-               END DO
-               zea(:,:,nksr+1:jpk) = 0.e0     ! below 400m set to zero
-               CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution
-               !
-            ELSE                                                 !*  Constant Chlorophyll
-               DO jk = 1, nksr
-                  qsr_hc(:,:,jk) =  etot3(:,:,jk) * qsr(:,:)
-               END DO
-               ! clem: store attenuation coefficient of the first ocean level
-               IF ( ln_qsr_ice ) THEN
-                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp
-               ENDIF
-           ENDIF
-
-         ENDIF
-         !                                                ! ------------------------- !
-         IF( ln_qsr_2bd ) THEN                            !  2 band light penetration !
-            !                                             ! ------------------------- !
-            !
-            IF( lk_vvl ) THEN                                  !* variable volume
-               zz0   =        rn_abs   * r1_rau0_rcp
-               zz1   = ( 1. - rn_abs ) * r1_rau0_rcp
-               DO jk = 1, nksr                    ! solar heat absorbed at T-point in the top 400m 
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
-                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
-                        qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) ) 
-                     END DO
-                  END DO
-               END DO
-               ! clem: store attenuation coefficient of the first ocean level
-               IF ( ln_qsr_ice ) THEN
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r )
-                        zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r )
-                        fraqsr_1lev(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp
-                     END DO
-                  END DO
-               ENDIF
-            ELSE                                               !* constant volume: coef. computed one for all
-               DO jk = 1, nksr
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt.
-                        ! (ISF) no light penetration below the ice shelves         
-                        qsr_hc(ji,jj,jk) =  etot3(ji,jj,jk) * qsr(ji,jj) * tmask(ji,jj,1)
-                     END DO
-                  END DO
-               END DO
-               ! clem: store attenuation coefficient of the first ocean level
-               IF ( ln_qsr_ice ) THEN
-                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp
-               ENDIF
-               !
-            ENDIF
-            !
-         ENDIF
-         !
-         !                                        Add to the general trend
-         DO jk = 1, nksr
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z1_e3t = zfact / fse3t(ji,jj,jk)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-      !
-      IF( lrst_oce ) THEN   !                  Write in the ocean restart file
-         !                                     *******************************
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'qsr tracer content forcing field written in ocean restart file ',   &
-            &                    'at it= ', kt,' date= ', ndastp
-         IF(lwp) WRITE(numout,*) '~~~~'
+            END DO
+         END DO
+         ! Update haloes since lim_thd needs fraqsr_1lev to be defined everywhere
+         CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp )
+      ENDIF
+      !
+      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
+         CALL wrk_alloc( jpi,jpj,jpk,   zetot )
+         !
+         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
+         DO jk = nksr, 1, -1
+            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp
+         END DO         
+         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
+         !
+         CALL wrk_dealloc( jpi,jpj,jpk,   zetot ) 
+      ENDIF
+      !
+      IF( lrst_oce ) THEN     ! write in the ocean restart file
          CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      )
-         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev )   ! default definition in sbcssm 
-         !
-      ENDIF
-
+         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev ) 
+      ENDIF
+      !
       IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt )
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt ) 
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt ) 
       ENDIF
       !                       ! print mean trends (used for debugging)
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
-      !
-      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_qsr')
@@ -358,34 +328,25 @@
       !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
       !!----------------------------------------------------------------------
-      !
-      INTEGER  ::   ji, jj, jk                   ! dummy loop indices
-      INTEGER  ::   irgb, ierror, ioptio, nqsr   ! local integer
-      INTEGER  ::   ios                          ! Local integer output status for namelist read
-      REAL(wp) ::   zz0, zc0  , zc1, zcoef       ! local scalars
-      REAL(wp) ::   zz1, zc2  , zc3, zchl        !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea
+      INTEGER  ::   ji, jj, jk                  ! dummy loop indices
+      INTEGER  ::   ios, irgb, ierror, ioptio   ! local integer
+      REAL(wp) ::   zz0, zc0 , zc1, zcoef      ! local scalars
+      REAL(wp) ::   zz1, zc2 , zc3, zchl       !   -      -
       !
       CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
       TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
       !!
-      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
+      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
          &                  nn_chldta, rn_abs, rn_si0, rn_si1
       !!----------------------------------------------------------------------
-
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init')
-      !
-      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
-      !
-
-      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference namelist : Ratio and length of penetration
+      !
+      IF( nn_timing == 1 )   CALL timing_start('tra_qsr_init')
+      !
+      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference     namelist
       READ  ( numnam_ref, namtra_qsr, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_qsr in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              !  Namelist namtra_qsr in configuration namelist : Ratio and length of penetration
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namtra_qsr in configuration namelist
       READ  ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namtra_qsr )
       !
@@ -395,173 +356,84 @@
          WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namtra_qsr : set the parameter of penetration'
-         WRITE(numout,*) '      Light penetration (T) or not (F)         ln_traqsr  = ', ln_traqsr
-         WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration   ln_qsr_rgb = ', ln_qsr_rgb
-         WRITE(numout,*) '      2 band               light penetration   ln_qsr_2bd = ', ln_qsr_2bd
-         WRITE(numout,*) '      bio-model            light penetration   ln_qsr_bio = ', ln_qsr_bio
-         WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice
-         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)    nn_chldta  = ', nn_chldta
-         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs = ', rn_abs
-         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0
-         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1
-      ENDIF
-
-      IF( ln_traqsr ) THEN     ! control consistency
-         !                      
-         IF( .NOT.lk_qsr_bio .AND. ln_qsr_bio )   THEN
-            CALL ctl_warn( 'No bio model : force ln_qsr_bio = FALSE ' )
-            ln_qsr_bio = .FALSE.
+         WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration       ln_qsr_rgb = ', ln_qsr_rgb
+         WRITE(numout,*) '      2 band               light penetration       ln_qsr_2bd = ', ln_qsr_2bd
+         WRITE(numout,*) '      bio-model            light penetration       ln_qsr_bio = ', ln_qsr_bio
+         WRITE(numout,*) '      light penetration for ice-model (LIM3)       ln_qsr_ice = ', ln_qsr_ice
+         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)        nn_chldta  = ', nn_chldta
+         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs     = ', rn_abs
+         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0     = ', rn_si0
+         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1     = ', rn_si1
+         WRITE(numout,*)
+      ENDIF
+      !
+      ioptio = 0                    ! Parameter control
+      IF( ln_qsr_rgb  )   ioptio = ioptio + 1
+      IF( ln_qsr_2bd  )   ioptio = ioptio + 1
+      IF( ln_qsr_bio  )   ioptio = ioptio + 1
+      !
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE type of light penetration in namelist namtra_qsr',  &
+         &                               ' 2 bands, 3 RGB bands or bio-model light penetration' )
+      !
+      IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr = np_RGB 
+      IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr = np_RGBc
+      IF( ln_qsr_2bd                      )   nqsr = np_2BD
+      IF( ln_qsr_bio                      )   nqsr = np_BIO
+      !
+      !                             ! Initialisation
+      xsi0r = 1._wp / rn_si0
+      xsi1r = 1._wp / rn_si1
+      !
+      SELECT CASE( nqsr )
+      !                               
+      CASE( np_RGB , np_RGBc )         !==  Red-Green-Blue light penetration  ==!
+         !                             
+         IF(lwp)   WRITE(numout,*) '   R-G-B   light penetration '
+         !
+         CALL trc_oce_rgb( rkrgb )                 ! tabulated attenuation coef.
+         !                                   
+         nksr = trc_oce_ext_lev( r_si2, 33._wp )   ! level of light extinction
+         !
+         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
+         !
+         IF( nqsr == np_RGBc ) THEN                ! Chl data : set sf_chl structure
+            IF(lwp) WRITE(numout,*) '        Chlorophyll read in a file'
+            ALLOCATE( sf_chl(1), STAT=ierror )
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN
+            ENDIF
+            ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   )
+            IF( sn_chl%ln_tint )   ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
+            !                                        ! fill sf_chl with sn_chl and control print
+            CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   &
+               &           'Solar penetration function of read chlorophyll', 'namtra_qsr' )
          ENDIF
-         !
-         ioptio = 0                      ! Parameter control
-         IF( ln_qsr_rgb  )   ioptio = ioptio + 1
-         IF( ln_qsr_2bd  )   ioptio = ioptio + 1
-         IF( ln_qsr_bio  )   ioptio = ioptio + 1
-         !
-         IF( ioptio /= 1 ) &
-            CALL ctl_stop( '          Choose ONE type of light penetration in namelist namtra_qsr',  &
-            &              ' 2 bands, 3 RGB bands or bio-model light penetration' )
-         !
-         IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr =  1 
-         IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr =  2
-         IF( ln_qsr_2bd                      )   nqsr =  3
-         IF( ln_qsr_bio                      )   nqsr =  4
-         !
-         IF(lwp) THEN                   ! Print the choice
-            WRITE(numout,*)
-            IF( nqsr ==  1 )   WRITE(numout,*) '         R-G-B   light penetration - Constant Chlorophyll'
-            IF( nqsr ==  2 )   WRITE(numout,*) '         R-G-B   light penetration - Chl data '
-            IF( nqsr ==  3 )   WRITE(numout,*) '         2 bands light penetration'
-            IF( nqsr ==  4 )   WRITE(numout,*) '         bio-model light penetration'
+         IF( nqsr == np_RGB ) THEN                 ! constant Chl
+            IF(lwp) WRITE(numout,*) '        Constant Chlorophyll concentration = 0.05'
          ENDIF
          !
-      ENDIF
-      !                          ! ===================================== !
-      IF( ln_traqsr  ) THEN      !  Initialisation of Light Penetration  !  
-         !                       ! ===================================== !
-         !
-         xsi0r = 1.e0 / rn_si0
-         xsi1r = 1.e0 / rn_si1
-         !                                ! ---------------------------------- !
-         IF( ln_qsr_rgb ) THEN            !  Red-Green-Blue light penetration  !
-            !                             ! ---------------------------------- !
-            !
-            CALL trc_oce_rgb( rkrgb )           !* tabulated attenuation coef.
-            !
-            !                                   !* level of light extinction
-            IF(  ln_sco ) THEN   ;   nksr = jpkm1
-            ELSE                 ;   nksr = trc_oce_ext_lev( r_si2, 0.33e2 )
-            ENDIF
-
-            IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
-            !
-            IF( nn_chldta == 1 ) THEN           !* Chl data : set sf_chl structure
-               IF(lwp) WRITE(numout,*)
-               IF(lwp) WRITE(numout,*) '        Chlorophyll read in a file'
-               ALLOCATE( sf_chl(1), STAT=ierror )
-               IF( ierror > 0 ) THEN
-                  CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN
-               ENDIF
-               ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   )
-               IF( sn_chl%ln_tint )ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
-               !                                        ! fill sf_chl with sn_chl and control print
-               CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   &
-                  &                                         'Solar penetration function of read chlorophyll', 'namtra_qsr' )
-               !
-            ELSE                                !* constant Chl : compute once for all the distribution of light (etot3)
-               IF(lwp) WRITE(numout,*)
-               IF(lwp) WRITE(numout,*) '        Constant Chlorophyll concentration = 0.05'
-               IF( lk_vvl ) THEN                   ! variable volume
-                  IF(lwp) WRITE(numout,*) '        key_vvl: light distribution will be computed at each time step'
-               ELSE                                ! constant volume: computes one for all
-                  IF(lwp) WRITE(numout,*) '        fixed volume: light distribution computed one for all'
-                  !
-                  zchl = 0.05                                 ! constant chlorophyll
-                  irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
-                  zekb(:,:) = rkrgb(1,irgb)                   ! Separation in R-G-B depending of the chlorophyll 
-                  zekg(:,:) = rkrgb(2,irgb)
-                  zekr(:,:) = rkrgb(3,irgb)
-                  !
-                  zcoef = ( 1. - rn_abs ) / 3.e0              ! equi-partition in R-G-B
-                  ze0(:,:,1) = rn_abs
-                  ze1(:,:,1) = zcoef
-                  ze2(:,:,1) = zcoef 
-                  ze3(:,:,1) = zcoef
-                  zea(:,:,1) = tmask(:,:,1)                   ! = ( ze0+ze1+z2+ze3 ) * tmask
-               
-                  DO jk = 2, nksr+1
-                     DO jj = 1, jpj
-                        DO ji = 1, jpi
-                           zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r     )
-                           zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekb(ji,jj) )
-                           zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekg(ji,jj) )
-                           zc3 = ze3(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekr(ji,jj) )
-                           ze0(ji,jj,jk) = zc0
-                           ze1(ji,jj,jk) = zc1
-                           ze2(ji,jj,jk) = zc2
-                           ze3(ji,jj,jk) = zc3
-                           zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk)
-                        END DO
-                     END DO
-                  END DO 
-                  !
-                  DO jk = 1, nksr
-                     ! (ISF) no light penetration below the ice shelves
-                     etot3(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) ) * tmask(:,:,1)
-                  END DO
-                  etot3(:,:,nksr+1:jpk) = 0.e0                ! below 400m set to zero
-               ENDIF
-            ENDIF
-            !
-         ENDIF
-            !                             ! ---------------------------------- !
-         IF( ln_qsr_2bd ) THEN            !    2 bands    light penetration    !
-            !                             ! ---------------------------------- !
-            !
-            !                                ! level of light extinction
-            nksr = trc_oce_ext_lev( rn_si1, 1.e2 )
-            IF(lwp) THEN
-               WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
-            ENDIF
-            !
-            IF( lk_vvl ) THEN                   ! variable volume
-               IF(lwp) WRITE(numout,*) '        key_vvl: light distribution will be computed at each time step'
-            ELSE                                ! constant volume: computes one for all
-               zz0 =        rn_abs   * r1_rau0_rcp
-               zz1 = ( 1. - rn_abs ) * r1_rau0_rcp
-               DO jk = 1, nksr                    !*  solar heat absorbed at T-point computed once for all
-                  DO jj = 1, jpj                              ! top 400 meters
-                     DO ji = 1, jpi
-                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
-                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
-                        etot3(ji,jj,jk) = (  zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1)  ) * tmask(ji,jj,1) 
-                     END DO
-                  END DO
-               END DO
-               etot3(:,:,nksr+1:jpk) = 0.e0                   ! below 400m set to zero
-               !
-            ENDIF
-         ENDIF
-         !                       ! ===================================== !
-      ELSE                       !        No light penetration           !                   
-         !                       ! ===================================== !
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'tra_qsr_init : NO solar flux penetration'
-            WRITE(numout,*) '~~~~~~~~~~~~'
-         ENDIF
-      ENDIF
-      !
-      ! initialisation of fraqsr_1lev used in sbcssm
+      CASE( np_2BD )                   !==  2 bands light penetration  ==!
+         !
+         IF(lwp)  WRITE(numout,*) '   2 bands light penetration'
+         !
+         nksr = trc_oce_ext_lev( rn_si1, 100._wp )    ! level of light extinction
+         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
+         !
+      CASE( np_BIO )                   !==  BIO light penetration  ==!
+         !
+         IF(lwp) WRITE(numout,*) '   bio-model light penetration'
+         IF( .NOT.lk_qsr_bio )   CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' )
+         !
+      END SELECT
+      !
+      qsr_hc(:,:,:) = 0._wp     ! now qsr heat content set to zero where it will not be computed
+      !
+      ! 1st ocean level attenuation coefficient (used in sbcssm)
       IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
          CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  )
       ELSE
-         fraqsr_1lev(:,:) = 1._wp   ! default definition
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_qsr_init')
+         fraqsr_1lev(:,:) = 1._wp   ! default : no penetration
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('tra_qsr_init')
       !
    END SUBROUTINE tra_qsr_init
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 7351)
@@ -13,32 +13,32 @@
 
    !!----------------------------------------------------------------------
-   !!   tra_sbc      : update the tracer trend at ocean surface
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE dom_oce         ! ocean space domain variables
-   USE phycst          ! physical constant
-   USE sbcmod          ! ln_rnf  
-   USE sbcrnf          ! River runoff  
-   USE sbcisf          ! Ice shelf   
-   USE traqsr          ! solar radiation penetration
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
+   !!   tra_sbc       : update the tracer trend at ocean surface
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE dom_oce        ! ocean space domain variables
+   USE phycst         ! physical constant
+   USE eosbn2         ! Equation Of State
+   USE sbcmod         ! ln_rnf  
+   USE sbcrnf         ! River runoff  
+   USE sbcisf         ! Ice shelf   
+   USE iscplini       ! Ice sheet coupling
+   USE traqsr         ! solar radiation penetration
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers 
    !
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
-   USE iom
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-   USE eosbn2
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE iom            ! xIOS server
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   tra_sbc    ! routine called by step.F90
+   PUBLIC   tra_sbc   ! routine called by step.F90
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -57,67 +57,22 @@
       !!      and add it to the general trend of tracer equations.
       !!
-      !! ** Method :
-      !!      Following Roullet and Madec (2000), the air-sea flux can be divided 
-      !!      into three effects: (1) Fext, external forcing; 
-      !!      (2) Fwi, concentration/dilution effect due to water exchanged 
-      !!         at the surface by evaporation, precipitations and runoff (E-P-R); 
-      !!      (3) Fwe, tracer carried with the water that is exchanged. 
-      !!            - salinity    : salt flux only due to freezing/melting
-      !!            sa = sa +  sfx / rau0 / e3t  for k=1
+      !! ** Method :   The (air+ice)-sea flux has two components: 
+      !!      (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface); 
+      !!      (2) Fwe , tracer carried with the water that is exchanged with air+ice. 
+      !!               The input forcing fields (emp, rnf, sfx, isf) contain Fext+Fwe,
+      !!             they are simply added to the tracer trend (tsa).
+      !!               In linear free surface case (ln_linssh=T), the volume of the
+      !!             ocean does not change with the water exchanges at the (air+ice)-sea
+      !!             interface. Therefore another term has to be added, to mimic the
+      !!             concentration/dilution effect associated with water exchanges.
       !!
-      !!      Fext, flux through the air-sea interface for temperature and salt: 
-      !!            - temperature : heat flux q (w/m2). If penetrative solar
-      !!         radiation q is only the non solar part of the heat flux, the
-      !!         solar part is added in traqsr.F routine.
-      !!            ta = ta + q /(rau0 rcp e3t)  for k=1
-      !!            - salinity    : no salt flux
-      !!
-      !!      The formulation for Fwb and Fwi vary according to the free 
-      !!      surface formulation (linear or variable volume). 
-      !!      * Linear free surface
-      !!            The surface freshwater flux modifies the ocean volume
-      !!         and thus the concentration of a tracer and the temperature.
-      !!         First order of the effect of surface freshwater exchange 
-      !!         for salinity, it can be neglected on temperature (especially
-      !!         as the temperature of precipitations and runoffs is usually
-      !!         unknown).
-      !!            - temperature : we assume that the temperature of both
-      !!         precipitations and runoffs is equal to the SST, thus there
-      !!         is no additional flux since in this case, the concentration
-      !!         dilution effect is balanced by the net heat flux associated
-      !!         to the freshwater exchange (Fwe+Fwi=0):
-      !!            (Tp P - Te E) + SST (P-E) = 0 when Tp=Te=SST
-      !!            - salinity    : evaporation, precipitation and runoff
-      !!         water has a zero salinity  but there is a salt flux due to 
-      !!         freezing/melting, thus:
-      !!            sa = sa + emp * sn / rau0 / e3t   for k=1
-      !!                    + sfx    / rau0 / e3t
-      !!         where emp, the surface freshwater budget (evaporation minus
-      !!         precipitation minus runoff) given in kg/m2/s is divided
-      !!         by rau0 (density of sea water) to obtain m/s.    
-      !!         Note: even though Fwe does not appear explicitly for 
-      !!         temperature in this routine, the heat carried by the water
-      !!         exchanged through the surface is part of the total heat flux
-      !!         forcing and must be taken into account in the global heat
-      !!         balance).
-      !!      * nonlinear free surface (variable volume, lk_vvl)
-      !!         contrary to the linear free surface case, Fwi is properly 
-      !!         taken into account by using the true layer thicknesses to       
-      !!         calculate tracer content and advection. There is no need to 
-      !!         deal with it in this routine.
-      !!           - temperature: Fwe=SST (P-E+R) is added to Fext.
-      !!           - salinity:  Fwe = 0, there is no surface flux of salt.
-      !!
-      !! ** Action  : - Update the 1st level of (ta,sa) with the trend associated
-      !!                with the tracer surface boundary condition 
-      !!              - send trends to trdtra module (l_trdtra=T)
+      !! ** Action  : - Update tsa with the surface boundary condition trend 
+      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T)
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices  
-      INTEGER  ::   ikt, ikb 
-      INTEGER  ::   nk_isf
-      REAL(wp) ::   zfact, z1_e3t, zdep
-      REAL(wp) ::   zalpha, zhk
+      !
+      INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices  
+      INTEGER  ::   ikt, ikb              ! local integers
+      REAL(wp) ::   zfact, z1_e3t, zdep   ! local scalar
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -130,5 +85,5 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
       ENDIF
-
+      !
       IF( l_trdtra ) THEN                    !* Save ta and sa trends
          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
@@ -136,9 +91,9 @@
          ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
-
-!!gm      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration
+      !
+!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
       IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
          qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
-         qsr(:,:) = 0.e0                     ! qsr set to zero
+         qsr(:,:) = 0._wp                     ! qsr set to zero
       ENDIF
 
@@ -146,71 +101,52 @@
       !        EMP, SFX and QNS effects
       !----------------------------------------
-      !                                          Set before sbc tracer content fields
-      !                                          ************************************
-      IF( kt == nit000 ) THEN                      ! Set the forcing field at nit000 - 1
-         !                                         ! -----------------------------------
-         IF( ln_rstart .AND.    &                     ! Restart: read in restart file
+      !                             !==  Set before sbc tracer content fields  ==!
+      IF( kt == nit000 ) THEN             !* 1st time-step
+         IF( ln_rstart .AND.    &               ! Restart: read in restart file
               & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
-            IF(lwp) WRITE(numout,*) '          nit000-1 surface tracer content forcing fields red in the restart file'
+            IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file'
             zfact = 0.5_wp
             CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend
             CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend
-         ELSE                                         ! No restart or restart not found: Euler forward time stepping
+         ELSE                                   ! No restart or restart not found: Euler forward time stepping
             zfact = 1._wp
+            sbc_tsc(:,:,:) = 0._wp
             sbc_tsc_b(:,:,:) = 0._wp
          ENDIF
-      ELSE                                         ! Swap of forcing fields
-         !                                         ! ----------------------
+      ELSE                                !* other time-steps: swap of forcing fields
          zfact = 0.5_wp
          sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
       ENDIF
-      !                                          Compute now sbc tracer content fields
-      !                                          *************************************
-
-                                                   ! Concentration dilution effect on (t,s) due to  
-                                                   ! evaporation, precipitation and qns, but not river runoff 
-                                               
-      IF( lk_vvl ) THEN                            ! Variable Volume case  ==>> heat content of mass flux is in qns
-         DO jj = 1, jpj
-            DO ji = 1, jpi 
-               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)                              ! non solar heat flux
-               sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)                              ! salt flux due to freezing/melting
+      !                             !==  Now sbc tracer content fields  ==!
+      DO jj = 2, jpj
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux
+            sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)   ! salt flux due to freezing/melting
+         END DO
+      END DO
+      IF( ln_linssh ) THEN                !* linear free surface  
+         DO jj = 2, jpj                         !==>> add concentration/dilution effect due to constant volume cell
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_tem)
+               sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_sal)
             END DO
-         END DO
-      ELSE                                         ! Constant Volume case ==>> Concentration dilution effect
+         END DO                                 !==>> output c./d. term
+         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )
+         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )
+      ENDIF
+      !
+      DO jn = 1, jpts               !==  update tracer trend  ==!
          DO jj = 2, jpj
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! temperature : heat flux
-               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)                          &   ! non solar heat flux
-                  &                  + r1_rau0     * emp(ji,jj)  * tsn(ji,jj,1,jp_tem)       ! concent./dilut. effect
-               ! salinity    : salt flux + concent./dilut. effect (both in sfx)
-               sbc_tsc(ji,jj,jp_sal) = r1_rau0  * (  sfx(ji,jj)                          &   ! salt flux (freezing/melting)
-                  &                                + emp(ji,jj) * tsn(ji,jj,1,jp_sal) )      ! concent./dilut. effect
+            DO ji = fs_2, fs_jpim1   ! vector opt.  
+               tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t_n(ji,jj,1)
             END DO
          END DO
-         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )   ! c/d term on sst
-         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )   ! c/d term on sss
-      ENDIF
-      ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff  
-      DO jn = 1, jpts
-         DO jj = 2, jpj
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               z1_e3t = zfact / fse3t(ji,jj,1)
-               tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) * z1_e3t
-            END DO
-         END DO
       END DO
-      !                                          Write in the ocean restart file
-      !                                          *******************************
-      IF( lrst_oce ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in ocean restart file ',   &
-            &                    'at it= ', kt,' date= ', ndastp
-         IF(lwp) WRITE(numout,*) '~~~~'
+      !                  
+      IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==!
          CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
          CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) )
       ENDIF
       !
-      !
       !----------------------------------------
       !       Ice Shelf effects (ISF)
@@ -218,39 +154,33 @@
       !----------------------------------------
       !
-      IF( nn_isf > 0 ) THEN
-         zfact = 0.5e0
+!!gm BUG ?   Why no differences between non-linear and linear free surface ?
+!!gm         probably taken into account in r1_hisf_tbl : to be verified
+      IF( ln_isf ) THEN
+         zfact = 0.5_wp
          DO jj = 2, jpj
             DO ji = fs_2, fs_jpim1
-         
+               !
                ikt = misfkt(ji,jj)
                ikb = misfkb(ji,jj)
-   
+               !
                ! level fully include in the ice shelf boundary layer
-               ! if isfdiv, we have to remove heat flux due to inflow at 0oC (as in rnf when you add rnf at sst)
                ! sign - because fwf sign of evapo (rnf sign of precip)
                DO jk = ikt, ikb - 1
-               ! compute tfreez for the temperature correction (we add water at freezing temperature)
                ! 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)) * 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)
+                  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) )             &
+                     &           * r1_hisf_tbl(ji,jj)
                END DO
    
                ! level partially include in ice shelf boundary layer 
-               ! compute tfreez for the temperature correction (we add water at freezing temperature)
                ! 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)) * 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) 
+               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) )             &
+                  &              * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
+
             END DO
          END DO
          IF( lrst_oce ) THEN
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'sbc : isf surface tracer content forcing fields written in ocean restart file ',   &
-               &                    'at it= ', kt,' date= ', ndastp
-            IF(lwp) WRITE(numout,*) '~~~~'
-            CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:)          )
+            CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf  (:,:)        )
             CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) )
             CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) )
@@ -269,8 +199,8 @@
                   zdep = zfact / h_rnf(ji,jj)
                   DO jk = 1, nk_rnf(ji,jj)
-                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
-                                          &               +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
-                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
-                                          &               +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
+                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                 &
+                                           &                 +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
+                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)                                 &
+                                           &                 +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
                   END DO
                ENDIF
@@ -278,6 +208,28 @@
          END DO  
       ENDIF
- 
-      IF( l_trdtra )   THEN                      ! send trends for further diagnostics
+
+      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*tsn(:,:,1,jp_tem) )   ! runoff term on sst
+      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*tsn(:,:,1,jp_sal) )   ! runoff term on sss
+
+      !
+      !----------------------------------------
+      !        Ice Sheet coupling imbalance correction to have conservation
+      !----------------------------------------
+      !
+      IF( ln_iscpl .AND. ln_hsb) THEN         ! input of heat and salt due to river runoff 
+         DO jk = 1,jpk
+            DO jj = 2, jpj 
+               DO ji = fs_2, fs_jpim1
+                  zdep = 1._wp / e3t_n(ji,jj,jk) 
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - htsc_iscpl(ji,jj,jk,jp_tem)                       &
+                      &                                         * zdep
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - htsc_iscpl(ji,jj,jk,jp_sal)                       &
+                      &                                         * zdep  
+               END DO  
+            END DO  
+         END DO
+      ENDIF
+
+      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 7351)
@@ -9,28 +9,26 @@
 
    !!----------------------------------------------------------------------
-   !!   tra_zdf      : Update the tracer trend with the vertical diffusion
-   !!   tra_zdf_init : initialisation of the computation
+   !!   tra_zdf       : Update the tracer trend with the vertical diffusion
+   !!   tra_zdf_init  : initialisation of the computation
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE domvvl          ! variable volume
-   USE phycst          ! physical constant
-   USE zdf_oce         ! ocean vertical physics variables
-   USE sbc_oce         ! surface boundary condition: ocean
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE domvvl         ! variable volume
+   USE phycst         ! physical constant
+   USE zdf_oce        ! ocean vertical physics variables
+   USE sbc_oce        ! surface boundary condition: ocean
+   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 trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends: tracer trend manager
    !
-   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 trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
-   !
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -43,5 +41,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
@@ -60,5 +57,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!
+      !
       INTEGER  ::   jk                   ! Dummy loop indices
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace
@@ -68,9 +65,9 @@
       !
       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
-         r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping)
+         r2dt =  rdt                          ! = rdt (restarting with Euler time stepping)
       ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
-         r2dtra(:) = 2. * rdttra(:)                      ! = 2 rdttra (leapfrog)
+         r2dt = 2. * rdt                      ! = 2 rdt (leapfrog)
       ENDIF
-
+      !
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
@@ -78,8 +75,8 @@
          ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
-
+      !
       SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
-      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 ( 0 )    ;    CALL tra_zdf_exp( kt, nit000, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme 
+      CASE ( 1 )    ;    CALL tra_zdf_imp( kt, nit000, 'TRA', r2dt,            tsb, tsa, jpts )  !   implicit scheme 
       END SELECT
 !!gm WHY here !   and I don't like that !
@@ -87,11 +84,11 @@
       ! 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
+      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
          DO jk = 1, jpkm1
-            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(:,:,jk)
-            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk)
+            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt ) - ztrdt(:,:,jk)
+            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt ) - ztrds(:,:,jk)
          END DO
 !!gm this should be moved in trdtra.F90 and done on all trends
@@ -103,5 +100,4 @@
          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=' zdf  - Ta: ', mask1=tmask,               &
@@ -128,10 +124,10 @@
       USE zdfgls
       !!----------------------------------------------------------------------
-
+      !
       ! Choice from ln_zdfexp already read in namelist in zdfini module
       IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme
       ELSE                   ;   nzdf = 1           ! use implicit scheme
       ENDIF
-
+      !
       ! Force implicit schemes
       IF( lk_zdftke .OR. lk_zdfgls   )   nzdf = 1   ! TKE, or GLS physics
@@ -140,5 +136,5 @@
       IF( ln_zdfexp .AND. nzdf == 1 )   CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator',   &
             &                         ' GLS or TKE scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
-
+            !
       IF(lwp) THEN
          WRITE(numout,*)
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 7351)
@@ -20,17 +20,18 @@
 
    !!----------------------------------------------------------------------
-   !!   tra_zdf_exp  : compute the tracer the vertical diffusion trend using a
-   !!                  split-explicit time stepping and provide the after tracer
+   !!   tra_zdf_exp   : compute the tracer the vertical diffusion trend using a
+   !!                   split-explicit time stepping and provide the after tracer
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers 
-   USE dom_oce         ! ocean space and time domain 
-   USE domvvl          ! variable volume levels
-   USE zdf_oce         ! ocean vertical physics
-   USE zdfddm          ! ocean vertical physics: double diffusion
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   USE oce            ! ocean dynamics and active tracers 
+   USE dom_oce        ! ocean space and time domain 
+   USE domvvl         ! variable volume levels
+   USE zdf_oce        ! ocean vertical physics
+   USE zdfddm         ! ocean vertical physics: double diffusion
+   USE trc_oce        ! share passive tracers/Ocean variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -40,5 +41,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
@@ -50,6 +50,6 @@
 CONTAINS
 
-   SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, kn_zdfexp,   &
-      &                                ptb , pta      , kjpt )
+   SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, ksts,   &
+      &                                        ptb , pta , kjpt )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_zdf_exp  ***
@@ -60,5 +60,5 @@
       !! ** Method  : - The after tracer fields due to the vertical diffusion
       !!      of tracers alone is given by:
-      !!                zwx = ptb + p2dt difft
+      !!                ztb = ptb + p2dt difft
       !!      where difft = dz( avt dz(ptb) ) = 1/e3t dk+1( avt/e3w dk(ptb) )
       !!           (if lk_zdfddm=T use avs on salinity and passive tracers instead of avt)
@@ -67,33 +67,28 @@
       !!      (N.B. bottom condition is applied through the masked field avt).
       !!              - the after tracer fields due to the whole trend is 
-      !!      obtained in leap-frog environment by :
-      !!          pta = zwx + p2dt pta
-      !!              - in case of variable level thickness (lk_vvl=T) the 
-      !!     the leap-frog is applied on thickness weighted tracer. That is:
-      !!          pta = [ ptb*e3tb + e3tn*( zwx - ptb + p2dt pta ) ] / e3tn
+      !!      obtained in leap-frog environment applied on thickness weighted tracer by :
+      !!          pta = [ ptb*e3tb + e3tn*( ztb - ptb + p2dt pta ) ] / e3tn
       !!
       !! ** Action : - after tracer fields pta
       !!---------------------------------------------------------------------
+      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   ) ::   ksts     ! number of sub-time step
+      REAL(wp)                             , INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! in: tracer trend ; out: after tracer field 
       !
-      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_zdfexp   ! number of sub-time step
-      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt        ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb         ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta         ! tracer trend 
-      !
-      INTEGER  ::  ji, jj, jk, jn, jl        ! dummy loop indices
-      REAL(wp) ::  zlavmr, zave3r, ze3tr     ! local scalars
-      REAL(wp) ::  ztra, ze3tb               !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwx, zwy
+      INTEGER  ::  ji, jj, jk, jn, jl   ! dummy loop indices
+      REAL(wp) ::  z1_ksts, ze3tr       ! local scalars
+      REAL(wp) ::  ztra, ze3tb    !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztb, zwf
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_zdf_exp')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zwx, zwy ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   ztb, zwf ) 
       !
-
       IF( kt == kit000 )  THEN
          IF(lwp) WRITE(numout,*)
@@ -104,27 +99,22 @@
       ! Initializations
       ! ---------------
-      zlavmr = 1. / float( kn_zdfexp )         ! Local constant
+      z1_ksts = 1._wp / REAL( ksts, wp )
+      zwf(:,:, 1 ) = 0._wp    ! no flux at the surface and at bottom level
+      zwf(:,:,jpk) = 0._wp
       !
       !
-      DO jn = 1, kjpt                          ! loop over tracers
+      DO jn = 1, kjpt         !==  loop over tracers  ==!
          !
-         zwy(:,:, 1 ) = 0.e0     ! surface boundary conditions: no flux
-         zwy(:,:,jpk) = 0.e0     ! bottom  boundary conditions: no flux
-         !
-         zwx(:,:,:)   = ptb(:,:,:,jn)  ! zwx array set to before tracer values
-
-         ! Split-explicit loop  (after tracer due to the vertical diffusion alone)
-         ! -------------------
-         !
-         DO jl = 1, kn_zdfexp
-            !                     ! first vertical derivative
-            DO jk = 2, jpk
+         ztb(:,:,:) = ptb(:,:,:,jn)    ! initial before value for tracer
+         ! 
+         DO jl = 1, ksts         !==  Split-explicit loop  ==!
+            !              
+            DO jk = 2, jpk             ! 1st vertical derivative (w-flux)
                DO jj = 2, jpjm1 
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zave3r = 1.e0 / fse3w_n(ji,jj,jk) 
                      IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN  ! temperature : use of avt
-                        zwy(ji,jj,jk) =   avt(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r
+                        zwf(ji,jj,jk) =   avt(ji,jj,jk) * ( ztb(ji,jj,jk-1) - ztb(ji,jj,jk) ) / e3w_b(ji,jj,jk)
                      ELSE                                           ! salinity or pass. tracer : use of avs
-                        zwy(ji,jj,jk) = fsavs(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r
+                        zwf(ji,jj,jk) = fsavs(ji,jj,jk) * ( ztb(ji,jj,jk-1) - ztb(ji,jj,jk) ) / e3w_b(ji,jj,jk)
                      END IF
                   END DO
@@ -132,40 +122,27 @@
             END DO
             !
-            DO jk = 1, jpkm1      ! second vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
+            DO jk = 1, jpkm1           ! 2nd vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
                DO jj = 2, jpjm1 
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3tr = zlavmr / fse3t_n(ji,jj,jk)
-                     zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt(jk) * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * ze3tr
+                     ztb(ji,jj,jk) = ztb(ji,jj,jk) + p2dt * ( zwf(ji,jj,jk) - zwf(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
                   END DO
                END DO
             END DO
             !
-         END DO
+         END DO                  ! end sub-time stepping
 
-         ! After tracer due to all trends
-         ! ------------------------------
-         IF( lk_vvl ) THEN          ! variable level thickness : leap-frog on tracer*e3t
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3tb = fse3t_b(ji,jj,jk) / fse3t(ji,jj,jk)                          ! before e3t
-                     ztra  = zwx(ji,jj,jk) - ptb(ji,jj,jk,jn) + p2dt(jk) * pta(ji,jj,jk,jn)       ! total trends * 2*rdt 
-                     pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk)
-                  END DO
+         DO jk = 1, jpkm1        !==  After tracer due to all trends
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ze3tb = e3t_b(ji,jj,jk) / e3t_n(ji,jj,jk)
+                  ztra  = ( ztb(ji,jj,jk) - ptb(ji,jj,jk,jn) ) + p2dt * pta(ji,jj,jk,jn)  ! total trend * 2dt 
+                  pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk)    ! after tracer
                END DO
             END DO
-         ELSE                       ! fixed level thickness : leap-frog on tracers
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     pta(ji,jj,jk,jn) = ( zwx(ji,jj,jk) + p2dt(jk) * pta(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
+         END DO
          !
-      END DO
+      END DO                     ! end of tracer loop
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zwx, zwy ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,   ztb, zwf ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_exp')
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 7351)
@@ -16,8 +16,9 @@
    !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
    !!             -   !  2011-02  (A. Coward, C. Ethe, G. Madec) improvment of surface boundary condition
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  non linear free surface by default 
    !!----------------------------------------------------------------------
   
    !!----------------------------------------------------------------------
-   !!   tra_zdf_imp   : Update the tracer trend with the diagonal vertical part of the mixing tensor.
+   !!   tra_zdf_imp   : Update the tracer trend with vertical mixing, nad compute the after tracer field
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers variables
@@ -42,8 +43,5 @@
    PUBLIC   tra_zdf_imp   !  routine called by step.F90
 
-   REAL(wp) ::  r_vvl     ! variable volume indicator, =1 if lk_vvl=T, =0 otherwise 
-
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
@@ -64,7 +62,8 @@
       !!     it is already computed and add to the general trend in traldf) 
       !!
-      !! ** Method  :  The vertical diffusion of the tracer t  is given by:
-      !!                  difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
-      !!      It is computed using a backward time scheme (t=ta).
+      !! ** Method  :  The vertical diffusion of a tracer ,t , is given by:
+      !!          difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
+      !!      It is computed using a backward time scheme (t=after field)
+      !!      which provide directly the after tracer field.
       !!      If lk_zdfddm=T, use avs for salinity or for passive tracers
       !!      Surface and bottom boundary conditions: no diffusive flux on
@@ -75,13 +74,13 @@
       !!---------------------------------------------------------------------
       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(        jpk     ), INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step
+      REAL(wp)                             , INTENT(in   ) ::   p2dt     ! tracer time-step
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! in: tracer trend ; out: after tracer field
       !
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::  zrhs, ze3tb, ze3tn, ze3ta   ! local scalars
+      REAL(wp) ::  zrhs             ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt, zwd, zws
       !!---------------------------------------------------------------------
@@ -95,14 +94,8 @@
          IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype
          IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ '
-         !
-         IF( lk_vvl ) THEN   ;    r_vvl = 1._wp       ! Variable volume indicator
-         ELSE                ;    r_vvl = 0._wp       
-         ENDIF
       ENDIF
-      !
       !                                               ! ============= !
       DO jn = 1, kjpt                                 !  tracer loop  !
          !                                            ! ============= !
-         !
          !  Matrix construction
          ! --------------------
@@ -142,9 +135,8 @@
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ta =  ( 1. - r_vvl ) +        r_vvl   * fse3t_a(ji,jj,jk)   ! after scale factor at T-point
-                     ze3tn =         r_vvl   + ( 1. - r_vvl ) * fse3t_n(ji,jj,jk)   ! now   scale factor at T-point
-                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) )
-                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) )
-                     zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk)
+!!gm BUG  I think, use e3w_a instead of e3w_n
+                     zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w_n(ji,jj,jk  )
+                     zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1)
+                     zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zwi(ji,jj,jk) - zws(ji,jj,jk)
                  END DO
                END DO
@@ -170,8 +162,6 @@
             !   used as a work space array: its value is modified.
             !
-            ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
-            ! done once for all passive tracers (so included in the IF instruction)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
+            DO jj = 2, jpjm1        !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
+               DO ji = fs_2, fs_jpim1            ! done one for all passive tracers (so included in the IF instruction)
                   zwt(ji,jj,1) = zwd(ji,jj,1)
                END DO
@@ -185,12 +175,9 @@
             END DO
             !
-         END IF 
+         ENDIF 
          !         
-         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-         DO jj = 2, jpjm1
+         DO jj = 2, jpjm1           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
             DO ji = fs_2, fs_jpim1
-               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) = e3t_b(ji,jj,1) * ptb(ji,jj,1,jn) + p2dt * e3t_n(ji,jj,1) * pta(ji,jj,1,jn)
             END DO
          END DO
@@ -198,14 +185,11 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1
-                  ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,jk)
-                  ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t  (ji,jj,jk)
-                  zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn)   ! zrhs=right hand side 
+                  zrhs = e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * e3t_n(ji,jj,jk) * pta(ji,jj,jk,jn)   ! zrhs=right hand side
                   pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn)
                END DO
             END DO
          END DO
-
-         ! third recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
-         DO jj = 2, jpjm1
+         !
+         DO jj = 2, jpjm1           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
             DO ji = fs_2, fs_jpim1
                pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
Index: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
===================================================================
--- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 7350)
+++ branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 7351)
@@ -32,5 +32,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -111,10 +110,11 @@
                iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
                ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
-               ze3wu = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
-               ze3wv = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+!!gm BUG ? when applied to before fields, e3w_b should be used....
+               ze3wu = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
+               ze3wv = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
                !
                ! i- direction
                IF( ze3wu >= 0._wp ) THEN      ! case 1
-                  zmaxu =  ze3wu / fse3w(ji+1,jj,iku)
+                  zmaxu =  ze3wu / e3w_n(ji+1,jj,iku)
                   ! interpolated values of tracers
                   zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
@@ -122,5 +122,5 @@
                   pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
                ELSE                           ! case 2
-                  zmaxu = -ze3wu / fse3w(ji,jj,iku)
+                  zmaxu = -ze3wu / e3w_n(ji,jj,iku)
                   ! interpolated values of tracers
                   zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
@@ -131,5 +131,5 @@
                ! j- direction
                IF( ze3wv >= 0._wp ) THEN      ! case 1
-                  zmaxv =  ze3wv / fse3w(ji,jj+1,ikv)
+                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikv)
                   ! interpolated values of tracers
                   ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
@@ -137,5 +137,5 @@
                   pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
                ELSE                           ! case 2
-                  zmaxv =  -ze3wv / fse3w(ji,jj,ikv)
+                  zmaxv =  -ze3wv / e3w_n(ji,jj,ikv)
                   ! interpolated values of tracers
                   ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
@@ -156,11 +156,11 @@
                iku = mbku(ji,jj)
                ikv = mbkv(ji,jj)
-               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
-               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
-               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji  ,jj,iku)     ! i-direction: case 1
-               ELSE                        ;   zhi(ji,jj) = fsdept(ji+1,jj,iku)     ! -     -      case 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv)     ! j-direction: case 1
-               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv)     ! -     -      case 2
+               ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
+               ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)     ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)     ! -     -      case 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)     ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)     ! -     -      case 2
                ENDIF
             END DO
@@ -174,6 +174,6 @@
                iku = mbku(ji,jj)
                ikv = mbkv(ji,jj)
-               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
-               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+               ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
+               ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
                IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1
                ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2
@@ -191,20 +191,19 @@
       !
    END SUBROUTINE zps_hde
-
-
-   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  ***
+   !
+   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi,  &
+      &                          prd, pgru, pgrv, pgrui, pgrvi )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE zps_hde_isf  ***
       !!                    
       !! ** Purpose :   Compute the horizontal derivative of T, S and rho
       !!      at u- and v-points with a linear interpolation for z-coordinate
-      !!      with partial steps.
+      !!      with partial steps for top (ice shelf) and bottom.
       !!
       !! ** Method  :   In z-coord with partial steps, scale factors on last 
       !!      levels are different for each grid point, so that T, S and rd 
       !!      points are not at the same depth as in z-coord. To have horizontal
-      !!      gradients again, we interpolate T and S at the good depth : 
+      !!      gradients again, we interpolate T and S at the good depth :
+      !!      For the bottom case:
       !!      Linear interpolation of T, S   
       !!         Computation of di(tb) and dj(tb) by vertical interpolation:
@@ -235,31 +234,22 @@
       !!          di(rho) = rd~ - rd(i,j,k)   or   rd(i+1,j,k) - rd~
       !!
+      !!      For the top case (ice shelf): As for the bottom case but upside down
+      !!
       !! ** Action  : compute for top and bottom interfaces
       !!              - pgtu, pgtv, pgtui, pgtvi: horizontal gradient of tracer at u- & v-points
       !!              - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points
-      !!              - pmru, pmrv, pmrui, pmrvi: horizontal sum of rho at u- & v- point (used in dynhpg with vvl)
-      !!              - pgzu, pgzv, pgzui, pgzvi: horizontal gradient of z at u- and v- point (used in dynhpg with vvl)
-      !!              - 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
-      !                                                              !!  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                              , 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 ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top)
       !
       INTEGER  ::   ji, jj, jn      ! Dummy loop indices
       INTEGER  ::   iku, ikv, ikum1, ikvm1,ikup1, ikvp1   ! partial step level (ocean bottom level) at u- and v-points
-      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv, zdzwu, zdzwv, zdzwuip1, zdzwvjp1  ! temporary scalars
+      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             ! 
@@ -277,45 +267,142 @@
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
-               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
-               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
+
+               iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
+               ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
+               ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku)
+               ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)
+               !
+               ! i- direction
+               IF( ze3wu >= 0._wp ) THEN      ! case 1
+                  zmaxu =  ze3wu / e3w_n(ji+1,jj,iku)
+                  ! interpolated values of tracers
+                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+                  ! gradient of  tracers
+                  pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+               ELSE                           ! case 2
+                  zmaxu = -ze3wu / e3w_n(ji,jj,iku)
+                  ! interpolated values of tracers
+                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
+                  ! gradient of tracers
+                  pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+               ENDIF
+               !
+               ! j- direction
+               IF( ze3wv >= 0._wp ) THEN      ! case 1
+                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikv)
+                  ! interpolated values of tracers
+                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+               ELSE                           ! case 2
+                  zmaxv =  -ze3wv / e3w_n(ji,jj,ikv)
+                  ! interpolated values of tracers
+                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+               ENDIF
+
+            END DO
+         END DO
+         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
+         !
+      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 ; 
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku)
+               ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)
+               !
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)    ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)    ! -     -      case 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)    ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)    ! -     -      case 2
+               ENDIF
+
+            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 )
+
+         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
+            DO ji = 1, jpim1
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku)
+               ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)
+
+               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1
+               ELSE                        ;   pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1
+               ELSE                        ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2
+               ENDIF
+
+            END DO
+         END DO
+
+         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions
+         !
+      END IF
+      !
+      !     !==  (ISH)  compute grui and gruvi  ==!
+      !
+      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1
+               ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1
+               !
                ! (ISF) case partial step top and bottom in adjacent cell in vertical
                ! cannot used e3w because if 2 cell water column, we have ps at top and bottom
                ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj
                ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0
-               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))
-               !
+               ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku)
+               ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) 
+
                ! i- direction
                IF( ze3wu >= 0._wp ) THEN      ! case 1
-                  zmaxu =  ze3wu / fse3w(ji+1,jj,iku)
-                  ! interpolated values of tracers
-                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+                  zmaxu = ze3wu / e3w_n(ji+1,jj,ikup1)
+                  ! interpolated values of tracers
+                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) )
+                  ! gradient of tracers
+                  pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+               ELSE                           ! case 2
+                  zmaxu = - ze3wu / e3w_n(ji,jj,ikup1)
+                  ! interpolated values of tracers
+                  zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) )
                   ! gradient of  tracers
-                  pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
-               ELSE                           ! case 2
-                  zmaxu = -ze3wu / fse3w(ji,jj,iku)
-                  ! interpolated values of tracers
-                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
-                  ! gradient of tracers
-                  pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+                  pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
                ENDIF
                !
                ! j- direction
                IF( ze3wv >= 0._wp ) THEN      ! case 1
-                  zmaxv =  ze3wv / fse3w(ji,jj+1,ikv)
-                  ! interpolated values of tracers
-                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
-                  ! gradient of tracers
-                  pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
-               ELSE                           ! case 2
-                  zmaxv =  -ze3wv / fse3w(ji,jj,ikv)
-                  ! interpolated values of tracers
-                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
-                  ! gradient of tracers
-                  pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
-               ENDIF
-            END DO
-         END DO
-         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
+                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikvp1)
+                  ! interpolated values of tracers
+                  ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) )
+                  ! gradient of tracers
+                  pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+               ELSE                           ! case 2
+                  zmaxv =  - ze3wv / e3w_n(ji,jj,ikvp1)
+                  ! interpolated values of tracers
+                  ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) )
+                  ! gradient of tracers
+                  pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+               ENDIF
+
+            END DO
+         END DO
+         CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. ); CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
          !
       END DO
@@ -323,22 +410,21 @@
       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)
-               ikv = mbkv(ji,jj)
-               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
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv) - ze3wv    ! j-direction: case 1
-               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv) + ze3wv    ! -     -      case 2
-               ENDIF
+         pgrui(:,:)  =0.0_wp; pgrvi(:,:)  =0.0_wp;
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+
+               iku = miku(ji,jj)
+               ikv = mikv(ji,jj)
+               ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku)
+               ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) 
+               !
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)    ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)    ! -     -      case 2
+               ENDIF
+
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)    ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)    ! -     -      case 2
+               ENDIF
+
             END DO
          END DO
@@ -346,168 +432,22 @@
          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
-               ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 )    ! last and before last ocean level at u- & v-points
-               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 
-                  pgzu(ji,jj) = (fsde3w(ji+1,jj,iku) - ze3wu) - fsde3w(ji,jj,iku)
-                  pgru(ji,jj) = umask(ji,jj,iku) * ( zri(ji  ,jj) - prd(ji,jj,iku) )   ! i: 1
-                  pmru(ji,jj) = umask(ji,jj,iku) * ( zri(ji  ,jj) + prd(ji,jj,iku) )   ! i: 1 
-                  pge3ru(ji,jj) = umask(ji,jj,iku)                                                                  &
-                                * ( (fse3w(ji+1,jj,iku) - ze3wu )* ( zri(ji  ,jj    ) + prd(ji+1,jj,ikum1) + 2._wp) &
-                                   - fse3w(ji  ,jj,iku)          * ( prd(ji  ,jj,iku) + prd(ji  ,jj,ikum1) + 2._wp) )  ! j: 2
-               ELSE  
-                  pgzu(ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) + ze3wu)
-                  pgru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) )   ! i: 2
-                  pmru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) )   ! i: 2
-                  pge3ru(ji,jj) = umask(ji,jj,iku)                                                                  &
-                                * (  fse3w(ji+1,jj,iku)          * ( prd(ji+1,jj,iku) + prd(ji+1,jj,ikum1) + 2._wp) &
-                                   -(fse3w(ji  ,jj,iku) + ze3wu) * ( zri(ji  ,jj    ) + prd(ji  ,jj,ikum1) + 2._wp) )  ! j: 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN
-                  pgzv(ji,jj) = (fsde3w(ji,jj+1,ikv) - ze3wv) - fsde3w(ji,jj,ikv) 
-                  pgrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )   ! j: 1
-                  pmrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj  ) + prd(ji,jj,ikv) )   ! j: 1
-                  pge3rv(ji,jj) = vmask(ji,jj,ikv)                                                                  &
-                                * ( (fse3w(ji,jj+1,ikv) - ze3wv )* ( zrj(ji,jj      ) + prd(ji,jj+1,ikvm1) + 2._wp) &
-                                   - fse3w(ji,jj  ,ikv)          * ( prd(ji,jj  ,ikv) + prd(ji,jj  ,ikvm1) + 2._wp) )  ! j: 2
-               ELSE 
-                  pgzv(ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) + ze3wv)
-                  pgrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )   ! j: 2
-                  pmrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) )   ! j: 2
-                  pge3rv(ji,jj) = vmask(ji,jj,ikv)                                                                  &
-                                * (  fse3w(ji,jj+1,ikv)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikvm1) + 2._wp) &
-                                   -(fse3w(ji,jj  ,ikv) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikvm1) + 2._wp) )  ! j: 2
-               ENDIF
-            END DO
-         END DO
-         CALL lbc_lnk( pgru   , 'U', -1. )   ;   CALL lbc_lnk( pgrv   , 'V', -1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( pmru   , 'U',  1. )   ;   CALL lbc_lnk( pmrv   , 'V',  1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( pgzu   , 'U', -1. )   ;   CALL lbc_lnk( pgzv   , 'V', -1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( pge3ru , 'U', -1. )   ;   CALL lbc_lnk( pge3rv , 'V', -1. )   ! Lateral boundary conditions
-         !
-      END IF
-      !
-      !     !==  (ISH)  compute grui and gruvi  ==!
-      !
-      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               iku = miku(ji,jj)   ;  ikup1 = miku(ji,jj) + 1
-               ikv = mikv(ji,jj)   ;  ikvp1 = mikv(ji,jj) + 1
-               !
-               ! (ISF) case partial step top and bottom in adjacent cell in vertical
-               ! cannot used e3w because if 2 cell water column, we have ps at top and bottom
-               ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj
-               ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0
-               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))
-               ! i- direction
-               IF( ze3wu >= 0._wp ) THEN      ! case 1
-                  zmaxu = ze3wu / fse3w(ji+1,jj,iku+1)
-                  ! interpolated values of tracers
-                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku+1,jn) - pta(ji+1,jj,iku,jn) )
-                  ! gradient of tracers
-                  pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
-               ELSE                           ! case 2
-                  zmaxu = - ze3wu / fse3w(ji,jj,iku+1)
-                  ! interpolated values of tracers
-                  zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku+1,jn) - pta(ji,jj,iku,jn) )
-                  ! gradient of  tracers
-                  pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
-               ENDIF
-               !
-               ! j- direction
-               IF( ze3wv >= 0._wp ) THEN      ! case 1
-                  zmaxv =  ze3wv / fse3w(ji,jj+1,ikv+1)
-                  ! interpolated values of tracers
-                  ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv+1,jn) - pta(ji,jj+1,ikv,jn) )
-                  ! gradient of tracers
-                  pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
-               ELSE                           ! case 2
-                  zmaxv =  - ze3wv / fse3w(ji,jj,ikv+1)
-                  ! interpolated values of tracers
-                  ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv+1,jn) - pta(ji,jj,ikv,jn) )
-                  ! gradient of tracers
-                  pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
-               ENDIF
-            END DO!!
-         END DO!!
-         CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
-         !
-      END DO
-
-      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        ! depth of the partial step level
-            DO ji = 1, jpim1
-               iku = miku(ji,jj)
-               ikv = mikv(ji,jj)
-               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
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv) + ze3wv    ! j-direction: case 1
-               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv) - ze3wv    ! -     -      case 2
-               ENDIF
-            END DO
-         END DO
-         !
-         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
-               ikv = mikv(ji,jj) ; ikvp1 = mikv(ji,jj) + 1
-               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
-                 pgzui  (ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku)
-                 pgrui  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) - prd(ji,jj,iku) )          ! i: 1
-                 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
-               ELSE
-                 pgzui  (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu)
-                 pgrui  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) - zri(ji,jj) )      ! i: 2
-                 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
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN
-                 pgzvi  (ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv) 
-                 pgrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )        ! j: 1
-                 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
-                                  ! + 2 due to the formulation in density and not in anomalie in hpg sco
-               ELSE
-                 pgzvi  (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv)
-                 pgrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )     ! j: 2
-                 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
-               ENDIF
-            END DO
-         END DO
-         CALL lbc_lnk( pgrui   , 'U', -1. )   ;   CALL lbc_lnk( pgrvi   , 'V', -1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( pmrui   , 'U',  1. )   ;   CALL lbc_lnk( pmrvi   , 'V',  1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( pgzui   , 'U', -1. )   ;   CALL lbc_lnk( pgzvi   , 'V', -1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( pge3rui , 'U', -1. )   ;   CALL lbc_lnk( pge3rvi , 'V', -1. )   ! Lateral boundary conditions
+               iku = miku(ji,jj) 
+               ikv = mikv(ji,jj) 
+               ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku)
+               ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) 
+
+               IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj      ) - prd(ji,jj,iku) ) ! i: 1
+               ELSE                      ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj  ,iku) - zri(ji,jj    ) ) ! i: 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji  ,jj      ) - prd(ji,jj,ikv) ) ! j: 1
+               ELSE                      ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji  ,jj+1,ikv) - zrj(ji,jj    ) ) ! j: 2
+               ENDIF
+
+            END DO
+         END DO
+         CALL lbc_lnk( pgrui   , 'U', -1. ); CALL lbc_lnk( pgrvi   , 'V', -1. )   ! Lateral boundary conditions
          !
       END IF  
