Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv.F90	(revision 2024)
@@ -4,5 +4,6 @@
    !! Ocean active tracers:  advection trend 
    !!==============================================================================
-   !! History :  2.0  !  05-11  (G. Madec)  Original code
+   !! History :  2.0  !  2005-11  (G. Madec)  Original code
+   !!            3.0  !  2008-01  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
    !!----------------------------------------------------------------------
 
@@ -18,7 +19,6 @@
    USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine)
    USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine)
-   USE traadv_qck     !! QUICKEST scheme           (tra_adv_qck    routine)
+   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine)
    USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine)
-   USE trabbl          ! tracers: bottom boundary layer
    USE ldftra_oce      ! lateral diffusion coefficient on tracers
    USE in_out_manager  ! I/O manager
@@ -29,13 +29,14 @@
    PRIVATE
 
-   PUBLIC   tra_adv    ! routine called by step module
+   PUBLIC   tra_adv         ! routine called by step module
+   PUBLIC   tra_adv_init    ! routine called by opa module
  
    !                                                   !!* Namelist namtra_adv *
-   LOGICAL, PUBLIC ::   ln_traadv_cen2   = .TRUE.       ! 2nd order centered scheme flag
-   LOGICAL, PUBLIC ::   ln_traadv_tvd    = .FALSE.      ! TVD scheme flag
-   LOGICAL, PUBLIC ::   ln_traadv_muscl  = .FALSE.      ! MUSCL scheme flag
-   LOGICAL, PUBLIC ::   ln_traadv_muscl2 = .FALSE.      ! MUSCL2 scheme flag
-   LOGICAL, PUBLIC ::   ln_traadv_ubs    = .FALSE.      ! UBS scheme flag
-   LOGICAL, PUBLIC ::   ln_traadv_qck    = .FALSE.      ! QUICKEST scheme flag
+   LOGICAL ::   ln_traadv_cen2   = .TRUE.       ! 2nd order centered scheme flag
+   LOGICAL ::   ln_traadv_tvd    = .FALSE.      ! TVD scheme flag
+   LOGICAL ::   ln_traadv_muscl  = .FALSE.      ! MUSCL scheme flag
+   LOGICAL ::   ln_traadv_muscl2 = .FALSE.      ! MUSCL2 scheme flag
+   LOGICAL ::   ln_traadv_ubs    = .FALSE.      ! UBS scheme flag
+   LOGICAL ::   ln_traadv_qck    = .FALSE.      ! QUICKEST scheme flag
 
    INTEGER ::   nadv   ! choice of the type of advection scheme
@@ -60,58 +61,65 @@
       !! ** Method  : - Update (ua,va) with the advection term following nadv
       !!----------------------------------------------------------------------
-#if ( defined key_trabbl_adv || defined key_traldf_eiv )
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn   ! effective velocity
-#else
-      USE oce, ONLY :                       zun => un       ! the effective velocity is the
-      USE oce, ONLY :                       zvn => vn       ! Eulerian velocity
-      USE oce, ONLY :                       zwn => wn       ! 
-#endif
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL tra_adv_ctl          ! initialisation & control of options
-
-#if defined key_trabbl_adv
-      zun(:,:,:) = un(:,:,:) - u_bbl(:,:,:)          ! add the bbl velocity
-      zvn(:,:,:) = vn(:,:,:) - v_bbl(:,:,:)
-      zwn(:,:,:) = wn(:,:,:) + w_bbl(:,:,:)
-#endif
-      IF( lk_traldf_eiv ) THEN                       ! commpute and add the eiv velocity
-         IF( .NOT. lk_trabbl_adv ) THEN 
-            zun(:,:,:) = un(:,:,:)
-            zvn(:,:,:) = vn(:,:,:)
-            zwn(:,:,:) = wn(:,:,:)
-         ENDIF
-         CALL tra_adv_eiv( kt, zun, zvn, zwn ) 
-      ENDIF
+      INTEGER ::   jk   ! dummy loop index
+      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::  zun, zvn, zwn   ! effective transport
+      !!----------------------------------------------------------------------
+
+      !                                                   ! effective transport
+      DO jk = 1, jpkm1
+         !                                                ! eulerian transport only
+         zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
+         zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk)
+         !
+      END DO
+      zwn(:,:,jpk) = 0.e0                                 ! no transport trough the bottom
+
+      !                                                   ! add the eiv transport (if necessary)
+      IF( lk_traldf_eiv )   CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' )
+
 
       SELECT CASE ( nadv )                           ! compute advection trend and add it to general trend
-      CASE ( 1 )   ;   CALL tra_adv_cen2    ( kt, zun, zvn, zwn )    ! 2nd order centered scheme
-      CASE ( 2 )   ;   CALL tra_adv_tvd     ( kt, zun, zvn, zwn )    ! TVD      scheme
-      CASE ( 3 )   ;   CALL tra_adv_muscl   ( kt, zun, zvn, zwn )    ! MUSCL    scheme
-      CASE ( 4 )   ;   CALL tra_adv_muscl2  ( kt, zun, zvn, zwn )    ! MUSCL2   scheme
-      CASE ( 5 )   ;   CALL tra_adv_ubs     ( kt, zun, zvn, zwn )    ! UBS      scheme
-      CASE ( 6 )   ;   CALL tra_adv_qck     ( kt, zun, zvn, zwn )    ! QUICKEST scheme
+      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt , 'TRA', zun, zvn, zwn, &
+                        &                    tsb, tsn  , tsa, jpts      )    !  2nd order centered scheme
+      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt , 'TRA', zun, zvn, zwn, &
+                        &                    tsb, tsn  , tsa, jpts      )    !  TVD scheme
+      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt , 'TRA', zun, zvn, zwn, &
+                        &                    tsb, tsa  , jpts           )    !  MUSCL scheme
+      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt , 'TRA', zun, zvn, zwn, &
+                        &                    tsb, tsn  , tsa, jpts      )    !  MUSCL2 scheme
+      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt , 'TRA', zun, zvn, zwn, &
+                        &                    tsb, tsn  , tsa, jpts      )    !  UBS scheme
+      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt , 'TRA', zun, zvn, zwn, &
+                        &                    tsb, tsn  , tsa, jpts      )    !  QUICKEST scheme
       !
-      CASE (-1 )                                                     ! esopa: test all possibility with control print
-                       CALL tra_adv_cen2    ( kt, zun, zvn, zwn )
-                       CALL prt_ctl( tab3d_1=ta, clinfo1=' adv0 - Ta: ', mask1=tmask,               &
-            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-                       CALL tra_adv_tvd     ( kt, zun, zvn, zwn )
-                       CALL prt_ctl( tab3d_1=ta, clinfo1=' adv2 - Ta: ', mask1=tmask,               &
-            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-                       CALL tra_adv_muscl   ( kt, zun, zvn, zwn )
-                       CALL prt_ctl( tab3d_1=ta, clinfo1=' adv3 - Ta: ', mask1=tmask,               &
-            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-                       CALL tra_adv_muscl2  ( kt, zun, zvn, zwn )
-                       CALL prt_ctl( tab3d_1=ta, clinfo1=' adv4 - Ta: ', mask1=tmask,               &
-            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-                       CALL tra_adv_ubs     ( kt, zun, zvn, zwn )
-                       CALL prt_ctl( tab3d_1=ta, clinfo1=' adv5 - Ta: ', mask1=tmask,               &
-            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-                       CALL tra_adv_qck     ( kt, zun, zvn, zwn )
-                       CALL prt_ctl( tab3d_1=ta, clinfo1=' adv6 - Ta: ', mask1=tmask,               &
-            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      CASE (-1 )                                   ! esopa: test all possibility with control pr
+                        CALL tra_adv_cen2  ( kt , 'TRA', zun, zvn, zwn, &
+                        &                    tsb, tsn  , tsa, jpts      )          
+                        CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask,               &
+         &                            tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+                        CALL tra_adv_tvd   ( kt , 'TRA', zun, zvn, zwn, &
+                        &                    tsb, tsn  , tsa, jpts      )          
+                        CALL tra_adv_tvd   ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+                        CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask,               &
+         &                            tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+                        CALL tra_adv_muscl ( kt , 'TRA', zun, zvn, zwn, &
+                        &                    tsb, tsa  , jpts           )          
+                        CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask,               &
+         &                            tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+                        CALL tra_adv_muscl2( kt , 'TRA', zun, zvn, zwn, &
+                        &                    tsb, tsn  , tsa, jpts      )          
+                        CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask,               &
+         &                            tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+                        CALL tra_adv_ubs   ( kt , 'TRA', zun, zvn, zwn, &
+                        &                    tsb, tsn  , tsa, jpts      )          
+                        CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask,               &
+         &                            tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+                        CALL tra_adv_qck   ( kt , 'TRA', zun, zvn, zwn, &
+                        &                    tsb, tsn  , tsa, jpts      )          
+                        CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask,               &
+         &                            tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         !
       END SELECT
        
@@ -121,13 +129,13 @@
 
       !                                              ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' adv  - Ta: ', mask1=tmask,               &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      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' )
       !
    END SUBROUTINE tra_adv
 
 
-   SUBROUTINE tra_adv_ctl
+   SUBROUTINE tra_adv_init
       !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_ctl  ***
+      !!                  ***  ROUTINE tra_adv_init  ***
       !!                
       !! ** Purpose :   Control the consistency between namelist options for 
@@ -146,5 +154,5 @@
       IF(lwp) THEN                    ! Namelist print
          WRITE(numout,*)
-         WRITE(numout,*) 'tra_adv_ctl : choice/control of the tracer advection scheme'
+         WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers'
@@ -188,8 +196,9 @@
          IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used'
          IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used'
+         IF( nadv ==  7 )   WRITE(numout,*) '         SMOLAR    scheme is used'
          IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme'
       ENDIF
       !
-   END SUBROUTINE tra_adv_ctl
+   END SUBROUTINE tra_adv_init
 
   !!======================================================================
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_cen2.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 2024)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                     ***  MODULE  traadv_cen2  ***
-   !! Ocean active tracers:  horizontal & vertical advective trend
+   !! Ocean  tracers:  horizontal & vertical advective trend
    !!======================================================================
    !! History :  8.2  ! 2001-08  (G. Madec, E. Durand)  trahad+trazad=traadv 
@@ -11,4 +11,5 @@
    !!             -   ! 2006-07  (G. madec)  add ups_orca_set routine
    !!            3.2  ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection
+   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
    !!----------------------------------------------------------------------
 
@@ -19,21 +20,14 @@
    !!                  area (set for orca 2 and 4 only)
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
+   USE oce, ONLY: tsn  ! now ocean temperature and salinity
    USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
-   USE trdmod_oce      ! ocean variables trends
    USE eosbn2          ! equation of state
-   USE trdmod          ! ocean active tracers trends 
+   USE trdmod_oce      ! tracers trends
+   USE trdtra          ! tracers trends
    USE closea          ! closed sea
-   USE trabbl          ! advective term in the BBL
-   USE sbcmod          ! surface Boundary Condition
    USE sbcrnf          ! river runoffs
    USE in_out_manager  ! I/O manager
    USE iom             ! IOM library
-   USE lib_mpp
-   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
    USE zdf_oce         ! ocean vertical physics
    USE restart         ! ocean restart
@@ -45,9 +39,8 @@
    PUBLIC   ups_orca_set    ! routine used by traadv_cen2_jki.F90
 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   upsmsk    !: mixed upstream/centered scheme near some straits 
+   LOGICAL  :: l_trd       ! flag to compute trends
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: upsmsk    !: mixed upstream/centered scheme near some straits 
    !                                                   !  and in closed seas (orca 2 and 4 configurations)
-
-   REAL(wp), DIMENSION(jpi,jpj) ::   btr2   ! inverse of T-point surface [1/(e1t*e2t)]
-
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -61,5 +54,6 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_cen2( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_cen2( kt   , cdtype, pun  , pvn, pwn, &
+      &                     ptrab, ptran , ptraa, kjpt   ) 
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_cen2  ***
@@ -77,9 +71,9 @@
       !!         Part I : horizontal advection
       !!       * centered flux:
-      !!               zcenu = e2u*e3u  un  mi(tn)
-      !!               zcenv = e1v*e3v  vn  mj(tn)
+      !!               zcenu = e2u*e3u  un  mi(ptran)
+      !!               zcenv = e1v*e3v  vn  mj(ptran)
       !!       * upstream flux:
-      !!               zupsu = e2u*e3u  un  (tb(i) or tb(i-1) ) [un>0 or <0]
-      !!               zupsv = e1v*e3v  vn  (tb(j) or tb(j-1) ) [vn>0 or <0]
+      !!               zupsu = e2u*e3u  un  (ptrab(i) or ptrab(i-1) ) [un>0 or <0]
+      !!               zupsv = e1v*e3v  vn  (ptrab(j) or ptrab(j-1) ) [vn>0 or <0]
       !!       * mixed upstream / centered horizontal advection scheme
       !!               zcofi = max(zind(i+1), zind(i))
@@ -88,61 +82,55 @@
       !!               zwy = zcofj * zupsv + (1-zcofj) * zcenv
       !!       * horizontal advective trend (divergence of the fluxes)
-      !!               zta = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }
+      !!               ztra = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }
       !!       * Add this trend now to the general trend of tracer (ta,sa):
-      !!              (ta,sa) = (ta,sa) + ( zta , zsa )
+      !!               ptraa = ptraa + ztra
       !!       * trend diagnostic ('key_trdtra' defined): the trend is
       !!      saved for diagnostics. The trends saved is expressed as
       !!      Uh.gradh(T), i.e.
-      !!                     save trend = zta + tn divn
-      !!         In addition, the advective trend in the two horizontal direc-
-      !!      tion is also re-computed as Uh gradh(T). Indeed hadt+tn divn is
-      !!      equal to (in s-coordinates, and similarly in z-coord.):
-      !!         zta+tn*divn=1/(e1t*e2t*e3t) { mi-1( e2u*e3u  un  di[tn] )
-      !!                                      +mj-1( e1v*e3v  vn  mj[tn] )  }
-      !!         NB:in z-coordinate - full step (ln_zco=T) e3u=e3v=e3t, so
-      !!      they vanish from the expression of the flux and divergence.
+      !!                     save trend = ztra + ptran divn
       !!
       !!         Part II : vertical advection
       !!      For temperature (idem for salinity) the advective trend is com-
       !!      puted as follows :
-      !!            zta = 1/e3t dk+1[ zwz ]
+      !!            ztra = 1/e3t dk+1[ zwz ]
       !!      where the vertical advective flux, zwz, is given by :
       !!            zwz = zcofk * zupst + (1-zcofk) * zcent
       !!      with
-      !!        zupsv = upstream flux = wn * (tb(k) or tb(k-1) ) [wn>0 or <0]
+      !!        zupsv = upstream flux = wn * (ptrab(k) or ptrab(k-1) ) [wn>0 or <0]
       !!        zcenu = centered flux = wn * mk(tn)
       !!         The surface boundary condition is :
       !!      variable volume (lk_vvl = T) : zero advective flux
-      !!      lin. free-surf  (lk_vvl = F) : wn(:,:,1) * tn(:,:,1)
+      !!      lin. free-surf  (lk_vvl = F) : wn(:,:,1) * ptran(:,:,1)
       !!         Add this trend now to the general trend of tracer (ta,sa):
-      !!            (ta,sa) = (ta,sa) + ( zta , zsa )
+      !!             ptraa = ptraa + ztra
       !!         Trend diagnostic ('key_trdtra' defined): the trend is
       !!      saved for diagnostics. The trends saved is expressed as :
-      !!             save trend =  w.gradz(T) = zta - tn divn.
-      !!
-      !! ** Action :  - update (ta,sa) with the now advective tracer trends
-      !!              - save trends in (ztrdt,ztrds) ('key_trdtra')
-      !!----------------------------------------------------------------------
-      USE oce, ONLY :   zwx => ua   ! use ua as workspace
-      USE oce, ONLY :   zwy => va   ! use va as workspace
-      !!
-      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component
-      !!
-      INTEGER  ::   ji, jj, jk                       ! dummy loop indices
-      REAL(wp) ::   zbtr, zhw, ze3tr                 ! temporary scalars
-      REAL(wp) ::   zfp_ui, zfp_vj, zfp_w , zfui     !    -         -
-      REAL(wp) ::   zfm_ui, zfm_vj, zfm_w , zfvj     !    -         -
+      !!             save trend =  w.gradz(T) = ztra - ptran divn.
+      !!
+      !! ** Action :  - update ptraa  with the now advective tracer trends
+      !!              - save trends if needed
+      !!----------------------------------------------------------------------
+      !!* Module used
+      USE oce         , zwx => ua   ! use ua as workspace
+      USE oce         , zwy => va   ! use va as workspace
+      !!* Arguments
+      INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator)
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pun, pvn, pwn   ! 3 ocean velocity components
+      INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptrab, ptran        ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptraa           ! tracer trend 
+      !!* Local declarations
+      INTEGER  ::   ji, jj, jk, jn                   ! dummy loop indices
+      REAL(wp) ::   zbtr, ztra                       ! temporary scalars
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_w            !    -         -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_w            !    -         -
       REAL(wp) ::   zcofi , zcofj , zcofk            !    -         -
-      REAL(wp) ::   zupsut, zupsus, zcenut, zcenus   !    -         -
-      REAL(wp) ::   zupsvt, zupsvs, zcenvt, zcenvs   !    -         -
-      REAL(wp) ::   zupst , zupss , zcent , zcens    !    -         -
-      REAL(wp) ::   z_hdivn_x, z_hdivn_y, z_hdivn    !    -         -
+      REAL(wp) ::   zupsut, zcenut                   !    -         -
+      REAL(wp) ::   zupsvt, zcenvt                   !    -         -
+      REAL(wp) ::   zupst , zcent                    !    -         -
       REAL(wp) ::   zice                             !    -         -
       REAL(wp), DIMENSION(jpi,jpj)     ::   ztfreez            ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, ztrdt, zind   ! 3D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww, ztrds         !  "      "
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, zind   ! 3D workspace 
       !!----------------------------------------------------------------------
 
@@ -157,7 +145,4 @@
          IF( cp_cfg == "orca" )   CALL ups_orca_set      ! set mixed Upstream/centered scheme near some straits
          !                                               ! and in closed seas (orca2 and orca4 only)
-         !   
-         btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )        ! inverse of T-point surface
-         !
          IF( jp_cfg == 2 .AND. .NOT. ln_rstart ) THEN    ! Increase the background in the surface layers
             avmb(1) = 10.  * avmb(1)      ;      avtb(1) = 10.  * avtb(1)
@@ -166,16 +151,19 @@
             avmb(4) =  2.5 * avmb(4)      ;      avtb(4) =  2.5 * avtb(4)
          ENDIF
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
-
+      !
       ! Upstream / centered scheme indicator
       ! ------------------------------------
 !!gm  not strickly exact : the freezing point should be computed at each ocean levels...
 !!gm  not a big deal since cen2 is no more used in global ice-ocean simulations
-      ztfreez(:,:) = tfreez( sn(:,:,1) )
+      ztfreez(:,:) = tfreez( tsn(:,:,1,jp_sal) )
       DO jk = 1, jpk
          DO jj = 1, jpj
             DO ji = 1, jpi
                !                                        ! below ice covered area (if tn < "freezing"+0.1 )
-               IF( tn(ji,jj,jk) <= ztfreez(ji,jj) + 0.1 ) THEN   ;   zice = 1.e0
+               IF( tsn(ji,jj,jk,jp_tem) <= ztfreez(ji,jj) + 0.1 ) THEN   ;   zice = 1.e0
                ELSE                                              ;   zice = 0.e0
                ENDIF
@@ -189,167 +177,98 @@
       END DO
 
-      ! I. Horizontal advection
-      !    ====================
-      !
-      DO jk = 1, jpkm1
-         !                        ! Second order centered tracer flux at u- and v-points
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ! upstream indicator
-               zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
-               zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
-               ! volume fluxes * 1/2
-               zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
-               zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
+      DO jn = 1, kjpt
+         !
+         ! I. Horizontal advection
+         !    ====================
+         !
+         DO jk = 1, jpkm1
+            !                        ! Second order centered tracer flux at u- and v-points
+            DO jj = 1, jpjm1
                !
-               ! upstream scheme
-               zfp_ui = zfui + ABS( zfui )
-               zfp_vj = zfvj + ABS( zfvj )
-               zfm_ui = zfui - ABS( zfui )
-               zfm_vj = zfvj - ABS( zfvj )
-               zupsut = zfp_ui * tb(ji,jj,jk) + zfm_ui * tb(ji+1,jj  ,jk)
-               zupsvt = zfp_vj * tb(ji,jj,jk) + zfm_vj * tb(ji  ,jj+1,jk)
-               zupsus = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj  ,jk)
-               zupsvs = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji  ,jj+1,jk)
-               ! centered scheme
-               zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj  ,jk) )
-               zcenvt = zfvj * ( tn(ji,jj,jk) + tn(ji  ,jj+1,jk) )
-               zcenus = zfui * ( sn(ji,jj,jk) + sn(ji+1,jj  ,jk) )
-               zcenvs = zfvj * ( sn(ji,jj,jk) + sn(ji  ,jj+1,jk) )
-               ! mixed centered / upstream scheme
-               zwx(ji,jj,jk) = zcofi * zupsut + (1.-zcofi) * zcenut
-               zwy(ji,jj,jk) = zcofj * zupsvt + (1.-zcofj) * zcenvt
-               zww(ji,jj,jk) = zcofi * zupsus + (1.-zcofi) * zcenus
-               zwz(ji,jj,jk) = zcofj * zupsvs + (1.-zcofj) * zcenvs
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream indicator
+                  zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
+                  zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
+                  !
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zupsut = zfp_ui * ptrab(ji,jj,jk,jn) + zfm_ui * ptrab(ji+1,jj  ,jk,jn)
+                  zupsvt = zfp_vj * ptrab(ji,jj,jk,jn) + zfm_vj * ptrab(ji  ,jj+1,jk,jn)
+                  ! centered scheme
+                  zcenut = pun(ji,jj,jk) * ( ptran(ji,jj,jk,jn) + ptran(ji+1,jj  ,jk,jn) )
+                  zcenvt = pvn(ji,jj,jk) * ( ptran(ji,jj,jk,jn) + ptran(ji  ,jj+1,jk,jn) )
+                  ! mixed centered / upstream scheme
+                  zwx(ji,jj,jk) = 0.5 * ( zcofi * zupsut + (1.-zcofi) * zcenut )
+                  zwy(ji,jj,jk) = 0.5 * ( zcofj * zupsvt + (1.-zcofj) * zcenvt )
+               END DO
             END DO
          END DO
-         !                        ! Tracer flux divergence at t-point added to the general trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr = btr2(ji,jj) / fse3t(ji,jj,jk)
-               !
-               ta(ji,jj,jk) = ta(ji,jj,jk) - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)  &
-                  &                                  + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
-               sa(ji,jj,jk) = sa(ji,jj,jk) - zbtr * (  zww(ji,jj,jk) - zww(ji-1,jj  ,jk)  &
-                  &                                  + zwz(ji,jj,jk) - zwz(ji  ,jj-1,jk)  )
+
+         ! II. Vertical advection
+         !     ==================
+         !
+         !                                                ! Vertical advective fluxes
+         zwz(:,:,jpk) = 0.e0                                   ! Bottom  value : flux set to zero
+         !                                                     ! Surface value : 
+         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptran(:,:,1,jn)   ! linear free surface 
+         ENDIF
+         !
+         DO jk = 2, jpk              ! Second order centered tracer flux at w-point
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! upstream indicator
+                  zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) ) 
+                  ! mixed centered / upstream scheme
+                  zfp_w = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_w = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zupst = zfp_w * ptrab(ji,jj,jk,jn) + zfm_w * ptrab(ji,jj,jk-1,jn)
+                  ! centered scheme
+                  zcent = pwn(ji,jj,jk) * ( ptran(ji,jj,jk,jn) + ptran(ji,jj,jk-1,jn) )
+                  ! mixed centered / upstream scheme
+                  zwz(ji,jj,jk) = 0.5 * ( zcofk * zupst + (1.-zcofk) * zcent )
+               END DO
             END DO
          END DO
-      END DO
-
-
-      IF( l_trdtra ) THEN      ! Save the i- and j-advective trends for diagnostic (U.gradz(T) trends)
-         !
+
+         ! II. Divergence of advective fluxes
+         ! ----------------------------------
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid with OBC, BDY, cla, eiv, advective bbl 
-                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
-                  !
-                  ztrdt(ji,jj,jk) = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x
-                  ztrds(ji,jj,jk) = - zbtr * ( zww(ji,jj,jk) - zww(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) *  fse3t(ji,jj,jk) )
+                  ! advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                  &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                  &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  )
+                  ! advective trends added to the general tracer trends
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
                END DO
             END DO
          END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)
-         !
-         DO jk = 1, jpkm1           ! T/S MERIDIONAL advection trends
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
-                  !
-                  ztrdt(ji,jj,jk) = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y          
-                  ztrds(ji,jj,jk) = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)
-         !
-         ztrdt(:,:,:) = ta(:,:,:)   ;   ztrds(:,:,:) = sa(:,:,:)       ! Save the horizontal up-to-date ta/sa trends
-         !
-      ENDIF
-
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN      ! "zonal" mean advective heat and salt transport 
-         pht_adv(:) = ptr_vj( zwy(:,:,:) )
-         pst_adv(:) = ptr_vj( zwz(:,:,:) )
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 had  - Ta: ', mask1=tmask, &
-         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' )
-
-
-      ! II. Vertical advection
-      !     ==================
-      !
-      zwx(:,:,jpk) = 0.e0     ;    zwy(:,:,jpk) = 0.e0      ! Bottom value  : flux set to zero
-      !
-      IF( lk_vvl ) THEN                                     ! Surface value : zero in variable volume
-         zwx(:,:, 1 ) = 0.e0    ;    zwy(:,:, 1 ) = 0.e0
-      ELSE                                                  !               : linear free surface case
-         zwx(:,:, 1 ) = pwn(:,:,1) * tn(:,:,1)
-         zwy(:,:, 1 ) = pwn(:,:,1) * sn(:,:,1)
-      ENDIF
-      !
-      DO jk = 2, jpk              ! Second order centered tracer flux at w-point
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) )      ! upstream indicator
-               zhw = 0.5 * pwn(ji,jj,jk)                            ! velocity * 1/2
-               !
-               zfp_w = zhw + ABS( zhw )                             ! upstream scheme
-               zfm_w = zhw - ABS( zhw )
-               zupst = zfp_w * tb(ji,jj,jk) + zfm_w * tb(ji,jj,jk-1)
-               zupss = zfp_w * sb(ji,jj,jk) + zfm_w * sb(ji,jj,jk-1)
-               !
-               zcent = zhw * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) )      ! centered scheme
-               zcens = zhw * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) )
-               !
-               zwx(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent   ! mixed centered / upstream scheme
-               zwy(ji,jj,jk) = zcofk * zupss + (1.-zcofk) * zcens
-            END DO
-         END DO
-      END DO
-      !
-      DO jk = 1, jpkm1            ! divergence of Tracer flux added to the general trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ze3tr = 1. / fse3t(ji,jj,jk)
-               ta(ji,jj,jk) =  ta(ji,jj,jk) - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
-               sa(ji,jj,jk) =  sa(ji,jj,jk) - ze3tr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) )
-            END DO
-         END DO
-      END DO
-
-      IF( l_trdtra ) THEN      ! Save the vertical advective trends for diagnostic (W gradz(T) trends)
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
-                  !
-                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
-                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn 
-                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)
-      ENDIF
-
-      ! write avmb, avtb in restart (traadv_cen2 requires a modified avmb, avtb that are
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd ) THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptran(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptran(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, ptran(:,:,:,jn) )
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) )
+           IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+         !
+      ENDDO
+
       ! ---------------------------  required in restart file to ensure restartability)
       ! avmb, avtb will be read in zdfini in restart case as they are used in zdftke, kpp etc...
-      IF( lrst_oce ) THEN
+      IF( lrst_oce .AND. cdtype == 'TRA' ) THEN
          CALL iom_rstput( kt, nitrst, numrow, 'avmb', avmb )
          CALL iom_rstput( kt, nitrst, numrow, 'avtb', avtb )
       ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 zad  - Ta: ', mask1=tmask, &
-         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
    END SUBROUTINE tra_adv_cen2
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_eiv.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 2024)
@@ -2,7 +2,8 @@
    !!======================================================================
    !!                    ***  MODULE  traadv_eiv  ***
-   !! Ocean active tracers:  advection trend - eddy induced velocity
+   !! Ocean tracers:  advection trend - eddy induced velocity
    !!======================================================================
-   !! History :  9.0  !  05-11  (G. Madec)  Original code, from traldf and zdf _iso
+   !! History :  9.0  !  05-11 (G. Madec)  Original code, from traldf and zdf _iso
+   !!            3.3  !  10-05 (C. Ethe, G. Madec)  merge TRC-TRA 
    !!----------------------------------------------------------------------
 #if defined key_traldf_eiv   ||   defined key_esopa
@@ -45,5 +46,5 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_eiv  ***
@@ -63,14 +64,15 @@
       !! ** Action  : - add to p.n the eiv component
       !!----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                         ::   kt    ! ocean time-step index
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun   ! in : 3 ocean velocity components 
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pvn   ! out: 3 ocean velocity components
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pwn   !      increased by the eiv
+      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index
+      CHARACTER(len=3), INTENT(in)                    ::   cdtype          ! =TRA or TRC (tracer indicator)
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun    ! in : 3 ocean velocity components 
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pvn    ! out: 3 ocean velocity components
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pwn    ! increased by the eiv
       !!
       INTEGER  ::   ji, jj, jk                 ! dummy loop indices
       REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! temporary scalar
       REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !    "         "
-      REAL(wp) ::   zu_eiv, zv_eiv, zw_eiv     !    "         "
-# if defined key_diaeiv
+      REAL(wp), DIMENSION(jpi,jpj) ::   zu_eiv, zv_eiv, zw_eiv     !    "         "
+# if defined key_diaeiv 
       REAL(wp) ::   zztmp                      !    "         "
       REAL(wp), DIMENSION(jpi,jpj) ::   z2d    !    "         "
@@ -82,11 +84,15 @@
          IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection :'
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   add to velocity fields the eiv component'
-# if defined key_diaeiv
-         u_eiv(:,:,:) = 0.e0
-         v_eiv(:,:,:) = 0.e0
-         w_eiv(:,:,:) = 0.e0
+# if defined key_diaeiv 
+         IF( cdtype == 'TRA') THEN
+            u_eiv(:,:,:) = 0.e0
+            v_eiv(:,:,:) = 0.e0
+            w_eiv(:,:,:) = 0.e0
+         END IF
 # endif
       ENDIF
-      !                                             ! =================
+
+      zu_eiv(:,:) = 0.e0   ;   zv_eiv(:,:) = 0.e0   ;    zw_eiv(:,:) = 0.e0  
+                                                    ! =================
       DO jk = 1, jpkm1                              !  Horizontal slab
          !                                          ! =================
@@ -98,15 +104,17 @@
                zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji,jj+1,jk+1) ) * fsaeiv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
 
-               zu_eiv = 0.5 * umask(ji,jj,jk) * ( zuwk - zuwk1 ) / fse3u(ji,jj,jk)
-               zv_eiv = 0.5 * vmask(ji,jj,jk) * ( zvwk - zvwk1 ) / fse3v(ji,jj,jk)
+               zu_eiv(ji,jj) = 0.5 * umask(ji,jj,jk) * ( zuwk - zuwk1 ) 
+               zv_eiv(ji,jj) = 0.5 * vmask(ji,jj,jk) * ( zvwk - zvwk1 ) 
    
-               pun(ji,jj,jk) = pun(ji,jj,jk) + zu_eiv
-               pvn(ji,jj,jk) = pvn(ji,jj,jk) + zv_eiv
-# if defined key_diaeiv
-               u_eiv(ji,jj,jk) = zu_eiv
-               v_eiv(ji,jj,jk) = zv_eiv
-# endif
+               pun(ji,jj,jk) = pun(ji,jj,jk) + e2u(ji,jj) * zu_eiv(ji,jj)
+               pvn(ji,jj,jk) = pvn(ji,jj,jk) + e1v(ji,jj) * zv_eiv(ji,jj)
             END DO
          END DO
+# if defined key_diaeiv 
+         IF( cdtype == 'TRA') THEN
+            u_eiv(:,:,jk) = zu_eiv(:,:) / fse3u(:,:,jk)
+            v_eiv(:,:,jk) = zv_eiv(:,:) / fse3v(:,:,jk)
+         END IF
+# endif
          IF( jk >=2 ) THEN                             ! jk=1 zw_eiv=0, not computed
             DO jj = 2, jpjm1
@@ -118,5 +126,5 @@
                   zvwj1 = ( wslpj(ji,jj,jk)+wslpj(ji,jj+1,jk) ) * fsaeiv(ji,jj  ,jk) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
   
-                  zw_eiv = - 0.5 * tmask(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj ) / ( e1t(ji,jj)*e2t(ji,jj) )
+                  zw_eiv(ji,jj) = - 0.5 * tmask(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj ) 
 # else
                   zuwi  = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) ) * e2u(ji-1,jj) * umask(ji-1,jj,jk)
@@ -125,14 +133,12 @@
                   zvwj1 = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) ) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
 
-                  zw_eiv = - 0.5 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj )  &
-                     &                                                / ( e1t(ji,jj)*e2t(ji,jj) )
+                  zw_eiv(ji,jj) = - 0.5 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj )
 # endif
-                  pwn(ji,jj,jk) = pwn(ji,jj,jk) + zw_eiv
-
-# if defined key_diaeiv
-                  w_eiv(ji,jj,jk) = zw_eiv
-# endif
+                  pwn(ji,jj,jk) = pwn(ji,jj,jk) + zw_eiv(ji,jj)
                END DO
             END DO
+# if defined key_diaeiv 
+            IF( cdtype == 'TRA')  w_eiv(:,:,jk) = zw_eiv(:,:) / ( e1t(:,:) * e2t(:,:) )
+# endif
          ENDIF
          !                                          ! =================
@@ -140,31 +146,35 @@
       !                                             ! =================
 
-# if defined key_diaeiv
-      CALL iom_put( "uoce_eiv", u_eiv )    ! i-eiv current
-      CALL iom_put( "voce_eiv", v_eiv )    ! j-eiv current
-      CALL iom_put( "woce_eiv", w_eiv )    ! vert. eiv current
-      IF( lk_diaar5 ) THEN
-         zztmp = 0.5 * rau0 * rcp 
-         z2d(:,:) = 0.e0 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + zztmp * u_eiv(ji,jj,jk) * (tn(ji,jj,jk)+tn(ji+1,jj,jk)) * e1u(ji,jj) * fse3u(ji,jj,jk) 
+# if defined key_diaeiv 
+      IF( cdtype == 'TRA') THEN
+         CALL iom_put( "uoce_eiv", u_eiv )    ! i-eiv current
+         CALL iom_put( "voce_eiv", v_eiv )    ! j-eiv current
+         CALL iom_put( "woce_eiv", w_eiv )    ! vert. eiv current
+         IF( lk_diaar5 ) THEN
+            zztmp = 0.5 * rau0 * rcp 
+            z2d(:,:) = 0.e0 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zztmp * u_eiv(ji,jj,jk) &
+                       &         * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e1u(ji,jj) * fse3u(ji,jj,jk) 
+                  END DO
                END DO
             END DO
-         END DO
-         CALL lbc_lnk( z2d, 'U', -1. )
-         CALL iom_put( "ueiv_heattr", z2d )                  ! heat transport in i-direction
-         z2d(:,:) = 0.e0 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + zztmp * v_eiv(ji,jj,jk) * (tn(ji,jj,jk)+tn(ji,jj+1,jk)) * e2v(ji,jj) * fse3v(ji,jj,jk) 
+            CALL lbc_lnk( z2d, 'U', -1. )
+            CALL iom_put( "ueiv_heattr", z2d )                  ! heat transport in i-direction
+            z2d(:,:) = 0.e0 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zztmp * v_eiv(ji,jj,jk) &
+                     &           * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e2v(ji,jj) * fse3v(ji,jj,jk) 
+                  END DO
                END DO
             END DO
-         END DO
-         CALL lbc_lnk( z2d, 'V', -1. )
-         CALL iom_put( "veiv_heattr", z2d )                  !  heat transport in i-direction
-      ENDIF
+            CALL lbc_lnk( z2d, 'V', -1. )
+            CALL iom_put( "veiv_heattr", z2d )                  !  heat transport in i-direction
+         ENDIF
+    END IF
 # endif  
       ! 
@@ -176,7 +186,11 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn )              ! Empty routine
+   SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype )              ! Empty routine
+      INTEGER , INTENT(in   )           ::   kt     ! ocean time-step index
+      CHARACTER(len=3), INTENT(in)      ::   cdtype          ! =TRA or TRC (tracer indicator)
       REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn
-      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, pun(1,1,1), pvn(1,1,1), pwn(1,1,1)
+      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt
+      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', cdtype
+      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', pun(1,1,1), pvn(1,1,1), pwn(1,1,1)
    END SUBROUTINE tra_adv_eiv
 #endif
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 2024)
@@ -2,9 +2,10 @@
    !!======================================================================
    !!                       ***  MODULE  traadv_muscl  ***
-   !! Ocean active tracers:  horizontal & vertical advective trend
+   !! Ocean  tracers:  horizontal & vertical advective trend
    !!======================================================================
-   !! History :       !  06-00  (A.Estublier)  for passive tracers
-   !!                 !  01-08  (E.Durand, G.Madec)  adapted for T & S
-   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
+   !! History :       !  2000-06  (A.Estublier)  for passive tracers
+   !!                 !  2001-08  (E.Durand, G.Madec)  adapted for T & S
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
    !!----------------------------------------------------------------------
 
@@ -15,6 +16,6 @@
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! tracers trends 
+   USE trdtra      ! tracers trends 
    USE in_out_manager  ! I/O manager
    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
@@ -23,5 +24,5 @@
    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
+
 
    IMPLICIT NONE
@@ -29,4 +30,6 @@
 
    PUBLIC   tra_adv_muscl  ! routine called by step.F90
+
+   LOGICAL  :: l_trd       ! flag to compute trends
 
    !! * Substitutions
@@ -41,5 +44,6 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_muscl( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_muscl( kt   , cdtype, pun, pvn, pwn, &
+      &                      ptrab, ptraa , kjpt   )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE tra_adv_muscl  ***
@@ -52,28 +56,26 @@
       !!
       !! ** Action  : - update (ta,sa) with the now advective tracer trends
-      !!              - save trends in (ztrdt,ztrds) ('key_trdtra')
+      !!              - save trends 
       !!
       !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
       !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as workspace
-      USE oce, ONLY :   ztrds => va   ! use va as workspace
-      !!
-      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component
-      !!
-      INTEGER ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   &
-         zu, zv, zw, zeu, zev,           &  
-         zew, zbtr, zstep,               &
-         z0u, z0v, z0w,                  &
-         zzt1, zzt2, zalpha,             &
-         zzs1, zzs2, z2,                 &
-         zta, zsa,                       &
-        z_hdivn_x, z_hdivn_y, z_hdivn
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zt1, zt2, ztp1, ztp2   ! 3D workspace
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zs1, zs2, zsp1, zsp2   !  "      "
+      !!* Module used
+      USE oce         , zwx => ua   ! use ua as workspace
+      USE oce         , zwy => va   ! use va as workspace
+      !!* Arguments
+      INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptrab           ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptraa           ! tracer trend 
+      !!* Local declarations
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zu, z0u, zzwx
+      REAL(wp) ::   zv, z0v, zzwy
+      REAL(wp) ::   zw, z0w
+      REAL(wp) ::   ztra, zbtr, z2, zdt, zalpha
+      REAL(wp), DIMENSION (jpi,jpj,jpk) :: zslpx, zslpy   ! 3D workspace
       !!----------------------------------------------------------------------
 
@@ -82,4 +84,7 @@
          WRITE(numout,*) 'tra_adv : MUSCL advection scheme'
          WRITE(numout,*) '~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
 
@@ -87,335 +92,173 @@
       ELSE                                        ;    z2 = 2.
       ENDIF
-
-      ! I. Horizontal advective fluxes
-      ! ------------------------------
-      ! first guess of the slopes
-      ! interior values
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1      
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zt1(ji,jj,jk) = umask(ji,jj,jk) * ( tb(ji+1,jj,jk) - tb(ji,jj,jk) )
-               zs1(ji,jj,jk) = umask(ji,jj,jk) * ( sb(ji+1,jj,jk) - sb(ji,jj,jk) )
-               zt2(ji,jj,jk) = vmask(ji,jj,jk) * ( tb(ji,jj+1,jk) - tb(ji,jj,jk) )
-               zs2(ji,jj,jk) = vmask(ji,jj,jk) * ( sb(ji,jj+1,jk) - sb(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
-      ! bottom values
-      zt1(:,:,jpk) = 0.e0    ;    zt2(:,:,jpk) = 0.e0
-      zs1(:,:,jpk) = 0.e0    ;    zs2(:,:,jpk) = 0.e0
-
-      ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign)
-      CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. )
-      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. )
-
-      ! Slopes
-      ! interior values
-      DO jk = 1, jpkm1
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vector opt.
-               ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji-1,jj  ,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji-1,jj  ,jk) ) )
-               zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji-1,jj  ,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji-1,jj  ,jk) ) )
-               ztp2(ji,jj,jk) =                    ( zt2(ji,jj,jk) + zt2(ji  ,jj-1,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zt2(ji,jj,jk) * zt2(ji  ,jj-1,jk) ) )
-               zsp2(ji,jj,jk) =                    ( zs2(ji,jj,jk) + zs2(ji  ,jj-1,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zs2(ji,jj,jk) * zs2(ji  ,jj-1,jk) ) )
-            END DO
-         END DO
-      END DO
-      ! bottom values
-      ztp1(:,:,jpk) = 0.e0    ;    ztp2(:,:,jpk) = 0.e0
-      zsp1(:,:,jpk) = 0.e0    ;    zsp2(:,:,jpk) = 0.e0
-
-      ! Slopes limitation
-      DO jk = 1, jpkm1
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vector opt.
-               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( ztp1(ji  ,jj,jk) ),   &
-                  &                  2.*ABS( zt1 (ji-1,jj,jk) ),   &
-                  &                  2.*ABS( zt1 (ji  ,jj,jk) ) )
-               zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( zsp1(ji  ,jj,jk) ),   &
-                  &                  2.*ABS( zs1 (ji-1,jj,jk) ),   &
-                  &                  2.*ABS( zs1 (ji  ,jj,jk) ) )
-               ztp2(ji,jj,jk) = SIGN( 1., ztp2(ji,jj,jk) )   &
-                  &           * MIN(    ABS( ztp2(ji,jj  ,jk) ),   &
-                  &                  2.*ABS( zt2 (ji,jj-1,jk) ),   &
-                  &                  2.*ABS( zt2 (ji,jj  ,jk) ) )
-               zsp2(ji,jj,jk) = SIGN( 1., zsp2(ji,jj,jk) )   &
-                  &           * MIN(    ABS( zsp2(ji,jj  ,jk) ),   &
-                  &                  2.*ABS( zs2 (ji,jj-1,jk) ),   &
-                  &                  2.*ABS( zs2 (ji,jj  ,jk) ) )
-            END DO
-         END DO
-      END DO        
-
-      ! Advection terms
-      ! interior values
-      DO jk = 1, jpkm1
-         zstep  = z2 * rdttra(jk)
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! volume fluxes
-#if defined key_zco
-               zeu = e2u(ji,jj)                   * pun(ji,jj,jk)
-               zev = e1v(ji,jj)                   * pvn(ji,jj,jk)
-#else
-               zeu = e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
-               zev = e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
-#endif
-               ! MUSCL fluxes
-               z0u = SIGN( 0.5, pun(ji,jj,jk) )            
-               zalpha = 0.5 - z0u
-               zu  = z0u - 0.5 * pun(ji,jj,jk) * zstep / e1u(ji,jj)
-               zzt1 = tb(ji+1,jj,jk) + zu*ztp1(ji+1,jj,jk)
-               zzt2 = tb(ji  ,jj,jk) + zu*ztp1(ji  ,jj,jk)
-               zzs1 = sb(ji+1,jj,jk) + zu*zsp1(ji+1,jj,jk)
-               zzs2 = sb(ji  ,jj,jk) + zu*zsp1(ji  ,jj,jk)
-               zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
-               zs1(ji,jj,jk) = zeu * ( zalpha * zzs1 + (1.-zalpha) * zzs2 )
-               !
-               z0v = SIGN( 0.5, pvn(ji,jj,jk) )            
-               zalpha = 0.5 - z0v
-               zv  = z0v - 0.5 * pvn(ji,jj,jk) * zstep / e2v(ji,jj)
-               zzt1 = tb(ji,jj+1,jk) + zv*ztp2(ji,jj+1,jk)
-               zzt2 = tb(ji,jj  ,jk) + zv*ztp2(ji,jj  ,jk)
-               zzs1 = sb(ji,jj+1,jk) + zv*zsp2(ji,jj+1,jk)
-               zzs2 = sb(ji,jj  ,jk) + zv*zsp2(ji,jj  ,jk)
-               zt2(ji,jj,jk) = zev * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
-               zs2(ji,jj,jk) = zev * ( zalpha * zzs1 + (1.-zalpha) * zzs2 )
-            END DO
-         END DO
-      END DO
-
-      ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign)
-      CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. ) 
-      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. )
-
-      ! Tracer flux divergence at t-point added to the general trend
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
-#else
-               zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-#endif
-               ! horizontal advective trends
-               zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk  )   &
-                  &           + zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk  ) )
-               zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj  ,jk  )   &
-                  &           + zs2(ji,jj,jk) - zs2(ji  ,jj-1,jk  ) ) 
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
-            END DO
-        END DO
-      END DO        
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl had  - Ta: ', mask1=tmask ,  &
-         &                       tab3d_2=sa, clinfo2=             ' Sa: ', mask2=tmask, clinfo3='tra' )
-
-      ! Save the horizontal advective trends for diagnostics
-      IF( l_trdtra ) THEN
-         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0
-         !
-         ! T/S ZONAL advection trends
+      !
+      !                                                     ! ===========
+      DO jn = 1, kjpt                                       ! tracer loop
+         !                                                  ! ===========
+         ! I. Horizontal advective fluxes
+         ! ------------------------------
+         ! first guess of the slopes
+         zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
+         ! interior values
          DO jk = 1, jpkm1
+            DO jj = 1, jpjm1      
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptrab(ji+1,jj,jk,jn) - ptrab(ji,jj,jk,jn) )
+                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptrab(ji,jj+1,jk,jn) - ptrab(ji,jj,jk,jn) )
+               END DO
+           END DO
+         END DO
+         !
+         CALL lbc_lnk( zwx, 'U', -1. )                        ! lateral boundary conditions on zwx, zwy   (changed sign)
+         CALL lbc_lnk( zwy, 'V', -1. )
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
+         DO jk = 1, jpkm1                                     ! interior values
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
+                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1                                     ! Slopes limitation
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
+                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
+               END DO
+           END DO
+         END DO             ! interior values
+
+         !                                             !-- MUSCL horizontal advective fluxes
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = z2 * rdttra(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-#if defined key_zco
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              &
-                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr
-#else
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
-#endif
-                  ztrdt(ji,jj,jk) = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x
-                  ztrds(ji,jj,jk) = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)
-
-         ! T/S MERIDIONAL advection trends
+                  ! MUSCL fluxes
+                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
+                  zalpha = 0.5 - z0u
+                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  zzwx = ptrab(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk)
+                  zzwy = ptrab(ji  ,jj,jk,jn) + zu * zslpx(ji  ,jj,jk)
+                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+                  !
+                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
+                  zalpha = 0.5 - z0v
+                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+                  zzwx = ptrab(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk)
+                  zzwy = ptrab(ji,jj  ,jk,jn) + zv * zslpy(ji,jj  ,jk) 
+                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO
+            END DO
+         END DO
+         !                                                    ! lateral boundary conditions on zwx, zwy   (changed sign)
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )
+         !
+         ! Tracer flux divergence at t-point added to the general trend
          DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-#if defined key_zco
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                  z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              &
-                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr
-#else
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
-#endif
-                  ztrdt(ji,jj,jk) = - zbtr * ( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y          
-                  ztrds(ji,jj,jk) = - zbtr * ( zs2(ji,jj,jk) - zs2(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)
-
-         ! Save the up-to-date ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = sa(:,:,:) 
-         !
-      ENDIF
-
-      ! "zonal" mean advective heat and salt transport
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         IF( lk_zco ) THEN
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                    zt2(ji,jj,jk) = zt2(ji,jj,jk) * fse3v(ji,jj,jk)
-                    zs2(ji,jj,jk) = zs2(ji,jj,jk) * fse3v(ji,jj,jk)
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective trends
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                  &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )
+                  ! add it to the general tracer trends
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
+               END DO
+           END DO
+         END DO        
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptrab(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptrab(:,:,:,jn) )
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN  
+            IF( lk_zco ) THEN
+               DO jk = 1, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                       zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk)                 
+                     END DO
                   END DO
                END DO
-            END DO
+            ENDIF
+            IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) )
+            IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) )
          ENDIF
-         pht_adv(:) = ptr_vj( zt2(:,:,:) )
-         pst_adv(:) = ptr_vj( zs2(:,:,:) )
-      ENDIF
-
-      ! II. Vertical advective fluxes
-      ! -----------------------------
-      
-      ! First guess of the slope
-      ! interior values
-      DO jk = 2, jpkm1
-         zt1(:,:,jk) = tmask(:,:,jk) * ( tb(:,:,jk-1) - tb(:,:,jk) )
-         zs1(:,:,jk) = tmask(:,:,jk) * ( sb(:,:,jk-1) - sb(:,:,jk) )
-      END DO
-      ! surface & bottom boundary conditions
-      zt1 (:,:, 1 ) = 0.e0    ;    zt1 (:,:,jpk) = 0.e0
-      zs1 (:,:, 1 ) = 0.e0    ;    zs1 (:,:,jpk) = 0.e0
-
-      ! Slopes
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji,jj,jk+1) ) )
-               zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji,jj,jk+1) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji,jj,jk+1) ) )
-            END DO
-         END DO
-      END DO
-
-      ! Slopes limitation
-      ! interior values
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( ztp1(ji,jj,jk  ) ),   &
-                  &                  2.*ABS( zt1 (ji,jj,jk+1) ),   &
-                  &                  2.*ABS( zt1 (ji,jj,jk  ) ) )
-               zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( zsp1(ji,jj,jk  ) ),   &
-                  &                  2.*ABS( zs1 (ji,jj,jk+1) ),   &
-                  &                  2.*ABS( zs1 (ji,jj,jk  ) ) )
-            END DO
-         END DO
-      END DO
-      ! surface values
-      ztp1(:,:,1) = 0.e0
-      zsp1(:,:,1) = 0.e0
-
-      ! vertical advective flux
-      ! interior values
-      DO jk = 1, jpkm1
-         zstep  = z2 * rdttra(jk)
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zew = pwn(ji,jj,jk+1)
-               z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
-               zalpha = 0.5 + z0w
-               zw  = z0w - 0.5 * pwn(ji,jj,jk+1)*zstep / fse3w(ji,jj,jk+1)
-               zzt1 = tb(ji,jj,jk+1) + zw*ztp1(ji,jj,jk+1)
-               zzt2 = tb(ji,jj,jk  ) + zw*ztp1(ji,jj,jk  )
-               zzs1 = sb(ji,jj,jk+1) + zw*zsp1(ji,jj,jk+1)
-               zzs2 = sb(ji,jj,jk  ) + zw*zsp1(ji,jj,jk  )
-               zt1(ji,jj,jk+1) = zew * ( zalpha * zzt1 + (1.-zalpha)*zzt2 )
-               zs1(ji,jj,jk+1) = zew * ( zalpha * zzs1 + (1.-zalpha)*zzs2 )
-            END DO
-         END DO
-      END DO
-      ! surface values
-      IF( lk_vvl ) THEN
-         ! variable volume : flux set to zero
-         zt1(:,:, 1 ) = 0.e0
-         zs1(:,:, 1 ) = 0.e0
-      ELSE
-         ! free surface-constant volume
-         zt1(:,:, 1 ) = pwn(:,:,1) * tb(:,:,1)
-         zs1(:,:, 1 ) = pwn(:,:,1) * sb(:,:,1)
-      ENDIF
-
-      ! bottom values
-      zt1(:,:,jpk) = 0.e0
-      zs1(:,:,jpk) = 0.e0
-
-
-      ! Compute & add the vertical advective trend
-
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr = 1. / fse3t(ji,jj,jk)
-               ! horizontal advective trends
-               zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
-               zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji,jj,jk+1) )
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) =  ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa
-            END DO
-         END DO
-      END DO
-
-      ! Save the vertical advective trends for diagnostic
-      ! -------------------------------------------------
-      IF( l_trdtra )   THEN
-         ! Recompute the vertical advection zta & zsa trends computed 
-         ! at the step 2. above in making the difference between the new 
-         ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract
-         ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends
-
+
+         ! II. Vertical advective fluxes
+         ! -----------------------------
+         !                                             !-- first guess of the slopes
+         zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0    ! surface & bottom boundary conditions
+         DO jk = 2, jpkm1                                     ! interior values
+            zwx(:,:,jk) = tmask(:,:,jk) * ( ptrab(:,:,jk-1,jn) - ptrab(:,:,jk,jn) )
+         END DO
+
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,1) = 0.e0                                  ! surface values
+         DO jk = 2, jpkm1                                     ! interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
+               END DO
+            END DO
+         END DO
+         !                                             !-- Slopes limitation
+         DO jk = 2, jpkm1                                     ! interior values
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
+               END DO
+            END DO
+         END DO
+         !                                             !-- vertical advective flux
+         !                                                    ! surface values  (bottom already set to zero)
+         IF( lk_vvl ) THEN    ;   zwx(:,:, 1 ) = 0.e0                      !  variable volume
+         ELSE                 ;   zwx(:,:, 1 ) = pwn(:,:,1) * ptrab(:,:,1,jn)   ! linear free surface
+         ENDIF 
+         !
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = z2 * rdttra(jk)
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) )
+                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
+                  zalpha = 0.5 + z0w
+                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr 
+                  zzwx = ptrab(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1)
+                  zzwy = ptrab(ji,jj,jk  ,jn) + zw * zslpx(ji,jj,jk  )
+                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO 
+            END DO
+         END DO
+
+         ! Compute & add the vertical advective trend
          DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk)
-#else
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
-#endif
-                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
-                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn 
-                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)
-         !
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl zad  - Ta: ', mask1=tmask ,   &
-         &                       tab3d_2=sa, clinfo2=             ' Sa: ', mask2=tmask, clinfo3='tra' )
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! vertical advective trends 
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
+                  ! add it to the general tracer trends
+                  ptraa(ji,jj,jk,jn) =  ptraa(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+         !                                 ! Save the vertical advective trends for diagnostic
+         IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwx, pwn, ptrab(:,:,:,jn) )
+         !
+      ENDDO
       !
    END SUBROUTINE tra_adv_muscl
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 2024)
@@ -2,7 +2,8 @@
    !!==============================================================================
    !!                       ***  MODULE  traadv_muscl2  ***
-   !! Ocean active tracers:  horizontal & vertical advective trend
+   !! Ocean  tracers:  horizontal & vertical advective trend
    !!==============================================================================
-   !! History :  9.0  !  02-06  (G. Madec) from traadv_muscl
+   !! History :  1.0  !  2002-06  (G. Madec) from traadv_muscl
+   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
    !!----------------------------------------------------------------------
 
@@ -13,13 +14,13 @@
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! tracers trends 
+   USE trdtra          ! tracers trends 
    USE in_out_manager  ! I/O manager
    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
    USE trabbl          ! tracers: bottom boundary layer
-   USE lib_mpp
+   USE lib_mpp         ! distribued memory computing
    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
+
 
    IMPLICIT NONE
@@ -28,4 +29,6 @@
    !! * Accessibility
    PUBLIC tra_adv_muscl2        ! routine called by step.F90
+
+   LOGICAL  :: l_trd       ! flag to compute trends
 
    !! * Substitutions
@@ -40,5 +43,6 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_muscl2( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_muscl2( kt   , cdtype, pun  , pvn, pwn, &
+      &                       ptrab, ptran , ptraa, kjpt   )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE tra_adv_muscl2  ***
@@ -50,29 +54,27 @@
       !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
       !!
-      !! ** Action  : - update (ta,sa) with the now advective tracer trends
-      !!              - save trends in (ztrdt,ztrds) ('key_trdtra')
+      !! ** Action  : - update (ptraa) with the now advective tracer trends
+      !!              - save trends 
       !!
       !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
       !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
       !!----------------------------------------------------------------------
-      USE oce              , ztrdt => ua   ! use ua as workspace
-      USE oce              , ztrds => va   ! use va as workspace
-      !!
-      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component
-      !!
-      INTEGER ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   &
-         zu, zv, zw, zeu, zev,           &  
-         zew, zbtr, zstep,               &
-         z0u, z0v, z0w,                  &
-         zzt1, zzt2, zalpha,             &
-         zzs1, zzs2, z2,                 &
-         zta, zsa,                       &
-         z_hdivn_x, z_hdivn_y, z_hdivn
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zt1, zt2, ztp1, ztp2   ! 3D workspace
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zs1, zs2, zsp1, zsp2   !  "      "
+      !!* Module used
+      USE oce         , zwx => ua   ! use ua as workspace
+      USE oce         , zwy => va   ! use va as workspace
+      !!* Arguments
+      INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptrab, ptran        ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptraa           ! tracer trend 
+      !!* Local declarations
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zu, z0u, zzwx
+      REAL(wp) ::   zv, z0v, zzwy
+      REAL(wp) ::   zw, z0w
+      REAL(wp) ::   ztra, zbtr, z2, zdt, zalpha
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::  zslpx, zslpy   ! 3D workspace
       !!----------------------------------------------------------------------
 
@@ -81,4 +83,7 @@
          WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme'
          WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
 
@@ -86,408 +91,213 @@
       ELSE                                        ;   z2 = 2.
       ENDIF
-
-      ! I. Horizontal advective fluxes
-      ! ------------------------------
-
-      ! first guess of the slopes
-      ! interior values
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1      
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zt1(ji,jj,jk) = umask(ji,jj,jk) * ( tb(ji+1,jj,jk) - tb(ji,jj,jk) )
-               zs1(ji,jj,jk) = umask(ji,jj,jk) * ( sb(ji+1,jj,jk) - sb(ji,jj,jk) )
-               zt2(ji,jj,jk) = vmask(ji,jj,jk) * ( tb(ji,jj+1,jk) - tb(ji,jj,jk) )
-               zs2(ji,jj,jk) = vmask(ji,jj,jk) * ( sb(ji,jj+1,jk) - sb(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
-      ! bottom values
-      zt1(:,:,jpk) = 0.e0    ;    zt2(:,:,jpk) = 0.e0
-      zs1(:,:,jpk) = 0.e0    ;    zs2(:,:,jpk) = 0.e0
-
-      ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign)
-      CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. )
-      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. )
-
-      ! Slopes
-      ! interior values
-      DO jk = 1, jpkm1
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vector opt.
-               ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji-1,jj  ,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji-1,jj  ,jk) ) )
-               zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji-1,jj  ,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji-1,jj  ,jk) ) )
-               ztp2(ji,jj,jk) =                    ( zt2(ji,jj,jk) + zt2(ji  ,jj-1,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zt2(ji,jj,jk) * zt2(ji  ,jj-1,jk) ) )
-               zsp2(ji,jj,jk) =                    ( zs2(ji,jj,jk) + zs2(ji  ,jj-1,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zs2(ji,jj,jk) * zs2(ji  ,jj-1,jk) ) )
-            END DO
-         END DO
-      END DO
-      ! bottom values
-      ztp1(:,:,jpk) = 0.e0    ;    ztp2(:,:,jpk) = 0.e0
-      zsp1(:,:,jpk) = 0.e0    ;    zsp2(:,:,jpk) = 0.e0
-
-      ! Slopes limitation
-      DO jk = 1, jpkm1
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vector opt.
-               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( ztp1(ji  ,jj,jk) ),   &
-                  &                  2.*ABS( zt1 (ji-1,jj,jk) ),   &
-                  &                  2.*ABS( zt1 (ji  ,jj,jk) ) )
-               zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( zsp1(ji  ,jj,jk) ),   &
-                  &                  2.*ABS( zs1 (ji-1,jj,jk) ),   &
-                  &                  2.*ABS( zs1 (ji  ,jj,jk) ) )
-               ztp2(ji,jj,jk) = SIGN( 1., ztp2(ji,jj,jk) )   &
-                  &           * MIN(    ABS( ztp2(ji,jj  ,jk) ),   &
-                  &                  2.*ABS( zt2 (ji,jj-1,jk) ),   &
-                  &                  2.*ABS( zt2 (ji,jj  ,jk) ) )
-               zsp2(ji,jj,jk) = SIGN( 1., zsp2(ji,jj,jk) )   &
-                  &           * MIN(    ABS( zsp2(ji,jj  ,jk) ),   &
-                  &                  2.*ABS( zs2 (ji,jj-1,jk) ),   &
-                  &                  2.*ABS( zs2 (ji,jj  ,jk) ) )
-            END DO
-         END DO
-      END DO        
-
-      ! Advection terms
-      ! interior values
-      DO jk = 1, jpkm1
-         zstep  = z2 * rdttra(jk)
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! volume fluxes
-#if defined key_zco
-               zeu = e2u(ji,jj)                   * pun(ji,jj,jk)
-               zev = e1v(ji,jj)                   * pvn(ji,jj,jk)
-#else
-               zeu = e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
-               zev = e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
-#endif
-               ! MUSCL fluxes
-               z0u = SIGN( 0.5, pun(ji,jj,jk) )            
-               zalpha = 0.5 - z0u
-               zu  = z0u - 0.5 * pun(ji,jj,jk) * zstep / e1u(ji,jj)
-               zzt1 = tb(ji+1,jj,jk) + zu*ztp1(ji+1,jj,jk)
-               zzt2 = tb(ji  ,jj,jk) + zu*ztp1(ji  ,jj,jk)
-               zzs1 = sb(ji+1,jj,jk) + zu*zsp1(ji+1,jj,jk)
-               zzs2 = sb(ji  ,jj,jk) + zu*zsp1(ji  ,jj,jk)
-               zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
-               zs1(ji,jj,jk) = zeu * ( zalpha * zzs1 + (1.-zalpha) * zzs2 )
-               !
-               z0v = SIGN( 0.5, pvn(ji,jj,jk) )            
-               zalpha = 0.5 - z0v
-               zv  = z0v - 0.5 * pvn(ji,jj,jk) * zstep / e2v(ji,jj)
-               zzt1 = tb(ji,jj+1,jk) + zv*ztp2(ji,jj+1,jk)
-               zzt2 = tb(ji,jj  ,jk) + zv*ztp2(ji,jj  ,jk)
-               zzs1 = sb(ji,jj+1,jk) + zv*zsp2(ji,jj+1,jk)
-               zzs2 = sb(ji,jj  ,jk) + zv*zsp2(ji,jj  ,jk)
-               zt2(ji,jj,jk) = zev * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
-               zs2(ji,jj,jk) = zev * ( zalpha * zzs1 + (1.-zalpha) * zzs2 )
-            END DO
-         END DO
-      END DO
-
-      !!!!  centered scheme at lateral b.C. if off-shore velocity
-      DO jk = 1, jpkm1
-        DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               IF( umask(ji,jj,jk) == 0. ) THEN
-                  IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
-                     zt1(ji+1,jj,jk) = e2u(ji+1,jj) * pun(ji+1,jj,jk) * ( tb(ji+1,jj,jk) + tb(ji+2,jj,jk) ) * 0.5
-                     zs1(ji+1,jj,jk) = e2u(ji+1,jj) * pun(ji+1,jj,jk) * ( sb(ji+1,jj,jk) + sb(ji+2,jj,jk) ) * 0.5
+      !
+      !
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! I. Horizontal advective fluxes
+         ! ------------------------------
+         ! first guess of the slopes
+         zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
+         ! interior values
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1      
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptrab(ji+1,jj,jk,jn) - ptrab(ji,jj,jk,jn) )
+                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptrab(ji,jj+1,jk,jn) - ptrab(ji,jj,jk,jn) )
+               END DO
+           END DO
+         END DO
+         !
+         CALL lbc_lnk( zwx, 'U', -1. )                        ! lateral boundary conditions on zwx, zwy   (changed sign)
+         CALL lbc_lnk( zwy, 'V', -1. )
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
+         DO jk = 1, jpkm1                                     ! interior values
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
+                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1                                     ! Slopes limitation
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
+                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
+               END DO
+           END DO
+         END DO             ! interior values
+
+        !                                             !-- MUSCL horizontal advective fluxes
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = z2 * rdttra(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! MUSCL fluxes
+                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
+                  zalpha = 0.5 - z0u
+                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  zzwx = ptrab(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk)
+                  zzwy = ptrab(ji  ,jj,jk,jn) + zu * zslpx(ji  ,jj,jk)
+                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+                  !
+                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
+                  zalpha = 0.5 - z0v
+                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+                  zzwx = ptrab(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk)
+                  zzwy = ptrab(ji,jj  ,jk,jn) + zv * zslpy(ji,jj  ,jk)
+                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO
+            END DO
+         END DO
+
+         !!  centered scheme at lateral b.C. if off-shore velocity
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( umask(ji,jj,jk) == 0. ) THEN
+                     IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
+                        zwx(ji+1,jj,jk) = 0.5 * pun(ji+1,jj,jk) * ( ptran(ji+1,jj,jk,jn) + ptran(ji+2,jj,jk,jn) )
+                     ENDIF
+                     IF( pun(ji-1,jj,jk) < 0. ) THEN
+                        zwx(ji-1,jj,jk) = 0.5 * pun(ji-1,jj,jk) * ( ptran(ji-1,jj,jk,jn) + ptran(ji,jj,jk,jn) ) 
+                     ENDIF
                   ENDIF
-                  IF( pun(ji-1,jj,jk) < 0. ) THEN
-                     zt1(ji-1,jj,jk) = e2u(ji-1,jj) * pun(ji-1,jj,jk) * ( tb(ji-1,jj,jk) + tb(ji  ,jj,jk) ) * 0.5
-                     zs1(ji-1,jj,jk) = e2u(ji-1,jj) * pun(ji-1,jj,jk) * ( sb(ji-1,jj,jk) + sb(ji  ,jj,jk) ) * 0.5
+                  IF( vmask(ji,jj,jk) == 0. ) THEN
+                     IF( pvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
+                        zwy(ji,jj+1,jk) = 0.5 * pvn(ji,jj+1,jk) * ( ptran(ji,jj+1,jk,jn) + ptran(ji,jj+2,jk,jn) )
+                     ENDIF
+                     IF( pvn(ji,jj-1,jk) < 0. ) THEN
+                        zwy(ji,jj-1,jk) = 0.5 * pvn(ji,jj-1,jk) * ( ptran(ji,jj-1,jk,jn) + ptran(ji,jj,jk,jn) ) 
+                     ENDIF
                   ENDIF
-               ENDIF
-               IF( vmask(ji,jj,jk) == 0. ) THEN
-                  IF( pvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
-                     zt2(ji,jj+1,jk) = e1v(ji,jj+1) * pvn(ji,jj+1,jk) * ( tb(ji,jj+1,jk) + tb(ji,jj+2,jk) ) * 0.5
-                     zs2(ji,jj+1,jk) = e1v(ji,jj+1) * pvn(ji,jj+1,jk) * ( sb(ji,jj+1,jk) + sb(ji,jj+2,jk) ) * 0.5
+               END DO
+            END DO
+         END DO
+
+         !                                                    ! lateral boundary conditions on zwx, zwy   (changed sign)
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )
+         ! Tracer flux divergence at t-point added to the general trend
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective trends 
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                  &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )
+                  ! added to the general tracer trends
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
+               END DO
+           END DO
+         END DO
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd ) THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptrab(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptrab(:,:,:,jn) )
+         END IF
+
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
+            IF( lk_zco ) THEN
+               DO jk = 1, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                       zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+            IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) )
+            IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+
+         ! II. Vertical advective fluxes
+         ! -----------------------------
+         !                                             !-- first guess of the slopes
+         zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0    ! surface & bottom boundary conditions
+         DO jk = 2, jpkm1                                     ! interior values
+            zwx(:,:,jk) = tmask(:,:,jk) * ( ptrab(:,:,jk-1,jn) - ptrab(:,:,jk,jn) )
+         END DO
+
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,1) = 0.e0                                  ! surface values
+         DO jk = 2, jpkm1                                     ! interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
+               END DO
+            END DO
+         END DO
+         !                                             !-- Slopes limitation
+         DO jk = 2, jpkm1                                     ! interior values
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
+               END DO
+            END DO
+         END DO
+         !                                             !-- vertical advective flux
+         !                                                    ! surface values  (bottom already set to zero)
+         IF( lk_vvl ) THEN    ;   zwx(:,:, 1 ) = 0.e0                      !  variable volume
+         ELSE                 ;   zwx(:,:, 1 ) = pwn(:,:,1) * ptrab(:,:,1,jn)   ! linear free surface
+         ENDIF
+         !
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = z2 * rdttra(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) )
+                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
+                  zalpha = 0.5 + z0w
+                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr
+                  zzwx = ptrab(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1)
+                  zzwy = ptrab(ji,jj,jk  ,jn) + zw * zslpx(ji,jj,jk  )
+                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 2, jpkm1        ! centered near the bottom
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( tmask(ji,jj,jk+1) == 0. ) THEN
+                     IF( pwn(ji,jj,jk) > 0. ) THEN
+                        zwx(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptran(ji,jj,jk-1,jn) + ptran(ji,jj,jk,jn) ) 
+                     ENDIF
                   ENDIF
-                  IF( pvn(ji,jj-1,jk) < 0. ) THEN
-                     zt2(ji,jj-1,jk) = e1v(ji,jj-1) * pvn(ji,jj-1,jk) * ( tb(ji,jj-1,jk) + tb(ji  ,jj,jk) ) * 0.5
-                     zs2(ji,jj-1,jk) = e1v(ji,jj-1) * pvn(ji,jj-1,jk) * ( sb(ji,jj-1,jk) + sb(ji  ,jj,jk) ) * 0.5
-                  ENDIF
-               ENDIF
-#else
-               IF( umask(ji,jj,jk) == 0. ) THEN
-                  IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
-                     zt1(ji+1,jj,jk) = e2u(ji+1,jj)* fse3u(ji+1,jj,jk)   &
-                        &            * pun(ji+1,jj,jk) * ( tb(ji+1,jj,jk) + tb(ji+2,jj,jk) ) * 0.5
-                     zs1(ji+1,jj,jk) = e2u(ji+1,jj)* fse3u(ji+1,jj,jk)   &
-                        &            * pun(ji+1,jj,jk) * ( sb(ji+1,jj,jk) + sb(ji+2,jj,jk) ) * 0.5
-                  ENDIF
-                  IF( pun(ji-1,jj,jk) < 0. ) THEN
-                     zt1(ji-1,jj,jk) = e2u(ji-1,jj)* fse3u(ji-1,jj,jk)   &
-                        &            * pun(ji-1,jj,jk) * ( tb(ji-1,jj,jk) + tb(ji  ,jj,jk) ) * 0.5
-                     zs1(ji-1,jj,jk) = e2u(ji-1,jj)* fse3u(ji-1,jj,jk)   &
-                        &            * pun(ji-1,jj,jk) * ( sb(ji-1,jj,jk) + sb(ji  ,jj,jk) ) * 0.5
-                  ENDIF
-               ENDIF
-               IF( vmask(ji,jj,jk) == 0. ) THEN
-                  IF( pvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
-                     zt2(ji,jj+1,jk) = e1v(ji,jj+1) * fse3v(ji,jj+1,jk)   &
-                        &            * pvn(ji,jj+1,jk) * ( tb(ji,jj+1,jk) + tb(ji,jj+2,jk) ) * 0.5
-                     zs2(ji,jj+1,jk) = e1v(ji,jj+1) * fse3v(ji,jj+1,jk)   &
-                        &            * pvn(ji,jj+1,jk) * ( sb(ji,jj+1,jk) + sb(ji,jj+2,jk) ) * 0.5
-                  ENDIF
-                  IF( pvn(ji,jj-1,jk) < 0. ) THEN
-                     zt2(ji,jj-1,jk) = e1v(ji,jj-1)* fse3v(ji,jj-1,jk)   &
-                        &            * pvn(ji,jj-1,jk) * ( tb(ji,jj-1,jk) + tb(ji  ,jj,jk) ) * 0.5
-                     zs2(ji,jj-1,jk) = e1v(ji,jj-1)* fse3v(ji,jj-1,jk)   &
-                        &            * pvn(ji,jj-1,jk) * ( sb(ji,jj-1,jk) + sb(ji  ,jj,jk) ) * 0.5
-                  ENDIF
-               ENDIF
-#endif
-            END DO
-         END DO
-      END DO
-
-      ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign)
-      CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. ) 
-      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. )
-
-      ! Compute & add the horizontal advective trend
-
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
-#else
-               zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-#endif
-               ! horizontal advective trends
-               zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk  )   &
-                  &           + zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk  ) )
-               zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj  ,jk  )   &
-                  &           + zs2(ji,jj,jk) - zs2(ji  ,jj-1,jk  ) ) 
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
-            END DO
-        END DO
-      END DO        
-
-      ! Save the horizontal advective trends for diagnostic
-      IF( l_trdtra ) THEN
-         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0
-         !
-         ! T/S ZONAL advection trends
+               END DO
+            END DO
+         END DO
+
+         ! Compute & add the vertical advective trend
          DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-#if defined key_zco
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              &
-                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr
-#else
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
-#endif
-                  ztrdt(ji,jj,jk) = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x
-                  ztrds(ji,jj,jk) = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)
-
-         ! T/S MERIDIONAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-#if defined key_zco
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                  z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              &
-                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr
-#else
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
-#endif
-                  ztrdt(ji,jj,jk) = - zbtr * ( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y          
-                  ztrds(ji,jj,jk) = - zbtr * ( zs2(ji,jj,jk) - zs2(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)
-
-         ! Save the up-to-date ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = sa(:,:,:) 
-         !
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl2 had  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=              ' Sa: ', mask2=tmask, clinfo3='tra')
-
-      ! "zonal" mean advective heat and salt transport
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         IF( lk_zco ) THEN
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                    zt2(ji,jj,jk) = zt2(ji,jj,jk) * fse3v(ji,jj,jk)
-                    zs2(ji,jj,jk) = zs2(ji,jj,jk) * fse3v(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
-         pht_adv(:) = ptr_vj( zt2(:,:,:) )
-         pst_adv(:) = ptr_vj( zs2(:,:,:) )
-      ENDIF
-
-      ! II. Vertical advective fluxes
-      ! -----------------------------
-      
-      ! First guess of the slope
-      ! interior values
-      DO jk = 2, jpkm1
-         zt1(:,:,jk) = tmask(:,:,jk) * ( tb(:,:,jk-1) - tb(:,:,jk) )
-         zs1(:,:,jk) = tmask(:,:,jk) * ( sb(:,:,jk-1) - sb(:,:,jk) )
-      END DO
-      ! surface & bottom boundary conditions
-      zt1 (:,:, 1 ) = 0.e0    ;    zt1 (:,:,jpk) = 0.e0
-      zs1 (:,:, 1 ) = 0.e0    ;    zs1 (:,:,jpk) = 0.e0
-
-      ! Slopes
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji,jj,jk+1) ) )
-               zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji,jj,jk+1) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji,jj,jk+1) ) )
-            END DO
-         END DO
-      END DO
-
-      ! Slopes limitation
-      ! interior values
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( ztp1(ji,jj,jk  ) ),   &
-                  &                  2.*ABS( zt1 (ji,jj,jk+1) ),   &
-                  &                  2.*ABS( zt1 (ji,jj,jk  ) ) )
-               zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( zsp1(ji,jj,jk  ) ),   &
-                  &                  2.*ABS( zs1 (ji,jj,jk+1) ),   &
-                  &                  2.*ABS( zs1 (ji,jj,jk  ) ) )
-            END DO
-         END DO
-      END DO
-      ! surface values
-      ztp1(:,:,1) = 0.e0
-      zsp1(:,:,1) = 0.e0
-
-      ! vertical advective flux
-      ! interior values
-      DO jk = 1, jpkm1
-         zstep  = z2 * rdttra(jk)
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zew = pwn(ji,jj,jk+1)
-               z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
-               zalpha = 0.5 + z0w
-               zw  = z0w - 0.5 * pwn(ji,jj,jk+1)*zstep / fse3w(ji,jj,jk+1)
-               zzt1 = tb(ji,jj,jk+1) + zw*ztp1(ji,jj,jk+1)
-               zzt2 = tb(ji,jj,jk  ) + zw*ztp1(ji,jj,jk  )
-               zzs1 = sb(ji,jj,jk+1) + zw*zsp1(ji,jj,jk+1)
-               zzs2 = sb(ji,jj,jk  ) + zw*zsp1(ji,jj,jk  )
-               zt1(ji,jj,jk+1) = zew * ( zalpha * zzt1 + (1.-zalpha)*zzt2 )
-               zs1(ji,jj,jk+1) = zew * ( zalpha * zzs1 + (1.-zalpha)*zzs2 )
-            END DO
-         END DO
-      END DO
-      DO jk = 2, jpkm1
-        DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               IF( tmask(ji,jj,jk+1) == 0. ) THEN
-                  IF( pwn(ji,jj,jk) > 0. ) THEN
-                     zt1(ji,jj,jk) = pwn(ji,jj,jk) * ( tb(ji,jj,jk-1) + tb(ji,jj,jk) ) * 0.5
-                     zs1(ji,jj,jk) = pwn(ji,jj,jk) * ( sb(ji,jj,jk-1) + sb(ji,jj,jk) ) * 0.5
-                  ENDIF
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! surface values
-      IF( lk_vvl ) THEN
-         ! variable volume : flux set to zero
-         zt1(:,:, 1 ) = 0.e0
-         zs1(:,:, 1 ) = 0.e0
-      ELSE
-         ! free surface-constant volume
-         zt1(:,:, 1 ) = pwn(:,:,1) * tb(:,:,1)
-         zs1(:,:, 1 ) = pwn(:,:,1) * sb(:,:,1)
-      ENDIF
-
-      ! bottom values
-      zt1(:,:,jpk) = 0.e0
-      zs1(:,:,jpk) = 0.e0
-
-
-      ! Compute & add the vertical advective trend
-
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr = 1. / fse3t(ji,jj,jk)
-               ! horizontal advective trends
-               zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
-               zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji,jj,jk+1) )
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) =  ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa
-            END DO
-         END DO
-      END DO
-
-      ! Save the vertical advective trends for diagnostic
-      IF( l_trdtra )   THEN
-         ! Recompute the vertical advection zta & zsa trends computed 
-         ! at the step 2. above in making the difference between the new 
-         ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract
-         ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends
-
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk)
-#else
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
-#endif
-                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
-                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn 
-                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)
-         !
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl2 zad  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=              ' Sa: ', mask2=tmask, clinfo3='tra' )
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! vertical advective trends 
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
+                  ! added to the general tracer trends
+                  ptraa(ji,jj,jk,jn) =  ptraa(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+
+         ! Save the vertical advective trends for diagnostic
+         ! -------------------------------------------------
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwx, pwn, ptrab(:,:,:,jn) )
+         !
+      ENDDO
       !
    END SUBROUTINE tra_adv_muscl2
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_qck.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 2024)
@@ -2,7 +2,8 @@
    !!==============================================================================
    !!                       ***  MODULE  traadv_qck  ***
-   !! Ocean active tracers:  horizontal & vertical advective trend
+   !! Ocean tracers:  horizontal & vertical advective trend
    !!==============================================================================
    !! History :  3.0  !  2008-07  (G. Reffray)  Original code
+   !!            3.3  !  2010-05  (C.Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
    !!----------------------------------------------------------------------
 
@@ -16,6 +17,6 @@
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce         ! ocean space and time domain
+   USE trdtra      ! ocean tracers trends 
    USE trabbl          ! advective term in the BBL
    USE lib_mpp         ! distribued memory computing
@@ -24,5 +25,4 @@
    USE in_out_manager  ! I/O manager
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
 
    IMPLICIT NONE
@@ -31,6 +31,6 @@
    PUBLIC   tra_adv_qck   ! routine called by step.F90
 
-   REAL(wp), DIMENSION(jpi,jpj) ::   btr2
-   REAL(wp)                     ::   r1_6
+   REAL(wp)  ::   r1_6 = 1./ 6.
+   LOGICAL   :: l_trd    ! flag to compute trends
 
    !! * Substitutions
@@ -45,5 +45,6 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_qck( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_qck ( kt   , cdtype, pun  , pvn, pwn, &
+      &                     ptrab, ptran , ptraa, kjpt   )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_qck  ***
@@ -69,5 +70,5 @@
       !!         dt = 2*rdtra and the scalar values are tb and sb
       !!
-      !!       On the vertical, the simple centered scheme used tn and sn
+      !!       On the vertical, the simple centered scheme used ptran
       !!
       !!               The fluxes are bounded by the ULTIMATE limiter to
@@ -75,20 +76,18 @@
       !!            prevent the appearance of spurious numerical oscillations
       !!
-      !! ** Action : - update (ta,sa) with the now advective tracer trends
-      !!             - save the trends ('key_trdtra')
+      !! ** Action : - update (ptraa) with the now advective tracer trends
+      !!             - save the trends 
       !!
       !! ** Reference : Leonard (1979, 1991)
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as workspace
-      USE oce, ONLY :   ztrds => va   ! use va as workspace
-      !!
-      INTEGER , INTENT(in)                         ::  kt  ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pun ! effective ocean velocity, u_component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pvn ! effective ocean velocity, v_component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pwn ! effective ocean velocity, w_component
-      !!
-      INTEGER  ::   ji, jj, jk                          ! dummy loop indices
-      REAL(wp) ::   z_hdivn_x, z_hdivn_y, z_hdivn       ! temporary scalars
-      REAL(wp) ::   zbtr, z2                            !    "         "
+      !!* Arguments
+      INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptrab, ptran        ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptraa           ! tracer trend 
+      !!* Local declarations
+      REAL(wp) ::   z2                            !    temporary scalar
       !!----------------------------------------------------------------------
 
@@ -98,6 +97,7 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
          IF(lwp) WRITE(numout,*)
-         btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
-         r1_6      = 1. / 6.
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
 
@@ -109,392 +109,366 @@
       !---------------------------------------------------------------------------
 
-      CALL tra_adv_qck_i( pun, tb, tn, ta, ztrdt, z2)
-      CALL tra_adv_qck_i( pun, sb, sn, sa, ztrds, z2)
-
-      IF( l_trdtra ) CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)
-
-      CALL tra_adv_qck_j( kt, pvn, tb, tn, ta, ztrdt, pht_adv, z2)
-      CALL tra_adv_qck_j( kt, pvn, sb, sn, sa, ztrds, pst_adv, z2)  
-
-      IF( l_trdtra ) THEN
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)
-         !
-         ztrdt(:,:,:) = ta(:,:,:)    ! Save the horizontal up-to-date ta/sa trends
-         ztrds(:,:,:) = sa(:,:,:)
-      END IF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' qck had  - Ta: ', mask1=tmask, &
-         &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+      CALL tra_adv_qck_i( kt   , cdtype, pun  , z2,  &
+      &                   ptrab, ptran , ptraa, kjpt )
+      CALL tra_adv_qck_j( kt   , cdtype, pvn  , z2,  &
+      &                   ptrab, ptran , ptraa, kjpt )
 
       ! II. The vertical fluxes are computed with the 2nd order centered scheme
       !-------------------------------------------------------------------------
       !
-      CALL tra_adv_cen2_k( pwn, tn, ta )
-      CALL tra_adv_cen2_k( pwn, sn, sa )
-      !
-      !Save the vertical advective trends for diagnostic
-      ! ----------------------------------------------------
-      IF( l_trdtra )   THEN
-         ! Recompute the vertical advection zta & zsa trends computed
-         ! at the step 2. above in making the difference between the new
-         ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract
-         ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends
-
-         DO jk = 1, jpkm1
+      CALL tra_adv_cen2_k( kt   , cdtype, pwn,      &
+      &                    ptran, ptraa , kjpt      )
+      !
+   END SUBROUTINE tra_adv_qck
+
+   SUBROUTINE tra_adv_qck_i( kt   , cdtype, pun  , pz2,   &
+      &                      ptrab, ptran , ptraa, kjpt   )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      !!* Module used
+      USE oce         , zwx => ua   ! use ua as workspace
+      !!* Arguments
+      INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pun             ! zonal velocity component
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptrab, ptran    ! before tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptraa           ! tracer trend 
+      REAL(wp)        , INTENT(in   )                               ::   pz2
+      !!* Local declarations
+      INTEGER  :: ji, jj, jk, jn           ! dummy loop indices
+      REAL(wp) :: ztra, zbtr               ! temporary scalars
+      REAL(wp) :: zdir, zdx, zdt, zmsk     ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu, zfc, zfd
+      !----------------------------------------------------------------------
+
+      
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         zfu(:,:,:) = 0.0     ;   zfc(:,:,:) = 0.0  
+         zfd(:,:,:) = 0.0     ;   zwx(:,:,:) = 0.0     
+         !                                                  
+         DO jk = 1, jpkm1                                
+            !                                             
+            !--- Computation of the ustream and downstream value of the tracer and the mask
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-                  zbtr      = btr2(ji,jj)
-                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk)
-#else
-                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
-#endif
-                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
-                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn
-                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' qck zad  - Ta: ', mask1=tmask, &
-         &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
-      !
-   END SUBROUTINE tra_adv_qck
-
-
-   SUBROUTINE tra_adv_qck_i ( pun, tra, tran, traa, ztrdtra, z2 )
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      REAL,     INTENT(in)                            :: z2
-      REAL(wp), INTENT(in)   , DIMENSION(jpi,jpj,jpk) :: pun, tra, tran  ! horizontal effective velocity
-      REAL(wp), INTENT(out)  , DIMENSION(jpi,jpj,jpk) :: ztrdtra
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: traa
-      !
-      INTEGER  :: ji, jj, jk
-      REAL(wp) :: za, zbtr, dir, dx, dt     ! temporary scalars
-      REAL(wp) :: z_hdivn_x
-      REAL(wp), DIMENSION(jpi,jpj)     ::  zmask, zupst, zdwst, zc_cfl
-      REAL(wp), DIMENSION(jpi,jpj)     ::  zfu, zfc, zfd, zfho, zmskl, zsc_e 
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zflux
-      !----------------------------------------------------------------------
-
-      zfu   (:,jpj) = 0.e0   ;   zfc   (:,jpj) = 0.e0
-      zfd   (:,jpj) = 0.e0   ;   zc_cfl(:,jpj) = 0.e0
-      zsc_e (:,jpj) = 0.e0   ;   zmskl (:,jpj) = 0.e0
-      zfho  (:,jpj) = 0.e0
-                                                       ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !--- Computation of the ustream and downstream value of the tracer and the mask
-         DO jj = 2, jpjm1
-            DO ji = 2, fs_jpim1   ! vector opt.
-               ! Upstream in the x-direction for the tracer
-               zupst(ji,jj)=tra(ji-1,jj,jk)
-               ! Downstream in the x-direction for the tracer
-               zdwst(ji,jj)=tra(ji+1,jj,jk)
-               ! Mask at the T-points in the x-direction (mask=0 or mask=1)
-               zmask(ji,jj)=tmask(ji-1,jj,jk)+tmask(ji,jj,jk)+tmask(ji+1,jj,jk)-2
-            END DO
-         END DO
-         !
-         !--- Lateral boundary conditions 
-         CALL lbc_lnk( zupst(:,:), 'T', 1. )
-         CALL lbc_lnk( zdwst(:,:), 'T', 1. ) 
-         CALL lbc_lnk( zmask(:,:), 'T', 1. ) 
+                  ! Upstream in the x-direction for the tracer
+                  zfc(ji,jj,jk) = ptrab(ji-1,jj,jk,jn)
+                  ! Downstream in the x-direction for the tracer
+                  zfd(ji,jj,jk) = ptrab(ji+1,jj,jk,jn)
+               END DO
+            END DO
+         END DO
+         !
+         !--- Lateral boundary conditions 
+         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zfd(:,:,:), 'T', 1. ) 
+         
          !
          ! Horizontal advective fluxes
          ! ---------------------------
          !
-         dt = z2 * rdttra(jk)
-         !--- tracer flux at u-points
-         DO jj = 1, jpjm1
-            DO ji = 1, jpi
-#if defined key_zco
-               zsc_e(ji,jj) = e2u(ji,jj)
-#else
-               zsc_e(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk)
-#endif
-               dir = 0.5 + sign(0.5,pun(ji,jj,jk))                             ! if pun>0 : dir = 1 otherwise dir = 0
-               dx = dir * e1t(ji,jj) + (1-dir)* e1t(ji+1,jj)
-               zc_cfl (ji,jj) = ABS(pun(ji,jj,jk))*dt/dx                       ! (0<zc_cfl<1 : Courant number on x-direction)
-
-               zfu(ji,jj)   = dir*zupst(ji  ,jj   )+(1-dir)*zdwst(ji+1,jj   )  ! FU in the x-direction for T
-               zfc(ji,jj)   = dir*tra  (ji  ,jj,jk)+(1-dir)*tra  (ji+1,jj,jk)  ! FC in the x-direction for T
-               zfd(ji,jj)   = dir*tra  (ji+1,jj,jk)+(1-dir)*tra  (ji  ,jj,jk)  ! FD in the x-direction for T
-               zmskl(ji,jj) = dir*zmask(ji  ,jj)   +(1-dir)*zmask(ji+1,jj)
-           END DO
-         END DO
-         !
+         DO jk = 1, jpkm1                             
+            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 
+                  zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T 
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1  
+            zdt =  pz2 * rdttra(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)
+                  zfc(ji,jj,jk)  = zdir * ptrab(ji  ,jj,jk,jn) + ( 1. - zdir ) * ptrab(ji+1,jj,jk,jn)  ! FC in the x-direction for T
+                  zfd(ji,jj,jk)  = zdir * ptrab(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptrab(ji  ,jj,jk,jn)  ! FD in the x-direction for T
+               END DO
+            END DO
+         END DO      !
+
+         !--- Lateral boundary conditions 
+         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zfd(:,:,:), 'T', 1. )
+         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zwx(:,:,:), 'T', 1. )
+
          !--- QUICKEST scheme
+         CALL quickest( zfu, zfd, zfc, zwx )
+         !
+         ! Mask at the T-points in the x-direction (mask=0 or mask=1)
+         DO jk = 1, jpkm1  
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.               
+                  zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2.
+               ENDDO
+            END DO
+         END DO
+         !--- Lateral boundary conditions 
+         CALL lbc_lnk( zfu(:,:,:), 'T', 1. ) 
+         !
          ! Tracer flux on the x-direction
-         CALL quickest(zfu,zfd,zfc,zfho,zc_cfl)
-         !--- If the second ustream point is a land point
-         !--- the flux is computed by the 1st order UPWIND scheme
-         zfho(:,:) = zmskl(:,:)*zfho(:,:) + (1.-zmskl(:,:))*zfc(:,:)
-         !--- Computation of fluxes
-         zflux(:,:,jk) = zsc_e(:,:)*pun(:,:,jk)*zfho(:,:)
-         !
-         !--- Tracer flux divergence at t-point added to the general trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               !--- horizontal advective trends
-#if defined key_zco
-               zbtr = btr2(ji,jj)
-#else
-               zbtr = btr2(ji,jj) / fse3t(ji,jj,jk)              
-#endif
-               za = - zbtr * ( zflux(ji,jj,jk) - zflux(ji-1,jj,jk) )
-               !--- add it to the general tracer trends
-               traa(ji,jj,jk) = traa(ji,jj,jk) + za
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-      !
-      !  Save the horizontal advective trends for diagnostic
-      ! -----------------------------------------------------
-      IF( l_trdtra ) THEN
-         ! T/S ZONAL advection trends
-         ztrdtra(:,:,:) = 0.e0
-         !
-         DO jk = 1, jpkm1
+         DO jk = 1, jpkm1  
+            !
+            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 
+                  !--- If the second ustream point is a land point
+                  !--- the flux is computed by the 1st order UPWIND scheme
+                  zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji+1,jj,jk)
+                  zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk)
+                  zwx(ji,jj,jk) = zwx(ji,jj,jk) * pun(ji,jj,jk)
+               END DO
+            END DO
+            !
+            ! Computation of the trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective trends
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) )
+                  !--- add it to the general tracer trends
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !
+         END DO
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptran(:,:,:,jn) )
+         !
+      END DO
+      !
+   END SUBROUTINE tra_adv_qck_i
+
+   SUBROUTINE tra_adv_qck_j( kt   , cdtype, pvn  , pz2,   &
+      &                      ptrab, ptran , ptraa, kjpt   )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      !!* Module used
+      USE oce         , zwy => ua   ! use ua as workspace
+      !!* Arguments
+      INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pvn             ! meridional velocity component
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptrab, ptran    ! before tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptraa           ! tracer trend 
+      REAL(wp)        , INTENT(in   )                               ::   pz2
+      !!* Local declarations
+      INTEGER  :: ji, jj, jk, jn           ! dummy loop indices
+      REAL(wp) :: ztra, zbtr               ! temporary scalars
+      REAL(wp) :: zdir, zdx, zdt, zmsk     ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu, zfc, zfd
+      !----------------------------------------------------------------------
+
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         zfu(:,:,:) = 0.0     ;   zfc(:,:,:) = 0.0  
+         zfd(:,:,:) = 0.0     ;   zwy(:,:,:) = 0.0     
+         !                                                  
+         DO jk = 1, jpkm1                                
+            !                                             
+            !--- Computation of the ustream and downstream value of the tracer and the mask
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-#if defined key_zco
-                  zbtr      = btr2(ji,jj)
-                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              &
-                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr
-#else
-                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
-#endif
-                  ztrdtra(ji,jj,jk) = - zbtr * ( zflux(ji,jj,jk) - zflux(ji-1,jj,jk) ) + tran(ji,jj,jk) * z_hdivn_x
-               END DO
-            END DO
-         END DO
-      END IF
-
-   END SUBROUTINE tra_adv_qck_i
-
-
-   SUBROUTINE tra_adv_qck_j ( kt, pvn, tra, tran, traa, ztrdtra, trd_adv, z2 )
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER,  INTENT(in)                            :: kt              ! ocean time-step index
-      REAL,     INTENT(in)                            :: z2
-      REAL(wp), INTENT(in)   , DIMENSION(jpi,jpj,jpk) :: pvn, tra, tran  ! horizontal effective velocity
-      REAL(wp), INTENT(out)  , DIMENSION(jpj)         :: trd_adv
-      REAL(wp), INTENT(out)  , DIMENSION(jpi,jpj,jpk) :: ztrdtra
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: traa
-      !!
-      INTEGER  :: ji, jj, jk
-      REAL(wp) :: za, zbtr, dir, dx, dt     ! temporary scalars
-      REAL(wp) :: z_hdivn_y
-      REAL(wp), DIMENSION(jpi,jpj)     ::  zmask, zupst, zdwst, zc_cfl
-      REAL(wp), DIMENSION(jpi,jpj)     ::  zfu, zfc, zfd, zfho, zmskl, zsc_e
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zflux
-      !----------------------------------------------------------------------
-      ! II. Part 2 : y-direction
-      !----------------------------------------------------------------------
-
-      zfu   (:,jpj) = 0.e0   ;   zfc   (:,jpj) = 0.e0
-      zfd   (:,jpj) = 0.e0   ;   zc_cfl(:,jpj) = 0.e0
-      zsc_e (:,jpj) = 0.e0   ;   zmskl (:,jpj) = 0.e0
-      zfho  (:,jpj) = 0.e0
-
-                                                       ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !--- Computation of the ustream and downstream value of the tracer and the mask
-         DO jj = 2, jpjm1
-            DO ji = 2, fs_jpim1   ! vector opt.
-               ! Upstream in the x-direction for the tracer
-               zupst(ji,jj)=tra(ji,jj-1,jk)
-               ! Downstream in the x-direction for the tracer
-               zdwst(ji,jj)=tra(ji,jj+1,jk)
-               ! Mask at the T-points in the x-direction (mask=0 or mask=1)
-               zmask(ji,jj)=tmask(ji,jj-1,jk)+tmask(ji,jj,jk)+tmask(ji,jj+1,jk)-2
-            END DO
-         END DO
-         !
-         !--- Lateral boundary conditions
-         CALL lbc_lnk( zupst(:,:), 'T', 1. )
-         CALL lbc_lnk( zdwst(:,:), 'T', 1. )
-         CALL lbc_lnk( zmask(:,:), 'T', 1. )
+                  ! Upstream in the x-direction for the tracer
+                  zfc(ji,jj,jk) = ptrab(ji,jj-1,jk,jn)
+                  ! Downstream in the x-direction for the tracer
+                  zfd(ji,jj,jk) = ptrab(ji,jj+1,jk,jn)
+               END DO
+            END DO
+         END DO
+         !
+         !--- Lateral boundary conditions 
+         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zfd(:,:,:), 'T', 1. ) 
+         
          !
          ! Horizontal advective fluxes
          ! ---------------------------
          !
-         dt = z2 * rdttra(jk)
-         !--- tracer flux at v-points
-         DO jj = 1, jpjm1
+         DO jk = 1, jpkm1                             
+            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 
+                  zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T 
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1  
+            zdt =  pz2 * rdttra(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)
+                  zfc(ji,jj,jk)  = zdir * ptrab(ji,jj  ,jk,jn) + ( 1. - zdir ) * ptrab(ji,jj+1,jk,jn)  ! FC in the x-direction for T
+                  zfd(ji,jj,jk)  = zdir * ptrab(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptrab(ji,jj  ,jk,jn)  ! FD in the x-direction for T
+               END DO
+            END DO
+         END DO      !
+
+         !--- Lateral boundary conditions 
+         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zfd(:,:,:), 'T', 1. )
+         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zwy(:,:,:), 'T', 1. )
+
+         !--- QUICKEST scheme
+         CALL quickest( zfu, zfd, zfc, zwy )
+         !
+         ! Mask at the T-points in the x-direction (mask=0 or mask=1)
+         DO jk = 1, jpkm1  
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.               
+                  zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2.
+               ENDDO
+            END DO
+         END DO
+         !--- Lateral boundary conditions 
+         CALL lbc_lnk( zfu(:,:,:), 'T', 1. ) 
+         !
+         ! Tracer flux on the x-direction
+         DO jk = 1, jpkm1  
+            !
+            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 
+                  !--- If the second ustream point is a land point
+                  !--- the flux is computed by the 1st order UPWIND scheme
+                  zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji,jj+1,jk)
+                  zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk)
+                  zwy(ji,jj,jk) = zwy(ji,jj,jk) * pvn(ji,jj,jk)
+               END DO
+            END DO
+            !
+            ! Computation of the trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective trends
+                  ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) )
+                  !--- add it to the general tracer trends
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !
+         END DO
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptran(:,:,:,jn) )
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) )
+           IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+         !
+      END DO
+
+   END SUBROUTINE tra_adv_qck_j
+
+   SUBROUTINE tra_adv_cen2_k( kt   , cdtype, pwn,   &
+     &                        ptran, ptraa , kjpt   )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      !!* Module used
+      USE oce         , zwz => ua   ! use ua as workspace
+      !!* Arguments
+      INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pwn             ! vertical velocity component
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptran           ! now tracer field
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptraa           ! tracer trend 
+      !!* Local declarations
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zbtr , ztra      ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      !
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         zwz(:,:,jpk) = 0.e0             ! Bottom value : flux set to zero
+         !
+         !                                 ! Surface value
+         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                      ! Variable volume : flux set to zero
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptran(:,:,1,jn)   ! Constant volume : advective flux through the surface
+         ENDIF
+         !
+         DO jk = 2, jpkm1                  ! Interior point: second order centered tracer flux at w-point
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptran(ji,jj,jk-1,jn) + ptran(ji,jj,jk,jn) )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! k- vertical advective trends 
+                  ztra = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) 
+                  ! added to the general tracer trends
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+         !                                 ! Save the vertical advective trends for diagnostic
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, ptran(:,:,:,jn) )
+         !
+      END DO
+      !
+   END SUBROUTINE tra_adv_cen2_k
+
+
+   SUBROUTINE quickest( pfu, pfd, pfc, puc )
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose :  Computation of advective flux with Quickest scheme
+      !!
+      !! ** Method :   
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in)    , DIMENSION(jpi,jpj,jpk) :: pfu   ! second upwind point
+      REAL(wp), INTENT(in)    , DIMENSION(jpi,jpj,jpk) :: pfd   ! first douwning point
+      REAL(wp), INTENT(in)    , DIMENSION(jpi,jpj,jpk) :: pfc   ! the central point (or the first upwind point)
+      REAL(wp), INTENT(inout) , DIMENSION(jpi,jpj,jpk) :: puc   ! input as Courant number ; output as flux
+      !!
+      INTEGER  ::  ji, jj, jk               ! dummy loop indices 
+      REAL(wp) ::  zcoef1, zcoef2, zcoef3   ! temporary scalars          
+      REAL(wp) ::  zc, zcurv, zfho          ! 
+      !----------------------------------------------------------------------
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
             DO ji = 1, jpi
-#if defined key_zco
-               zsc_e(ji,jj) = e1v(ji,jj)
-#else
-               zsc_e(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk)
-#endif
-               dir = 0.5 + sign(0.5,pvn(ji,jj,jk))                             ! if pvn>0 : dir = 1 otherwise dir = 0
-               dx = dir * e2t(ji,jj) + (1-dir)* e2t(ji,jj+1)
-               zc_cfl(ji,jj) = ABS(pvn(ji,jj,jk))*dt/dx                        ! (0<zc_cfl<1 : Courant number on y-direction)
-
-               zfu(ji,jj)   = dir*zupst(ji,jj     )+(1-dir)*zdwst(ji,jj+1   )  ! FU in the y-direction for T
-               zfc(ji,jj)   = dir*tra  (ji,jj  ,jk)+(1-dir)*tra  (ji,jj+1,jk)  ! FC in the y-direction for T
-               zfd(ji,jj)   = dir*tra  (ji,jj+1,jk)+(1-dir)*tra  (ji,jj  ,jk)  ! FD in the y-direction for T
-               zmskl(ji,jj) = dir*zmask(ji,jj     )+(1-dir)*zmask(ji,jj+1)
-            END DO
-         END DO
-         !
-         !--- QUICKEST scheme
-         ! Tracer flux on the y-direction
-         CALL quickest(zfu,zfd,zfc,zfho,zc_cfl)
-         !--- If the second ustream point is a land point
-         !--- the flux is computed by the 1st order UPWIND scheme
-         zfho(:,:) = zmskl(:,:)*zfho(:,:) + (1.-zmskl(:,:))*zfc(:,:)
-         !--- Computation of fluxes
-         zflux(:,:,jk) = zsc_e(:,:)*pvn(:,:,jk)*zfho(:,:)
-         !
-         !--- Tracer flux divergence at t-point added to the general trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               !--- horizontal advective trends
-#if defined key_zco
-               zbtr = btr2(ji,jj)
-#else
-               zbtr = btr2(ji,jj) / fse3t(ji,jj,jk)
-#endif
-               za = - zbtr * ( zflux(ji,jj,jk) - zflux(ji,jj-1,jk) )
-               !--- add it to the general tracer trends
-               traa(ji,jj,jk) = traa(ji,jj,jk) + za
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-      !
-      !  Save the horizontal advective trends for diagnostic
-      ! -----------------------------------------------------
-      IF( l_trdtra ) THEN
-         ! T/S MERIDIONAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-#if defined key_zco
-                  zbtr      = btr2(ji,jj)
-                  z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              &
-                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr
-#else
-                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
-#endif
-                  ztrdtra(ji,jj,jk) = - zbtr * ( zflux(ji,jj,jk) - zflux(ji,jj-1,jk) ) + tran(ji,jj,jk) * z_hdivn_y
-               END DO
-            END DO
-         END DO
-      END IF
-
-      ! "zonal" mean advective heat and salt transport
-      ! ----------------------------------------------
-
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         IF( lk_zco ) THEN
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                    zflux(ji,jj,jk) = zflux(ji,jj,jk) * fse3v(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
-         trd_adv(:) = ptr_vj( zflux(:,:,:) )
-      ENDIF
-
-   END SUBROUTINE tra_adv_qck_j
-
-
-   SUBROUTINE tra_adv_cen2_k ( pwn, ptn, pta )
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk)  :: pwn   ! vertical effective velocity
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk)  :: ptn   ! now tracer
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk)  :: pta   ! tracer general trend
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zflux   ! 3D workspace
-      !!----------------------------------------------------------------------
-      !
-      !                         !==  Vertical advective fluxes  ==!
-      zflux(:,:,jpk) = 0.e0             ! Bottom value : flux set to zero
-      !
-      !                                 ! Surface value
-      IF( lk_vvl ) THEN   ;   zflux(:,:, 1 ) = 0.e0                      ! Variable volume : flux set to zero
-      ELSE                ;   zflux(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1)   ! Constant volume : advective flux through the surface
-      ENDIF
-      !
-      DO jk = 2, jpkm1                  ! Interior point: second order centered tracer flux at w-point
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zflux(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1) + ptn(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
-      !
-      DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==!
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               pta(ji,jj,jk) =  pta(ji,jj,jk) - ( zflux(ji,jj,jk) - zflux(ji,jj,jk+1) )   &
-                  &                           /   fse3t(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      !
-   END SUBROUTINE tra_adv_cen2_k
-
-
-   SUBROUTINE quickest( fu, fd, fc, fho, fc_cfl )
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in)  , DIMENSION(jpi,jpj) :: fu, fd, fc, fc_cfl  
-      REAL(wp), INTENT(out) , DIMENSION(jpi,jpj) :: fho
-      REAL(wp)              , DIMENSION(jpi,jpj) :: zcurv, zcoef1, zcoef2, zcoef3  ! temporary scalars
-      !
-      zcurv (:,:) = fd(:,:) + fu(:,:) - 2.*fc(:,:)
-      zcoef1(:,:) = 0.5*( fc(:,:) + fd(:,:) )
-      zcoef2(:,:) = 0.5*fc_cfl(:,:)*( fd(:,:) - fc(:,:) )
-      zcoef3(:,:) = ( ( 1. - ( fc_cfl(:,:)*fc_cfl(:,:) ) )*r1_6 )*zcurv(:,:)
-      fho   (:,:) = zcoef1(:,:) - zcoef2(:,:) - zcoef3(:,:)                         ! phi_f QUICKEST 
-      !
-      zcoef1(:,:) = fd(:,:) - fu(:,:)                                               ! DEL
-      zcoef2(:,:) = ABS( zcoef1(:,:) )                                              ! ABS(DEL)
-      zcoef3(:,:) = ABS( zcurv(:,:) )                                               ! ABS(CURV)
-      !
-      WHERE ( zcoef3(:,:) >= zcoef2(:,:) ) 
-        fho(:,:) = fc(:,:)
-      ELSEWHERE
-        zcoef3(:,:) = fu(:,:) + ( ( fc(:,:) - fu(:,:) )/MAX(fc_cfl(:,:),1.e-9) )    ! phi_REF
-          WHERE ( zcoef1(:,:) >= 0.e0 )
-            fho(:,:) = MAX(fc(:,:),fho(:,:))
-            fho(:,:) = MIN(fho(:,:),MIN(zcoef3(:,:),fd(:,:)))
-          ELSEWHERE
-            fho(:,:) = MIN(fc(:,:),fho(:,:))
-            fho(:,:) = MAX(fho(:,:),MAX(zcoef3(:,:),fd(:,:)))
-          ENDWHERE
-      ENDWHERE
+               zc     = puc(ji,jj,jk)                         ! Courant number
+               zcurv  = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk)
+               zcoef1 = 0.5 *      ( pfc(ji,jj,jk) + pfd(ji,jj,jk) )
+               zcoef2 = 0.5 * zc * ( pfd(ji,jj,jk) - pfc(ji,jj,jk) )
+               zcoef3 = ( 1. - ( zc * zc ) ) * r1_6 * zcurv
+               zfho   = zcoef1 - zcoef2 - zcoef3              !  phi_f QUICKEST 
+               !
+               zcoef1 = pfd(ji,jj,jk) - pfu(ji,jj,jk)
+               zcoef2 = ABS( zcoef1 )
+               zcoef3 = ABS( zcurv )
+               IF( zcoef3 >= zcoef2 ) THEN
+                  zfho = pfc(ji,jj,jk) 
+               ELSE
+                  zcoef3 = pfu(ji,jj,jk) + ( ( pfc(ji,jj,jk) - pfu(ji,jj,jk) ) / MAX( zc, 1.e-9 ) )    ! phi_REF
+                  IF( zcoef1 >= 0. ) THEN
+                     zfho = MAX( pfc(ji,jj,jk), zfho ) 
+                     zfho = MIN( zfho, MIN( zcoef3, pfd(ji,jj,jk) ) ) 
+                  ELSE
+                     zfho = MIN( pfc(ji,jj,jk), zfho ) 
+                     zfho = MAX( zfho, MAX( zcoef3, pfd(ji,jj,jk) ) ) 
+                  ENDIF
+               ENDIF
+               puc(ji,jj,jk) = zfho
+            ENDDO
+         ENDDO
+      ENDDO
       !
    END SUBROUTINE quickest
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 2024)
@@ -2,5 +2,5 @@
    !!==============================================================================
    !!                       ***  MODULE  traadv_tvd  ***
-   !! Ocean active tracers:  horizontal & vertical advective trend
+   !! Ocean  tracers:  horizontal & vertical advective trend
    !!==============================================================================
    !! History :       !  95-12  (L. Mortier)  Original code
@@ -8,9 +8,10 @@
    !!                 !  00-10  (MA Foujols E.Kestenare)  include file not routine
    !!                 !  00-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes
-   !!                 !  01-07  (E. Durand G. Madec)  adaptation to ORCA config
+   !!                 !  01-07  (E. Durand G. Madec)  adaptraation to ORCA config
    !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
    !!            9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl
    !!            9.0  !  08-04  (S. Cravatte) add the i-, j- & k- trends computation
-   !!            " "  !  05-11  (V. Garnier) Surface pressure gradient organization
+   !!            " "  !  09-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  10-05 (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
    !!----------------------------------------------------------------------
 
@@ -24,13 +25,11 @@
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! tracers trends
+   USE trdtra      ! tracers trends
    USE in_out_manager  ! I/O manager
    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
-   USE trabbl          ! Advective term of BBL
    USE lib_mpp
    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
 
 
@@ -39,4 +38,6 @@
 
    PUBLIC   tra_adv_tvd    ! routine called by step.F90
+
+   LOGICAL  :: l_trd       ! flag to compute trends
 
    !! * Substitutions
@@ -51,5 +52,6 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_tvd( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_tvd ( kt   , cdtype, pun  , pvn, pwn, &
+      &                     ptrab, ptran , ptraa, kjpt   )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_tvd  ***
@@ -62,29 +64,28 @@
       !!       note: - this advection scheme needs a leap-frog time scheme
       !!
-      !! ** Action : - update (ta,sa) with the now advective tracer trends
-      !!             - save the trends in (ztrdt,ztrds) ('key_trdtra')
-      !!----------------------------------------------------------------------
-      USE oce              , ztrdt => ua   ! use ua as workspace
-      USE oce              , ztrds => va   ! use va as workspace
-      !!
-      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component
-      !!
-      INTEGER  ::   ji, jj, jk              ! dummy loop indices
-      REAL(wp) ::                        &  ! temporary scalar
-         ztat, zsat,                     &  !    "         "   
-         z_hdivn_x, z_hdivn_y, z_hdivn
+      !! ** Action : - update (ptraa) with the now advective tracer trends
+      !!             - save the trends 
+      !!----------------------------------------------------------------------
+      !!* Module used
+      USE oce         , zwx => ua   ! use ua as workspace
+      USE oce         , zwy => va   ! use va as workspace
+      !!* Arguments
+      INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptrab, ptran        ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptraa           ! tracer trend 
+      !!* Local declarations
+      INTEGER  ::   ji, jj, jk, jn          ! dummy loop indices  
       REAL(wp) ::   &
-         z2dtt, zbtr, zeu, zev,          &  ! temporary scalar
-         zew, z2, zbtr1,                 &  ! temporary scalar
-         zfp_ui, zfp_vj, zfp_wk,         &  !    "         "
-         zfm_ui, zfm_vj, zfm_wk             !    "         "
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zti, ztu, ztv, ztw   ! temporary workspace
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zsi, zsu, zsv, zsw   !    "           "
-      !!----------------------------------------------------------------------
-
-      zti(:,:,:) = 0.e0   ;   zsi(:,:,:) = 0.e0
+         z2, z2dtt, zbtr, ztra,              &  ! temporary scalar
+         zfp_ui, zfp_vj, zfp_wk,             &  !    "         "
+         zfm_ui, zfm_vj, zfm_wk                 !    "         "
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zwi, zwz   ! temporary workspace
+      REAL(wp), DIMENSION (:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz
+      !!----------------------------------------------------------------------
+
+      zwi(:,:,:) = 0.e0
 
       IF( kt == nit000 .AND. lwp ) THEN
@@ -92,286 +93,161 @@
          WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
-
+      !
+      IF( l_trd )  THEN
+        ALLOCATE( ztrdx(jpi,jpj,jpk) )      ;      ztrdx(:,:,:) = 0.
+        ALLOCATE( ztrdy(jpi,jpj,jpk) )      ;      ztrdy(:,:,:) = 0.
+        ALLOCATE( ztrdz(jpi,jpj,jpk) )      ;      ztrdz(:,:,:) = 0.
+      END IF
+      !
       IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2 = 1.
       ELSE                                        ;    z2 = 2.
       ENDIF
-
-      ! 1. Bottom value : flux set to zero
-      ! ---------------
-      ztu(:,:,jpk) = 0.e0   ;   zsu(:,:,jpk) = 0.e0
-      ztv(:,:,jpk) = 0.e0   ;   zsv(:,:,jpk) = 0.e0
-      ztw(:,:,jpk) = 0.e0   ;   zsw(:,:,jpk) = 0.e0
-      zti(:,:,jpk) = 0.e0   ;   zsi(:,:,jpk) = 0.e0
-
-
-      ! 2. upstream advection with initial mass fluxes & intermediate update
-      ! --------------------------------------------------------------------
-      ! upstream tracer flux in the i and j direction
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zeu = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
-               zev = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
-               ! upstream scheme
-               zfp_ui = zeu + ABS( zeu )
-               zfm_ui = zeu - ABS( zeu )
-               zfp_vj = zev + ABS( zev )
-               zfm_vj = zev - ABS( zev )
-               ztu(ji,jj,jk) = zfp_ui * tb(ji,jj,jk) + zfm_ui * tb(ji+1,jj  ,jk)
-               ztv(ji,jj,jk) = zfp_vj * tb(ji,jj,jk) + zfm_vj * tb(ji  ,jj+1,jk)
-               zsu(ji,jj,jk) = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj  ,jk)
-               zsv(ji,jj,jk) = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji  ,jj+1,jk)
-            END DO
-         END DO
-      END DO
-
-      ! upstream tracer flux in the k direction
-      ! Surface value
-      IF( lk_vvl ) THEN
-         ! variable volume : flux set to zero
-         ztw(:,:,1) = 0.e0
-         zsw(:,:,1) = 0.e0
-      ELSE
-         ! free surface-constant volume
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zew = e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,1)
-               ztw(ji,jj,1) = zew * tb(ji,jj,1)
-               zsw(ji,jj,1) = zew * sb(ji,jj,1)
-            END DO
-         END DO
-      ENDIF
-
-      ! Interior value
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,jk)
-               zfp_wk = zew + ABS( zew )
-               zfm_wk = zew - ABS( zew )
-               ztw(ji,jj,jk) = zfp_wk * tb(ji,jj,jk) + zfm_wk * tb(ji,jj,jk-1)
-               zsw(ji,jj,jk) = zfp_wk * sb(ji,jj,jk) + zfm_wk * sb(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-
-      ! total advective trend
-      DO jk = 1, jpkm1
-         z2dtt = z2 * rdttra(jk)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               ! total intermediate advective trends
-               ztat = - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )   &
-                  &     + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   &
-                  &     + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr
-               zsat = - ( zsu(ji,jj,jk) - zsu(ji-1,jj  ,jk  )   & 
-                  &     + zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  )   &
-                  &     + zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr
-               ! update and guess with monotonic sheme
-               ta(ji,jj,jk) =  ta(ji,jj,jk) + ztat
-               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsat
-               zti (ji,jj,jk) = ( tb(ji,jj,jk) + z2dtt * ztat ) * tmask(ji,jj,jk)
-               zsi (ji,jj,jk) = ( sb(ji,jj,jk) + z2dtt * zsat ) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! "zonal" mean advective heat and salt transport
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         pht_adv(:) = ptr_vj( ztv(:,:,:) )
-         pst_adv(:) = ptr_vj( zsv(:,:,:) )
-      ENDIF
-
-      ! Save the intermediate i / j / k advective trends for diagnostics
-      ! -------------------------------------------------------------------
-      ! Warning : We should use zun instead of un in the computations below, but we
-      ! also use hdivn which is computed with un, vn (check ???). So we use un, vn
-      ! for consistency. Results are therefore approximate with key_trabbl_adv.
-
-      IF( l_trdtra ) THEN
-         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0
-         ! 
-         ! T/S ZONAL advection trends
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         ! ----------------------------------
+         zwx(:,:,jpk) = 0.e0    ;    zwz(:,:,jpk) = 0.e0
+         zwy(:,:,jpk) = 0.e0    ;    zwi(:,:,jpk) = 0.e0
+
+         ! 2. upstream advection with initial mass fluxes & intermediate update
+         ! --------------------------------------------------------------------
+         ! upstream tracer flux in the i and j direction
          DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptrab(ji,jj,jk,jn) + zfm_ui * ptrab(ji+1,jj  ,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptrab(ji,jj,jk,jn) + zfm_vj * ptrab(ji  ,jj+1,jk,jn) )
+               END DO
+            END DO
+         END DO
+
+         ! upstream tracer flux in the k direction
+         ! Surface value
+         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptrab(:,:,1,jn)   ! linear free surface 
+         ENDIF
+         ! Interior value
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptrab(ji,jj,jk,jn) + zfm_wk * ptrab(ji,jj,jk-1,jn) )
+               END DO
+            END DO
+         END DO
+
+         ! total advective trend
+         DO jk = 1, jpkm1
+            z2dtt = z2 * rdttra(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ztrdt(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr
-                  ztrds(ji,jj,jk) = - ( zsu(ji,jj,jk) - zsu(ji-1,jj,jk) ) * zbtr
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)    ! save the trends
-         !
-         ! T/S MERIDIONAL advection trends
+                  ! total intermediate advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  ! update and guess with monotonic sheme
+                  ptraa(ji,jj,jk,jn) =   ptraa(ji,jj,jk,jn)         + ztra
+                  zwi(ji,jj,jk)    = ( ptrab(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                             ! Lateral boundary conditions on zwi  (unchanged sign)
+         CALL lbc_lnk( zwi, 'T', 1. )  
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ! store intermediate advective trends
+            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) )
+           IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+
+         ! 3. antidiffusive flux : high order minus low order
+         ! --------------------------------------------------
+         ! antidiffusive flux on i and j
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptran(ji,jj,jk,jn) + ptran(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
+                  zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptran(ji,jj,jk,jn) + ptran(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      
+         ! antidiffusive flux on k
+         ! Surface value
+         zwz(:,:,1) = 0.e0
+         ! Interior value
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptran(ji,jj,jk,jn) + ptran(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+         ! Lateral bondary conditions
+         CALL lbc_lnk( zwx, 'U', -1. )
+         CALL lbc_lnk( zwy, 'V', -1. )
+         CALL lbc_lnk( zwz, 'W',  1. )
+
+         ! 4. monotonicity algorithm
+         ! -------------------------
+         CALL nonosc( ptrab(:,:,:,jn), zwx, zwy, zwz, zwi, z2 )
+
+
+         ! 5. final trend with corrected fluxes
+         ! ------------------------------------
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ztrdt(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zbtr
-                  ztrds(ji,jj,jk) = - ( zsv(ji,jj,jk) - zsv(ji,jj-1,jk) ) * zbtr
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)     ! save the trends
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! total advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  ! add them to the general tracer trends
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
+            
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, ztrdx, pun, ptran(:,:,:,jn) )   
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, ztrdy, pvn, ptran(:,:,:,jn) )  
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, ztrdz, pwn, ptran(:,:,:,jn) ) 
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) ) + pht_adv(:)
+           IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) ) + pst_adv(:)
+         ENDIF
          !
-         ! T/S VERTICAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.         
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ztrdt(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
-                  ztrds(ji,jj,jk) = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)     ! save the trends
-         !
-      ENDIF
-
-      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
-      CALL lbc_lnk( zti, 'T', 1. )
-      CALL lbc_lnk( zsi, 'T', 1. )
-
-
-      ! 3. antidiffusive flux : high order minus low order
-      ! --------------------------------------------------
-      ! antidiffusive flux on i and j
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zeu = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
-               zev = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
-               ztu(ji,jj,jk) = zeu * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) - ztu(ji,jj,jk)
-               zsu(ji,jj,jk) = zeu * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) ) - zsu(ji,jj,jk)
-               ztv(ji,jj,jk) = zev * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) ) - ztv(ji,jj,jk)
-               zsv(ji,jj,jk) = zev * ( sn(ji,jj,jk) + sn(ji,jj+1,jk) ) - zsv(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      
-      ! antidiffusive flux on k
-      ! Surface value
-      ztw(:,:,1) = 0.e0
-      zsw(:,:,1) = 0.e0
-
-      ! Interior value
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,jk)
-               ztw(ji,jj,jk) = zew * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) - ztw(ji,jj,jk)
-               zsw(ji,jj,jk) = zew * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) ) - zsw(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! Lateral bondary conditions
-      CALL lbc_lnk( ztu, 'U', -1. )   ;   CALL lbc_lnk( zsu, 'U', -1. )
-      CALL lbc_lnk( ztv, 'V', -1. )   ;   CALL lbc_lnk( zsv, 'V', -1. )
-      CALL lbc_lnk( ztw, 'W',  1. )   ;   CALL lbc_lnk( zsw, 'W',  1. )
-
-      ! 4. monotonicity algorithm
-      ! -------------------------
-      CALL nonosc( tb, ztu, ztv, ztw, zti, z2 )
-      CALL nonosc( sb, zsu, zsv, zsw, zsi, z2 )
-
-
-      ! 5. final trend with corrected fluxes
-      ! ------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.  
-               zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               ! total advective trends
-               ztat = - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )   &
-                  &     + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   &
-                  &     + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr
-               zsat = - ( zsu(ji,jj,jk) - zsu(ji-1,jj  ,jk  )   &
-                  &     + zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  )   &
-                  &     + zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr
-               ! add them to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + ztat
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsat
-            END DO
-         END DO
-      END DO
-
-
-      ! Save the advective trends for diagnostics
-      ! --------------------------------------------
-
-      IF( l_trdtra ) THEN
-         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0
-         !
-         ! T/S ZONAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
-                  !-- Compute T/S zonal advection trends
-                  ztrdt(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_x
-                  ztrds(ji,jj,jk) = - ( zsu(ji,jj,jk) - zsu(ji-1,jj,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_x
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt, cnbpas='bis')   ! <<< ADD TO PREVIOUSLY COMPUTED
-         !
-         ! T/S MERIDIONAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
-                  !-- Compute T/S meridional advection trends
-                  ztrdt(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_y          
-                  ztrds(ji,jj,jk) = - ( zsv(ji,jj,jk) - zsv(ji,jj-1,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_y          
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt, cnbpas='bis')   ! <<< ADD TO PREVIOUSLY COMPUTED
-         !
-         ! T/S VERTICAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr1     = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-#if defined key_zco
-                  zbtr      = zbtr1
-                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk)
-#else
-                  zbtr      = zbtr1 / fse3t(ji,jj,jk)
-                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
-#endif
-                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
-                  zbtr      = zbtr1 / fse3t(ji,jj,jk)
-                  ztrdt(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr - tn(ji,jj,jk) * z_hdivn
-                  ztrds(ji,jj,jk) = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr - sn(ji,jj,jk) * z_hdivn
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt, cnbpas='bis')   ! <<< ADD TO PREVIOUSLY COMPUTED
-         !
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' tvd adv  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
-
-      ! "zonal" mean advective heat and salt transport
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         pht_adv(:) = ptr_vj( ztv(:,:,:) ) + pht_adv(:)
-         pst_adv(:) = ptr_vj( zsv(:,:,:) ) + pst_adv(:)
-      ENDIF
+      ENDDO
+      !
+      IF( l_trd )  THEN
+        DEALLOCATE( ztrdx )     ;     DEALLOCATE( ztrdy )     ;      DEALLOCATE( ztrdz )  
+      END IF
       !
    END SUBROUTINE tra_adv_tvd
@@ -392,7 +268,8 @@
       !!----------------------------------------------------------------------
       REAL(wp), INTENT( in ) ::   prdt   ! ???
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( in    ) ::   &
+         pbef,                            & ! before field
+         paft                               ! after field
       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( inout ) ::   &
-         pbef,                            & ! before field
-         paft,                            & ! after field
          paa,                             & ! monotonic flux in the i direction
          pbb,                             & ! monotonic flux in the j direction
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_ubs.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 2024)
@@ -4,5 +4,6 @@
    !! Ocean active tracers:  horizontal & vertical advective trend
    !!==============================================================================
-   !! History :  9.0  !  06-08  (L. Debreu, R. Benshila)  Original code
+   !! History :  1.0  !  2006-08  (L. Debreu, R. Benshila)  Original code
+  !!             3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
    !!----------------------------------------------------------------------
 
@@ -13,6 +14,6 @@
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
-   USE trdmod
-   USE trdmod_oce
+   USE trdmod_oce         ! ocean space and time domain
+   USE trdtra
    USE lib_mpp
    USE lbclnk          ! ocean lateral boundary condition (or mpp link)
@@ -20,5 +21,4 @@
    USE diaptr          ! poleward transport diagnostics
    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
-   USE prtctl
 
    IMPLICIT NONE
@@ -27,5 +27,5 @@
    PUBLIC   tra_adv_ubs   ! routine called by traadv module
 
-   REAL(wp), DIMENSION(jpi,jpj) ::   e1e2tr   ! = 1/(e1t * e2t)
+   LOGICAL :: l_trd  ! flag to compute trends or not
 
    !! * Substitutions
@@ -40,5 +40,6 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_ubs( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_ubs ( kt   , cdtype, pun  , pvn, pwn, &
+      &                     ptrab, ptran , ptraa, kjpt   )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_ubs  ***
@@ -67,32 +68,31 @@
       !!      the UBS have been found to be too diffusive.
       !!
-      !! ** Action : - update (ta,sa) with the now advective tracer trends
+      !! ** Action : - update (ptraa) with the now advective tracer trends
       !!
       !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404. 
       !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741. 
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   zwx => ua   ! use ua as workspace
-      USE oce, ONLY :   zwy => va   ! use va as workspace
-      !!
-      INTEGER , INTENT(in)                         ::   kt             ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pun   ! effective ocean velocity, u_component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pvn   ! effective ocean velocity, v_component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pwn   ! effective ocean velocity, w_component
-      !!
-      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
-      REAL(wp) ::   zta, zsa, zbtr, zcoef                  ! temporary scalars
-      REAL(wp) ::   zfui, zfp_ui, zfm_ui, zcenut, zcenus   !    "         "
-      REAL(wp) ::   zfvj, zfp_vj, zfm_vj, zcenvt, zcenvs   !    "         "
-      REAL(wp) ::   z_hdivn_x, z_hdivn_y, z_hdivn          !    "         "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zeeu, zeev     ! temporary 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz , zww                        ! temporary 3D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu , ztv , zltu , zltv, ztrdt   !    "              "
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zsu , zsv , zlsu , zlsv, ztrds   !    "              "
-      !!----------------------------------------------------------------------
-
-      zltu(:,:,:) = 0.e0
-      zltv(:,:,:) = 0.e0
-      zlsu(:,:,:) = 0.e0
-      zlsv(:,:,:) = 0.e0
+      !!* Module used
+      USE oce         , zwx => ua   ! use ua as workspace
+      USE oce         , zwy => va   ! use va as workspace
+      !!* Arguments
+      INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator)
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pun, pvn, pwn   ! 3 ocean velocity components
+      INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptrab, ptran        ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptraa           ! tracer trend 
+      !!* Local declarations
+      INTEGER  ::   ji, jj, jk, jn          ! dummy loop indices
+      REAL(wp) ::   ztra, zbtr, zcoef                  ! temporary scalars
+      REAL(wp) ::   zfp_ui, zfm_ui, zcenut  !    "         "
+      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt  !    "         "    !    "         "
+      REAL(wp) ::   z2dtt, z2                   
+      REAL(wp) ::   ztak, zfp_wk, zfm_wk    !    "         "
+      REAL(wp) ::   zeeu, zeev, z_hdivn     
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu , zltv   !    "              "
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zti, ztw                !    "              "
+      !!----------------------------------------------------------------------
+
 
       IF( kt == nit000 ) THEN
@@ -101,365 +101,190 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
          !
-         e1e2tr(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
-
-      ! Save ta and sa trends
-      ztrdt(:,:,:) = ta(:,:,:)
-      ztrds(:,:,:) = sa(:,:,:)
-
-      zcoef = 1./6.
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-
-         !  Initialization of metric arrays (for z- or s-coordinates)
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-#if defined key_zco
-               ! z-coordinates, no vertical scale factors
-               zeeu(ji,jj) = e2u(ji,jj) / e1u(ji,jj) * umask(ji,jj,jk)
-               zeev(ji,jj) = e1v(ji,jj) / e2v(ji,jj) * vmask(ji,jj,jk)
-#else
-               ! s-coordinates, vertical scale factor are used
-               zeeu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
-               zeev(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
-#endif
-            END DO
-         END DO
-
-         !  Laplacian
-         ! First derivative (gradient)
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ztu(ji,jj,jk) = zeeu(ji,jj) * ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) )
-               zsu(ji,jj,jk) = zeeu(ji,jj) * ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) )
-               ztv(ji,jj,jk) = zeev(ji,jj) * ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) )
-               zsv(ji,jj,jk) = zeev(ji,jj) * ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) )
-            END DO
-         END DO
-         ! Second derivative (divergence)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-#if ! defined key_zco
-               zcoef = 1. / ( 6. * fse3t(ji,jj,jk) )
-#endif         
-               zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef
-               zlsu(ji,jj,jk) = (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk)  ) * zcoef
-               zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef
-               zlsv(ji,jj,jk) = (  zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  ) * zcoef
-            END DO
-         END DO
-         !                                             ! =================
-      END DO                                           !    End of slab
-      !                                                ! =================
-
-      ! Lateral boundary conditions on the laplacian (zlt,zls)   (unchanged sgn)
-      CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zlsu, 'T', 1. )
-      CALL lbc_lnk( zltv, 'T', 1. )   ;    CALL lbc_lnk( zlsv, 'T', 1. )
-
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !  Horizontal advective fluxes
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ! volume fluxes * 1/2
-#if defined key_zco
-               zfui = 0.5 * e2u(ji,jj) * pun(ji,jj,jk)
-               zfvj = 0.5 * e1v(ji,jj) * pvn(ji,jj,jk)
-#else
-               zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
-               zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
-#endif
-               ! upstream scheme
-               zfp_ui = zfui + ABS( zfui )
-               zfp_vj = zfvj + ABS( zfvj )
-               zfm_ui = zfui - ABS( zfui )
-               zfm_vj = zfvj - ABS( zfvj )
-               ! centered scheme
-               zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj  ,jk) )
-               zcenvt = zfvj * ( tn(ji,jj,jk) + tn(ji  ,jj+1,jk) )
-               zcenus = zfui * ( sn(ji,jj,jk) + sn(ji+1,jj  ,jk) )
-               zcenvs = zfvj * ( sn(ji,jj,jk) + sn(ji  ,jj+1,jk) )
-               ! mixed centered / upstream scheme
-               zwx(ji,jj,jk) = zcenut - zfp_ui * zltu(ji,jj,jk) -zfm_ui * zltu(ji+1,jj,jk)
-               zwy(ji,jj,jk) = zcenvt - zfp_vj * zltv(ji,jj,jk) -zfm_vj * zltv(ji,jj+1,jk)
-               zww(ji,jj,jk) = zcenus - zfp_ui * zlsu(ji,jj,jk) -zfm_ui * zlsu(ji+1,jj,jk)
-               zwz(ji,jj,jk) = zcenvs - zfp_vj * zlsv(ji,jj,jk) -zfm_vj * zlsv(ji,jj+1,jk)
-            END DO
-         END DO
-
-         !  Tracer flux divergence at t-point added to the general trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! horizontal advective trends
-#if defined key_zco
-               zbtr = e1e2tr(ji,jj)
-#else
-               zbtr = e1e2tr(ji,jj) / fse3t(ji,jj,jk)
-#endif
-               zta = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
-                  &            + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
-               zsa = - zbtr * (  zww(ji,jj,jk) - zww(ji-1,jj  ,jk)   &
-                  &            + zwz(ji,jj,jk) - zwz(ji  ,jj-1,jk)  )
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      ! Horizontal trend used in tra_adv_ztvd subroutine
-      zltu(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
-      zlsu(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
-
-      ! 3. Save the horizontal advective trends for diagnostic
-      ! ------------------------------------------------------
-      IF( l_trdtra )   THEN
-         ! Recompute the hoizontal advection zta & zsa trends computed 
-         ! at the step 2. above in making the difference between the new 
-         ! trends and the previous one ta()/sa - ztrdt()/ztrds() and add
-         ! the term tn()/sn()*hdivn() to recover the Uh gradh(T/S) trends
-         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0
-         !
-         ! T/S ZONAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-#if defined key_zco
-                  zbtr = e1e2tr(ji,jj)
-                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr
-#else
-                  zbtr = e1e2tr(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
-#endif
-                  ztrdt(ji,jj,jk) = - ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_x
-                  ztrds(ji,jj,jk) = - ( zww(ji,jj,jk) - zww(ji-1,jj,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_x
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)    ! save the trends
-         !
-         ! T/S MERIDIONAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
-#if defined key_zco
-                  zbtr      = e1e2tr(ji,jj)
-                  z_hdivn_y = (  e1v(ji,  jj) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr
-#else
-                  zbtr      = e1e2tr(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
-#endif
-                  ztrdt(ji,jj,jk) = - ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_y          
-                  ztrds(ji,jj,jk) = - ( zwz(ji,jj,jk) - zwz(ji,jj-1,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_y
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)     ! save the trends
-         !
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' ubs had  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
-
-      ! "zonal" mean advective heat and salt transport 
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         IF( lk_zco ) THEN
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk)
-                     zwz(ji,jj,jk) = zwz(ji,jj,jk) * fse3v(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
-         pht_adv(:) = ptr_vj( zwy(:,:,:) )
-         pst_adv(:) = ptr_vj( zwz(:,:,:) )
-      ENDIF
-
-      ! II. Vertical advection
-      ! ----------------------
-      IF( l_trdtra ) THEN          ! Save ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:)
-      ENDIF
-    
-      ! TVD scheme the vertical direction  
-      CALL tra_adv_ztvd(kt, pwn, zltu, zlsu)
-
-      IF( l_trdtra )   THEN         !  Save the final vertical advective trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-                  zbtr      = e1e2tr(ji,jj)
-                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk)
-#else
-                  zbtr      = e1e2tr(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
-#endif
-                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
-                  zbtr      = e1e2tr(ji,jj) / fse3t(ji,jj,jk)
-                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn
-                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)   ! <<< ADD TO PREVIOUSLY COMPUTED
-         !
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' ubs zad  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra')
       !
-   END SUBROUTINE tra_adv_ubs
-
-
-   SUBROUTINE tra_adv_ztvd( kt, pwn, zttrd, zstrd )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_ztvd  ***
-      !! 
-      !! **  Purpose :   Compute the now trend due to total advection of 
-      !!       tracers and add it to the general trend of tracer equations
-      !!
-      !! **  Method  :   TVD scheme, i.e. 2nd order centered scheme with
-      !!       corrected flux (monotonic correction)
-      !!       note: - this advection scheme needs a leap-frog time scheme
-      !!
-      !! ** Action : - update (ta,sa) with the now advective tracer trends
-      !!             - save the trends in (ztrdt,ztrds) ('key_trdtra')
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT(in)                         ::   kt             ! ocean time-step
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn            ! verical effective velocity
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   zttrd, zstrd   ! lateral advective trends on T & S 
-      !!
-      INTEGER  ::   ji, jj, jk              ! dummy loop indices
-      REAL(wp) ::   z2dtt, zbtr, zew, z2    ! temporary scalar  
-      REAL(wp) ::   ztak, zfp_wk            !    "         "
-      REAL(wp) ::   zsak, zfm_wk            !    "         "
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zti, ztw   ! temporary 3D workspace
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zsi, zsw   !    "              "
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_adv_ztvd : vertical TVD advection scheme'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-      ENDIF
-
       IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2 = 1.
       ELSE                                        ;    z2 = 2.
       ENDIF
-
-      !  Bottom value : flux set to zero
-      ! --------------
-      ztw(:,:,jpk) = 0.e0   ;   zsw(:,:,jpk) = 0.e0
-      zti  (:,:,:) = 0.e0   ;   zsi  (:,:,:) = 0.e0
-
-
-      !  upstream advection with initial mass fluxes & intermediate update
-      ! -------------------------------------------------------------------
-      ! Surface value
-      IF( lk_vvl ) THEN
-         ! variable volume : flux set to zero
-         ztw(:,:,1) = 0.e0
-         zsw(:,:,1) = 0.e0
-      ELSE
-         ! free surface-constant volume
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zew = e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,1)
-               ztw(ji,jj,1) = zew * tb(ji,jj,1)
-               zsw(ji,jj,1) = zew * sb(ji,jj,1)
-            END DO
-         END DO
-      ENDIF
-
-      ! Interior value
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,jk)
-               zfp_wk = zew + ABS( zew )
-               zfm_wk = zew - ABS( zew )
-               ztw(ji,jj,jk) = zfp_wk * tb(ji,jj,jk) + zfm_wk * tb(ji,jj,jk-1)
-               zsw(ji,jj,jk) = zfp_wk * sb(ji,jj,jk) + zfm_wk * sb(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-
-      ! update and guess with monotonic sheme
-      DO jk = 1, jpkm1
-         z2dtt = z2 * rdttra(jk)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
-               zsak = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr
-               ta(ji,jj,jk) =  ta(ji,jj,jk) + ztak
-               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsak 
-               zti (ji,jj,jk) = ( tb(ji,jj,jk) + z2dtt * ( ztak + zttrd(ji,jj,jk) ) ) * tmask(ji,jj,jk)
-               zsi (ji,jj,jk) = ( sb(ji,jj,jk) + z2dtt * ( zsak + zstrd(ji,jj,jk) ) ) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
-      CALL lbc_lnk( zti, 'T', 1. )
-      CALL lbc_lnk( zsi, 'T', 1. )
-
-
-      !  antidiffusive flux : high order minus low order
-      ! -------------------------------------------------      
-      ! Surface value
-      ztw(:,:,1) = 0.e0   ;   zsw(:,:,1) = 0.e0
-
-      ! Interior value
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,jk)
-               ztw(ji,jj,jk) = zew * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) - ztw(ji,jj,jk)
-               zsw(ji,jj,jk) = zew * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) ) - zsw(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      !  monotonicity algorithm
-      ! ------------------------
-      CALL nonosc_z( tb, ztw, zti, z2 )
-      CALL nonosc_z( sb, zsw, zsi, z2 )
-
-
-      !  final trend with corrected fluxes
-      ! -----------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.  
-               zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               ! k- vertical advective trends
-               ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
-               zsak = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr
-               ! add them to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + ztak
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsak
-            END DO
-         END DO
-      END DO
       !
-   END SUBROUTINE tra_adv_ztvd
-
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         ! ----------------------------------
+         zltu(:,:,jpk) = 0.e0       ;      zltv(:,:,jpk) = 0.e0
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            !  Laplacian
+            ! First derivative (gradient)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zeeu = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
+                  zeev = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
+                  ztu(ji,jj,jk) = zeeu * ( ptrab(ji+1,jj  ,jk,jn) - ptrab(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zeev * ( ptrab(ji  ,jj+1,jk,jn) - ptrab(ji,jj,jk,jn) )
+               END DO
+            END DO
+            ! Second derivative (divergence)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zcoef = 1. / ( 6. * fse3t(ji,jj,jk) )
+                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef
+                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef
+               END DO
+            END DO
+            !                                             ! =================
+         END DO                                           !    End of slab
+         !                                                ! =================
+         
+         ! Lateral boundary conditions on the laplacian (zlt)   (unchanged sgn)
+         CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )
+
+         !    
+         !  Horizontal advective fluxes               
+         DO jk = 1, jpkm1 
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream transport
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  ! centered scheme
+                  zcenut = 0.5 * pun(ji,jj,jk) * ( ptran(ji,jj,jk,jn) + ptran(ji+1,jj  ,jk,jn) )
+                  zcenvt = 0.5 * pvn(ji,jj,jk) * ( ptran(ji,jj,jk,jn) + ptran(ji  ,jj+1,jk,jn) )
+                  ! UBS scheme
+                  zwx(ji,jj,jk) =  zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) 
+                  zwy(ji,jj,jk) =  zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) 
+               END DO
+            END DO
+         ENDDO
+
+         zltu(:,:,:) = ptraa(:,:,:,jn)      ! store ptraa trends
+
+         ! Horizontal advective trends
+         DO jk = 1, jpkm1
+            !  Tracer flux divergence at t-point added to the general trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
+                  ! add it to the general tracer trends
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+         ! Horizontal trend used in tra_adv_ztvd subroutine
+         zltu(:,:,:) = ptraa(:,:,:,jn) - zltu(:,:,:)
+
+         ! 3. Save the horizontal advective trends for diagnostic
+         ! ------------------------------------------------------
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd ) THEN
+             CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptran(:,:,:,jn) )
+             CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptran(:,:,:,jn) )
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN  
+            IF( lk_zco ) THEN
+               DO jk = 1, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                       zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk)                 
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+            IF( jn == jp_tem )  pht_adv(:) = ptr_vj( zwy(:,:,:) )
+            IF( jn == jp_sal )  pst_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+         
+         ! TVD scheme for the vertical direction  
+         ! ----------------------
+         IF( l_trd )   zltv(:,:,:) = ptraa(:,:,:,jn)          ! store pta if trend diag.
+
+         !  Bottom value : flux set to zero
+         ztw(:,:,jpk) = 0.e0   ;   zti(:,:,jpk) = 0.e0
+
+         ! Surface value
+         IF( lk_vvl ) THEN   ;   ztw(:,:,1) = 0.e0                      ! variable volume : flux set to zero
+         ELSE                ;   ztw(:,:,1) = pwn(:,:,1) * ptrab(:,:,1,jn)   ! free constant surface 
+         ENDIF
+         !  upstream advection with initial mass fluxes & intermediate update
+         ! -------------------------------------------------------------------
+         ! Interior value
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                   zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                   zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                   ztw(ji,jj,jk) = 0.5 * (  zfp_wk * ptrab(ji,jj,jk,jn) + zfm_wk * ptrab(ji,jj,jk-1,jn)  )
+               END DO
+            END DO
+         END DO 
+         ! update and guess with monotonic sheme
+         DO jk = 1, jpkm1
+            z2dtt = z2 * rdttra(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
+                  ptraa(ji,jj,jk,jn) =   ptraa(ji,jj,jk,jn) +  ztak 
+                  zti(ji,jj,jk)    = ( ptrab(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         CALL lbc_lnk( zti, 'T', 1. )      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
+
+         !  antidiffusive flux : high order minus low order
+         ztw(:,:,1) = 0.e0       ! Surface value
+         DO jk = 2, jpkm1        ! Interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztw(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptran(ji,jj,jk,jn) + ptran(ji,jj,jk-1,jn) ) - ztw(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         CALL nonosc_z( ptrab(:,:,:,jn), ztw, zti, z2 )      !  monotonicity algorithm
+
+         !  final trend with corrected fluxes
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.   
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! k- vertical advective trends  
+                  ztra = - zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )
+                  ! added to the general tracer trends
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+
+         !  Save the final vertical advective trends
+         IF( l_trd )  THEN                        ! vertical advective trend diagnostics
+            DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w])
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     z_hdivn = (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  ) * zbtr
+                     zltv(ji,jj,jk) = ptraa(ji,jj,jk,jn) - zltv(ji,jj,jk) + ptran(ji,jj,jk,jn) * z_hdivn
+                  END DO
+               END DO
+            END DO
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zltv )
+         ENDIF
+         !
+      ENDDO
+      !
+   END SUBROUTINE tra_adv_ubs
 
    SUBROUTINE nonosc_z( pbef, pcc, paft, prdt )
@@ -477,5 +302,5 @@
       !!----------------------------------------------------------------------
       REAL(wp), INTENT(in   )                          ::   prdt   ! ???
-      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field
+      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field
       REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field
       REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pcc    ! monotonic flux in the k direction
@@ -525,5 +350,5 @@
       pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:)
       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:)
- 
+
 
       ! 2. Positive and negative part of fluxes and beta terms
@@ -544,5 +369,4 @@
          END DO
       END DO
-
       ! monotonic flux in the k direction, i.e. pcc
       ! -------------------------------------------
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 2024)
@@ -18,6 +18,6 @@
    USE dom_oce         ! ocean space and time domain
    USE phycst          ! physical constants
-   USE trdmod          ! ocean trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! ocean trends 
+   USE trdtra      ! ocean trends 
    USE in_out_manager  ! I/O manager
    USE prtctl          ! Print control
@@ -27,4 +27,5 @@
 
    PUBLIC tra_bbc          ! routine called by step.F90
+   PUBLIC tra_bbc_init     ! routine called by opa.F90
 
    !! to be transfert in the namelist ???!   
@@ -70,18 +71,15 @@
       !!              Emile-Geay and Madec, 2009, Ocean Science.
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
       !!
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!
-      INTEGER  ::   ji, jj    ! dummy loop indices
+      INTEGER  ::   ji, jj, ik    ! dummy loop indices
       REAL(wp) ::   zqgh_trd  ! geothermal heat flux trend
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
 
-      IF( kt == nit000 )   CALL tra_bbc_init      ! Initialization
-
       IF( l_trdtra )   THEN         ! Save ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = 0.e0
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )     ;   ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ALLOCATE( ztrds(jpi,jpj,jpk) )     ;   ztrds(:,:,:) = 0.
       ENDIF
 
@@ -98,6 +96,7 @@
             DO ji = 2, jpim1
 #endif
-               zqgh_trd = ro0cpr * qgh_trd0(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj))
-               ta(ji,jj,nbotlevt(ji,jj)) = ta(ji,jj,nbotlevt(ji,jj)) + zqgh_trd
+               ik = nbotlevt(ji,jj)
+               zqgh_trd = ro0cpr * qgh_trd0(ji,jj) / fse3t(ji,jj,ik)
+               tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd
             END DO
          END DO
@@ -105,9 +104,11 @@
 
       IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         CALL trd_mod( ztrdt, ztrds, jptra_trd_bbc, 'TRA', kt )
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbc, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_bbc, ztrds )
+         DEALLOCATE( ztrdt )   ;     DEALLOCATE( ztrds )
       ENDIF
       !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
       !
    END SUBROUTINE tra_bbc
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbl.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 2024)
@@ -4,54 +4,66 @@
    !! Ocean physics :  advective and/or diffusive bottom boundary layer scheme
    !!==============================================================================
-   !! History :  8.0  !  96-06  (L. Mortier)  Original code
-   !!            8.0  !  97-11  (G. Madec)  Optimization
-   !!            8.5  !  02-08  (G. Madec)  free form + modules
-   !!----------------------------------------------------------------------
-#if   defined key_trabbl_dif   ||   defined key_trabbl_adv   || defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_trabbl_dif'   or            diffusive bottom boundary layer
-   !!   'key_trabbl_adv'                 advective bottom boundary layer
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   tra_bbl_dif  : update the active tracer trends due to the bottom
-   !!                  boundary layer (diffusive only)
-   !!   tra_bbl_adv  : update the active tracer trends due to the bottom
-   !!                  boundary layer (advective and/or diffusive)
-   !!   tra_bbl_init : initialization, namlist read, parameters control
-   !!----------------------------------------------------------------------
-   USE oce                ! ocean dynamics and active tracers
-   USE dom_oce            ! ocean space and time domain
-   USE trdmod             ! ocean active tracers trends
-   USE trdmod_oce         ! ocean variables trends
-   USE in_out_manager     ! I/O manager
-   USE lbclnk             ! ocean lateral boundary conditions
-   USE prtctl             ! Print control
+   !! History :  OPA  !  1996-06  (L. Mortier)  Original code
+   !!            8.0  !  1997-11  (G. Madec)    Optimization
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  free form + modules
+   !!             -   !  2004-01  (A. de Miranda, G. Madec, J.M. Molines ) add advective bbl
+   !!            3.3  !  2009-11  (G. Madec)  merge trabbl and trabbl_adv + style + optimization 
+   !!             -   !  2010-04  (G. Madec)  Campin & Goosse advective bbl 
+   !!             -   !  2010-06  (C. Ethe, G. Madec)  merge TRA-TRC
+   !!----------------------------------------------------------------------
+#if   defined key_trabbl   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trabbl'   or                             bottom boundary layer
+   !!----------------------------------------------------------------------
+   !!   tra_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive)
+   !!   tra_bbl_dif   : generic routine to compute bbl diffusive trend
+   !!   tra_bbl_adv   : generic routine to compute bbl advective trend
+   !!   bbl           : computation of bbl diffu. flux coef. & transport in bottom boundary layer
+   !!   tra_bbl_init  : initialization, namlist read, parameters control
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! 
+   USE eosbn2         ! equation of state
+   USE trdmod_oce        ! ocean space and time domain
+   USE trdtra     ! ocean active tracers trends
+   USE iom            ! IOM server               
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions
+   USE prtctl         ! Print control
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC tra_bbl_dif    ! routine called by step.F90
-   PUBLIC tra_bbl_adv    ! routine called by step.F90
-
-   !!* Namelist nambbl: bottom boundary layer
-   REAL(wp), PUBLIC ::   rn_ahtbbl = 1.e+3   !: lateral coeff. for bottom boundary layer scheme (m2/s)
-
-# if defined key_trabbl_dif
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_dif = .TRUE.          !: diffusive bottom boundary layer flag
+   PUBLIC   tra_bbl       !  routine called by step.F90
+   PUBLIC   tra_bbl_init  !  routine called by opa.F90
+   PUBLIC   tra_bbl_dif   !  routine called by tra_bbl and trc_bbl
+   PUBLIC   tra_bbl_adv   !  -          -          -              -
+   PUBLIC   bbl           !  -          -          -              -
+
+# if defined key_trabbl
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .TRUE.    !: bottom boundary layer flag
 # else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_dif = .FALSE.         !: diffusive bottom boundary layer flag
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .FALSE.   !: bottom boundary layer flag
 # endif
 
-# if defined key_trabbl_adv
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .TRUE.   !: advective bottom boundary layer flag
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   u_bbl      !: 3 components of the velocity
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   v_bbl      !: associated with advective BBL
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   w_bbl      !: (only affect tracer)
-# else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .FALSE.  !: advective bottom boundary layer flag
-# endif
-
-   INTEGER, DIMENSION(jpi,jpj) ::   mbkt          ! vertical index of the bottom ocean T-level
-   INTEGER, DIMENSION(jpi,jpj) ::   mbku, mbkv    ! vertical index of the bottom ocean U/V-level
+   !                                         !!* Namelist nambbl * 
+   INTEGER , PUBLIC ::   nn_bbl_ldf = 0       !: =1   : diffusive bbl or not (=0)
+   INTEGER , PUBLIC ::   nn_bbl_adv = 0       !: =1/2 : advective bbl or not (=0)
+   !                                          !  =1 : advective bbl using the model velocity
+   !                                          !  =2 :   -        -  using utr_bbl proportional to grad(rho)
+   REAL(wp), PUBLIC ::   rn_ahtbbl  = 1.e+3   !: along slope bbl diffusive coefficient [m2/s]
+   REAL(wp), PUBLIC ::   rn_gambbl  = 10.e0   !: lateral coeff. for bottom boundary layer scheme [s]
+
+   INTEGER , DIMENSION(jpi,jpj) ::   mbkt                   ! vertical index of the bottom ocean T-level
+   INTEGER , DIMENSION(jpi,jpj) ::   mbku     , mbkv        ! vertical index of the (upper) bottom ocean U/V-level
+   INTEGER , DIMENSION(jpi,jpj) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level
+   INTEGER , DIMENSION(jpi,jpj) ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction
+   REAL(wp), DIMENSION(jpi,jpj), PUBLIC ::   utr_bbl  , vtr_bbl     ! u- (v-) transport in the bottom boundary layer
+   REAL(wp), DIMENSION(jpi,jpj) ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points
+   REAL(wp), DIMENSION(jpi,jpj) ::   ahu_bbl  , ahv_bbl     ! masked diffusive bbl coefficients at u and v-points
+   REAL(wp), DIMENSION(jpi,jpj) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points
+   REAL(wp), DIMENSION(jpi,jpj) ::   e1e2t_r   ! thichness of the bbl (e3) at u and v-points
+   LOGICAL, PUBLIC              ::   l_bbl                    !: flag to compute bbl diffu. flux coef and transport
 
    !! * Substitutions
@@ -59,5 +71,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
@@ -66,328 +78,448 @@
 CONTAINS
 
-   SUBROUTINE tra_bbl_dif( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE tra_bbl_dif  ***
-      !!
+
+   SUBROUTINE tra_bbl( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bbl  ***
+      !!                   
       !! ** Purpose :   Compute the before tracer (t & s) trend associated 
-      !!      with the bottom boundary layer and add it to the general trend 
-      !!      of tracer equations. The bottom boundary layer is supposed to be
-      !!      a purely diffusive bottom boundary layer.
-      !!
-      !! ** Method  :   When the product grad( rho) * grad(h) < 0 (where grad 
-      !!      is an along bottom slope gradient) an additional lateral diffu-
-      !!      sive trend along the bottom slope is added to the general tracer
-      !!      trend, otherwise nothing is done.
-      !!      Second order operator (laplacian type) with variable coefficient
-      !!      computed as follow for temperature (idem on s): 
-      !!         difft = 1/(e1t*e2t*e3t) { di-1[ ahbt e2u*e3u/e1u di[ztb] ]
-      !!                                 + dj-1[ ahbt e1v*e3v/e2v dj[ztb] ] }
-      !!      where ztb is a 2D array: the bottom ocean temperature and ahtb
-      !!      is a time and space varying diffusive coefficient defined by:
-      !!         ahbt = zahbp    if grad(rho).grad(h) < 0
-      !!              = 0.       otherwise.
-      !!      Note that grad(.) is the along bottom slope gradient. grad(rho)
-      !!      is evaluated using the local density (i.e. referenced at the
-      !!      local depth). Typical value of ahbt is 2000 m2/s (equivalent to
+      !!     with the bottom boundary layer and add it to the general trend
+      !!     of tracer equations.
+      !!
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
+      !!----------------------------------------------------------------------
+
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+
+      !* bbl coef and transport are computed only if not already done in passive tracers routine
+      IF( l_bbl )      CALL bbl( kt, 'TRA' ) 
+
+      !* Diffusive bbl :
+      IF( nn_bbl_ldf == 1 ) THEN
+         CALL tra_bbl_dif( tsb, tsa, jpts )
+         IF( ln_ctl )  &
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+         ! lateral boundary conditions ; just need for outputs                          
+         CALL lbc_lnk( ahu_bbl, 'U', 1. )     ;     CALL lbc_lnk( ahv_bbl, 'V', 1. )
+         CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef     
+         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef
+      END IF
+
+      !* Advective bbl : bbl upstream advective trends added to the tracer trends
+      IF( nn_bbl_adv /= 0 ) THEN
+         CALL tra_bbl_adv( tsb, tsa, jpts )  
+         IF(ln_ctl)   &
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+         ! lateral boundary conditions ; just need for outputs                          
+         CALL lbc_lnk( utr_bbl, 'U', 1. )     ;   CALL lbc_lnk( vtr_bbl, 'V', 1. )   
+         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport     
+         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport
+      END IF
+
+      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbl, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_bbl, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
+      ENDIF
+      !
+   END SUBROUTINE tra_bbl
+
+
+   SUBROUTINE tra_bbl_dif( ptrab, ptraa, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbl_dif  ***
+      !!                   
+      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
+      !!                advection terms. 
+      !!
+      !! ** Method  :   
+      !!        * diffusive bbl (nn_bbl_ldf=1) :
+      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
+      !!      along bottom slope gradient) an additional lateral 2nd order
+      !!      diffusion along the bottom slope is added to the general
+      !!      tracer trend, otherwise the additional trend is set to 0.
+      !!      A typical value of ahbt is 2000 m2/s (equivalent to
       !!      a downslope velocity of 20 cm/s if the condition for slope
       !!      convection is satified)
-      !!      Add this before trend to the general trend (ta,sa) of the 
-      !!      botton ocean tracer point:
-      !!         ta = ta + difft
-      !!
-      !! ** Action  : - update (ta,sa) at the bottom level with the bottom
-      !!                boundary layer trend
-      !!              - save the trends in ztrdt/ztrds ('key_trdtra')
+      !!
       !!
       !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
-      !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
-      USE eosbn2                      ! equation of state
-      !!
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step
-      !!
-      INTEGER  ::   ji, jj                  ! dummy loop indices
-      INTEGER  ::   ik
-      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers
-      INTEGER  ::   iku1, iku2, ikv1,ikv2   ! temporary intergers
-      REAL(wp) ::   ze3u, ze3v              ! temporary scalars
-      INTEGER  ::   iku, ikv
-      REAL(wp) ::   zsign, zt, zs, zh, zalbet   ! temporary scalars
-      REAL(wp) ::   zgdrho, zbtr, zta, zsa
-      REAL(wp), DIMENSION(jpi,jpj) ::   zki, zkj, zkw, zkx, zky, zkz             ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztnb, zsnb, zdep, ztbb, zsbb, zahu, zahv
-      !!
-      REAL(wp) ::    fsalbt, pft, pfs, pfh   ! statement function
-      !!----------------------------------------------------------------------
-      ! ratio alpha/beta
-      ! ================
-      !  fsalbt: ratio of thermal over saline expension coefficients
-      !       pft :  potential temperature in degrees celcius
-      !       pfs :  salinity anomaly (s-35) in psu
-      !       pfh :  depth in meters
-
-      fsalbt( pft, pfs, pfh ) =                                              &
-         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
-         &                         - 0.203814e-03 ) * pft                    &
-         &                         + 0.170907e-01 ) * pft                    &
-         &                         + 0.665157e-01                            &
-         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
-         +  ( ( - 0.302285e-13 * pfh                                         &
-         &      - 0.251520e-11 * pfs                                         &
-         &      + 0.512857e-12 * pft * pft          ) * pfh                  &
-         &                           - 0.164759e-06   * pfs                  &
-         &   +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
-         &                           + 0.380374e-04 ) * pfh   
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL tra_bbl_init
-
-      IF( l_trdtra )   THEN         ! Save ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = sa(:,:,:) 
-      ENDIF
-
-      ! 0. 2D fields of bottom temperature and salinity, and bottom slope
-      ! -----------------------------------------------------------------
-      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F)
+      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
+      !!----------------------------------------------------------------------  
+      !!* Arguments
+      INTEGER         , INTENT(in   )                                ::   kjpt      ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptrab     ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptraa     ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jn           ! dummy loop indices
+      INTEGER  ::   ik                       ! temporary integers
+      REAL(wp) ::   zbtr, ztra               ! temporary 
+      REAL(wp), DIMENSION(jpi,jpj) :: ztrb, zkx, zky        ! 2D workspace
+      !!----------------------------------------------------------------------
+                                                          ! ===========
+      DO jn = 1, kjpt                                     ! tracer loop
+         !                                                ! ===========
+#if defined key_vectopt_loop
+         DO jj = 1, 1   ! vector opt. (forced unrolling)
+            DO ji = 1, jpij
+#else
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+#endif
+               ik = mbkt(ji,jj)                        ! bottom T-level index
+               ztrb(ji,jj) = ptrab(ji,jj,ik,jn)              ! bottom before T and S
+            END DO
+         END DO
+         !
 #  if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-#  endif
-            ik = mbkt(ji,jj)                              ! index of the bottom ocean T-level
-            ztnb(ji,jj) = tn(ji,jj,ik) * tmask(ji,jj,1)   ! masked now T and S at ocean bottom 
-            zsnb(ji,jj) = sn(ji,jj,ik) * tmask(ji,jj,1)
-            ztbb(ji,jj) = tb(ji,jj,ik) * tmask(ji,jj,1)   ! masked before T and S at ocean bottom 
-            zsbb(ji,jj) = sb(ji,jj,ik) * tmask(ji,jj,1)
-            zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level
-         END DO
-      END DO
-
-      IF( ln_zps ) THEN      ! partial steps correction 
-# if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-# endif
-               iku1 = MAX( mbathy(ji+1,jj  )-1, 1 )
-               iku2 = MAX( mbathy(ji  ,jj  )-1, 1 )
-               ikv1 = MAX( mbathy(ji  ,jj+1)-1, 1 )
-               ikv2 = MAX( mbathy(ji  ,jj  )-1, 1 )
-               ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 
-               ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 
-               zahu(ji,jj) = rn_ahtbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1)
-               zahv(ji,jj) = rn_ahtbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1)
-            END DO
-         END DO
-      ELSE                    ! z-coordinate - full steps or s-coordinate
-#   if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#   else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-#   endif
-               iku = mbku(ji,jj)
-               ikv = mbkv(ji,jj)
-               zahu(ji,jj) = rn_ahtbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1)
-               zahv(ji,jj) = rn_ahtbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1)
-            END DO
-         END DO
-      ENDIF
-
-      ! 1. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0
-      ! --------------------------------------------
-      ! Sign of the local density gradient along the i- and j-slopes
-      ! multiplied by the slope of the ocean bottom
-
-      SELECT CASE ( nn_eos )
-      !
-      CASE ( 0 )                 !==  Jackett and McDougall (1994) formulation  ==!
-#  if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+         DO jj = 1, 1   ! vector opt. (forced unrolling)
+            DO ji = 1, jpij-jpi
 #  else
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
 #  endif
-               ! temperature, salinity anomalie and depth
-               zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
-               zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0
-               zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
-               ! masked ratio alpha/beta
-               zalbet = fsalbt( zt, zs, zh )*umask(ji,jj,1)
-               ! local density gradient along i-bathymetric slope
-               zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   &
-                      -          ( zsnb(ji+1,jj) - zsnb(ji,jj) )
-               ! sign of local i-gradient of density multiplied by the i-slope
-               zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
-               !
-               ! temperature, salinity anomalie and depth
-               zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )
-               zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0
-               zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
-               ! masked ratio alpha/beta
-               zalbet = fsalbt( zt, zs, zh )*vmask(ji,jj,1)
-               ! local density gradient along j-bathymetric slope
-               zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   &
-                      -          ( zsnb(ji,jj+1) - zsnb(ji,jj) )
-               ! sign of local j-gradient of density multiplied by the j-slope
-               zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
+               zkx(ji,jj) = ahu_bbl(ji,jj) * ( ztrb(ji+1,jj  ) - ztrb(ji,jj) )  ! diffusive i-flux
+               zky(ji,jj) = ahv_bbl(ji,jj) * ( ztrb(ji  ,jj+1) - ztrb(ji,jj) )  ! diffusive j-flux
             END DO
          END DO
-         !
-      CASE ( 1 )               !==  Linear formulation function of temperature only  ==!
+            !                                        ! Add the diffusive trends
 #  if defined key_vectopt_loop
+         DO jj = 1, 1   ! vector opt. (forced unrolling)
+            DO ji = jpi+1, jpij-jpi-1
+#  else
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+#  endif
+               ik = mbkt(ji,jj)
+               zbtr = e1e2t_r(ji,jj)  / fse3t(ji,jj,ik)
+               ztra = ( zkx(ji,jj) - zkx(ji-1,jj) + zky(ji,jj) - zky(ji,jj-1) ) * zbtr
+               ptraa(ji,jj,ik,jn) = ptraa(ji,jj,ik,jn) + ztra
+            END DO
+         END DO
+         !
+      END DO
+      !
+   END SUBROUTINE tra_bbl_dif
+
+   SUBROUTINE tra_bbl_adv( ptrab, ptraa, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_bbl  ***
+      !!                   
+      !! ** Purpose :   Compute the before passive tracer trend associated 
+      !!     with the bottom boundary layer and add it to the general trend
+      !!     of tracer equations.
+      !!        * advective bbl (nn_bbl_adv=1 or 2) :
+      !!      nn_bbl_adv = 1   use of the ocean velocity as bbl velocity
+      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation
+      !!        i.e. transport proportional to the along-slope density gradient
+      !!
+      !!      NB: the along slope density gradient is evaluated using the
+      !!      local density (i.e. referenced at a common local depth).
+      !!
+      !!
+      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
+      !!
+      !!----------------------------------------------------------------------  
+      !!* Arguments
+      INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptrab          ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptraa          ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices
+      INTEGER  ::   ik                       ! temporary integers
+      INTEGER  ::   iis , iid , ijs , ijd    !    -          -
+      INTEGER  ::   ikus, ikud, ikvs, ikvd   !    -          -
+      REAL(wp) ::   zbtr, ztra               !    -         -
+      REAL(wp) ::   zu_bbl, zv_bbl           !    -         -
+      !!----------------------------------------------------------------------
+
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========         
+# if defined key_vectopt_loop
          DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+            DO ji = jpi+1, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+         DO jj = 2, jpjm1
+            DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west
+# endif
+               IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection
+                  ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf)
+                  iid  = ji + MAX( 0, mgrhu(ji,jj) )   ;   iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
+                  ikud = mbku_d(ji,jj)                 ;   ikus = mbku(ji,jj)
+                  zu_bbl = ABS( utr_bbl(ji,jj) )
+                  !
+                  !                                               ! up  -slope T-point (shelf bottom point)
+                  zbtr = e1e2t_r(iis,jj) / fse3t(iis,jj,ikus)
+                  ztra = zu_bbl * ( ptrab(iid,jj,ikus,jn) - ptrab(iis,jj,ikus,jn) ) * zbtr
+                  ptraa(iis,jj,ikus,jn) = ptraa(iis,jj,ikus,jn) + ztra
+                  !                   
+                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column)
+                     zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,jk)
+                     ztra = zu_bbl * ( ptrab(iid,jj,jk+1,jn) - ptrab(iid,jj,jk,jn) ) * zbtr
+                     ptraa(iid,jj,jk,jn) = ptraa(iid,jj,jk,jn) + ztra
+                  END DO
+                  ! 
+                  zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,ikud)
+                  ztra = zu_bbl * ( ptrab(iis,jj,ikus,jn) - ptrab(iid,jj,ikud,jn) ) * zbtr
+                  ptraa(iid,jj,ikud,jn) = ptraa(iid,jj,ikud,jn) + ztra
+               ENDIF
+               IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero j-direction bbl advection
+                  ! down-slope j/k-indices (deep)        &   up-slope j/k indices (shelf)
+                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )     ;   ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
+                  ikvd = mbkv_d(ji,jj)                   ;   ikvs = mbkv(ji,jj)
+                  zv_bbl = ABS( vtr_bbl(ji,jj) )
+                  ! 
+                  ! up  -slope T-point (shelf bottom point)
+                  zbtr = e1e2t_r(ji,ijs) / fse3t(ji,ijs,ikvs)
+                  ztra = zv_bbl * ( ptrab(ji,ijd,ikvs,jn) - ptrab(ji,ijs,ikvs,jn) ) * zbtr
+                  ptraa(ji,ijs,ikvs,jn) = ptraa(ji,ijs,ikvs,jn) + ztra
+                  !                   
+                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column)
+                     zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,jk)
+                     ztra = zv_bbl * ( ptrab(ji,ijd,jk+1,jn) - ptrab(ji,ijd,jk,jn) ) * zbtr
+                     ptraa(ji,ijd,jk,jn) = ptraa(ji,ijd,jk,jn)  + ztra
+                  END DO
+                  !                                               ! down-slope T-point (deep bottom point)
+                  zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,ikvd)
+                  ztra = zv_bbl * ( ptrab(ji,ijs,ikvs,jn) - ptrab(ji,ijd,ikvd,jn) ) * zbtr
+                  ptraa(ji,ijd,ikvd,jn) = ptraa(ji,ijd,ikvd,jn) + ztra
+               ENDIF
+            END DO
+            !
+         END DO
+            !
+      END DO
+      !
+   END SUBROUTINE tra_bbl_adv
+
+   SUBROUTINE bbl( kt, cdtype )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bbl  ***
+      !!                   
+      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
+      !!                advection terms. 
+      !!
+      !! ** Method  :   
+      !!        * diffusive bbl (nn_bbl_ldf=1) :
+      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
+      !!      along bottom slope gradient) an additional lateral 2nd order
+      !!      diffusion along the bottom slope is added to the general
+      !!      tracer trend, otherwise the additional trend is set to 0.
+      !!      A typical value of ahbt is 2000 m2/s (equivalent to
+      !!      a downslope velocity of 20 cm/s if the condition for slope
+      !!      convection is satified)
+      !!        * advective bbl (nn_bbl_adv=1 or 2) :
+      !!      nn_bbl_adv = 1   use of the ocean velocity as bbl velocity
+      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation
+      !!        i.e. transport proportional to the along-slope density gradient
+      !!
+      !!      NB: the along slope density gradient is evaluated using the
+      !!      local density (i.e. referenced at a common local depth).
+      !!
+      !!
+      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
+      !!----------------------------------------------------------------------  
+      INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER  ::   ji, jj                    ! dummy loop indices
+      INTEGER  ::   ik                         ! temporary integers
+      INTEGER  ::   iis , iid , ijs , ijd     !    -          -
+      INTEGER  ::   ikus, ikud, ikvs, ikvd    !    -          -
+      REAL(wp) ::   zsign, zsigna, zgbbl      ! temporary scalars
+      REAL(wp) ::   zgdrho, zt, zs, zh        !    -         -
+      REAL(wp), DIMENSION(jpi,jpj) ::   zub, zvb, ztb, zsb, zdep  !  -      -
+      !!
+      REAL(wp) ::   fsalbt, fsbeta, pft, pfs, pfh   ! statement function
+      !!----------------------- zv_bbl-----------------------------------------------
+      ! ratio alpha/beta = fsalbt : ratio of thermal over saline expension coefficients
+      ! ================            pft :  potential temperature in degrees celcius
+      !                             pfs :  salinity anomaly (s-35) in psu
+      !                             pfh :  depth in meters
+      ! nn_eos = 0  (Jackett and McDougall 1994 formulation)
+      fsalbt( pft, pfs, pfh ) =                                              &   ! alpha/beta
+         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
+                                   - 0.203814e-03 ) * pft                    &
+                                   + 0.170907e-01 ) * pft                    &
+                                   + 0.665157e-01                            &
+         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
+         +  ( ( - 0.302285e-13 * pfh                                         &
+                - 0.251520e-11 * pfs                                         &
+                + 0.512857e-12 * pft * pft          ) * pfh                  &
+                                     - 0.164759e-06   * pfs                  &
+             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
+                                     + 0.380374e-04 ) * pfh
+      fsbeta( pft, pfs, pfh ) =                                              &   ! beta
+         ( ( -0.415613e-09 * pft + 0.555579e-07 ) * pft                      &
+                                 - 0.301985e-05 ) * pft                      &
+                                 + 0.785567e-03                              &
+         + (     0.515032e-08 * pfs                                          &
+               + 0.788212e-08 * pft - 0.356603e-06 ) * pfs                   &
+               +(  (   0.121551e-17 * pfh                                    &
+                     - 0.602281e-15 * pfs                                    &
+                     - 0.175379e-14 * pft + 0.176621e-12 ) * pfh             &
+                                          + 0.408195e-10   * pfs             &
+                 + ( - 0.213127e-11 * pft + 0.192867e-09 ) * pft             &
+                                          - 0.121555e-07 ) * pfh
+      !!----------------------------------------------------------------------
+      
+      !                                        !* bottom temperature, salinity, velocity and depth
+      IF( kt == nit000 ) THEN
+         IF(lwp)  WRITE(numout,*) ' '
+         IF(lwp)  WRITE(numout,*) ' trabbl:bbl  : Compute bbl velocities and diffusive coefficients in ', cdtype, ' at time step ', kt
+         IF(lwp)  WRITE(numout,*) ' '
+      ENDIF
+
+#if defined key_vectopt_loop
+      DO jj = 1, 1   ! vector opt. (forced unrolling)
+         DO ji = 1, jpij
+#else
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+#endif
+            ik = mbkt(ji,jj)                        ! bottom T-level index
+            ztb (ji,jj) = tb(ji,jj,ik)              ! bottom before T and S
+            zsb (ji,jj) = sb(ji,jj,ik)
+            zdep(ji,jj) = fsdept_0(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)) 
+         END DO
+      END DO
+      
+      !                                   !-------------------!
+      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   !
+         !                                !-------------------!
+         !                                        ! bbl diffusive fluxes
+         !                                             ! (criteria for non zero flux: grad(rho).grad(h) < 0 )
+#  if defined key_vectopt_loop
+         DO jj = 1, 1   ! vector opt. (forced unrolling)
+            DO ji = 1, jpij-jpi
 #  else
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
 #  endif
-               ! local 'density/temperature' gradient along i-bathymetric slope
-               zgdrho =  ztnb(ji+1,jj) - ztnb(ji,jj) 
-               ! sign of local i-gradient of density multiplied by the i-slope
-               zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
+               !                                                ! i-direction 
+               zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )  ! T, S anomalie, and depth
+               zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+               zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+               !                                                         ! masked bbl i-gradient of density
+               zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    &
+                  &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask(ji,jj,1)
+               !                                                     
+               zsign          = SIGN(  0.5, - zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope )
+               ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)                  ! masked diffusive flux coeff.
                !
-               ! local density gradient along j-bathymetric slope
-               zgdrho =  ztnb(ji,jj+1) - ztnb(ji,jj) 
-               ! sign of local j-gradient of density multiplied by the j-slope
-               zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
+               !                                                ! j-direction 
+               zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                ! T, S anomalie, and depth
+               zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0
+               zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
+               !                                                         ! masked bbl j-gradient of density
+               zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    &
+                  &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask(ji,jj,1)
+               !                                                    
+               zsign          = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope )
+               ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj)
+               !
             END DO
          END DO
          !
-      CASE ( 2 )               !==  Linear formulation function of temperature and salinity  ==!
-#  if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-#  endif      
-               ! local density gradient along i-bathymetric slope
-               zgdrho = - ( rn_beta *( zsnb(ji+1,jj) - zsnb(ji,jj) )   &
-                  &       - rn_alpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) )
-               ! sign of local i-gradient of density multiplied by the i-slope
-               zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
-               !
-               ! local density gradient along j-bathymetric slope
-               zgdrho = - ( rn_beta *( zsnb(ji,jj+1) - zsnb(ji,jj) )   &
-                  &       - rn_alpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )   
-               ! sign of local j-gradient of density multiplied by the j-slope
-               zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
+      ENDIF
+
+
+      !                                   !-------------------!
+      IF( nn_bbl_adv /= 0 ) THEN          !   advective bbl   !
+         !                                !-------------------!
+         SELECT CASE ( nn_bbl_adv )             !* bbl transport type
+         !
+         CASE( 1 )                                   != use of upper velocity
+            DO jj = 2, jpjm1                                 ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  !                                               ! i-direction
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )                  ! T, S anomalie, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+                  !                                                           ! masked bbl i-gradient of density
+                  zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    &  
+                     &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask(ji,jj,1)
+                  !                                                         
+                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )    ! sign of i-gradient * i-slope
+                  zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )    ! sign of u * i-slope
+                  !
+                  !                                                           ! bbl velocity
+                  utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj)
+                  !
+                  !                                               ! j-direction
+                  zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                  ! T, S anomalie, and depth
+                  zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
+                  !                                                           ! masked bbl j-gradient of density
+                  zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    &  
+                     &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask(ji,jj,1)
+                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )    ! sign of j-gradient * j-slope
+                  zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )    ! sign of u * i-slope
+                  !
+                  !                                                           ! bbl velocity
+                  vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj)
+               END DO
             END DO
-         END DO
-         !
-      END SELECT
-
-      ! 2. Additional second order diffusive trends
-      ! -------------------------------------------
-
-      ! first derivative (gradient)
-#  if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-#  endif
-            zkx(ji,jj) = zki(ji,jj) * ( ztbb(ji+1,jj) - ztbb(ji,jj) )
-            zkz(ji,jj) = zki(ji,jj) * ( zsbb(ji+1,jj) - zsbb(ji,jj) )
-
-            zky(ji,jj) = zkj(ji,jj) * ( ztbb(ji,jj+1) - ztbb(ji,jj) )
-            zkw(ji,jj) = zkj(ji,jj) * ( zsbb(ji,jj+1) - zsbb(ji,jj) )
-#  if ! defined key_vectopt_loop
-         END DO
-#  endif
-      END DO
-
-      IF( cp_cfg == "orca" ) THEN
-         !
-         SELECT CASE ( jp_cfg )
-         !                                           ! =======================
-         CASE ( 2 )                                  !  ORCA_R2 configuration
-            !                                        ! =======================
-            ! Gibraltar enhancement of BBL
-            ij0 = 102   ;   ij1 = 102
-            ii0 = 139   ;   ii1 = 140  
-            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-            !
-            ! Red Sea enhancement of BBL
-            ij0 =  88   ;   ij1 =  88
-            ii0 = 161   ;   ii1 = 162
-            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-            !
-            !                                        ! =======================
-         CASE ( 4 )                                  !  ORCA_R4 configuration
-            !                                        ! =======================
-            ! Gibraltar enhancement of BBL
-            ij0 =  52   ;   ij1 =  52
-            ii0 =  70   ;   ii1 =  71  
-            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-            !
+         !
+         CASE( 2 )                                 != bbl velocity = F( delta rho )
+            zgbbl = grav * rn_gambbl
+            DO jj = 2, jpjm1                            ! criteria: rho_up > rho_down
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  !                                         ! i-direction
+                  ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf)
+                  iid  = ji + MAX( 0, mgrhu(ji,jj) )     ;    iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
+                  ikud = mbku_d(ji,jj)                   ;    ikus = mbku(ji,jj)
+                  !
+                  !                                             ! mid-depth density anomalie (up-slope minus down-slope)
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )           ! mid slope depth of T, S, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+                  zgdrho =    fsbeta( zt, zs, zh )                                    &
+                     &   * (  fsalbt( zt, zs, zh ) * ( ztb(iid,jj) - ztb(iis,jj) )    &  
+                     &                             - ( zsb(iid,jj) - zsb(iis,jj) )  ) * umask(ji,jj,1)
+                  zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep
+                  !
+                  !                                             ! bbl transport (down-slope direction)
+                  utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) )
+                  !
+                  !                                         ! j-direction
+                  !  down-slope T-point j/k-index (deep)  &   of the up  -slope T-point j/k-index (shelf)
+                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )      ;    ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
+                  ikvd = mbkv_d(ji,jj)                    ;    ikvs = mbkv(ji,jj)
+                  !
+                  !                                             ! mid-depth density anomalie (up-slope minus down-slope)
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji,jj+1) )           ! mid slope depth of T, S, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji,jj+1) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji,jj+1) )
+                  zgdrho =    fsbeta( zt, zs, zh )                                    &
+                     &   * (  fsalbt( zt, zs, zh ) * ( ztb(ji,ijd) - ztb(ji,ijs) )    &  
+                     &                             - ( zsb(ji,ijd) - zsb(ji,ijs) )  ) * vmask(ji,jj,1)
+                  zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep
+                  !
+                  !                                             ! bbl transport (down-slope direction)
+                  vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) )
+               END DO
+            END DO
          END SELECT
-      !
+         !
       ENDIF
-
-
-      ! second derivative (divergence) and add to the general tracer trend
-#  if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-#  endif
-            ik = max( mbathy(ji,jj)-1, 1 )
-            zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) )
-            zta = (  zkx(ji,jj) - zkx(ji-1,jj  )    &
-                   + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr
-            zsa = (  zkz(ji,jj) - zkz(ji-1,jj  )    &
-                   + zkw(ji,jj) - zkw(ji  ,jj-1)  ) * zbtr
-            ta(ji,jj,ik) = ta(ji,jj,ik) + zta
-            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa
-         END DO
-      END DO
-
-      IF( l_trdtra ) THEN      ! save the BBL lateral diffusion trends for diagnostic
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_bbl, 'TRA', kt)
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' bbl  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-      !
-   END SUBROUTINE tra_bbl_dif
-
-# if defined key_trabbl_adv
-   !!----------------------------------------------------------------------
-   !!   'key_trabbl_adv'                    advective bottom boundary layer
-   !!----------------------------------------------------------------------
-#  include "trabbl_adv.h90"
-# else
-   !!----------------------------------------------------------------------
-   !!   Default option :                 NO advective bottom boundary layer
-   !!----------------------------------------------------------------------
-   SUBROUTINE tra_bbl_adv (kt )              ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'tra_bbl_adv: You should not have seen this print! error?', kt
-   END SUBROUTINE tra_bbl_adv
-# endif
+      !
+   END SUBROUTINE bbl
+
 
    SUBROUTINE tra_bbl_init
@@ -400,46 +532,96 @@
       !!      called by tra_bbl at the first timestep (nit000)
       !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj      ! dummy loop indices
-      REAL(wp),  DIMENSION(jpi,jpj) :: zmbk  
-
-      NAMELIST/nambbl/ rn_ahtbbl
-      !!----------------------------------------------------------------------
-
-      REWIND ( numnam )              ! Read Namelist nambbl : bottom boundary layer scheme
+      INTEGER ::   ji, jj               ! dummy loop indices
+      INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integer
+      REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! 2D workspace 
+
+      NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
+      !!----------------------------------------------------------------------
+
+      REWIND ( numnam )              !* Read Namelist nambbl : bottom boundary layer scheme
       READ   ( numnam, nambbl )
 
-      IF(lwp) THEN                   ! Parameter control and print
+      IF(lwp) THEN                   !* Parameter control and print
          WRITE(numout,*)
-         WRITE(numout,*) 'tra_bbl_init : '
+         WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation'
          WRITE(numout,*) '~~~~~~~~~~~~'
-         IF( lk_trabbl_dif )   WRITE(numout,*) '               * Diffusive Bottom Boundary Layer'
-         IF( lk_trabbl_adv )   WRITE(numout,*) '               * Advective Bottom Boundary Layer'
          WRITE(numout,*) '       Namelist nambbl : set bbl parameters'
-         WRITE(numout,*) '          bottom boundary layer coef.    rn_ahtbbl = ', rn_ahtbbl
+         WRITE(numout,*) '          diffusive bbl (=1)   or not (=0)    nn_bbl_ldf = ', nn_bbl_ldf
+         WRITE(numout,*) '          advective bbl (=1/2) or not (=0)    nn_bbl_adv = ', nn_bbl_adv
+         WRITE(numout,*) '          diffusive bbl coefficient           rn_ahtbbl  = ', rn_ahtbbl, ' m2/s'
+         WRITE(numout,*) '          advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s'
       ENDIF
- 
-      DO jj = 1, jpj
+      
+      IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity'
+      IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)'
+
+      IF( nn_eos /= 0 )   CALL ctl_stop ( ' bbl parameterisation requires eos = 0. We stop.' )
+
+
+      !                             !* inverse of surface of T-cells
+      e1e2t_r(:,:) = 1.0 / ( e1t(:,:) * e2t(:,:) )
+      
+      !                             !* vertical index of bottom t-, u- and v-points
+      DO jj = 1, jpj                      ! bottom k-index of T-level
          DO ji = 1, jpi
-            mbkt(ji,jj) = MAX( mbathy(ji,jj) - 1, 1 )   ! vertical index of the bottom ocean T-level
+            mbkt(ji,jj) = MAX( mbathy(ji,jj) - 1, 1 )
          END DO
       END DO
-      DO jj = 1, jpjm1
+      DO jj = 1, jpjm1                    ! bottom k-index of u- (v-) level (shelf and deep)
          DO ji = 1, jpim1
-            mbku(ji,jj) = MAX( MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) ) - 1, 1 )
-            mbkv(ji,jj) = MAX( MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) ) - 1, 1 )
+            mbku  (ji,jj) = MAX( MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) ) - 1, 1 )   ! "shelf"
+            mbkv  (ji,jj) = MAX( MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) ) - 1, 1 )
+            mbku_d(ji,jj) = MAX( MAX( mbathy(ji+1,jj  ), mbathy(ji,jj) ) - 1, 1 )   ! "deep"
+            mbkv_d(ji,jj) = MAX( MAX( mbathy(ji  ,jj+1), mbathy(ji,jj) ) - 1, 1 )
          END DO
       END DO
-
-      zmbk(:,:) = FLOAT( mbku (:,:) )   
-      CALL lbc_lnk(zmbk,'U',1.)
-      mbku(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
-
-      zmbk(:,:) = FLOAT( mbkv (:,:) )   
-      CALL lbc_lnk(zmbk,'V',1.)
-      mbkv(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
-
-# if defined key_trabbl_adv
-      w_bbl(:,:,:) = 0.e0          ! initialisation of w_bbl to zero
-# endif
+      zmbk(:,:) = FLOAT( mbku  (:,:) )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = FLOAT( mbkv  (:,:) )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = FLOAT( mbku_d(:,:) )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = FLOAT( mbkv_d(:,:) )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+
+      DO jj = 1, jpj                !* sign of grad(H) at u- and v-points
+         DO ji = 1, jpi
+            mgrhu(ji,jj) = INT(  SIGN( 1.e0, fsdept_0(ji+1,jj,mbkt(ji+1,jj)) - fsdept_0(ji,jj,mbkt(ji,jj)) )  )
+            mgrhv(ji,jj) = INT(  SIGN( 1.e0, fsdept_0(ji,jj+1,mbkt(ji,jj+1)) - fsdept_0(ji,jj,mbkt(ji,jj)) )  )
+         END DO
+      END DO
+
+      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point 
+         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0)
+            e3u_bbl_0(ji,jj) = MIN( fse3u_0(ji,jj,mbkt(ji+1,jj  )), fse3u_0(ji,jj,mbkt(ji,jj)) )  
+            e3v_bbl_0(ji,jj) = MIN( fse3v_0(ji,jj,mbkt(ji  ,jj+1)), fse3v_0(ji,jj,mbkt(ji,jj)) )  
+         END DO 
+      END DO
+      CALL lbc_lnk( e3u_bbl_0, 'U', 1. )   ;   CALL lbc_lnk( e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions
+
+      !                             !* masked diffusive flux coefficients 
+      ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)  * umask(:,:,1)
+      ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)  * vmask(:,:,1)
+
+      IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : regional enhancement of ah_bbl
+         !
+         SELECT CASE ( jp_cfg )
+         CASE ( 2 )                          ! ORCA_R2
+            ij0 = 102   ;   ij1 = 102              ! Gibraltar enhancement of BBL
+            ii0 = 139   ;   ii1 = 140  
+            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            !
+            ij0 =  88   ;   ij1 =  88              ! Red Sea enhancement of BBL
+            ii0 = 161   ;   ii1 = 162
+            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            !
+         CASE ( 4 )                          ! ORCA_R4
+            ij0 =  52   ;   ij1 =  52              ! Gibraltar enhancement of BBL
+            ii0 =  70   ;   ii1 =  71  
+            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+         END SELECT
+         !
+      ENDIF
+      !
+      l_bbl = .TRUE.     !: flag to compute bbl coef and transport
       !
    END SUBROUTINE tra_bbl_init
@@ -449,13 +631,9 @@
    !!   Dummy module :                      No bottom boundary layer scheme
    !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_dif = .FALSE.   !: diff bbl flag
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .FALSE.   !: adv  bbl flag
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .FALSE.   !: bbl flag
 CONTAINS
-   SUBROUTINE tra_bbl_dif( kt )              ! Empty routine
-      WRITE(*,*) 'tra_bbl_dif: You should not have seen this print! error?', kt
-   END SUBROUTINE tra_bbl_dif
-   SUBROUTINE tra_bbl_adv( kt )              ! Empty routine
-      WRITE(*,*) 'tra_bbl_adv: You should not have seen this print! error?', kt
-   END SUBROUTINE tra_bbl_adv
+   SUBROUTINE tra_bbl( kt )              ! Empty routine
+      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt
+   END SUBROUTINE tra_bbl
 #endif
 
Index: anches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbl_adv.h90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbl_adv.h90	(revision 2023)
+++ 	(revision )
@@ -1,426 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                     ***  trabbl_adv.h90  ***
-   !!----------------------------------------------------------------------
-   !! History :  8.5  !  02-12  (A. de Miranda, G. Madec)  Original Code 
-   !!            9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines )
-   !!----------------------------------------------------------------------     
-
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE tra_bbl_adv( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_bbl_adv  ***
-      !!                   
-      !! ** Purpose :   Compute the before tracer (t & s) trend associated 
-      !!     with the bottom boundary layer and add it to the general trend
-      !!     of tracer equations. The bottom boundary layer is supposed to be 
-      !!     both an advective and diffusive bottom boundary layer.
-      !!
-      !! ** Method  :   Computes the bottom boundary horizontal and vertical 
-      !!      advection terms. Add it to the general trend : ta =ta + adv_bbl.
-      !!        When the product grad( rho) * grad(h) < 0 (where grad is a
-      !!      along bottom slope gradient) an additional lateral 2nd order
-      !!      diffusion along the bottom slope is added to the general
-      !!      tracer trend, otherwise the additional trend is set to 0.
-      !!      Second order operator (laplacian type) with variable coefficient
-      !!      computed as follow for temperature (idem on s):
-      !!         difft = 1/(e1t*e2t*e3t) { di-1[ ahbt e2u*e3u/e1u di[ztb] ]
-      !!                                 + dj-1[ ahbt e1v*e3v/e2v dj[ztb] ] }
-      !!      where ztb is a 2D array: the bottom ocean te;perature and ahtb
-      !!      is a time and space varying diffusive coefficient defined by:
-      !!         ahbt = zahbp    if grad(rho).grad(h) < 0
-      !!              = 0.       otherwise.
-      !!      Note that grad(.) is the along bottom slope gradient. grad(rho)
-      !!      is evaluated using the local density (i.e. referenced at the
-      !!      local depth). Typical value of ahbt is 2000 m2/s (equivalent to
-      !!      a downslope velocity of 20 cm/s if the condition for slope
-      !!      convection is satified)
-      !!        Add this before trend to the general trend (ta,sa) of the
-      !!      botton ocean tracer point:
-      !!              ta = ta + difft
-      !!
-      !! ** Action  : - update (ta,sa) at the bottom level with the bottom
-      !!                boundary layer trend
-      !!
-      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
-      !!----------------------------------------------------------------------     
-      USE eosbn2                      ! equation of state
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace 
-      USE iom                           
-      !!
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
-      !!
-      INTEGER  ::   ji, jj, jk        ! dummy loop indices
-      INTEGER  ::   ik                ! temporary integers
-      INTEGER  ::   iku, iku1, iku2   !    "          "
-      INTEGER  ::   ikv, ikv1, ikv2   !    "          "
-      REAL(wp) ::   zsign, zh, zalbet     ! temporary scalars
-      REAL(wp) ::   zgdrho, zbtr          !    "         " 
-      REAL(wp) ::   zbt, zsigna           !    "         "
-      REAL(wp) ::   zfui, ze3u, zt, zta   !    "         "
-      REAL(wp) ::   zfvj, ze3v, zs, zsa   !    "         "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zalphax, zwu, zunb   ! temporary 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zalphay, zwv, zvnb   !    "             "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zwx, zwy, zww, zwz   !    "             "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   ztbb, zsbb           !    "             "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   ztnb, zsnb, zdep     !    "             "
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhdivn               ! temporary 3D workspace
-      REAL(wp) ::   fsalbt, pft, pfs, pfh   ! statement function
-      !!----------------------------------------------------------------------
-      ! ratio alpha/beta
-      ! ================
-      !  fsalbt: ratio of thermal over saline expension coefficients
-      !       pft :  potential temperature in degrees celcius
-      !       pfs :  salinity anomaly (s-35) in psu
-      !       pfh :  depth in meters
-
-      fsalbt( pft, pfs, pfh ) =                                              &
-         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
-                                   - 0.203814e-03 ) * pft                    &
-                                   + 0.170907e-01 ) * pft                    &
-                                   + 0.665157e-01                            &
-         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
-         +  ( ( - 0.302285e-13 * pfh                                         &
-                - 0.251520e-11 * pfs                                         &
-                + 0.512857e-12 * pft * pft          ) * pfh                  &
-                                     - 0.164759e-06   * pfs                  &
-             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
-                                     + 0.380374e-04 ) * pfh
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL tra_bbl_init    ! initialization at first time-step
-
-      ! 1. 2D fields of bottom temperature and salinity, and bottom slope
-      ! -----------------------------------------------------------------
-      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F)
-
-#if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#else
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-#endif
-            ik = mbkt(ji,jj)                               ! index of the bottom ocean T-level
-            ztnb(ji,jj) = tn(ji,jj,ik)
-            zsnb(ji,jj) = sn(ji,jj,ik)
-            ztbb(ji,jj) = tb(ji,jj,ik)
-            zsbb(ji,jj) = sb(ji,jj,ik) 
-            zdep(ji,jj) = fsdept(ji,jj,ik)                 ! depth of the ocean bottom T-level
-
-            zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) 
-            zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
-         END DO
-      END DO
-
-
-      ! 2. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0
-      ! --------------------------------------------
-      ! Sign of the local density gradient along the i- and j-slopes
-      ! multiplied by the slope of the ocean bottom
-
-      SELECT CASE ( nn_eos )
-      !
-      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               !   ... temperature, salinity anomalie and depth
-               zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
-               zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0
-               zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
-               !   ... masked ratio alpha/beta
-               zalbet = fsalbt( zt, zs, zh ) * umask(ji,jj,1)
-               !   ... local density gradient along i-bathymetric slope
-               zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   &
-                  &       -      ( zsnb(ji+1,jj) - zsnb(ji,jj) )
-               zgdrho = zgdrho * umask(ji,jj,1)
-               !   ... sign of local i-gradient of density multiplied by the i-slope
-               zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1)
-               !
-               !   ... temperature, salinity anomalie and depth
-               zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )
-               zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0
-               zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
-               !   ... masked ratio alpha/beta
-               zalbet = fsalbt( zt, zs, zh ) * vmask(ji,jj,1)
-               !   ... local density gradient along j-bathymetric slope
-               zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   &
-                  &       -      ( zsnb(ji,jj+1) - zsnb(ji,jj) )
-               zgdrho = zgdrho*vmask(ji,jj,1)
-               !   ... sign of local j-gradient of density multiplied by the j-slope
-               zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)
-            END DO
-         END DO
-         !
-      CASE ( 1 )               ! Linear formulation function of temperature only
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ! local 'density/temperature' gradient along i-bathymetric slope
-               zgdrho =  ( ztnb(ji+1,jj) - ztnb(ji,jj) )
-               ! sign of local i-gradient of density multiplied by the i-slope
-               zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1)
-               ! 
-               ! local density gradient along j-bathymetric slope
-               zgdrho =  ( ztnb(ji,jj+1) - ztnb(ji,jj) )
-               ! sign of local j-gradient of density multiplied by the j-slope
-               zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)
-            END DO
-         END DO
-         !
-      CASE ( 2 )               ! Linear formulation function of temperature and salinity
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.            
-               ! local density gradient along i-bathymetric slope
-               zgdrho = - ( rn_beta *( zsnb(ji+1,jj) - zsnb(ji,jj) )   &
-                  &       - rn_alpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) )
-               ! sign of local i-gradient of density multiplied by the i-slope
-               zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zalphax(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1)
-               ! 
-               ! local density gradient along j-bathymetric slope
-               zgdrho = - ( rn_beta *( zsnb(ji,jj+1) - zsnb(ji,jj) )   &
-                  &       - rn_alpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )   
-               ! sign of local j-gradient of density multiplied by the j-slope
-               zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zalphay(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)
-            END DO
-         END DO
-         !
-      END SELECT
-
-      ! lateral boundary conditions on zalphax and zalphay   (unchanged sign)
-       CALL lbc_lnk( zalphax, 'U', 1. )   ;   CALL lbc_lnk( zalphay, 'V', 1. )
-
-
-      ! 3. Velocities that are exchanged between ajacent bottom boxes.
-      !---------------------------------------------------------------
-
-      ! ... is equal to zero but where bbl will work.
-      u_bbl(:,:,:) = 0.e0
-      v_bbl(:,:,:) = 0.e0
-
-      IF( ln_zps ) THEN     ! partial steps correction   
-      
-# if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else   
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-# endif
-               iku  = mbku(ji  ,jj  )
-               ikv  = mbkv(ji  ,jj  )  
-               iku1 = mbkt(ji+1,jj  )
-               iku2 = mbkt(ji  ,jj  )
-               ikv1 = mbkt(ji  ,jj+1)
-               ikv2 = mbkt(ji  ,jj  )
-               ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 
-               ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 
-               
-               IF( MAX(iku,ikv) >  1 ) THEN
-                  u_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) * ze3u / fse3u(ji,jj,iku)
-                  v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * ze3v / fse3v(ji,jj,ikv)       
-               ENDIF
-            END DO
-         END DO
-
-         ! lateral boundary conditions on u_bbl and v_bbl   (changed sign)
-         CALL lbc_lnk( u_bbl, 'U', -1. )   ;   CALL lbc_lnk( v_bbl, 'V', -1. )
-       
-      ELSE       ! if not partial step loop over the whole domain no lbc call
-
-#if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#else
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-#endif   
-               iku = mbku(ji,jj)
-               ikv = mbkv(ji,jj)
-               IF( MAX(iku,ikv) >  1 ) THEN
-                  u_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) 
-                  v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv)       
-               ENDIF
-            END DO
-         END DO
-       
-      ENDIF
-
-
-      ! 5. Along sigma advective trend
-      ! -------------------------------
-      ! ... Second order centered tracer flux at u and v-points
-
-# if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-# endif
-            iku = mbku(ji,jj)
-            ikv = mbkv(ji,jj)
-            zfui = e2u(ji,jj) * fse3u(ji,jj,iku) * u_bbl(ji,jj,iku)
-            zfvj = e1v(ji,jj) * fse3v(ji,jj,ikv) * v_bbl(ji,jj,ikv)
-            ! centered scheme
-!           zwx(ji,jj) = 0.5* zfui * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
-!           zwy(ji,jj) = 0.5* zfvj * ( ztnb(ji,jj) + ztnb(ji,jj+1) )
-!           zww(ji,jj) = 0.5* zfui * ( zsnb(ji,jj) + zsnb(ji+1,jj) )
-!           zwz(ji,jj) = 0.5* zfvj * ( zsnb(ji,jj) + zsnb(ji,jj+1) )
-            ! upstream scheme
-            zwx(ji,jj) = ( ( zfui + ABS( zfui ) ) * ztbb(ji  ,jj  )   &
-               &          +( zfui - ABS( zfui ) ) * ztbb(ji+1,jj  ) ) * 0.5
-            zwy(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * ztbb(ji  ,jj  )   &
-               &          +( zfvj - ABS( zfvj ) ) * ztbb(ji  ,jj+1) ) * 0.5
-            zww(ji,jj) = ( ( zfui + ABS( zfui ) ) * zsbb(ji  ,jj  )   &
-               &          +( zfui - ABS( zfui ) ) * zsbb(ji+1,jj  ) ) * 0.5
-            zwz(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * zsbb(ji  ,jj  )   &
-               &          +( zfvj - ABS( zfvj ) ) * zsbb(ji  ,jj+1) ) * 0.5
-         END DO
-      END DO
-# if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-# else
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-# endif
-            ik = mbkt(ji,jj)
-            zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,ik) )
-            ! horizontal advective trends
-            zta = - zbtr * (  zwx(ji,jj) - zwx(ji-1,jj  )   &
-               &            + zwy(ji,jj) - zwy(ji  ,jj-1)  )
-            zsa = - zbtr * (  zww(ji,jj) - zww(ji-1,jj  )   &
-               &            + zwz(ji,jj) - zwz(ji  ,jj-1)  )
-
-            ! add it to the general tracer trends
-            ta(ji,jj,ik) = ta(ji,jj,ik) + zta
-            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa
-         END DO
-      END DO
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' bbl  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-
-      ! 6. Vertical advection velocities
-      ! --------------------------------
-      ! ... computes divergence perturbation (velocties to be removed from upper t boxes :
-      DO jk= 1, jpkm1
-         DO jj=1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zwu(ji,jj) = -e2u(ji,jj) * u_bbl(ji,jj,jk) * fse3u(ji,jj,jk)
-               zwv(ji,jj) = -e1v(ji,jj) * v_bbl(ji,jj,jk) * fse3v(ji,jj,jk)
-            END DO
-         END DO
-
-      ! ... horizontal divergence
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-               zhdivn(ji,jj,jk) = (  zwu(ji,jj) - zwu(ji-1,jj  )   &
-                                   + zwv(ji,jj) - zwv(ji  ,jj-1)  ) / zbt
-            END DO
-         END DO
-      END DO
-
-
-      ! ... horizontal bottom divergence
-
-      IF( ln_zps ) THEN
- 
-# if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-# endif
-               iku  = mbku(ji  ,jj  )
-               ikv  = mbkv(ji  ,jj  )  
-               iku1 = mbkt(ji+1,jj  )
-               iku2 = mbkt(ji  ,jj  )
-               ikv1 = mbkt(ji  ,jj+1)
-               ikv2 = mbkt(ji  ,jj  )
-               ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 
-               ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 
-
-               zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * ze3u  
-               zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * ze3v
-            END DO
-         END DO  
-         !
-      ELSE
-         !
-# if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-# endif
-               iku = mbku(ji,jj)
-               ikv = mbkv(ji,jj)
-               zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku) 
-               zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv) 
-            END DO
-         END DO
-         !
-      ENDIF
- 
-
-# if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-# else
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-# endif
-            ik = mbkt(ji,jj)
-            zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik)
-            zhdivn(ji,jj,ik) =   &
-               &   (  zwu(ji  ,jj  ) * ( zunb(ji  ,jj  ) - un(ji  ,jj  ,ik) )   &
-               &    - zwu(ji-1,jj  ) * ( zunb(ji-1,jj  ) - un(ji-1,jj  ,ik) )   &
-               &    + zwv(ji  ,jj  ) * ( zvnb(ji  ,jj  ) - vn(ji  ,jj  ,ik) )   &
-               &    - zwv(ji  ,jj-1) * ( zvnb(ji  ,jj-1) - vn(ji  ,jj-1,ik) )   &
-               &   ) / zbt
-
-         END DO
-      END DO
-
-      ! 7. compute additional vertical velocity to be used in t boxes
-      ! -------------------------------------------------------------
-      ! ... Computation from the bottom
-      ! Note that w_bbl(:,:,jpk) has been set to 0 in tra_bbl_init
-      DO jk = jpkm1, 1, -1
-         DO jj= 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               w_bbl(ji,jj,jk) = w_bbl(ji,jj,jk+1) - fse3t(ji,jj,jk)*zhdivn(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( w_bbl, 'W', 1. )      ! Boundary condition on w_bbl   (unchanged sign)
-
-      CALL iom_put( "uoce_bbl", u_bbl )   ! bbl i-current      
-      CALL iom_put( "voce_bbl", v_bbl )   ! bbl j-current
-      CALL iom_put( "woce_bbl", w_bbl )   ! bbl vert. current
-      !
-   END SUBROUTINE tra_bbl_adv
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 2024)
@@ -13,4 +13,5 @@
    !!  NEMO      1.0  ! 2002-08  (G. Madec, E. Durand)  free form + modules
    !!            3.2  ! 2009-08  (G. Madec, C. Talandier)  DOCTOR norm for namelist parameter
+   !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC 
    !!----------------------------------------------------------------------
 #if   defined key_tradmp   ||   defined key_esopa
@@ -26,6 +27,6 @@
    USE oce             ! ocean dynamics and tracers variables
    USE dom_oce         ! ocean space and time domain variables
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce         ! ocean space and time domain variables
+   USE trdtra         ! ocean space and time domain variables
    USE zdf_oce         ! ocean vertical physics
    USE phycst          ! Define parameters for the routines
@@ -40,5 +41,8 @@
    PRIVATE
 
-   PUBLIC   tra_dmp    ! routine called by step.F90
+   PUBLIC   tra_dmp      ! routine called by step.F90
+   PUBLIC   tra_dmp_init ! routine called by opa.F90
+   PUBLIC   dtacof       ! routine called by tradmp.F90 and trcdmp.F90
+   PUBLIC   dtacof_zoom  ! routine called by tradmp.F90 and trcdmp.F90
 
 #if ! defined key_agrif
@@ -86,17 +90,14 @@
       !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
-      !!
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !!
       INTEGER ::   ji, jj, jk   ! dummy loop indices
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL tra_dmp_init      ! Initialization
-
-      IF( l_trdtra )   THEN                       ! Save ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = sa(:,:,:) 
+      REAL(wp) ::  zta, zsa
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
+      !!----------------------------------------------------------------------
+
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
 
@@ -107,6 +108,8 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ta(ji,jj,jk) = ta(ji,jj,jk) + resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) )
-                  sa(ji,jj,jk) = sa(ji,jj,jk) + resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) )
+                  zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )
+                  zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) )
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
                END DO
             END DO
@@ -118,6 +121,8 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   IF( avt(ji,jj,jk) <= 5.e-4 ) THEN
-                     ta(ji,jj,jk) = ta(ji,jj,jk) + resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) )
-                     sa(ji,jj,jk) = sa(ji,jj,jk) + resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) )
+                     zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )
+                     zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) )
+                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
+                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
                   ENDIF
                END DO
@@ -130,6 +135,8 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
-                     ta(ji,jj,jk) = ta(ji,jj,jk) + resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) )
-                     sa(ji,jj,jk) = sa(ji,jj,jk) + resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) )
+                     zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )
+                     zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) )
+                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
+                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
                   ENDIF
                END DO
@@ -140,11 +147,13 @@
 
       IF( l_trdtra )   THEN       ! trend diagnostic
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
-         CALL trd_mod( ztrdt, ztrds, jptra_trd_dmp, 'TRA', kt )
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_dmp, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_dmp, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )
       ENDIF
       !                           ! Control print
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' dmp  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' dmp  - Ta: ', mask1=tmask,   &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
    END SUBROUTINE tra_dmp
@@ -200,6 +209,7 @@
 
       !                          ! Damping coefficients initialization
-      IF( lzoom ) THEN   ;   CALL dtacof_zoom
-      ELSE               ;   CALL dtacof
+      IF( lzoom ) THEN   ;   CALL dtacof_zoom( resto )
+      ELSE               ;   CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep,  &
+                             &            nn_file, 'TRA'  , resto            )
       ENDIF
       !
@@ -207,5 +217,5 @@
 
 
-   SUBROUTINE dtacof_zoom
+   SUBROUTINE dtacof_zoom( presto )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dtacof_zoom  ***
@@ -220,4 +230,7 @@
       !! ** Action  : - resto, the damping coeff. for T and S
       !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)  ::  presto     !: restoring coeff. (s-1)
+      !
       INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
       REAL(wp) ::   zlat, zlat0, zlat1, zlat2   ! temporary scalar
@@ -233,12 +246,12 @@
       zfact(:) = zfact(:) / ( 5. * rday )    ! 5 days max restoring time scale
 
-      resto(:,:,:) = 0.e0
+      presto(:,:,:) = 0.e0
 
       ! damping along the forced closed boundary over 6 grid-points
       DO jn = 1, 6
-         IF( lzoom_w )   resto( mi0(jn+jpizoom):mi1(jn+jpizoom), : , : )                    = zfact(jn)   ! west  closed
-         IF( lzoom_s )   resto( : , mj0(jn+jpjzoom):mj1(jn+jpjzoom), : )                    = zfact(jn)   ! south closed 
-         IF( lzoom_e )   resto( mi0(jpiglo+jpizoom-1-jn):mi1(jpiglo+jpizoom-1-jn) , : , : ) = zfact(jn)   ! east  closed 
-         IF( lzoom_n )   resto( : , mj0(jpjglo+jpjzoom-1-jn):mj1(jpjglo+jpjzoom-1-jn) , : ) = zfact(jn)   ! north closed
+         IF( lzoom_w )   presto( mi0(jn+jpizoom):mi1(jn+jpizoom), : , : )                    = zfact(jn)   ! west  closed
+         IF( lzoom_s )   presto( : , mj0(jn+jpjzoom):mj1(jn+jpjzoom), : )                    = zfact(jn)   ! south closed 
+         IF( lzoom_e )   presto( mi0(jpiglo+jpizoom-1-jn):mi1(jpiglo+jpizoom-1-jn) , : , : ) = zfact(jn)   ! east  closed 
+         IF( lzoom_n )   presto( : , mj0(jpjglo+jpjzoom-1-jn):mj1(jpjglo+jpjzoom-1-jn) , : ) = zfact(jn)   ! north closed
       END DO
 
@@ -252,5 +265,5 @@
          !
          !                          ! Initialization : 
-         resto(:,:,:) = 0.e0
+         presto(:,:,:) = 0.e0
          zlat0 = 10.                     ! zlat0 : latitude strip where resto decreases
          zlat1 = 30.                     ! zlat1 : resto = 1 before zlat1
@@ -262,7 +275,7 @@
                   zlat = ABS( gphit(ji,jj) )
                   IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
-                     resto(ji,jj,jk) = 0.5 * ( 1./(5.*rday) ) * ( 1. - cos(rpi*(zlat2-zlat)/zlat0) ) 
+                     presto(ji,jj,jk) = 0.5 * ( 1./(5.*rday) ) * ( 1. - cos(rpi*(zlat2-zlat)/zlat0) ) 
                   ELSEIF( zlat < zlat1 ) THEN
-                     resto(ji,jj,jk) = 1./(5.*rday)
+                     presto(ji,jj,jk) = 1./(5.*rday)
                   ENDIF
                END DO
@@ -272,10 +285,11 @@
       ENDIF
       !                             ! Mask resto array
-      resto(:,:,:) = resto(:,:,:) * tmask(:,:,:)
+      presto(:,:,:) = presto(:,:,:) * tmask(:,:,:)
       !
    END SUBROUTINE dtacof_zoom
 
 
-   SUBROUTINE dtacof
+   SUBROUTINE dtacof( kn_hdmp, pn_surf, pn_bot, pn_dep,  &
+      &               kn_file, cdtype , presto           )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dtacof  ***
@@ -291,5 +305,13 @@
       USE iom
       USE ioipsl
-      !!
+      !! * Arguments
+      INTEGER                         , INTENT(in   )  ::  kn_hdmp    !: damping option
+      REAL(wp)                        , INTENT(in   )  ::  pn_surf    !: surface time scale (days)
+      REAL(wp)                        , INTENT(in   )  ::  pn_bot     !: bottom time scale (days)
+      REAL(wp)                        , INTENT(in   )  ::  pn_dep     !: depth of transition (meters)
+      INTEGER                         , INTENT(in   )  ::  kn_file    !: save the damping coef on a file or not
+      CHARACTER(len=3)                , INTENT(in   )  ::  cdtype     ! =TRA or TRC (tracer indicator)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)  ::  presto     !: restoring coeff. (s-1)
+      !
       INTEGER ::   ji, jj, jk                   ! dummy loop indices
       INTEGER ::   ii0, ii1, ij0, ij1           !    -          -
@@ -302,4 +324,5 @@
       REAL(wp), DIMENSION(jpi,jpj)     ::   zmrs
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdct
+      CHARACTER(len=20)                ::   cfile
       !!----------------------------------------------------------------------
 
@@ -313,11 +336,10 @@
 
       ! ... Initialization : 
-      resto(:,:,:) = 0.e0
-
-      !                           !-----------------------------------------!
-      IF( nn_hdmp > 0 ) THEN      !  Damping poleward of 'nn_hdmp' degrees  !
+      presto(:,:,:) = 0.e0
+      !
+      IF( kn_hdmp > 0 ) THEN      !  Damping poleward of 'nn_hdmp' degrees  !
          !                        !-----------------------------------------!
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '              Damping poleward of ', nn_hdmp,' deg.'
+         IF(lwp) WRITE(numout,*) '              Damping poleward of ', kn_hdmp,' deg.'
          !
          CALL iom_open ( 'dist.coast.nc', icot, ldstop = .FALSE. )
@@ -333,5 +355,5 @@
          zinfl = 1000.e3                   ! distance of influence for damping term
          zlat0 = 10.                       ! latitude strip where resto decreases
-         zlat1 = REAL( nn_hdmp )           ! resto = 0 between -zlat1 and zlat1
+         zlat1 = REAL( kn_hdmp )           ! resto = 0 between -zlat1 and zlat1
          zlat2 = zlat1 + zlat0             ! resto increases from 0 to 1 between |zlat1| and |zlat2|
 
@@ -340,12 +362,12 @@
                zlat = ABS( gphit(ji,jj) )
                IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
-                  resto(ji,jj,1) = 0.5 * ( 1. - cos(rpi*(zlat-zlat1)/zlat0 ) )
+                  presto(ji,jj,1) = 0.5 * ( 1. - cos(rpi*(zlat-zlat1)/zlat0 ) )
                ELSEIF ( zlat > zlat2 ) THEN
-                  resto(ji,jj,1) = 1.
+                  presto(ji,jj,1) = 1.
                ENDIF
             END DO
          END DO
 
-         IF ( nn_hdmp == 20 ) THEN       ! North Indian ocean (20N/30N x 45E/100E) : resto=0
+         IF ( kn_hdmp == 20 ) THEN       ! North Indian ocean (20N/30N x 45E/100E) : resto=0
             DO jj = 1, jpj
                DO ji = 1, jpi
@@ -353,5 +375,5 @@
                   zlon = MOD( glamt(ji,jj), 360. )
                   IF ( zlat1 < zlat .AND. zlat < zlat2 .AND. 45. < zlon .AND. zlon < 100. ) THEN
-                     resto(ji,jj,1) = 0.e0
+                     presto(ji,jj,1) = 0.e0
                   ENDIF
                END DO
@@ -359,6 +381,6 @@
          ENDIF
 
-         zsdmp = 1./(rn_surf * rday)
-         zbdmp = 1./(rn_bot  * rday)
+         zsdmp = 1./(pn_surf * rday)
+         zbdmp = 1./(pn_bot  * rday)
          DO jk = 2, jpkm1
             DO jj = 1, jpj
@@ -366,7 +388,7 @@
                   zdct(ji,jj,jk) = MIN( zinfl, zdct(ji,jj,jk) )
                   !   ... Decrease the value in the vicinity of the coast
-                  resto(ji,jj,jk) = resto(ji,jj,1) * 0.5 * ( 1. - COS( rpi*zdct(ji,jj,jk)/zinfl) )
+                  presto(ji,jj,jk) = presto(ji,jj,1) * 0.5 * ( 1. - COS( rpi*zdct(ji,jj,jk)/zinfl) )
                   !   ... Vertical variation from zsdmp (sea surface) to zbdmp (bottom)
-                  resto(ji,jj,jk) = resto(ji,jj,jk)      * ( zbdmp + (zsdmp-zbdmp)*EXP(-fsdept(ji,jj,jk)/rn_dep) )
+                  presto(ji,jj,jk) = presto(ji,jj,jk)      * ( zbdmp + (zsdmp-zbdmp)*EXP(-fsdept(ji,jj,jk)/pn_dep) )
                END DO
             END DO
@@ -376,5 +398,5 @@
 
 
-      IF( cp_cfg == "orca" .AND. ( nn_hdmp > 0 .OR. nn_hdmp == -1 ) ) THEN
+      IF( cp_cfg == "orca" .AND. ( kn_hdmp > 0 .OR. kn_hdmp == -1 ) ) THEN
 
          !                                         ! =========================
@@ -465,8 +487,8 @@
                zmrs( ji , mj0(ij0):mj1(ij1) ) = 0.1 * ABS( FLOAT(ji - mi1(ii1)) )
             END DO 
-            zsdmp = 1./(rn_surf * rday)
-            zbdmp = 1./(rn_bot * rday)
+            zsdmp = 1./(pn_surf * rday)
+            zbdmp = 1./(pn_bot  * rday)
             DO jk = 1, jpk
-               zhfac (jk) = ( zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(1,1,jk)/rn_dep) )
+               zhfac (jk) = ( zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(1,1,jk)/pn_dep) )
             END DO
             !                                       ! ========================
@@ -478,11 +500,11 @@
 
          DO jk = 1, jpkm1
-            resto(:,:,jk) = zmrs(:,:) * zhfac(jk) + ( 1. - zmrs(:,:) ) * resto(:,:,jk)
+            presto(:,:,jk) = zmrs(:,:) * zhfac(jk) + ( 1. - zmrs(:,:) ) * presto(:,:,jk)
          END DO
 
          ! Mask resto array and set to 0 first and last levels
-         resto(:,:, : ) = resto(:,:,:) * tmask(:,:,:)
-         resto(:,:, 1 ) = 0.e0
-         resto(:,:,jpk) = 0.e0
+         presto(:,:, : ) = presto(:,:,:) * tmask(:,:,:)
+         presto(:,:, 1 ) = 0.e0
+         presto(:,:,jpk) = 0.e0
          !                         !--------------------!
       ELSE                         !     No damping     !
@@ -492,9 +514,12 @@
 
       !                            !--------------------------------!
-      IF( nn_file == 1 ) THEN      !  save damping coef. in a file  !
+      IF( kn_file == 1 ) THEN      !  save damping coef. in a file  !
          !                         !--------------------------------!
          IF(lwp) WRITE(numout,*) '              create damping.coeff.nc file'
-         CALL iom_open  ( 'damping.coeff', inum0, ldwrt = .TRUE., kiolib = jprstlib )
-         CALL iom_rstput( 0, 0, inum0, 'Resto', resto )
+         IF( cdtype == 'TRA' ) cfile = 'damping.coeff'
+         IF( cdtype == 'TRC' ) cfile = 'damping.coeff.trc'
+         cfile = TRIM( cfile )
+         CALL iom_open  ( cfile, inum0, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_rstput( 0, 0, inum0, 'Resto', presto )
          CALL iom_close ( inum0 )
       ENDIF
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf.F90	(revision 2024)
@@ -4,5 +4,6 @@
    !! Ocean Active tracers : lateral diffusive trends 
    !!=====================================================================
-   !! History :  9.0  ! 05-11 (G. Madec)  Original code
+   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
+   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
    !!----------------------------------------------------------------------
 
@@ -21,6 +22,6 @@
    USE traldf_iso      ! lateral mixing               (tra_ldf_iso routine)
    USE traldf_lap      ! lateral mixing               (tra_ldf_lap routine)
-   USE trdmod          ! ocean active tracers trends
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! ocean space and time domain
+   USE trdtra          ! ocean active tracers trends
    USE prtctl          ! Print control
    USE in_out_manager  ! I/O manager
@@ -31,8 +32,8 @@
    PRIVATE
 
-   PUBLIC   tra_ldf    ! called by step.F90 
-
-   INTEGER, PUBLIC ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals)
-                                   ! (need to be public to be used in vertical diffusion routine)
+   PUBLIC   tra_ldf         ! called by step.F90 
+   PUBLIC   tra_ldf_init    ! called by opa.F90 
+   !
+   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals)
 #if defined key_traldf_ano
    REAL, DIMENSION(jpi,jpj,jpk) ::   t0_ldf, s0_ldf   ! lateral diffusion trends of T & S
@@ -60,54 +61,65 @@
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdt, ztrds   ! 3D temporary workspace
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL ldf_ctl          ! initialisation & control of options
-
-      IF( l_trdtra )   THEN                      ! temporary save of ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = sa(:,:,:) 
-      ENDIF
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
+      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zgtsu, zgtsv
+      !!----------------------------------------------------------------------
+
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+
+      zgtsu(:,:,jp_tem) = gtu(:,:)        ;        zgtsu(:,:,jp_sal) = gsu(:,:)
+      zgtsv(:,:,jp_tem) = gtv(:,:)        ;        zgtsv(:,:,jp_sal) = gsv(:,:)
 
       SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
-      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt )      ! iso-level laplacian
-      CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt )      ! rotated laplacian (except dk[ dk[.] ] part)
-      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt )      ! iso-level bilaplacian
-      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt )      ! s-coord. horizontal bilaplacian
+      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt , 'TRA', zgtsu, zgtsv,  &
+                       &                    tsb, tsa  , jpts           )   ! iso-level laplacian
+      CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt , 'TRA', zgtsu, zgtsv,  &
+                       &                    tsb, tsa  , jpts , ahtb0   )   ! rotated laplacian 
+      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt , 'TRA', zgtsu, zgtsv,  &
+                       &                    tsb, tsa  , jpts           )   ! iso-level bilaplacian
+      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt , 'TRA', tsb, tsa, jpts )      ! s-coord. horizontal bilaplacian
          !
       CASE ( -1 )                                     ! esopa: test all possibility with control print
-         CALL tra_ldf_lap    ( kt )
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf0 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_ldf_iso    ( kt )
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf1 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_ldf_bilap  ( kt )
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf2 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_ldf_bilapg ( kt )
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf3 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+                       CALL tra_ldf_lap   ( kt , 'TRA', zgtsu, zgtsv,  &
+                       &                    tsb, tsa  , jpts           ) 
+                       CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask,               &
+                       &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+                       CALL tra_ldf_iso   ( kt , 'TRA', zgtsu, zgtsv,  &
+                       &                    tsb, tsa  , jpts , ahtb0   ) 
+                       CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask,               &
+                       &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+                       CALL tra_ldf_bilap ( kt , 'TRA', zgtsu, zgtsv,  &
+                       &                    tsb, tsa  , jpts           ) 
+                       CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask,               &
+                       &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+                       CALL tra_ldf_bilapg( kt , 'TRA', tsb, tsa, jpts ) 
+                       CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask,               &
+                       &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       END SELECT
 
 #if defined key_traldf_ano
-      ta(:,:,:) = ta(:,:,:) - t0_ldf(:,:,:)      ! anomaly: substract the reference diffusivity
-      sa(:,:,:) = sa(:,:,:) - s0_ldf(:,:,:)
+      tsa(:,:,:,jp_tem) = tsa(:,:,:,jp_tem) - t0_ldf(:,:,:)      ! anomaly: substract the reference diffusivity
+      tsa(:,:,:,jp_sal) = tsa(:,:,:,jp_sal) - s0_ldf(:,:,:)
 #endif
+
       IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
-         CALL trd_mod( ztrdt, ztrds, jptra_trd_ldf, 'TRA', kt )
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_ldf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_ldf, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
       ENDIF
       !                                          ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf  - Ta: ', mask1=tmask,               &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf  - Ta: ', mask1=tmask,               &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
    END SUBROUTINE tra_ldf
 
 
-   SUBROUTINE ldf_ctl
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_ctl  ***
+   SUBROUTINE tra_ldf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_init  ***
       !! 
       !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
@@ -135,5 +147,5 @@
       IF(lwp) THEN                    ! Namelist print
          WRITE(numout,*)
-         WRITE(numout,*) 'tra:ldf_ctl : lateral tracer diffusive operator'
+         WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator'
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namtra_ldf : set lateral mixing parameters (type, direction, coefficients)'
@@ -225,5 +237,5 @@
       CALL ldf_ano
       !
-   END SUBROUTINE ldf_ctl
+   END SUBROUTINE tra_ldf_init
 
 #if defined key_traldf_ano
@@ -271,16 +283,16 @@
       t0_ldf(:,:,:) = 0.e0
       s0_ldf(:,:,:) = 0.e0
-      ztb   (:,:,:) = tb (:,:,:)
-      zsb   (:,:,:) = sb (:,:,:)
-      ua    (:,:,:) = ta (:,:,:)
-      va    (:,:,:) = sa (:,:,:)
+      ztb   (:,:,:) = tsb (:,:,:,jp_tem)
+      zsb   (:,:,:) = tsb (:,:,:,jp_sal)
+      ua    (:,:,:) = tsa (:,:,:,jp_tem)
+      va    (:,:,:) = tsa (:,:,:,jp_sal)
       zavt  (:,:,:) = avt(:,:,:)
       IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' )
       ! set tb, sb to reference values and avr to zero
-      tb (:,:,:) = zt_ref(:,:,:)
-      sb (:,:,:) = zs_ref(:,:,:)
-      ta (:,:,:) = 0.e0
-      sa (:,:,:) = 0.e0
-      avt(:,:,:) = 0.e0
+      tsb (:,:,:,jp_tem) = zt_ref(:,:,:)
+      tsb (:,:,:,jp_sal) = zs_ref(:,:,:)
+      tsa (:,:,:,jp_tem) = 0.e0
+      tsa (:,:,:,jp_sal) = 0.e0
+      avt(:,:,:)         = 0.e0
 
       ! Compute the ldf trends
@@ -295,17 +307,17 @@
       IF( neuler == 1)   z12 = 1.e0
       IF( ln_zdfexp ) THEN      ! ta,sa are the trends
-         t0_ldf(:,:,:) = ta(:,:,:)
-         s0_ldf(:,:,:) = sa(:,:,:)
+         t0_ldf(:,:,:) = tsa(:,:,:,jp_tem)
+         s0_ldf(:,:,:) = tsa(:,:,:,jp_sal)
       ELSE
          DO jk = 1, jpkm1
-            t0_ldf(:,:,jk) = ( ta(:,:,jk) - tb(:,:,jk) ) / ( z12 *rdttra(jk) )
-            s0_ldf(:,:,jk) = ( sa(:,:,jk) - tb(:,:,jk) ) / ( z12 *rdttra(jk) )
+            t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdttra(jk) )
+            s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdttra(jk) )
          END DO
       ENDIF
-      tb    (:,:,:) = ztb (:,:,:)
-      sb    (:,:,:) = zsb (:,:,:)
-      ta    (:,:,:) = ua  (:,:,:)
-      sa    (:,:,:) = va  (:,:,:)
-      avt   (:,:,:) = zavt(:,:,:)
+      tsb(:,:,:,jp_tem) = ztb (:,:,:)
+      tsb(:,:,:,jp_sal) = zsb (:,:,:)
+      tsa(:,:,:,jp_tem) = ua  (:,:,:)
+      tsa(:,:,:,jp_sal) = va  (:,:,:)
+      avt(:,:,:)        = zavt(:,:,:)
       !
    END SUBROUTINE ldf_ano
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilap.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 2024)
@@ -2,5 +2,16 @@
    !!==============================================================================
    !!                   ***  MODULE  traldf_bilap  ***
-   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+   !! History :     !  91-11  (G. Madec)  Original code
+   !!               !  93-03  (M. Guyon)  symetrical conditions
+   !!               !  95-11  (G. Madec)  suppress volumetric scale factors
+   !!               !  96-01  (G. Madec)  statement function for e3
+   !!               !  96-01  (M. Imbard)  mpp exchange
+   !!               !  97-07  (G. Madec)  optimization, and ahtt
+   !!          8.5  !  02-08  (G. Madec)  F90: Free form and module
+   !!          9.0  !  04-08  (C. Talandier) New trends organization
+   !!               !  05-11  (G. Madec)  zps or sco as default option
+   !!          3.3  !  10-05  (C. Ethe, G. Madec)  merge TRC-TRA 
    !!==============================================================================
 
@@ -13,11 +24,8 @@
    USE dom_oce         ! ocean space and time domain
    USE ldftra_oce      ! ocean tracer   lateral physics
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
    USE in_out_manager  ! I/O manager
    USE ldfslp          ! iso-neutral slopes 
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
 
    IMPLICIT NONE
@@ -39,15 +47,16 @@
 
 CONTAINS
-   
-   SUBROUTINE tra_ldf_bilap( kt )
+ 
+   SUBROUTINE tra_ldf_bilap( kt   , cdtype, pgtu, pgtv,  &
+      &                      ptrab, ptraa , kjpt         )  
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf_bilap  ***
       !!
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !! ** Purpose :   Compute the before horizontal tracer diffusive 
       !!      trend and add it to the general trend of tracer equation.
       !!
       !! ** Method  :   4th order diffusive operator along model level surfaces 
       !!      evaluated using before fields (forward time scheme). The hor.
-      !!      diffusive trends of temperature (idem for salinity) is given by:
+      !!      diffusive trends  is given by:
       !!      Laplacian of tb:
       !!         zlt   = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(tb) ]
@@ -59,39 +68,27 @@
       !!         difft = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(zlt) ]
       !!                                  + dj-1[ e1v*e3v/e2v dj(zlt) ]  }
-      !!      Note: if key_zco defined, e3t=e3u=e3v, they are simplified.
       !!
-      !!      Add this trend to the general trend (ta,sa):
-      !!         (ta,sa) = (ta,sa) + ( difft , diffs )
+      !!      Add this trend to the general trend
+      !!         (ptraa) = (ptraa) + ( difft )
       !!
-      !! ** Action : - Update (ta,sa) arrays with the before iso-level
+      !! ** Action : - Update ptraa arrays with the before iso-level
       !!               biharmonic mixing trend.
-      !!
-      !! History :
-      !!        !  91-11  (G. Madec)  Original code
-      !!        !  93-03  (M. Guyon)  symetrical conditions
-      !!        !  95-11  (G. Madec)  suppress volumetric scale factors
-      !!        !  96-01  (G. Madec)  statement function for e3
-      !!        !  96-01  (M. Imbard)  mpp exchange
-      !!        !  97-07  (G. Madec)  optimization, and ahtt
-      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
-      !!   9.0  !  04-08  (C. Talandier) New trends organization
-      !!        !  05-11  (G. Madec)  zps or sco as default option
       !!----------------------------------------------------------------------
-      !! * Modules used
-      USE oce           , ztu => ua,  &  ! use ua as workspace
-         &                ztv => va      ! use va as workspace
-
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
-
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk             ! dummy loop indices
-      INTEGER ::   iku, ikv               ! temporary integers
-      REAL(wp) ::   zta, zsa              ! temporary scalars
+      !!* Module used
+      USE oce         , ztu => ua   ! use ua as workspace
+      USE oce         , ztv => va   ! use va as workspace
+      !!* Arguments
+      INTEGER         , INTENT(in   )                                ::   kt             ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                                ::   cdtype         ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt  )     ::   pgtu, pgtv     ! tracer gradient at pstep levels
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptrab          ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptraa          ! tracer trend 
+      !!* Local declarations
+      INTEGER  ::  ji, jj, jk, jn         ! dummy loop indices
+      INTEGER  ::  iku, ikv               ! temporary integers
+      REAL(wp) ::  zbtr, ztra             ! temporary scalars
       REAL(wp), DIMENSION(jpi,jpj) ::   & 
-         zeeu, zeev, zbtr,              & ! 2D workspace
-         zlt, zls
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
-         zsu, zsv                         ! 3D workspace 
+         zeeu, zeev, zlt               ! 2D workspace
       !!----------------------------------------------------------------------
 
@@ -101,124 +98,86 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
       ENDIF
-
-
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-
-         ! 0. Initialization of metric arrays (for z- or s-coordinates)
-         ! ----------------------------------
-
-         IF( lk_zco ) THEN      ! z-coordinate (1D arrays): no vertical scale factors
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !                                               
+         DO jk = 1, jpkm1                                 
+            !                                             
+            
+            ! 0. Initialization of metric arrays (for z- or s-coordinates)
+            ! ----------------------------------
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
-                  zeeu(ji,jj) = e2u(ji,jj) / e1u(ji,jj) * umask(ji,jj,jk)
-                  zeev(ji,jj) = e1v(ji,jj) / e2v(ji,jj) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         ELSE                   ! All coordinates (3D arrays): vertical scale factor are used
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
                   zeeu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
                   zeev(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
                END DO
             END DO
-         ENDIF
 
 
-         ! 1. Laplacian
-         ! ------------
-
-         ! First derivative (gradient)
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ztu(ji,jj,jk) = zeeu(ji,jj) * ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) )
-               zsu(ji,jj,jk) = zeeu(ji,jj) * ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) )
-               ztv(ji,jj,jk) = zeev(ji,jj) * ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) )
-               zsv(ji,jj,jk) = zeev(ji,jj) * ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) )
-            END DO
-         END DO
-         IF( ln_zps ) THEN      ! set gradient at partial step level
+            ! 1. Laplacian
+            ! ------------
+            
+            ! First derivative (gradient)
             DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  ! last level
-                  iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
-                  ikv = MIN ( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
-                  IF( iku == jk ) THEN
-                     ztu(ji,jj,jk) = zeeu(ji,jj) * gtu(ji,jj)
-                     zsu(ji,jj,jk) = zeeu(ji,jj) * gsu(ji,jj)
-                  ENDIF
-                  IF( ikv == jk ) THEN
-                     ztv(ji,jj,jk) = zeev(ji,jj) * gtv(ji,jj)
-                     zsv(ji,jj,jk) = zeev(ji,jj) * gsv(ji,jj)
-                  ENDIF
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( ptrab(ji+1,jj  ,jk,jn) - ptrab(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zeev(ji,jj) * ( ptrab(ji  ,jj+1,jk,jn) - ptrab(ji,jj,jk,jn) )
                END DO
             END DO
-         ENDIF
-
-         ! Second derivative (divergence)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zlt(ji,jj) = zbtr(ji,jj) * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
-               zls(ji,jj) = zbtr(ji,jj) * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk) + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  )
-            END DO
-         END DO
-
-         ! Multiply by the eddy diffusivity coefficient
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zlt(ji,jj) = fsahtt(ji,jj,jk) * zlt(ji,jj)
-               zls(ji,jj) = fsahtt(ji,jj,jk) * zls(ji,jj)
-            END DO
-         END DO
-
-         ! Lateral boundary conditions on the laplacian (zlt,zls)   (unchanged sgn)
-         CALL lbc_lnk( zlt, 'T', 1. )   ;    CALL lbc_lnk( zls, 'T', 1. )
-
-         ! 2. Bilaplacian
-         ! --------------
-
-         ! third derivative (gradient)
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) )
-               zsu(ji,jj,jk) = zeeu(ji,jj) * ( zls(ji+1,jj  ) - zls(ji,jj) )
-               ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji  ,jj+1) - zlt(ji,jj) )
-               zsv(ji,jj,jk) = zeev(ji,jj) * ( zls(ji  ,jj+1) - zls(ji,jj) )
-            END DO
-         END DO
-
-         ! fourth derivative (divergence) and add to the general tracer trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! horizontal diffusive trends
-               zta = zbtr(ji,jj) * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
-               zsa = zbtr(ji,jj) * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk) + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  )
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           ! Horizontal slab
-      !                                                ! ===============
-
-      ! "zonal" mean lateral diffusive heat and salt transport
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         IF( lk_zco ) THEN      ! z-coordinate (1D arrays): multiply by the vertical scale factor
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ztv(ji,jj,jk) = ztv(ji,jj,jk) * fse3v(ji,jj,jk)
-                     zsv(ji,jj,jk) = zsv(ji,jj,jk) * fse3v(ji,jj,jk)
+            IF( ln_zps ) THEN      ! set gradient at partial step level
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     ! last level
+                     iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
+                     ikv = MIN ( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
+                     IF( iku == jk )  ztu(ji,jj,jk) = zeeu(ji,jj) * pgtu(ji,jj,jn)
+                     IF( ikv == jk )  ztv(ji,jj,jk) = zeev(ji,jj) * pgtv(ji,jj,jn)
                   END DO
                END DO
+            ENDIF
+
+            ! Second derivative (divergence) multiply by the eddy diffusivity coefficient
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  zlt(ji,jj) = fsahtt(ji,jj,jk) &
+                     &                * zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
+               END DO
             END DO
+
+            ! Lateral boundary conditions on the laplacian (zlt)   (unchanged sgn)
+            CALL lbc_lnk( zlt, 'T', 1. )
+
+            ! 2. Bilaplacian
+            ! --------------
+            
+            ! third derivative (gradient)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) )
+                  ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji  ,jj+1) - zlt(ji,jj) )
+               END DO
+            END DO
+
+            ! fourth derivative (divergence) and add to the general tracer trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! horizontal diffusive trends
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztra = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
+                  ! add it to the general tracer trends
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           ! Horizontal slab
+         !                                                ! ===============
+         ! "zonal" mean lateral diffusive heat and salt transport
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  pht_ldf(:) = ptr_vj( ztv(:,:,:) )
+           IF( jn == jp_sal )  pst_ldf(:) = ptr_vj( ztv(:,:,:) )
          ENDIF
-         pht_ldf(:) = ptr_vj( ztv(:,:,:) )
-         pst_ldf(:) = ptr_vj( zsv(:,:,:) )
-      ENDIF
+         !
+      END DO
 
    END SUBROUTINE tra_ldf_bilap
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 2024)
@@ -2,5 +2,9 @@
    !!==============================================================================
    !!                       ***  MODULE  traldf_bilapg  ***
-   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+   !! History : 8.0   !  1997-07  (G. Madec)  Original code
+   !!           NEMO  !  2002-08  (G. Madec)  F90: Free form and module
+   !!           3.3   !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
    !!==============================================================================
 #if defined key_ldfslp   ||   defined key_esopa
@@ -16,11 +20,8 @@
    USE dom_oce         ! ocean space and time domain variables
    USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
    USE in_out_manager  ! I/O manager
    USE ldfslp          ! iso-neutral slopes available
    USE lbclnk          ! ocean lateral boundary condition (or mpp link)
    USE diaptr          ! poleward transport diagnostics 
-   USE prtctl          ! Print control
 
    IMPLICIT NONE
@@ -42,9 +43,9 @@
 CONTAINS
 
-   SUBROUTINE tra_ldf_bilapg( kt )
+   SUBROUTINE tra_ldf_bilapg( kt, cdtype, ptrab, ptraa, kjpt )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE tra_ldf_bilapg  ***
       !!                    
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !! ** Purpose :   Compute the before horizontal tracer diffusive 
       !!      trend and add it to the general trend of tracer equation.
       !!
@@ -54,32 +55,26 @@
       !!      computed in routine inildf.
       !!         -1- compute the geopotential harmonic operator applied to
-      !!      (tb,sb) and multiply it by the eddy diffusivity coefficient
-      !!      (done by a call to ldfght routine, result in (wk1,wk2) arrays).
+      !!        ptrab and multiply it by the eddy diffusivity coefficient
+      !!       (done by a call to ldfght routine, result in wk1 arrays).
       !!      Applied the domain lateral boundary conditions by call to lbc_lnk
       !!         -2- compute the geopotential harmonic operator applied to
-      !!      (wk1,wk2) by a second call to ldfght routine (result in (wk3,wk4)
+      !!      wk1 by a second call to ldfght routine (result in wk2)
       !!      arrays).
-      !!         -3- Add this trend to the general trend (ta,sa):
-      !!            (ta,sa) = (ta,sa) + (wk3,wk4)
-      !!
-      !! ** Action : - Update (ta,sa) arrays with the before geopotential 
+      !!         -3- Add this trend to the general trend 
+      !!            ptraa = ptraa + wk2
+      !!
+      !! ** Action : - Update ptraa arrays with the before geopotential 
       !!               biharmonic mixing trend.
-      !!
-      !! History :
-      !!   8.0  !  97-07  (G. Madec)  Original code
-      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
-      !!   9.0  !  04-08  (C. Talandier) New trends organization
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE oce           , wk1 => ua,  &  ! use ua as workspace
-         &                wk2 => va      ! use va as workspace
-
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
-
+      !!----------------------------------------------------------------------
+      !!* Arguments
+      INTEGER         , INTENT(in   )                                ::   kt             ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                                ::   cdtype         ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptrab          ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptraa          ! tracer trend 
       !! * Local declarations
-      INTEGER ::   ji, jj, jk                 ! dummy loop indices
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-         wk3, wk4                ! work array used for rotated biharmonic
+      INTEGER ::   ji, jj, jk, jn                 ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,SIZE(ptrab,4)) ::   &
+         wk1, wk2                ! work array used for rotated biharmonic
          !                       ! operator on tracers and/or momentum
       !!----------------------------------------------------------------------
@@ -90,48 +85,52 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
       ENDIF
-
-      ! 1. Laplacian of (tb,sb) * aht
+      !
+      !
+
+      ! 1. Laplacian of ptrab * aht
       ! ----------------------------- 
-      ! rotated harmonic operator applied to (tb,sb)
-      ! and multiply by aht (output in (wk1,wk2) )
-
-      CALL ldfght ( kt, tb, sb, wk1, wk2, 1 )
-
-
-      ! Lateral boundary conditions on (wk1,wk2)   (unchanged sign)
-      CALL lbc_lnk( wk1, 'T', 1. )   ;   CALL lbc_lnk( wk2, 'T', 1. )
-
-      ! 2. Bilaplacian of (tb,sb)
+      ! rotated harmonic operator applied to ptrab and multiply by aht ; output in wk1 
+
+      CALL ldfght( kt, cdtype, ptrab, wk1, kjpt, 1 )
+
+      !
+      DO jn = 1, kjpt
+      ! Lateral boundary conditions on wk1   (unchanged sign)
+         CALL lbc_lnk( wk1(:,:,:,jn) , 'T', 1. )
+      END DO
+
+      ! 2. Bilaplacian of ptrab
       ! -------------------------
-      ! rotated harmonic operator applied to (wk1,wk2)
-      ! (output in (wk3,wk4) )
-
-      CALL ldfght ( kt, wk1, wk2, wk3, wk4, 2 )
+      ! rotated harmonic operator applied to wk1 ; output in wk2
+
+      CALL ldfght( kt, cdtype, wk1, wk2, kjpt, 2 )
 
 
       ! 3. Update the tracer trends                    (j-slab :   2, jpj-1)
       ! ---------------------------
-      !                                                ! ===============
-      DO jj = 2, jpjm1                                 !  Vertical slab
-         !                                             ! ===============
-         DO jk = 1, jpkm1
-            DO ji = 2, jpim1
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + wk3(ji,jj,jk)
-               sa(ji,jj,jk) = sa(ji,jj,jk) + wk4(ji,jj,jk)
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
+      !
+      DO jn = 1, kjpt
+         !                                                ! ===============
+         DO jj = 2, jpjm1                                 !  Vertical slab
+            !                                             ! ===============
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  ! add it to the general tracer trends
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + wk2(ji,jj,jk,jn)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+      END DO
 
    END SUBROUTINE tra_ldf_bilapg
 
 
-   SUBROUTINE ldfght ( kt, pt, ps, plt, pls, kaht )
+   SUBROUTINE ldfght ( kt, cdtype, pt, plt, kjpt, kaht )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ldfght  ***
       !!          
-      !! ** Purpose :   Apply a geopotential harmonic operator to (pt,ps) and 
+      !! ** Purpose :   Apply a geopotential harmonic operator to (pt) and 
       !!      multiply it by the eddy diffusivity coefficient (if kaht=1).
       !!      Routine only used in s-coordinates (l_sco=T) with bilaplacian
@@ -140,5 +139,5 @@
       !!
       !! ** Method  :   The harmonic operator rotated along geopotential 
-      !!      surfaces is applied to (pt,ps) using the slopes of geopotential
+      !!      surfaces is applied to (pt) using the slopes of geopotential
       !!      surfaces computed in inildf routine. The result is provided in
       !!      (plt,pls) arrays. It is computed in 2 steps:
@@ -166,224 +165,178 @@
       !!         plt  =  1  / (e1t*e2t*e3t) { plt + dk[ zftw ] }
       !!
-      !! * Action :
-      !!      'key_trdtra' defined: the trend is saved for diagnostics.
-      !!
-      !! History :
-      !!   8.0  !  97-07  (G. Madec)  Original code
-      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce         , zftv => ua     ! use ua as workspace
       !! * Arguments
-      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in  ) ::   &
-         pt, ps           ! tracer fields (before t and s for 1st call
-      !                   ! and laplacian of these fields for 2nd call.
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
-         plt, pls         ! partial harmonic operator applied to
-      !                   ! pt & ps components except
-      !                   ! second order vertical derivative term)
-      INTEGER, INTENT( in ) ::   &
-         kaht             ! =1 multiply the laplacian by the eddy diffusivity coeff.
-      !                   ! =2 no multiplication
-
+      INTEGER         , INTENT(in )                              ::  kt      ! ocean time-step index
+      CHARACTER(len=3), INTENT(in )                              ::  cdtype  ! =TRA or TRC (tracer indicator) 
+      INTEGER         , INTENT(in )                              ::  kjpt    !: dimension of 
+      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) ::  pt      ! tracer fields ( before for 1st call
+      !                                                         ! and laplacian of these fields for 2nd call. 
+      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk,kjpt) ::  plt     !: partial harmonic operator applied to  pt  components except
+      !                                                             !: second order vertical derivative term  
+      INTEGER         , INTENT(in )                              ::  kaht    !: =1 multiply the laplacian by the eddy diffusivity coeff.
+      !                                                             !: =2 no multiplication 
       !! * Local declarations
-      INTEGER ::   ji, jj, jk             ! dummy loop indices
-      REAL(wp) ::   &
-         zabe1, zabe2, zmku, zmkv,     &  ! temporary scalars
-         zbtr, ztah, zsah, ztav, zsav, &
-         zcof0, zcof1, zcof2,          &
-         zcof3, zcof4
-      REAL(wp), DIMENSION(jpi,jpj) ::  &
-         zftu, zfsu,                   &  ! workspace
-         zdkt, zdk1t,                  &
-         zdks, zdk1s
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-         zftv, zfsv                       ! workspace (only v components for ptr)
-      REAL(wp), DIMENSION(jpi,jpk) ::  &
-         zftw, zfsw,                   &  ! workspace
-         zdit, zdjt, zdj1t,            &
-         zdis, zdjs, zdj1s
-      !!----------------------------------------------------------------------
-
-      !                               ! ********** !   ! ===============
-      DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
-         !                            ! ********** !   ! ===============
-
-         ! I.1 Vertical gradient of pt and ps at level jk and jk+1
-         ! -------------------------------------------------------
-         !     surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-
-         zdk1t(:,:) = ( pt(:,:,jk) - pt(:,:,jk+1) ) * tmask(:,:,jk+1)
-         zdk1s(:,:) = ( ps(:,:,jk) - ps(:,:,jk+1) ) * tmask(:,:,jk+1)
-
-         IF( jk == 1 ) THEN
-            zdkt(:,:) = zdk1t(:,:)
-            zdks(:,:) = zdk1s(:,:)
-         ELSE
-            zdkt(:,:) = ( pt(:,:,jk-1) - pt(:,:,jk) ) * tmask(:,:,jk)
-            zdks(:,:) = ( ps(:,:,jk-1) - ps(:,:,jk) ) * tmask(:,:,jk)
+      INTEGER ::   ji, jj, jk,jn          ! dummy loop indices
+      !                                   ! temporary scalars
+      REAL(wp) ::  zabe1, zabe2, zmku, zmkv 
+      REAL(wp) ::  zbtr, ztah, ztav
+      REAL(wp) ::  zcof0, zcof1, zcof2, zcof3, zcof4
+      REAL(wp), DIMENSION(jpi,jpj) ::  zftu,  zdkt, zdk1t       ! workspace
+      REAL(wp), DIMENSION(jpi,jpk) ::  zftw, zdit, zdjt, zdj1t  ! 
+      !!----------------------------------------------------------------------
+
+      !
+      DO jn = 1, kjpt
+         !                               ! ********** !   ! ===============
+         DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
+            !                            ! ********** !   ! ===============
+            
+            ! I.1 Vertical gradient of pt and ps at level jk and jk+1
+            ! -------------------------------------------------------
+            !     surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+            
+            zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+            IF( jk == 1 ) THEN
+               zdkt(:,:) = zdk1t(:,:)
+            ELSE
+               zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+
+
+            ! I.2 Horizontal fluxes
+            ! ---------------------
+            
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  zabe1 = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
+                  zabe2 = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
+                  
+                  zmku = 1./MAX( tmask(ji+1,jj,jk  )+tmask(ji,jj,jk+1)   &
+                     &          +tmask(ji+1,jj,jk+1)+tmask(ji,jj,jk  ),1. )
+                  zmkv = 1./MAX( tmask(ji,jj+1,jk  )+tmask(ji,jj,jk+1)   &
+                     &          +tmask(ji,jj+1,jk+1)+tmask(ji,jj,jk  ),1. )
+                  
+                  zcof1 = -e2u(ji,jj) * uslp(ji,jj,jk) * zmku
+                  zcof2 = -e1v(ji,jj) * vslp(ji,jj,jk) * zmkv
+                  
+                  zftu(ji,jj)= umask(ji,jj,jk) *   &
+                     &         (  zabe1 *( pt   (ji+1,jj,jk,jn) - pt(ji,jj,jk,jn) )   &
+                     &          + zcof1 *( zdkt (ji+1,jj) + zdk1t(ji,jj)     &
+                     &                    +zdk1t(ji+1,jj) + zdkt (ji,jj) )  )
+                  
+                  zftv(ji,jj,jk)= vmask(ji,jj,jk) *   &
+                     &         (  zabe2 *( pt(ji,jj+1,jk,jn) - pt(ji,jj,jk,jn) )   &
+                     &          + zcof2 *( zdkt (ji,jj+1) + zdk1t(ji,jj)     &
+                     &                    +zdk1t(ji,jj+1) + zdkt (ji,jj) )  )                  
+               END DO
+            END DO
+
+
+            ! I.3 Second derivative (divergence) (not divided by the volume)
+            ! ---------------------
+            
+            DO jj = 2 , jpjm1
+               DO ji = 2 , jpim1
+                  ztah = zftu(ji,jj) - zftu(ji-1,jj) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)
+                  plt(ji,jj,jk,jn) = ztah
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+         ! "Poleward" diffusive heat or salt transport
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
+            IF( jn == jp_tem)   pht_ldf(:) = ptr_vj( zftv(:,:,:) )
+            IF( jn == jp_sal)   pst_ldf(:) = ptr_vj( zftv(:,:,:) )
          ENDIF
 
-
-         ! I.2 Horizontal fluxes
-         ! ---------------------
-
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zabe1 = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
-               zabe2 = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
-
-               zmku=1./MAX( tmask(ji+1,jj,jk  )+tmask(ji,jj,jk+1)   &
-                           +tmask(ji+1,jj,jk+1)+tmask(ji,jj,jk  ),1. )
-               zmkv=1./MAX( tmask(ji,jj+1,jk  )+tmask(ji,jj,jk+1)   &
-                           +tmask(ji,jj+1,jk+1)+tmask(ji,jj,jk  ),1. )
-
-               zcof1= -e2u(ji,jj) * uslp(ji,jj,jk) * zmku
-               zcof2= -e1v(ji,jj) * vslp(ji,jj,jk) * zmkv
-
-               zftu(ji,jj)= umask(ji,jj,jk) *   &
-                  (  zabe1 *( pt(ji+1,jj,jk) - pt(ji,jj,jk) )   &
-                   + zcof1 *( zdkt (ji+1,jj) + zdk1t(ji,jj)     &
-                             +zdk1t(ji+1,jj) + zdkt (ji,jj) )  )
-
-               zftv(ji,jj,jk)= vmask(ji,jj,jk) *   &
-                  (  zabe2 *( pt(ji,jj+1,jk) - pt(ji,jj,jk) )   &
-                   + zcof2 *( zdkt (ji,jj+1) + zdk1t(ji,jj)     &
-                             +zdk1t(ji,jj+1) + zdkt (ji,jj) )  )
-
-               zfsu(ji,jj)= umask(ji,jj,jk) *   &
-                  (  zabe1 *( ps(ji+1,jj,jk) - ps(ji,jj,jk) )   &
-                   + zcof1 *( zdks (ji+1,jj) + zdk1s(ji,jj)     &
-                             +zdk1s(ji+1,jj) + zdks (ji,jj) )  )
-
-               zfsv(ji,jj,jk)= vmask(ji,jj,jk) *   &
-                  (  zabe2 *( ps(ji,jj+1,jk) - ps(ji,jj,jk) )   &
-                   + zcof2 *( zdks (ji,jj+1) + zdk1s(ji,jj)     &
-                             +zdk1s(ji,jj+1) + zdks (ji,jj) )  )
-            END DO
-         END DO
-
-
-         ! I.3 Second derivative (divergence) (not divided by the volume)
-         ! ---------------------
-
-         DO jj = 2 , jpjm1
-            DO ji = 2 , jpim1
-               ztah = zftu(ji,jj) - zftu(ji-1,jj) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)
-               zsah = zfsu(ji,jj) - zfsu(ji-1,jj) + zfsv(ji,jj,jk) - zfsv(ji,jj-1,jk)
-               plt(ji,jj,jk) = ztah
-               pls(ji,jj,jk) = zsah
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
- 
-      !!but this should be done somewhere after 
-      ! "zonal" mean diffusive heat and salt transport
-      IF( ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         pht_ldf(:) = ptr_vj( zftv(:,:,:) )
-         pst_ldf(:) = ptr_vj( zfsv(:,:,:) )
-      ENDIF
-
-      !                             ! ************ !   ! ===============
-      DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
-         !                          ! ************ !   ! ===============
-
-         ! II.1 horizontal tracer gradient
-         ! -------------------------------
-
-         DO jk = 1, jpk
-            DO ji = 1, jpim1
-               zdit (ji,jk) = ( pt(ji+1,jj  ,jk) - pt(ji,jj  ,jk) ) * umask(ji,jj  ,jk)
-               zdis (ji,jk) = ( ps(ji+1,jj  ,jk) - ps(ji,jj  ,jk) ) * umask(ji,jj  ,jk)
-               zdjt (ji,jk) = ( pt(ji  ,jj+1,jk) - pt(ji,jj  ,jk) ) * vmask(ji,jj  ,jk)
-               zdjs (ji,jk) = ( ps(ji  ,jj+1,jk) - ps(ji,jj  ,jk) ) * vmask(ji,jj  ,jk)
-               zdj1t(ji,jk) = ( pt(ji  ,jj  ,jk) - pt(ji,jj-1,jk) ) * vmask(ji,jj-1,jk)
-               zdj1s(ji,jk) = ( ps(ji  ,jj  ,jk) - ps(ji,jj-1,jk) ) * vmask(ji,jj-1,jk)
-            END DO
-         END DO
-
-
-         ! II.2 Vertical fluxes
-         ! --------------------
-
-         ! Surface and bottom vertical fluxes set to zero
-         zftw(:, 1 ) = 0.e0
-         zfsw(:, 1 ) = 0.e0
-         zftw(:,jpk) = 0.e0
-         zfsw(:,jpk) = 0.e0
-
-         ! interior (2=<jk=<jpk-1)
-         DO jk = 2, jpkm1
-            DO ji = 2, jpim1
-               zcof0 = e1t(ji,jj) * e2t(ji,jj) / fse3w(ji,jj,jk)   &
-                     * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)        &
-                        + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
-
-               zmku =1./MAX(  umask(ji  ,jj,jk-1)+umask(ji-1,jj,jk)   &
-                             +umask(ji-1,jj,jk-1)+umask(ji  ,jj,jk), 1. )
-
-               zmkv =1./MAX(  vmask(ji,jj  ,jk-1)+vmask(ji,jj-1,jk)   &
-                             +vmask(ji,jj-1,jk-1)+vmask(ji,jj  ,jk), 1. )
-
-               zcof3 = - e2t(ji,jj) * wslpi (ji,jj,jk) * zmku
-               zcof4 = - e1t(ji,jj) * wslpj (ji,jj,jk) * zmkv
-
-               zftw(ji,jk) = tmask(ji,jj,jk) *   &
-                  (  zcof0 * ( pt  (ji,jj,jk-1) - pt  (ji,jj,jk) )   &
-                   + zcof3 * ( zdit (ji  ,jk-1) + zdit (ji-1,jk)     &
-                              +zdit (ji-1,jk-1) + zdit (ji  ,jk) )   &
-                   + zcof4 * ( zdjt (ji  ,jk-1) + zdj1t(ji  ,jk)     &
-                              +zdj1t(ji  ,jk-1) + zdjt (ji  ,jk) )  )
-
-               zfsw(ji,jk) = tmask(ji,jj,jk) *   &
-                  (  zcof0 * ( ps  (ji,jj,jk-1) - ps  (ji,jj,jk) )   &
-                   + zcof3 * ( zdis (ji  ,jk-1) + zdis (ji-1,jk)     &
-                              +zdis (ji-1,jk-1) + zdis (ji  ,jk) )   &
-                   + zcof4 * ( zdjs (ji  ,jk-1) + zdj1s(ji  ,jk)     &
-                              +zdj1s(ji  ,jk-1) + zdjs (ji  ,jk) )  )
-            END DO
-         END DO
-
-
-         ! II.3 Divergence of vertical fluxes added to the horizontal divergence
-         ! ---------------------------------------------------------------------
-
-         IF( kaht == 1 ) THEN
-            ! multiply the laplacian by the eddy diffusivity coefficient
-            DO jk = 1, jpkm1
+         !                             ! ************ !   ! ===============
+         DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
+            !                          ! ************ !   ! ===============
+            
+            ! II.1 horizontal tracer gradient
+            ! -------------------------------
+            
+            DO jk = 1, jpk
+               DO ji = 1, jpim1
+                  zdit (ji,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj  ,jk,jn) ) * umask(ji,jj  ,jk)
+                  zdjt (ji,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj  ,jk,jn) ) * vmask(ji,jj  ,jk)
+                  zdj1t(ji,jk) = ( pt(ji  ,jj  ,jk,jn) - pt(ji,jj-1,jk,jn) ) * vmask(ji,jj-1,jk)
+               END DO
+            END DO
+
+
+            ! II.2 Vertical fluxes
+            ! --------------------
+            
+            ! Surface and bottom vertical fluxes set to zero
+            zftw(:, 1 ) = 0.e0
+            zftw(:,jpk) = 0.e0
+            
+            ! interior (2=<jk=<jpk-1)
+            DO jk = 2, jpkm1
                DO ji = 2, jpim1
-                  ! eddy coef. divided by the volume element
-                  zbtr = fsahtt(ji,jj,jk) / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                  ! vertical divergence
-                  ztav = zftw(ji,jk) - zftw(ji,jk+1)
-                  zsav = zfsw(ji,jk) - zfsw(ji,jk+1)
-                  ! harmonic operator applied to (pt,ps) and multiply by aht
-                  plt(ji,jj,jk) = ( plt(ji,jj,jk) + ztav ) * zbtr
-                  pls(ji,jj,jk) = ( pls(ji,jj,jk) + zsav ) * zbtr
-               END DO
-            END DO
-         ELSEIF( kaht == 2 ) THEN
-            ! second call, no multiplication
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  ! inverse of the volume element
-                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                  ! vertical divergence
-                  ztav = zftw(ji,jk) - zftw(ji,jk+1)
-                  zsav = zfsw(ji,jk) - zfsw(ji,jk+1)
-                  ! harmonic operator applied to (pt,ps) 
-                  plt(ji,jj,jk) = ( plt(ji,jj,jk) + ztav ) * zbtr
-                  pls(ji,jj,jk) = ( pls(ji,jj,jk) + zsav ) * zbtr
-               END DO
-            END DO
-         ELSE
-            IF(lwp) WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht
-            IF(lwp) WRITE(numout,*) '         We stop'
-            STOP 'ldfght'
-         ENDIF
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
+                  zcof0 = e1t(ji,jj) * e2t(ji,jj) / fse3w(ji,jj,jk)   &
+                     &     * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)        &
+                     &        + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
+                  
+                  zmku = 1./MAX(  umask(ji  ,jj,jk-1)+umask(ji-1,jj,jk)   &
+                     &           +umask(ji-1,jj,jk-1)+umask(ji  ,jj,jk), 1. )
+                  
+                  zmkv = 1./MAX(  vmask(ji,jj  ,jk-1)+vmask(ji,jj-1,jk)   &
+                     &           +vmask(ji,jj-1,jk-1)+vmask(ji,jj  ,jk), 1. )
+                  
+                  zcof3 = - e2t(ji,jj) * wslpi (ji,jj,jk) * zmku
+                  zcof4 = - e1t(ji,jj) * wslpj (ji,jj,jk) * zmkv
+                  
+                  zftw(ji,jk) = tmask(ji,jj,jk) *   &
+                     &    (  zcof0 * ( pt   (ji,jj,jk-1,jn) - pt   (ji  ,jj,jk,jn) )   &
+                     &     + zcof3 * ( zdit (ji   ,jk-1   ) + zdit (ji-1,jk      )     &
+                     &                +zdit (ji-1 ,jk-1   ) + zdit (ji  ,jk      ) )   &
+                     &     + zcof4 * ( zdjt (ji   ,jk-1   ) + zdj1t(ji  ,jk)     &
+                     &                +zdj1t(ji   ,jk-1   ) + zdjt (ji  ,jk      ) )  )                 
+               END DO
+            END DO
+
+
+            ! II.3 Divergence of vertical fluxes added to the horizontal divergence
+            ! ---------------------------------------------------------------------
+            
+            IF( kaht == 1 ) THEN
+               ! multiply the laplacian by the eddy diffusivity coefficient
+               DO jk = 1, jpkm1
+                  DO ji = 2, jpim1
+                     ! eddy coef. divided by the volume element
+                     zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     ! vertical divergence
+                     ztav = fsahtt(ji,jj,jk) * ( zftw(ji,jk) - zftw(ji,jk+1) )
+                     ! harmonic operator applied to (pt,ps) and multiply by aht
+                     plt(ji,jj,jk,jn) = ( plt(ji,jj,jk,jn) + ztav ) * zbtr
+                  END DO
+               END DO
+            ELSEIF( kaht == 2 ) THEN
+               ! second call, no multiplication
+               DO jk = 1, jpkm1
+                  DO ji = 2, jpim1
+                     ! inverse of the volume element
+                     zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     ! vertical divergence
+                     ztav = zftw(ji,jk) - zftw(ji,jk+1)
+                     ! harmonic operator applied to (pt,ps) 
+                     plt(ji,jj,jk,jn) = ( plt(ji,jj,jk,jn) + ztav ) * zbtr
+                  END DO
+               END DO
+            ELSE
+               IF(lwp) WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht
+               IF(lwp) WRITE(numout,*) '         We stop'
+               STOP 'ldfght'
+            ENDIF
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+      END DO
+      !
    END SUBROUTINE ldfght
 
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 2024)
@@ -2,10 +2,11 @@
    !!======================================================================
    !!                   ***  MODULE  traldf_iso  ***
-   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
    !!======================================================================
-   !! History :        !  94-08  (G. Madec, M. Imbard)
-   !!                  !  97-05  (G. Madec)  split into traldf and trazdf
-   !!             8.5  !  02-08  (G. Madec)  Free form, F90
-   !!             9.0  !  05-11  (G. Madec)  merge traldf and trazdf :-)
+   !! History :   OPA  !  1994-08  (G. Madec, M. Imbard)
+   !!                  !  1997-05  (G. Madec)  split into traldf and trazdf
+   !!             NEMO !  2002-08  (G. Madec)  Free form, F90
+   !!             1.0  !  2005-11  (G. Madec)  merge traldf and trazdf :-)
+   !!             3.0  !  2008-01  (C. Ethe, G. Madec) Merge TRA-TRC
    !!----------------------------------------------------------------------
 #if   defined key_ldfslp   ||   defined key_esopa
@@ -22,6 +23,4 @@
    USE dom_oce         ! ocean space and time domain
    USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
    USE zdf_oce         ! ocean vertical physics
    USE in_out_manager  ! I/O manager
@@ -29,5 +28,4 @@
    USE ldfslp          ! iso-neutral slopes
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
 #if defined key_diaar5
    USE phycst          ! physical constants
@@ -52,5 +50,6 @@
 CONTAINS
 
-   SUBROUTINE tra_ldf_iso( kt )
+   SUBROUTINE tra_ldf_iso( kt   , cdtype, pgtu, pgtv,  &
+      &                    ptrab, ptraa , kjpt, pahtb0 )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf_iso  ***
@@ -66,5 +65,5 @@
       !!      nal or geopotential slopes computed in routine ldfslp.
       !!
-      !!      1st part :  masked horizontal derivative of T & S ( di[ t ] )
+      !!      1st part :  masked horizontal derivative of T  ( di[ t ] )
       !!      ========    with partial cell update if ln_zps=T.
       !!
@@ -88,32 +87,31 @@
       !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
       !!      Add this trend to the general trend (ta,sa):
-      !!         ta = ta + difft
-      !!
-      !! ** Action :   Update (ta,sa) arrays with the before rotated diffusion
-      !!            trend (except the dk[ dk[.] ] term)
+      !!         pta = pta + difft
+      !!
+      !! ** Action :   Update pta arrays with the before rotated diffusion
       !!----------------------------------------------------------------------
-      USE oce           , zftv => ua   ! use ua as workspace
-      USE oce           , zfsv => va   ! use va as workspace
-      !!
-      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   iku, ikv     ! temporary integer
-      REAL(wp) ::   zmsku, zabe1, zcof1, zcoef3, zta   ! temporary scalars
-      REAL(wp) ::   zmskv, zabe2, zcof2, zcoef4, zsa   !    "         "
-      REAL(wp) ::   zcoef0, zbtr                       !    "         "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt , zdk1t         ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zdks , zdk1s, zfsu   !  "         "
+      !!* Module used
+      USE oce         , zftu => ua   ! use ua as workspace
+      USE oce         , zftv => va   ! use va as workspace
+      !!* Arguments
+      INTEGER         , INTENT(in   )                                ::   kt             ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                                ::   cdtype         ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt  )     ::   pgtu, pgtv     ! tracer gradient at pstep levels
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptrab          ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptraa          ! tracer trend 
+      REAL(wp)        , INTENT(in   )                                ::   pahtb0         ! background diffusion coef
+      !!* Local declarations
+      INTEGER  ::  ji, jj, jk,jn   ! dummy loop indices
+      INTEGER  ::  iku, ikv     ! temporary integer
+      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! temporary scalars
+      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !    "         "
+      REAL(wp) ::  zcoef0, zbtr, ztra                           !    "         "
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt, zdk1t         ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw     ! 3D workspace
 #if defined key_diaar5
       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                  !  "         "
       REAL(wp)                         ::   zztmp                !  "         "
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zftu                 ! 3D workspace
-#else
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zftu                 ! 2D workspace
 #endif
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw     ! 3D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdis, zdjs, zsfw     !  "      "
-# if defined key_diaar5
-# endif  
       !!----------------------------------------------------------------------
 
@@ -123,211 +121,183 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
       ENDIF
-
-      !!----------------------------------------------------------------------
-      !!   I - masked horizontal derivative of T & S
-      !!----------------------------------------------------------------------
-!!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient....
-      zdit (1,:,:) = 0.e0     ;     zdit (jpi,:,:) = 0.e0
-      zdis (1,:,:) = 0.e0     ;     zdis (jpi,:,:) = 0.e0
-      zdjt (1,:,:) = 0.e0     ;     zdjt (jpi,:,:) = 0.e0
-      zdjs (1,:,:) = 0.e0     ;     zdjs (jpi,:,:) = 0.e0
-!!end
-
-      ! Horizontal temperature and salinity gradient 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zdit(ji,jj,jk) = ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) ) * umask(ji,jj,jk)
-               zdis(ji,jj,jk) = ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) ) * umask(ji,jj,jk)
-               zdjt(ji,jj,jk) = ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) ) * vmask(ji,jj,jk)
-               zdjs(ji,jj,jk) = ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) ) * vmask(ji,jj,jk)
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !                                               
+         !!----------------------------------------------------------------------
+         !!   I - masked horizontal derivative 
+         !!----------------------------------------------------------------------
+         !!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient....
+         zdit (1,:,:) = 0.e0     ;     zdit (jpi,:,:) = 0.e0
+         zdjt (1,:,:) = 0.e0     ;     zdjt (jpi,:,:) = 0.e0
+         !!end
+
+         ! Horizontal tracer gradient 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,jk) = ( ptrab(ji+1,jj  ,jk,jn) - ptrab(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                  zdjt(ji,jj,jk) = ( ptrab(ji  ,jj+1,jk,jn) - ptrab(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+               END DO
             END DO
          END DO
-      END DO
-      IF( ln_zps ) THEN      ! partial steps correction at the last level 
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ! last level
-               iku = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
-               ikv = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
-               zdit(ji,jj,iku) = gtu(ji,jj) 
-               zdis(ji,jj,iku) = gsu(ji,jj)               
-               zdjt(ji,jj,ikv) = gtv(ji,jj) 
-               zdjs(ji,jj,ikv) = gsv(ji,jj)               
+         IF( ln_zps ) THEN      ! partial steps correction at the last level 
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! last level
+                  iku = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
+                  ikv = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
+                  zdit(ji,jj,iku) = pgtu(ji,jj,jn)          
+                  zdjt(ji,jj,ikv) = pgtv(ji,jj,jn)      
+               END DO
+            END DO
+         ENDIF
+
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+         
+!CDIR PARALLEL DO PRIVATE( zdk1t ) 
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            ! 1. Vertical tracer gradient at level jk and jk+1
+            ! ------------------------------------------------
+            ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+            
+            zdk1t(:,:) = ( ptrab(:,:,jk,jn) - ptrab(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+            
+            IF( jk == 1 ) THEN
+               zdkt(:,:) = zdk1t(:,:)
+            ELSE
+               zdkt(:,:) = ( ptrab(:,:,jk-1,jn) - ptrab(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+
+
+            ! 2. Horizontal fluxes
+            ! --------------------
+            
+            DO jj = 1 , jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
+                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
+                  
+                  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. )
+                  
+                  zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
+                  zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+                  !
+                  zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   &
+                     &              + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
+                     &                         + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
+                  zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
+                     &              + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
+                     &                         + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                  
+               END DO
+            END DO
+
+
+            ! II.4 Second derivative (divergence) and add to the general trend
+            ! ----------------------------------------------------------------
+            DO jj = 2 , jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !                                          ! ===============
+         END DO                                        !   End of slab  
+         !                                             ! ===============
+         ! "Poleward" diffusive heat or salt transports
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
+            IF( jn == jp_tem)   pht_ldf(:) = ptr_vj( zftv(:,:,:) )
+            IF( jn == jp_sal)   pst_ldf(:) = ptr_vj( zftv(:,:,:) )
+         ENDIF
+ 
+#if defined key_diaar5
+         IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
+            zztmp = 0.5 * rau0 * rcp 
+            z2d(:,:) = 0.e0 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zztmp * zftu(ji,jj,jk)   &
+            &                    * ( ptran(ji,jj,jk,jn) + ptran(ji+1,jj,jk,jn) ) * e1u(ji,jj) * fse3u(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( z2d, 'U', -1. )
+            CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
+            z2d(:,:) = 0.e0 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zztmp * zftv(ji,jj,jk)   &
+           &                   * ( ptran(ji,jj,jk,jn) + ptran(ji,jj+1,jk,jn) ) * e2v(ji,jj) * fse3v(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( z2d, 'V', -1. )
+            CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
+         END IF
+#endif
+
+         !!----------------------------------------------------------------------
+         !!   III - vertical trend of T & S (extra diagonal terms only)
+         !!----------------------------------------------------------------------
+         
+         ! Local constant initialization
+         ! -----------------------------
+         ztfw(1,:,:) = 0.e0     ;     ztfw(jpi,:,:) = 0.e0
+         
+         ! Vertical fluxes
+         ! ---------------
+         
+         ! Surface and bottom vertical fluxes set to zero
+         ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0
+         
+         ! interior (2=<jk=<jpk-1)
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk)
+                  
+                  zmsku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      &
+                     &            + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.  )
+                  
+                  zmskv = 1./MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      &
+                     &            + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.  )
+                  
+                  zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)
+                  zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
+                  
+                  ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
+                     &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   &
+                     &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      &
+                     &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  )
+               END DO
             END DO
          END DO
-      ENDIF
-
-      !!----------------------------------------------------------------------
-      !!   II - horizontal trend of T & S (full)
-      !!----------------------------------------------------------------------
-      
-#if defined key_diaar5
-!CDIR PARALLEL DO PRIVATE( zdk1t, zdk1s, zfsu ) 
-#else
-!CDIR PARALLEL DO PRIVATE( zdk1t, zdk1s, zftu, zfsu ) 
-#endif
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         ! 1. Vertical tracer gradient at level jk and jk+1
-         ! ------------------------------------------------
-         ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-
-         zdk1t(:,:) = ( tb(:,:,jk) - tb(:,:,jk+1) ) * tmask(:,:,jk+1)
-         zdk1s(:,:) = ( sb(:,:,jk) - sb(:,:,jk+1) ) * tmask(:,:,jk+1)
-
-         IF( jk == 1 ) THEN
-            zdkt(:,:) = zdk1t(:,:)
-            zdks(:,:) = zdk1s(:,:)
-         ELSE
-            zdkt(:,:) = ( tb(:,:,jk-1) - tb(:,:,jk) ) * tmask(:,:,jk)
-            zdks(:,:) = ( sb(:,:,jk-1) - sb(:,:,jk) ) * tmask(:,:,jk)
-         ENDIF
-
-
-         ! 2. Horizontal fluxes
-         ! --------------------
-
-         DO jj = 1 , jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zabe1 = ( fsahtu(ji,jj,jk) + ahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
-               zabe2 = ( fsahtv(ji,jj,jk) + ahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
-
-               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. )
-
-               zcof1 = -fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
-               zcof2 = -fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
-
-#if defined key_diaar5
-               zftu(ji,jj,jk) = (  zabe1 * zdit(ji,jj,jk)   &
-#else
-               zftu(ji,jj   ) = (  zabe1 * zdit(ji,jj,jk)   &
-#endif
-                  &              + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
-                  &                         + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
-               zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
-                  &              + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
-                  &                         + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)
-               zfsu(ji,jj   ) = (  zabe1 * zdis(ji,jj,jk)   &
-                  &              + zcof1 * (  zdks (ji+1,jj) + zdk1s(ji,jj)      &
-                  &                         + zdk1s(ji+1,jj) + zdks (ji,jj)  )  ) * umask(ji,jj,jk)
-               zfsv(ji,jj,jk) = (  zabe2 * zdjs(ji,jj,jk)   &
-                  &              + zcof2 * (  zdks (ji,jj+1) + zdk1s(ji,jj)      &
-                  &                         + zdk1s(ji,jj+1) + zdks (ji,jj)  )  ) * vmask(ji,jj,jk)
+         
+         
+         ! I.5 Divergence of vertical fluxes added to the general tracer trend
+         ! -------------------------------------------------------------------
+         
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztra = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
+               END DO
             END DO
          END DO
-
-
-         ! II.4 Second derivative (divergence) and add to the general trend
-         ! ----------------------------------------------------------------
-         DO jj = 2 , jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr= 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-#if defined key_diaar5
-               zta = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
-#else
-               zta = zbtr * ( zftu(ji,jj   ) - zftu(ji-1,jj   ) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
-#endif
-               zsa = zbtr * ( zfsu(ji,jj   ) - zfsu(ji-1,jj   ) + zfsv(ji,jj,jk) - zfsv(ji,jj-1,jk)  )
-               ta (ji,jj,jk) = ta (ji,jj,jk) + zta
-               sa (ji,jj,jk) = sa (ji,jj,jk) + zsa
-            END DO
-         END DO
-         !                                          ! ===============
-      END DO                                        !   End of slab  
-      !                                             ! ===============
-
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   ! Poleward diffusive heat and salt transports
-         pht_ldf(:) = ptr_vj( zftv(:,:,:) )
-         pst_ldf(:) = ptr_vj( zfsv(:,:,:) )
-      ENDIF
-#if defined key_diaar5
-      zztmp = 0.5 * rau0 * rcp 
-      z2d(:,:) = 0.e0 
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               z2d(ji,jj) = z2d(ji,jj) + zztmp * zftu(ji,jj,jk) * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) * e1u(ji,jj) * fse3u(ji,jj,jk) 
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( z2d, 'U', -1. )
-      CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
-      z2d(:,:) = 0.e0 
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               z2d(ji,jj) = z2d(ji,jj) + zztmp * zftv(ji,jj,jk) * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) ) * e2v(ji,jj) * fse3v(ji,jj,jk) 
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( z2d, 'V', -1. )
-      CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
-#endif
-
-      !!----------------------------------------------------------------------
-      !!   III - vertical trend of T & S (extra diagonal terms only)
-      !!----------------------------------------------------------------------
-
-      ! Local constant initialization
-      ! -----------------------------
-      ztfw(1,:,:) = 0.e0     ;     ztfw(jpi,:,:) = 0.e0
-      zsfw(1,:,:) = 0.e0     ;     zsfw(jpi,:,:) = 0.e0
-
-
-      ! Vertical fluxes
-      ! ---------------
-
-      ! Surface and bottom vertical fluxes set to zero
-      ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0
-      zsfw(:,:, 1 ) = 0.e0      ;      zsfw(:,:,jpk) = 0.e0
-
-      ! interior (2=<jk=<jpk-1)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk)
-
-               zmsku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      &
-                  &            + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.  )
-
-               zmskv = 1./MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      &
-                  &            + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.  )
-
-               zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)
-               zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
-
-               ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
-                  &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   &
-                  &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      &
-                  &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  )
-
-               zsfw(ji,jj,jk) = zcoef3 * (   zdis(ji  ,jj  ,jk-1) + zdis(ji-1,jj  ,jk)      &
-                  &                        + zdis(ji-1,jj  ,jk-1) + zdis(ji  ,jj  ,jk)  )   &
-                  &           + zcoef4 * (   zdjs(ji  ,jj  ,jk-1) + zdjs(ji  ,jj-1,jk)      &
-                  &                        + zdjs(ji  ,jj-1,jk-1) + zdjs(ji  ,jj  ,jk)  )
-            END DO
-         END DO
-      END DO
-
-
-      ! I.5 Divergence of vertical fluxes added to the general tracer trend
-      ! -------------------------------------------------------------------
-
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-               zta  = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr
-               zsa  = (  zsfw(ji,jj,jk) - zsfw(ji,jj,jk+1)  ) * zbtr
-               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
-            END DO
-         END DO
+         !
       END DO
       !
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_lap.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 2024)
@@ -2,7 +2,15 @@
    !!==============================================================================
    !!                       ***  MODULE  traldf_lap  ***
-   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
    !!==============================================================================
-
+   !! History :  OPA  !  87-06  (P. Andrich, D. L Hostis)  Original code
+   !!                 !  91-11  (G. Madec)
+   !!                 !  95-11  (G. Madec)  suppress volumetric scale factors
+   !!                 !  96-01  (G. Madec)  statement function for e3
+   !!            NEMO !  02-06  (G. Madec)  F90: Free form and module
+   !!            1.0  !  04-08  (C. Talandier) New trends organization
+   !!                 !  05-11  (G. Madec)  add zps case
+   !!            3.0  !  10-06  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   tra_ldf_lap  : update the tracer trend with the horizontal diffusion
@@ -13,9 +21,6 @@
    USE dom_oce         ! ocean space and time domain
    USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
    USE in_out_manager  ! I/O manager
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
 
 
@@ -25,4 +30,6 @@
    !! * Routine accessibility
    PUBLIC tra_ldf_lap  ! routine called by step.F90
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   e1ur, e2vr   ! scale factor coefficients
 
    !! * Substitutions
@@ -38,5 +45,6 @@
 CONTAINS
 
-   SUBROUTINE tra_ldf_lap( kt )
+   SUBROUTINE tra_ldf_lap( kt   , cdtype, pgtu, pgtv,  &
+      &                    ptrab, ptraa , kjpt         ) 
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf_lap  ***
@@ -47,5 +55,5 @@
       !! ** Method  :   Second order diffusive operator evaluated using before
       !!      fields (forward time scheme). The horizontal diffusive trends of 
-      !!      temperature (idem for salinity) is given by:
+      !!      the tracer is given by:
       !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ]
       !!                                   + dj-1[ aht e1v*e3v/e2v dj(tb) ] }
@@ -53,37 +61,25 @@
       !!          difft = 1/(e1t*e2t) {  di-1[ aht e2u/e1u di(tb) ]
       !!                               + dj-1[ aht e1v/e2v dj(tb) ] }
-      !!      Add this trend to the general tracer trend (ta,sa):
-      !!          (ta,sa) = (ta,sa) + ( difft , diffs )
+      !!      Add this trend to the general tracer trend pta :
+      !!          pta = pta + difft
       !!
-      !! ** Action  : - Update (ta,sa) arrays with the before iso-level 
+      !! ** Action  : - Update pta arrays with the before iso-level 
       !!                harmonic mixing trend.
-      !!
-      !! History :
-      !!   1.0  !  87-06  (P. Andrich, D. L Hostis)  Original code
-      !!        !  91-11  (G. Madec)
-      !!        !  95-11  (G. Madec)  suppress volumetric scale factors
-      !!        !  96-01  (G. Madec)  statement function for e3
-      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
-      !!   9.0  !  04-08  (C. Talandier) New trends organization
-      !!        !  05-11  (G. Madec)  add zps case
       !!----------------------------------------------------------------------
-      USE oce              , ztu => ua,  &  ! use ua as workspace
-         &                   zsu => va      ! use va as workspace
-
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
-      
-      !! * Local save
-      REAL(wp), DIMENSION(jpi,jpj), SAVE ::   &
-         ze1ur, ze2vr, zbtr2              ! scale factor coefficients
-      
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk             ! dummy loop indices
-      INTEGER ::   iku, ikv               ! temporary integers
+      !!* Module used
+      USE oce         , ztu => ua   ! use ua as workspace
+      USE oce         , ztv => va   ! use va as workspace
+      !!* Arguments
+      INTEGER         , INTENT(in   )                                ::   kt             ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                                ::   cdtype         ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt  )     ::   pgtu, pgtv     ! tracer gradient at pstep levels
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptrab          ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptraa          ! tracer trend 
+      !!* Local declarations
+      INTEGER ::   ji, jj, jk, jn          ! dummy loop indices
+      INTEGER ::   iku, ikv                ! temporary integers
       REAL(wp) ::   &
-         zabe1, zta,                   &  ! temporary scalars
-         zabe2, zsa, zbtr                 !    "         "
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-         ztv, zsv                         ! 3D workspace
+         zabe1, zabe2, ztra, zbtr           ! temporary scalars
       !!----------------------------------------------------------------------
       
@@ -92,89 +88,66 @@
          IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion'
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
-         ze1ur(:,:) = e2u(:,:) / e1u(:,:)
-         ze2vr(:,:) = e1v(:,:) / e2v(:,:)
-         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
+         e1ur(:,:) = e2u(:,:) / e1u(:,:)
+         e2vr(:,:) = e1v(:,:) / e2v(:,:)
       ENDIF
-      
-      !                                                  ! =============
-      DO jk = 1, jpkm1                                   ! Vertical slab
-         !                                               ! =============
-         ! 1. First derivative (gradient)
-         ! -------------------
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-#if defined key_zco
-               zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj)
-               zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj)
-#else
-               zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) * fse3u(ji,jj,jk)
-               zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) * fse3v(ji,jj,jk)
-#endif
-               ztu(ji,jj,jk) = zabe1 * ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) )
-               zsu(ji,jj,jk) = zabe1 * ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) )
-               ztv(ji,jj,jk) = zabe2 * ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) )
-               zsv(ji,jj,jk) = zabe2 * ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) )
-            END DO  
-         END DO  
-         IF( ln_zps ) THEN      ! set gradient at partial step level
+
+      !
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========      
+         !                                                 
+         DO jk = 1, jpkm1                                
+            !                                           
+            ! 1. First derivative (gradient)
+            ! -------------------
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  ! last level
-                  iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
-                  ikv = MIN ( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
-                  IF( iku == jk ) THEN
-                     zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * ze1ur(ji,jj) * fse3u(ji,jj,iku)
-                     ztu(ji,jj,jk) = zabe1 * gtu(ji,jj)
-                     zsu(ji,jj,jk) = zabe1 * gsu(ji,jj)
-                  ENDIF
-                  IF( ikv == jk ) THEN
-                     zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * ze2vr(ji,jj) * fse3v(ji,jj,ikv)
-                     ztv(ji,jj,jk) = zabe2 * gtv(ji,jj)
-                     zsv(ji,jj,jk) = zabe2 * gsv(ji,jj)
-                  ENDIF
+                  zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * e1ur(ji,jj) * fse3u(ji,jj,jk)
+                  zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * e2vr(ji,jj) * fse3v(ji,jj,jk)
+                  ztu(ji,jj,jk) = zabe1 * ( ptrab(ji+1,jj  ,jk,jn) - ptrab(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zabe2 * ( ptrab(ji  ,jj+1,jk,jn) - ptrab(ji,jj,jk,jn) )
                END DO
             END DO
-         ENDIF
+            IF( ln_zps ) THEN      ! set gradient at partial step level
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     ! last level
+                     iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
+                     ikv = MIN ( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
+                     IF( iku == jk ) THEN
+                        zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e1ur(ji,jj) * fse3u(ji,jj,iku)
+                        ztu(ji,jj,jk) = zabe1 * pgtu(ji,jj,jn)
+                     ENDIF
+                     IF( ikv == jk ) THEN
+                        zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e2vr(ji,jj) * fse3v(ji,jj,ikv)
+                        ztv(ji,jj,jk) = zabe2 * pgtv(ji,jj,jn)
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
          
          
-         ! 2. Second derivative (divergence)
-         ! --------------------
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               zbtr = zbtr2(ji,jj)
-#else
-               zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk)
-#endif
-               ! horizontal diffusive trends
-               zta = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
-                  &          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
-               zsa = zbtr * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk)   &
-                  &          + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  )
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
-            END DO  
-         END DO  
-         !                                               ! =============
-      END DO                                             !  End of slab  
-      !                                                  ! =============
-
-      ! "zonal" mean lateral diffusive heat and salt transport 
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         IF( lk_zco ) THEN   ! z-coordinate - full step (1D arrays)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                    ztv(ji,jj,jk) = ztv(ji,jj,jk) * fse3v(ji,jj,jk)
-                    zsv(ji,jj,jk) = zsv(ji,jj,jk) * fse3v(ji,jj,jk)
-                  END DO
+            ! 2. Second derivative (divergence) added to the general tracer trends
+            ! ---------------------------------------------------------------------
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal diffusive trends
+                  ztra = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
+                     &           + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
+                  ! add it to the general tracer trends
+                  ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra
                END DO
             END DO
+            !                                               ! =============
+         END DO                                             !  End of slab  
+         !                                                  ! =============
+         ! "Poleward" diffusive heat or salt transports
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
+            IF( jn  == jp_tem)   pht_ldf(:) = ptr_vj( ztv(:,:,:) )
+            IF( jn  == jp_sal)   pst_ldf(:) = ptr_vj( ztv(:,:,:) )
          ENDIF
-         pht_ldf(:) = ptr_vj( ztv(:,:,:) )
-         pst_ldf(:) = ptr_vj( zsv(:,:,:) )
-      ENDIF
-
+         !
+      END DO
+      !
    END SUBROUTINE tra_ldf_lap
 
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranpc.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 2024)
@@ -16,6 +16,6 @@
    USE dom_oce         ! ocean space and time domain
    USE zdf_oce         ! ocean vertical physics
-   USE trdmod          ! ocean active tracer trends
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_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)
@@ -55,6 +55,4 @@
       !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371.
       !!----------------------------------------------------------------------
-      USE oce, ONLY :    ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :    ztrds => va   ! use va as 3D workspace   
       !! 
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
@@ -68,4 +66,5 @@
       REAL(wp), DIMENSION(jpi,jpk)     ::   zwx, zwy, zwz   ! 2D arrays
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zrhop           ! 3D arrays
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
 
@@ -75,10 +74,9 @@
          inpci = 0
 
-         CALL eos( ta, sa, rhd, zrhop )         ! Potential density
-
-
-         IF( l_trdtra )   THEN                  ! Save ta and sa trends
-            ztrdt(:,:,:) = ta(:,:,:) 
-            ztrds(:,:,:) = sa(:,:,:) 
+         CALL eos( tsa(:,:,:,jp_tem), tsa(:,:,:,jp_sal), rhd, zrhop )         ! Potential density
+
+         IF( l_trdtra )   THEN                    !* Save ta and sa trends
+            ALLOCATE( ztrdt(jpi,jpj,jpk) )  ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
+            ALLOCATE( ztrds(jpi,jpj,jpk) )  ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
          ENDIF
 
@@ -151,6 +149,6 @@
                         !
                         ze3tot= fse3t(ji,jj,ikup)
-                        zta   = ta   (ji,jj,ikup)
-                        zsa   = sa   (ji,jj,ikup)
+                        zta   = tsa  (ji,jj,ikup,jp_tem)
+                        zsa   = tsa  (ji,jj,ikup,jp_sal)
                         zraua = zrhop(ji,jj,ikup)
                         !
@@ -162,6 +160,6 @@
                            ze3dwn =  fse3t(ji,jj,jkdown)
                            ze3tot =  ze3tot + ze3dwn
-                           zta   = ( zta*(ze3tot-ze3dwn) + ta(ji,jj,jkdown)*ze3dwn )/ze3tot
-                           zsa   = ( zsa*(ze3tot-ze3dwn) + sa(ji,jj,jkdown)*ze3dwn )/ze3tot
+                           zta   = ( zta*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_tem)*ze3dwn )/ze3tot
+                           zsa   = ( zsa*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_sal)*ze3dwn )/ze3tot
                            zraua = ( zraua*(ze3tot-ze3dwn) + zrhop(ji,jj,jkdown)*ze3dwn )/ze3tot
                            inpci = inpci+1
@@ -171,12 +169,12 @@
                         !
                         DO jkp = ikup, ikdown-1
-                           ta(ji,jj,jkp) = zta
-                           sa(ji,jj,jkp) = zsa
-                           zrhop(ji,jj,jkp) = zraua
+                           tsa  (ji,jj,jkp,jp_tem) = zta
+                           tsa  (ji,jj,jkp,jp_sal) = zsa
+                           zrhop(ji,jj,jkp       ) = zraua
                         END DO
                         IF (ikdown == ikbot-1 .AND. zraua >= zrhop(ji,jj,ikdown) ) THEN
-                           ta(ji,jj,ikdown) = zta
-                           sa(ji,jj,ikdown) = zsa
-                           zrhop(ji,jj,ikdown) = zraua
+                           tsa  (ji,jj,jkp,jp_tem) = zta
+                           tsa  (ji,jj,jkp,jp_sal) = zsa
+                           zrhop(ji,jj,ikdown    ) = zraua
                         ENDIF
                      END DO
@@ -191,13 +189,15 @@
          ! 
          IF( l_trdtra )   THEN         ! save the Non penetrative mixing trends for diagnostic
-            ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-            ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
-            CALL trd_mod(ztrdt, ztrds, jptra_trd_npc, 'TRA', kt)
+            ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+            ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+            CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_npc, ztrdt )
+            CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_npc, ztrds )
+            DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
          ENDIF
       
          ! Lateral boundary conditions on ( ta, sa )   ( Unchanged sign)
          ! ------------------------------============
-         CALL lbc_lnk( ta, 'T', 1. )
-         CALL lbc_lnk( sa, 'T', 1. )
+         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )
+         CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
       
 
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 2024)
@@ -28,6 +28,6 @@
    USE dynspg_oce      ! surface     pressure gradient variables
    USE dynhpg          ! hydrostatic pressure gradient 
-   USE trdmod_oce      ! ocean variables trends
-   USE trdmod          ! ocean active tracers trends 
+   USE trdmod_oce      ! ocean space and time domain variables 
+   USE trdtra          ! ocean active tracers trends 
    USE phycst
    USE obctra          ! open boundary condition (obc_tra routine)
@@ -36,12 +36,15 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE prtctl          ! Print control
+   USE traswp          ! swap array
    USE agrif_opa_update
    USE agrif_opa_interp
-   USE obc_oce 
+   USE obc_oce
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   tra_nxt    ! routine called by step.F90
+   PUBLIC   tra_nxt       ! routine called by step.F90
+   PUBLIC   tra_nxt_fix   ! to be used in trcnxt
+   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt
 
    REAL(wp), DIMENSION(jpk) ::   r2dt_t   ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler)
@@ -81,11 +84,10 @@
       !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
       !!----------------------------------------------------------------------
-      USE oce, ONLY :    ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :    ztrds => va   ! use va as 3D workspace   
-      !!
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
       !!
       INTEGER  ::   jk    ! dummy loop indices
       REAL(wp) ::   zfact ! temporary scalars
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
+
       !!----------------------------------------------------------------------
 
@@ -98,7 +100,10 @@
       ! Update after tracer on domain lateral boundaries
       ! 
-      CALL lbc_lnk( ta, 'T', 1. )      ! local domain boundaries  (T-point, unchanged sign)
-      CALL lbc_lnk( sa, 'T', 1. )
-      !
+      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )      ! local domain boundaries  (T-point, unchanged sign)
+      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
+      !
+#if defined key_obc || defined key_bdy || defined key_agrif
+      CALL tra_unswap
+#endif
 #if defined key_obc
       IF( lk_obc )   CALL obc_tra( kt )  ! OBC open boundaries
@@ -110,4 +115,7 @@
       CALL Agrif_tra                   ! AGRIF zoom boundaries
 #endif
+#if defined key_obc || defined key_bdy || defined key_agrif
+      CALL tra_swap
+#endif
  
       ! set time step size (Euler/Leapfrog)
@@ -117,17 +125,21 @@
 
       ! trends computation initialisation
-      IF( l_trdtra ) THEN              ! store now fields before applying the Asselin filter
-         ztrdt(:,:,:) = tn(:,:,:)      
-         ztrds(:,:,:) = sn(:,:,:)
+      IF( l_trdtra )   THEN                    !* store now fields before applying the Asselin filter
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsn(:,:,:,jp_sal)
       ENDIF
 
       ! Leap-Frog + Asselin filter time stepping
-      IF( lk_vvl )   THEN   ;   CALL tra_nxt_vvl( kt )      ! variable volume level (vvl)
-      ELSE                  ;   CALL tra_nxt_fix( kt )      ! fixed    volume level
+      IF( lk_vvl )   THEN   ;   CALL tra_nxt_vvl( kt , nit000,           &
+                                &                 tsb, tsn   , tsa, jpts )      ! variable volume level (vvl)
+      ELSE                  ;   CALL tra_nxt_fix( kt , nit000,           &
+                                &                 tsb, tsn   , tsa, jpts )      ! fixed    volume level
       ENDIF
 
 #if defined key_agrif
+      CALL tra_unswap
       ! Update tracer at AGRIF zoom boundaries
       IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only
+      CALL tra_swap
 #endif      
 
@@ -136,18 +148,20 @@
          DO jk = 1, jpkm1
             zfact = 1.e0 / r2dt_t(jk)             
-            ztrdt(:,:,jk) = ( tb(:,:,jk) - ztrdt(:,:,jk) ) * zfact
-            ztrds(:,:,jk) = ( sb(:,:,jk) - ztrds(:,:,jk) ) * zfact
+            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
+            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
          END DO
-         CALL trd_mod( ztrdt, ztrds, jptra_trd_atf, 'TRA', kt )
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_atf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_atf, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
       END IF
 
       !                        ! control print
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tn, clinfo1=' nxt  - Tn: ', mask1=tmask,   &
-         &                       tab3d_2=sn, clinfo2=       ' Sn: ', mask2=tmask )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
+         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
       !
    END SUBROUTINE tra_nxt
 
-
-   SUBROUTINE tra_nxt_fix( kt )
+   SUBROUTINE tra_nxt_fix( kt   , kit000,              &
+      &                    ptrab, ptran , ptraa, kjpt  )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE tra_nxt_fix  ***
@@ -171,12 +185,16 @@
       !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   ztm, ztf     ! temporary scalars
-      REAL(wp) ::   zsm, zsf     !    -         -
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 ) THEN
+      INTEGER , INTENT(in   )                               ::  kt            ! ocean time-step index
+      INTEGER , INTENT(in   )                               ::  kit000        ! first time-step index
+      INTEGER , INTENT(in   )                               ::  kjpt            ! number of tracers
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptrab  ! before tracer fields
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptran  ! now tracer fields
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptraa         ! tracer trend
+      !!
+      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) :: ztm, ztf     ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF( kt == kit000 ) THEN
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping'
@@ -188,27 +206,26 @@
          !                                           ! ----------------------- !
          !
-         IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step
-            DO jk = 1, jpkm1                              ! (only swap)
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                                           ! tb <-- tn
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
+         IF( neuler == 0 .AND. kt == kit000 ) THEN        ! Euler time-stepping at first time-step
+            !                                             ! (only swap)
+            DO jn = 1, kjpt
+               DO jk = 1, jpkm1                              
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        ptran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn)     ! ptrab <-- ptran
+                     END DO
                   END DO
                END DO
             END DO
          ELSE                                             ! general case (Leapfrog + Asselin filter
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     ztm = 0.25 * ( ta(ji,jj,jk) + 2.* tn(ji,jj,jk) + tb(ji,jj,jk) )       ! mean t
-                     zsm = 0.25 * ( sa(ji,jj,jk) + 2.* sn(ji,jj,jk) + sb(ji,jj,jk) )
-                     ztf = atfp * ( ta(ji,jj,jk) - 2.* tn(ji,jj,jk) + tb(ji,jj,jk) )       ! Asselin filter on t 
-                     zsf = atfp * ( sa(ji,jj,jk) - 2.* sn(ji,jj,jk) + sb(ji,jj,jk) )
-                     tb(ji,jj,jk) = tn(ji,jj,jk) + ztf                                     ! tb <-- filtered tn 
-                     sb(ji,jj,jk) = sn(ji,jj,jk) + zsf
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                                           ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
-                     ta(ji,jj,jk) = ztm                                                    ! ta <-- mean t
-                     sa(ji,jj,jk) = zsm
+            DO jn = 1, kjpt
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        ztm = 0.25 * ( ptraa(ji,jj,jk,jn) + 2.* ptran(ji,jj,jk,jn) + ptrab(ji,jj,jk,jn) )  ! mean ptra
+                        ztf = atfp * ( ptraa(ji,jj,jk,jn) - 2.* ptran(ji,jj,jk,jn) + ptran(ji,jj,jk,jn) )  ! Asselin filter on ptra 
+                        ptrab(ji,jj,jk,jn) = ptran(ji,jj,jk,jn) + ztf                                      ! ptrab <-- filtered ptran 
+                        ptran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn)                                            ! ptran <-- ptraa
+                        ptraa(ji,jj,jk,jn) = ztm                                                           ! ptraa <-- mean ptra
+                     END DO
                   END DO
                END DO
@@ -219,27 +236,28 @@
          !                                           ! ----------------------- !
          !
-         IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                                           ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
+         IF( neuler == 0 .AND. kt == kit000 ) THEN        ! Euler time-stepping at first time-step
+            DO jn = 1, kjpt
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        ptran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn)                                             ! ptran <-- ptraa
+                     END DO
                   END DO
                END DO
             END DO
          ELSE                                             ! general case (Leapfrog + Asselin filter
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     ztf = atfp * ( ta(ji,jj,jk) - 2.* tn(ji,jj,jk) + tb(ji,jj,jk) )       ! Asselin filter on t 
-                     zsf = atfp * ( sa(ji,jj,jk) - 2.* sn(ji,jj,jk) + sb(ji,jj,jk) )
-                     tb(ji,jj,jk) = tn(ji,jj,jk) + ztf                                     ! tb <-- filtered tn 
-                     sb(ji,jj,jk) = sn(ji,jj,jk) + zsf
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                                           ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
+            DO jn = 1, kjpt
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        ztf = atfp * ( ptraa(ji,jj,jk,jn) - 2.* ptran(ji,jj,jk,jn) + ptrab(ji,jj,jk,jn) )       ! Asselin filter on t 
+                        ptrab(ji,jj,jk,jn) = ptran(ji,jj,jk,jn) + ztf                                     ! ptrab <-- filtered ptran 
+                        ptran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn)                                           ! ptran <-- ptraa
+                     END DO
                   END DO
                END DO
             END DO
          ENDIF
+         !
       ENDIF
       !
@@ -247,5 +265,6 @@
 
 
-   SUBROUTINE tra_nxt_vvl( kt )
+   SUBROUTINE tra_nxt_vvl( kt   , kit000,              &
+      &                    ptrab, ptran , ptraa, kjpt  )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE tra_nxt_vvl  ***
@@ -271,66 +290,67 @@
       !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      INTEGER , INTENT(in   )                               ::  kt            ! ocean time-step index
+      INTEGER , INTENT(in   )                               ::  kit000        ! first time-step index
+      INTEGER , INTENT(in   )                               ::  kjpt            ! number of tracers
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptrab  ! before tracer fields
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptran  ! now tracer fields
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptraa         ! tracer trend
       !!     
-      INTEGER  ::   ji, jj, jk             ! dummy loop indices
+      INTEGER  ::   ji, jj, jk, jn             ! dummy loop indices
       REAL(wp) ::   ztm , ztc_f , ztf , ztca, ztcn, ztcb   ! temporary scalar
-      REAL(wp) ::   zsm , zsc_f , zsf , zsca, zscn, zscb   !    -         -
       REAL(wp) ::   ze3mr, ze3fr                           !    -         -
       REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a, ze3t_f         !    -         -
       !!----------------------------------------------------------------------
 
-      IF( kt == nit000 ) THEN
+      IF( kt == kit000 ) THEN
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping'
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
       ENDIF
-
+      !
       !                                              ! ----------------------- !
       IF( ln_dynhpg_imp ) THEN                       ! semi-implicite hpg case !
          !                                           ! ----------------------- !
          !
-         IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step
-            DO jk = 1, jpkm1                              ! (only swap)
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                    ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
+         IF( neuler == 0 .AND. kt == kit000 ) THEN        ! Euler time-stepping at first time-step
+            DO jn = 1, kjpt                               ! (only swap)
+               DO jk = 1, jpkm1                              
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        ptran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn)                    ! tn <-- ta
+                     END DO
                   END DO
                END DO
             END DO
          ELSE
-            DO jk = 1, jpkm1
-               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)
-                     !                                         ! tracer content at Before, now and after
-                     ztcb = tb(ji,jj,jk) *  ze3t_b   ;   zscb = sb(ji,jj,jk) * ze3t_b
-                     ztcn = tn(ji,jj,jk) *  ze3t_n   ;   zscn = sn(ji,jj,jk) * ze3t_n
-                     ztca = ta(ji,jj,jk) *  ze3t_a   ;   zsca = sa(ji,jj,jk) * ze3t_a
-                     !
-                     !                                         ! Asselin filter on thickness and tracer content
-                     ze3t_f = atfp * ( ze3t_a - 2.* ze3t_n + ze3t_b )
-                     ztc_f  = atfp * ( ztca   - 2.* ztcn   + ztcb   ) 
-                     zsc_f  = atfp * ( zsca   - 2.* zscn   + zscb   ) 
-                     !
-                     !                                         ! filtered tracer including the correction 
-                     ze3fr = 1.e0  / ( ze3t_n + ze3t_f )
-                     ztf   = ze3fr * ( ztcn   + ztc_f  )
-                     zsf   = ze3fr * ( zscn   + zsc_f  )
-                     !                                         ! mean thickness and tracer
-                     ze3mr = 1.e0  / ( ze3t_a + 2.* ze3t_n + ze3t_b )
-                     ztm   = ze3mr * ( ztca   + 2.* ztcn   + ztcb   )
-                     zsm   = ze3mr * ( zsca   + 2.* zscn   + zscb   )
-!!gm mean e3t have to be saved and used in dynhpg  or it can be recomputed in dynhpg !!
-!!gm                 e3t_m(ji,jj,jk) = 0.25 / ze3mr
-                     !                                         ! swap of arrays
-                     tb(ji,jj,jk) = ztf                             ! tb <-- tn + filter
-                     sb(ji,jj,jk) = zsf
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                    ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
-                     ta(ji,jj,jk) = ztm                             ! ta <-- mean t
-                     sa(ji,jj,jk) = zsm
+            DO jn = 1, kjpt                               ! (only swap)
+               DO jk = 1, jpkm1
+                  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)
+                        !                                         ! tracer content at Before, now and after
+                        ztcb = ptrab(ji,jj,jk,jn) *  ze3t_b  
+                        ztcn = ptran(ji,jj,jk,jn) *  ze3t_n  
+                        ztca = ptraa(ji,jj,jk,jn) *  ze3t_a  
+                        !
+                        !                                         ! Asselin filter on thickness and tracer content
+                        ze3t_f = atfp * ( ze3t_a - 2.* ze3t_n + ze3t_b )
+                        ztc_f  = atfp * ( ztca   - 2.* ztcn   + ztcb   ) 
+                        !
+                        !                                         ! filtered tracer including the correction 
+                        ze3fr = 1.e0  / ( ze3t_n + ze3t_f )
+                        ztf   = ze3fr * ( ztcn   + ztc_f  )
+                        !                                         ! mean thickness and tracer
+                        ze3mr = 1.e0  / ( ze3t_a + 2.* ze3t_n + ze3t_b )
+                        ztm   = ze3mr * ( ztca   + 2.* ztcn   + ztcb   )
+                        !!gm mean e3t have to be saved and used in dynhpg  or it can be recomputed in dynhpg !!
+                        !!gm                 e3t_m(ji,jj,jk) = 0.25 / ze3mr
+                        !                                         ! swap of arrays
+                        ptrab(ji,jj,jk,jn) = ztf                             ! ptrab <-- ptran + filter
+                        ptran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn)              ! ptran <-- ptraa
+                        ptraa(ji,jj,jk,jn) = ztm                             ! ptraa <-- mean t
+                     END DO
                   END DO
                END DO
@@ -341,10 +361,11 @@
          !                                           ! ----------------------- !
          !
-         IF( neuler == 0 .AND. kt == nit000 ) THEN        ! case of Euler time-stepping at first time-step
-            DO jk = 1, jpkm1                              ! No filter nor thickness weighting computation required
-               DO jj = 1, jpj                             ! ONLY swap
-                  DO ji = 1, jpi
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                                 ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
+         IF( neuler == 0 .AND. kt == kit000 ) THEN        ! case of Euler time-stepping at first time-step
+            DO jn = 1, kjpt                               ! No filter nor thickness weighting computation required    
+               DO jk = 1, jpkm1                           ! ONLY swap                        
+                  DO jj = 1, jpj                             
+                     DO ji = 1, jpi
+                        ptran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn)                                 ! tn <-- ta
+                     END DO
                   END DO
                END DO
@@ -352,29 +373,27 @@
             !                                             ! general case (Leapfrog + Asselin filter)
          ELSE                                             ! apply filter on thickness weighted tracer and swap
-            DO jk = 1, jpkm1
-               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)
-                     !                                         ! tracer content at Before, now and after
-                     ztcb = tb(ji,jj,jk) *  ze3t_b   ;   zscb = sb(ji,jj,jk) * ze3t_b
-                     ztcn = tn(ji,jj,jk) *  ze3t_n   ;   zscn = sn(ji,jj,jk) * ze3t_n
-                     ztca = ta(ji,jj,jk) *  ze3t_a   ;   zsca = sa(ji,jj,jk) * ze3t_a
-                     !
-                     !                                         ! Asselin filter on thickness and tracer content
-                     ze3t_f = atfp * ( ze3t_a - 2.* ze3t_n + ze3t_b )
-                     ztc_f  = atfp * ( ztca   - 2.* ztcn   + ztcb   ) 
-                     zsc_f  = atfp * ( zsca   - 2.* zscn   + zscb   ) 
-                     !
-                     !                                         ! filtered tracer including the correction 
-                     ze3fr = 1.e0 / ( ze3t_n + ze3t_f )
-                     ztf   =  ( ztcn  + ztc_f ) * ze3fr
-                     zsf   =  ( zscn  + zsc_f ) * ze3fr
-                     !                                         ! swap of arrays
-                     tb(ji,jj,jk) = ztf                             ! tb <-- tn filtered
-                     sb(ji,jj,jk) = zsf
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                    ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
+            DO jn = 1, kjpt      
+               DO jk = 1, jpkm1
+                  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)
+                        !                                         ! tracer content at Before, now and after
+                        ztcb = ptrab(ji,jj,jk,jn) *  ze3t_b  
+                        ztcn = ptran(ji,jj,jk,jn) *  ze3t_n   
+                        ztca = ptraa(ji,jj,jk,jn) *  ze3t_a  
+                        !
+                        !                                         ! Asselin filter on thickness and tracer content
+                        ze3t_f = atfp * ( ze3t_a - 2.* ze3t_n + ze3t_b )
+                        ztc_f  = atfp * ( ztca   - 2.* ztcn   + ztcb   ) 
+                        !
+                        !                                         ! filtered tracer including the correction 
+                        ze3fr = 1.e0 / ( ze3t_n + ze3t_f )
+                        ztf   =  ( ztcn  + ztc_f ) * ze3fr
+                        !                                         ! swap of arrays
+                        ptrab(ji,jj,jk,jn) = ztf                  ! tb <-- tn filtered
+                        ptran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn)   ! tn <-- ta
+                     END DO
                   END DO
                END DO
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 2024)
@@ -21,5 +21,5 @@
    USE trc_oce         ! share SMS/Ocean variables
    USE trdmod_oce      ! ocean variables trends
-   USE trdmod          ! ocean active tracers trends 
+   USE trdtra          ! ocean active tracers trends 
    USE in_out_manager  ! I/O manager
    USE phycst          ! physical constants
@@ -31,5 +31,6 @@
    PRIVATE
 
-   PUBLIC   tra_qsr        ! routine called by step.F90 (ln_traqsr=T)
+   PUBLIC   tra_qsr       ! routine called by step.F90 (ln_traqsr=T)
+   PUBLIC   tra_qsr_init  ! routine called by opa.F90
 
    !                                           !!* Namelist namtra_qsr: penetrative solar radiation
@@ -87,6 +88,4 @@
       !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
       !!
       INTEGER, INTENT(in) ::   kt     ! ocean time-step
@@ -98,4 +97,5 @@
       REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr            ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0, ze1 , ze2, ze3, zea    ! 3D workspace
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt,  ztrds
       !!----------------------------------------------------------------------
 
@@ -104,13 +104,11 @@
          IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation'
          IF(lwp) WRITE(numout,*) '~~~~~~~'
-         CALL tra_qsr_init
          IF( .NOT.ln_traqsr )   RETURN
       ENDIF
 
       IF( l_trdtra ) THEN      ! Save ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = 0.e0
-      ENDIF
-
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = 0.
+      ENDIF
       
       !                                           ! ============================================== !
@@ -177,5 +175,5 @@
                !
                DO jk = 1, nksr                                        ! compute and add qsr trend to ta
-                  ta(:,:,jk) = ta(:,:,jk) + ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) / fse3t(:,:,jk)
+                  tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) / fse3t(:,:,jk)
                END DO
                zea(:,:,nksr+1:jpk) = 0.e0     ! below 400m set to zero
@@ -184,5 +182,5 @@
             ELSE                                                 !*  Constant Chlorophyll
                DO jk = 1, nksr
-                  ta(:,:,jk) = ta(:,:,jk) + etot3(:,:,jk) * qsr(:,:)
+                  tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + etot3(:,:,jk) * qsr(:,:)
                END DO
             ENDIF
@@ -196,5 +194,5 @@
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ta(ji,jj,jk) = ta(ji,jj,jk) + etot3(ji,jj,jk) * qsr(ji,jj)
+                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + etot3(ji,jj,jk) * qsr(ji,jj)
                   END DO
                END DO
@@ -206,9 +204,11 @@
 
       IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         CALL trd_mod( ztrdt, ztrds, jptra_trd_qsr, 'TRA', kt )
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_qsr, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_qsr, ztrds )
+         DEALLOCATE( ztrdt )    ;        DEALLOCATE( ztrds )
       ENDIF
       !                       ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
       !
    END SUBROUTINE tra_qsr
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 2024)
@@ -17,6 +17,6 @@
    USE phycst          ! physical constant
    USE traqsr          ! solar radiation penetration
-   USE trdmod          ! ocean trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! ocean trends 
+   USE trdtra          ! ocean trends
    USE in_out_manager  ! I/O manager
    USE prtctl          ! Print control
@@ -100,6 +100,4 @@
       !!              - save the trend it in ttrd ('key_trdtra')
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
       !!
       INTEGER, INTENT(in) ::   kt     ! ocean time-step index
@@ -110,4 +108,5 @@
       REAL(wp) ::   zsrau, zse3t, zdep   ! temporary scalars, 1/density, 1/height of box, 1/height of effected water column  
       REAL(wp) ::   zdheat, zdsalt       ! total change of temperature and salinity  
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
 
@@ -123,7 +122,7 @@
 #endif
 
-      IF( l_trdtra ) THEN           ! Save ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = sa(:,:,:) 
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
 
@@ -138,76 +137,75 @@
             IF( lk_vvl) THEN
                zta =  ro0cpr * qns(ji,jj) * zse3t &                  ! temperature : heat flux 
-                &    - emp(ji,jj) * zsrau * tn(ji,jj,1) * zse3t      ! & cooling/heating effet of EMP flux 
+                &    - emp(ji,jj) * zsrau * tsn(ji,jj,1,jp_tem) * zse3t      ! & cooling/heating effet of EMP flux 
                zsa = ( emps(ji,jj) - emp(ji,jj) ) &
-                &                 * zsrau * sn(ji,jj,1)  * zse3t     ! concent./dilut. effect due to sea-ice 
+                &                 * zsrau * tsn(ji,jj,1,jp_sal) * zse3t     ! concent./dilut. effect due to sea-ice 
                                                                      ! melt/formation and (possibly) SSS restoration
             ELSE
                zta =  ro0cpr * qns(ji,jj) * zse3t                    ! temperature : heat flux 
-               zsa =  emps(ji,jj) * zsrau * sn(ji,jj,1) * zse3t      ! salinity :  concent./dilut. effect 
+               zsa =  emps(ji,jj) * zsrau * tsn(ji,jj,1,jp_sal) * zse3t      ! salinity :  concent./dilut. effect 
             ENDIF
-            ta(ji,jj,1) = ta(ji,jj,1) + zta                          ! add the trend to the general tracer trend
-            sa(ji,jj,1) = sa(ji,jj,1) + zsa
+            tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + zta                  ! add the trend to the general tracer trend
+            tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) + zsa
          END DO
       END DO
 
       IF ( ln_rnf .AND. ln_rnf_att ) THEN  
-      ! Concentration / dilution effect on (t,s) due to river runoff  
-        DO jj=1,jpj  
-           DO ji=1,jpi  
-              rnf_dep(ji,jj)=0  
-              DO jk=1,rnf_mod_dep(ji,jj)                          ! recalculates rnf_dep to be the depth  
-                rnf_dep(ji,jj)=rnf_dep(ji,jj)+fse3t(ji,jj,jk)    ! in metres to the bottom of the relevant grid box  
+        ! Concentration / dilution effect on (t,s) due to river runoff  
+        DO jj = 1, jpj  
+           DO ji = 1, jpi  
+              rnf_dep(ji,jj) = 0.  
+              DO jk = 1, rnf_mod_dep(ji,jj)                          ! recalculates rnf_dep to be the depth  
+                rnf_dep(ji,jj) = rnf_dep(ji,jj) + fse3t(ji,jj,jk)    ! in metres to the bottom of the relevant grid box  
               ENDDO  
               zdep = 1. / rnf_dep(ji,jj)  
               zse3t= 1. / fse3t(ji,jj,1)  
-              IF ( rnf_tmp(ji,jj) == -999 )   rnf_tmp(ji,jj)=tn(ji,jj,1)        ! if not specified set runoff temp to be sst  
-  
-              IF ( rnf(ji,jj) .gt. 0.0 ) THEN  
-  
-                IF( lk_vvl) THEN  
-                  !!!indirect flux, concentration or dilution effect  
-                  !!!force a dilution effect in all levels;  
-                  zdheat=0.0  
-                  zdsalt=0.0  
-                  DO jk=1, rnf_mod_dep(ji,jj)  
-                    zta = -tn(ji,jj,jk) * rnf(ji,jj) * zsrau * zdep  
-                    zsa = -sn(ji,jj,jk) * rnf(ji,jj) * zsrau * zdep  
-                    ta(ji,jj,jk)=ta(ji,jj,jk)+zta  
-                    sa(ji,jj,jk)=sa(ji,jj,jk)+zsa  
-                    zdheat=zdheat+zta*fse3t(ji,jj,jk)  
-                    zdsalt=zdsalt+zsa*fse3t(ji,jj,jk)  
+              IF ( rnf_tmp(ji,jj) == -999 )   rnf_tmp(ji,jj) = tsn(ji,jj,1,jp_tem)    ! if not specified set runoff temp to be sst  
+  
+              IF ( rnf(ji,jj) > 0.0 ) THEN  
+  
+                IF( lk_vvl ) THEN  
+                  ! indirect flux, concentration or dilution effect : force a dilution effect in all levels 
+                  zdheat = 0.0  
+                  zdsalt = 0.0  
+                  DO jk = 1, rnf_mod_dep(ji,jj)  
+                    zta = -tsn(ji,jj,jk,jp_tem) * rnf(ji,jj) * zsrau * zdep  
+                    zsa = -tsn(ji,jj,jk,jp_sal) * rnf(ji,jj) * zsrau * zdep  
+                    tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta                  ! add the trend to the general tracer trend
+                    tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
+                    zdheat = zdheat + zta * fse3t(ji,jj,jk)  
+                    zdsalt = zdsalt + zsa * fse3t(ji,jj,jk)  
                   ENDDO  
-                  !!!negate this total change in heat and salt content from top level  
-                  zta=-zdheat*zse3t  
-                  zsa=-zdsalt*zse3t  
-                  ta(ji,jj,1)=ta(ji,jj,1)+zta  
-                  sa(ji,jj,1)=sa(ji,jj,1)+zsa  
+                  ! negate this total change in heat and salt content from top level  
+                  zta = -zdheat * zse3t  
+                  zsa = -zdsalt * zse3t  
+                  tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + zta                  ! add the trend to the general tracer trend
+                  tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) + zsa
     
-                  !!!direct flux  
+                  ! direct flux  
                   zta = rnf_tmp(ji,jj) * rnf(ji,jj) * zsrau * zdep  
                   zsa = rnf_sal(ji,jj) * rnf(ji,jj) * zsrau * zdep  
     
-                  DO jk=1, rnf_mod_dep(ji,jj)  
-                    ta(ji,jj,jk) = ta(ji,jj,jk) + zta  
-                    sa(ji,jj,jk) = sa(ji,jj,jk) + zsa  
+                  DO jk = 1, rnf_mod_dep(ji,jj)  
+                    tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta                  ! add the trend to the general tracer trend
+                    tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
                   ENDDO  
    
                 ELSE  
-                  DO jk=1, rnf_mod_dep(ji,jj)  
-                    zta = ( rnf_tmp(ji,jj)-tn(ji,jj,jk) ) * rnf(ji,jj) * zsrau * zdep  
-                    zsa = ( rnf_sal(ji,jj)-sn(ji,jj,jk) ) * rnf(ji,jj) * zsrau * zdep  
-                    ta(ji,jj,jk) = ta(ji,jj,jk) + zta  
-                    sa(ji,jj,jk) = sa(ji,jj,jk) + zsa  
+                  DO jk = 1, rnf_mod_dep(ji,jj)  
+                    zta = ( rnf_tmp(ji,jj) - tsn(ji,jj,jk,jp_tem) ) * rnf(ji,jj) * zsrau * zdep  
+                    zsa = ( rnf_sal(ji,jj) - tsn(ji,jj,jk,jp_sal) ) * rnf(ji,jj) * zsrau * zdep  
+                    tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta                  ! add the trend to the general tracer trend
+                    tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
                   ENDDO  
                 ENDIF  
   
-              ELSEIF (rnf(ji,jj) .lt. 0.) THEN   !! for use in baltic when flow is out of domain, want no change in temp and sal  
-  
-                IF( lk_vvl) THEN  
-                  !calculate automatic adjustment to sal and temp due to dilution/concentraion effect   
-                  zata = tn(ji,jj,1) * rnf(ji,jj) * zsrau * zse3t  
-                  zasa = sn(ji,jj,1) * rnf(ji,jj) * zsrau * zse3t  
-                  ta(ji,jj,1)=ta(ji,jj,1) + zata  
-                  sa(ji,jj,1)=sa(ji,jj,1) + zasa  
+              ELSE IF( rnf(ji,jj) > 0.) THEN   ! for use in baltic when flow is out of domain, want no change in temp and sal  
+  
+                IF( lk_vvl ) THEN  
+                  ! calculate automatic adjustment to sal and temp due to dilution/concentraion effect   
+                  zata = tsn(ji,jj,1,jp_tem) * rnf(ji,jj) * zsrau * zse3t  
+                  zasa = tsn(ji,jj,1,jp_sal) * rnf(ji,jj) * zsrau * zse3t  
+                  tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + zata                  ! add the trend to the general tracer trend
+                  tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) + zasa
                 ENDIF  
   
@@ -226,12 +224,12 @@
 #endif
               IF( lk_vvl) THEN
-                 zta =  rnf(ji,jj) * zsrau * tn(ji,jj,1) * zse3t       ! & cooling/heating effect of runoff
-                 zsa = 0.e0                                            ! No salinity concent./dilut. effect
+                 zta =    rnf(ji,jj) * zsrau * tsn(ji,jj,1,jp_tem) * zse3t       ! & cooling/heating effect of runoff
+                 zsa =    0.e0                                            ! No salinity concent./dilut. effect
               ELSE
-                 zta =  0.0                                            ! temperature : heat flux 
-                 zsa =  - rnf(ji,jj) * zsrau * sn(ji,jj,1) * zse3t     ! salinity :  concent./dilut. effect
+                 zta =    0.0                                            ! temperature : heat flux 
+                 zsa =  - rnf(ji,jj) * zsrau * tsn(ji,jj,1,jp_sal) * zse3t     ! salinity :  concent./dilut. effect
               ENDIF
-              ta(ji,jj,1) = ta(ji,jj,1) + zta                          ! add the trend to the general tracer trend
-              sa(ji,jj,1) = sa(ji,jj,1) + zsa
+              tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + zta          ! add the trend to the general tracer trend
+              tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) + zsa
            END DO
         END DO
@@ -239,12 +237,14 @@
       ENDIF  
 
-      IF( l_trdtra ) THEN      ! save the sbc trends for diagnostic
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_nsr, 'TRA', kt)
+      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_nsr, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_nsr, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )
       ENDIF
       !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' sbc  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' sbc  - Ta: ', mask1=tmask,   &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
    END SUBROUTINE tra_sbc
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traswp.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traswp.F90	(revision 2024)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traswp.F90	(revision 2024)
@@ -0,0 +1,52 @@
+MODULE traswp
+   !!==============================================================================
+   !!                       ***  MODULE  traswp  ***
+   !! Ocean active tracers: swapping array 
+   !!==============================================================================
+   USE par_oce
+   USE oce             ! ocean dynamics and active tracers
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_swap    ! routine called by step.F90
+   PUBLIC   tra_unswap    ! routine called by step.F90
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Id: trasbc.F90 1739 2009-11-19 13:24:00Z rblod $
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_swap 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_swp  ***
+      !!                   
+      !! ** Purpose : Store temperature and salinity aaray into a 4D array 
+      !!
+      !!----------------------------------------------------------------------
+
+      tsn(:,:,:,jp_tem) = tn(:,:,:)      ;      tsn(:,:,:,jp_sal) = sn(:,:,:)
+      tsb(:,:,:,jp_tem) = tb(:,:,:)      ;      tsb(:,:,:,jp_sal) = sb(:,:,:)
+      tsa(:,:,:,jp_tem) = ta(:,:,:)      ;      tsa(:,:,:,jp_sal) = sa(:,:,:)
+
+   END SUBROUTINE tra_swap
+
+   SUBROUTINE tra_unswap 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_unswap  ***
+      !!                   
+      !! ** Purpose : Store temperature and salinity aaray into a 4D array 
+      !!
+      !!----------------------------------------------------------------------
+
+      tn(:,:,:) = tsn(:,:,:,jp_tem)      ;      sn(:,:,:) = tsn(:,:,:,jp_sal)
+      tb(:,:,:) = tsb(:,:,:,jp_tem)      ;      sb(:,:,:) = tsb(:,:,:,jp_sal)
+      ta(:,:,:) = tsa(:,:,:,jp_tem)      ;      sa(:,:,:) = tsa(:,:,:,jp_sal)
+
+   END SUBROUTINE tra_unswap
+
+   !!======================================================================
+END MODULE traswp
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 2024)
@@ -4,5 +4,6 @@
    !! Ocean active tracers:  vertical component of the tracer mixing trend
    !!==============================================================================
-   !! History :  9.0  !  05-11  (G. Madec)  Original code
+   !! History :  9.0  ! 2005-11  (G. Madec)  Original code
+   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
    !!----------------------------------------------------------------------
 
@@ -21,6 +22,6 @@
 
    USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! ocean active tracers: lateral physics
+   USE trdtra      ! ocean tracers trends 
    USE in_out_manager  ! I/O manager
    USE prtctl          ! Print control
@@ -33,9 +34,9 @@
    PRIVATE
 
-   PUBLIC tra_zdf   !  routine called by step.F90
+   PUBLIC tra_zdf      !  routine called by step.F90
+   PUBLIC tra_zdf_init !  routine called by opa.F90
 
    INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used
       !                                ! defined from ln_zdf...  namlist logicals)
-
    REAL(wp), DIMENSION(jpk) ::   r2dt  ! vertical profile time-step, = 2 rdttra
       !                                ! except at nit000 (=rdttra) if neuler=0
@@ -62,8 +63,6 @@
 
       INTEGER  ::   jk                   ! Dummy loop indices
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdt, ztrds   ! 3D workspace
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace
       !!---------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL zdf_ctl          ! initialisation & control of options
 
       !                                          ! set time step
@@ -74,44 +73,45 @@
       ENDIF
 
-      IF( l_trdtra )   THEN                      ! temporary save of ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:)
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
 
       SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( 0 )    ;    CALL tra_zdf_exp( kt , 'TRA', r2dt, nn_zdfexp,  &
+                         &                 tsb, tsa  , jpts              )    !   explicit scheme
+      CASE ( 1 )    ;    CALL tra_zdf_imp( kt , 'TRA', r2dt,             &
+                         &                 tsb, tsa  , jpts              )    !   implicit scheme
       CASE ( -1 )                                       ! esopa: test all possibility with control print
-         CALL tra_zdf_exp    ( kt, r2dt )
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' zdf0 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_zdf_imp    ( kt, r2dt )
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' zdf1 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-
-      CASE ( 0 )                                       ! explicit scheme
-         CALL tra_zdf_exp    ( kt, r2dt )
-
-      CASE ( 1 )                                       ! implicit scheme 
-         CALL tra_zdf_imp    ( kt, r2dt )
-
+                         CALL tra_zdf_exp( kt , 'TRA', r2dt, nn_zdfexp,  &
+                         &                 tsb, tsa  , jpts              ) 
+                         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask,               &
+                         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+                         CALL tra_zdf_imp( kt , 'TRA', r2dt,             &
+                         &                 tsb, tsa  , jpts              ) 
+                         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask,               &
+                         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       END SELECT
 
       IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
          DO jk = 1, jpkm1
-            ztrdt(:,:,jk) = ( ( ta(:,:,jk) - tb(:,:,jk) ) / r2dt(jk) ) - ztrdt(:,:,jk)
-            ztrds(:,:,jk) = ( ( sa(:,:,jk) - sb(:,:,jk) ) / r2dt(jk) ) - ztrds(:,:,jk)
+            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt(jk) ) - ztrdt(:,:,jk)
+            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt(jk) ) - ztrds(:,:,jk)
          END DO
-         CALL trd_mod( ztrdt, ztrds, jptra_trd_zdf, 'TRA', kt )
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_zdf, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
       ENDIF
 
       !                                          ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' zdf  - Ta: ', mask1=tmask,               &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf  - Ta: ', mask1=tmask,               &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
 
    END SUBROUTINE tra_zdf
 
 
-   SUBROUTINE zdf_ctl
+   SUBROUTINE tra_zdf_init
       !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE zdf_ctl  ***
+      !!                 ***  ROUTINE tra_zdf_init  ***
       !!
       !! ** Purpose :   Choose the vertical mixing scheme
@@ -153,5 +153,5 @@
       IF(lwp) THEN
          WRITE(numout,*)
-         WRITE(numout,*) 'tra:zdf_ctl : vertical tracer physics scheme'
+         WRITE(numout,*) 'tra_zdf_init : vertical tracer physics scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
          IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
@@ -160,5 +160,5 @@
       ENDIF
 
-   END SUBROUTINE zdf_ctl
+   END SUBROUTINE tra_zdf_init
 
    !!==============================================================================
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_exp.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 2024)
@@ -2,6 +2,6 @@
    !!==============================================================================
    !!                    ***  MODULE  trazdf_exp  ***
-   !! Ocean active tracers:  vertical component of the tracer mixing trend using
-   !!                        a split-explicit time-stepping 
+   !! Ocean  tracers:  vertical component of the tracer mixing trend using
+   !!                  a split-explicit time-stepping 
    !!==============================================================================
    !! History :  OPA  !  1990-10  (B. Blanke)  Original code
@@ -16,4 +16,5 @@
    !!             -   !  2005-11  (G. Madec)  New organisation
    !!            3.0  !  2008-04  (G. Madec)  leap-frog time stepping done in trazdf
+   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
    !!----------------------------------------------------------------------
 
@@ -24,11 +25,8 @@
    USE oce             ! ocean dynamics and active tracers 
    USE dom_oce         ! ocean space and time domain 
-   USE domvvl          ! variablevolume levels
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE domvvl          ! variable volume levels
    USE zdf_oce         ! ocean vertical physics
    USE zdfddm          ! ocean vertical physics: double diffusion
    USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
 
    IMPLICIT NONE
@@ -49,5 +47,6 @@
 CONTAINS
 
-   SUBROUTINE tra_zdf_exp( kt, p2dt )
+   SUBROUTINE tra_zdf_exp( kt    , cdtype, p2dt, kn_zdfexp,  &
+      &                    ptrab , ptraa , kjpt              )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_zdf_exp  ***
@@ -58,7 +57,7 @@
       !! ** Method  : - The after tracer fields due to the vertical diffusion
       !!      of tracers alone is given by:
-      !!                zwx = tb + p2dt difft
-      !!      where difft = dz( avt dz(tb) ) = 1/e3t dk+1( avt/e3w dk(tb) )
-      !!           (if lk_zdfddm=T use avs on salinity instead of avt)
+      !!                zwx = ptrab + p2dt difft
+      !!      where difft = dz( avt dz(ptrab) ) = 1/e3t dk+1( avt/e3w dk(ptrab) )
+      !!           (if lk_zdfddm=T use avs on salinity and passive tracers instead of avt)
       !!      difft is evaluated with an Euler split-explit scheme using a
       !!      no flux boundary condition at both surface and bottomi boundaries.
@@ -66,18 +65,24 @@
       !!              - the after tracer fields due to the whole trend is 
       !!      obtained in leap-frog environment by :
-      !!          ta = zwx + p2dt ta
+      !!          ptraa = zwx + p2dt ptraa
       !!              - in case of variable level thickness (lk_vvl=T) the 
       !!     the leap-frog is applied on thickness weighted tracer. That is:
-      !!          ta = [ tb*e3tb + e3tn*( zwx - tb + p2dt ta ) ] / e3tn
+      !!          ptraa = [ ptrab*e3tb + e3tn*( zwx - ptrab + p2dt ptraa ) ] / e3tn
       !!
-      !! ** Action : - after tracer fields (ta,sa) 
+      !! ** Action : - after tracer fields pta
       !!---------------------------------------------------------------------
-      INTEGER , INTENT(in)                 ::   kt     ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpk) ::   p2dt   ! vertical profile of tracer time-step
-      !!
-      INTEGER  ::   ji, jj, jk, jl            ! dummy loop indices
-      REAL(wp) ::   zlavmr, zave3r, ze3tr     ! temporary scalars
-      REAL(wp) ::   zta, zsa, ze3tb           ! temporary scalars
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy, zwz, zww   ! 3D workspace
+      !! * Arguments
+      INTEGER         , INTENT(in   )                                ::   kt          ! ocean 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)        , INTENT(in   ), DIMENSION(jpk)                ::   p2dt        ! vertical profile of tracer time-step
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptrab       ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptraa       ! tracer trend 
+      !! * Local declarations
+      INTEGER  ::  ji, jj, jk, jn, jl        ! dummy loop indices
+      REAL(wp) ::  zlavmr, zave3r, ze3tr     ! temporary scalars
+      REAL(wp) ::  ztra, ze3tb               ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy   ! 3D workspace
       !!---------------------------------------------------------------------
 
@@ -90,62 +95,66 @@
       ! Initializations
       ! ---------------
-      zlavmr = 1. / float( nn_zdfexp )                           ! Local constant
+      zlavmr = 1. / float( kn_zdfexp )                           ! Local constant
       !
-      zwy(:,:, 1 ) = 0.e0        ;   zww(:,:, 1 ) = 0.e0        ! surface boundary conditions: no flux
-      zwy(:,:,jpk) = 0.e0        ;   zww(:,:,jpk) = 0.e0        ! bottom  boundary conditions: no flux
       !
-      zwx(:,:,:)   = tb(:,:,:)   ;   zwz(:,:,:)   = sb(:,:,:)   ! zwx and zwz arrays set to before tracer values
+      DO jn = 1, kjpt
+         !
+         zwy(:,:, 1 ) = 0.e0     ! surface boundary conditions: no flux
+         zwy(:,:,jpk) = 0.e0     ! bottom  boundary conditions: no flux
+         !
+         zwx(:,:,:)   = ptrab(:,:,:,jn)  ! zwx array set to before tracer values
 
-      ! Split-explicit loop  (after tracer due to the vertical diffusion alone)
-      ! -------------------
-      !
-      DO jl = 1, nn_zdfexp
-         !                     ! first vertical derivative
-         DO jk = 2, jpk
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zave3r = 1.e0 / fse3w_n(ji,jj,jk) 
-                  zwy(ji,jj,jk) =   avt(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r
-                  zww(ji,jj,jk) = fsavs(ji,jj,jk) * ( zwz(ji,jj,jk-1) - zwz(ji,jj,jk) ) * zave3r
+         ! Split-explicit loop  (after tracer due to the vertical diffusion alone)
+         ! -------------------
+         !
+         DO jl = 1, kn_zdfexp
+            !                     ! first vertical derivative
+            DO jk = 2, jpk
+               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
+                     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
+                     END IF
+                  END DO
                END DO
             END DO
-         END DO
-         !
-         DO jk = 1, jpkm1      ! second 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
-                  zwz(ji,jj,jk) = zwz(ji,jj,jk) + p2dt(jk) * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) * ze3tr
+            !
+            DO jk = 1, jpkm1      ! second 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
+                  END DO
                END DO
             END DO
+            !
          END DO
+
+         ! 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) - ptrab(ji,jj,jk,jn) + p2dt(jk) * ptraa(ji,jj,jk,jn)       ! total trends * 2*rdt 
+                     ptraa(ji,jj,jk,jn) = ( ze3tb * ptrab(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk)
+                  END DO
+               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.
+                     ptraa(ji,jj,jk,jn) = ( zwx(ji,jj,jk) + p2dt(jk) * ptraa(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
          !
       END DO
-
-      ! 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
-                  zta   = zwx(ji,jj,jk) - tb(ji,jj,jk) + p2dt(jk) * ta(ji,jj,jk)       ! total trends * 2*rdt
-                  zsa   = zwz(ji,jj,jk) - sb(ji,jj,jk) + p2dt(jk) * sa(ji,jj,jk)     
-                  ta(ji,jj,jk) = (  ze3tb * tb(ji,jj,jk) + zta  ) * tmask(ji,jj,jk)
-                  sa(ji,jj,jk) = (  ze3tb * sb(ji,jj,jk) + zsa  ) * tmask(ji,jj,jk)
-               END DO
-            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.
-                  ta(ji,jj,jk) = ( zwx(ji,jj,jk) + p2dt(jk) * ta(ji,jj,jk) ) * tmask(ji,jj,jk)
-                  sa(ji,jj,jk) = ( zwz(ji,jj,jk) + p2dt(jk) * sa(ji,jj,jk) ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ENDIF
       !
    END SUBROUTINE tra_zdf_exp
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 2024)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                 ***  MODULE  trazdf_imp  ***
-   !! Ocean active tracers:  vertical component of the tracer mixing trend
+   !! Ocean  tracers:  vertical component of the tracer mixing trend
    !!======================================================================
    !! History :  OPA  !  1990-10  (B. Blanke)  Original code
@@ -14,4 +14,5 @@
    !!            2.0  !  2006-11  (G. Madec) New step reorganisation
    !!            3.2  !  2009-03  (G. Madec)  heat and salt content trends
+   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
    !!----------------------------------------------------------------------
   
@@ -25,10 +26,7 @@
    USE ldftra_oce      ! ocean active tracers: lateral physics
    USE ldfslp          ! lateral physics: slope of diffusion
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
    USE zdfddm          ! ocean vertical physics: double diffusion
    USE in_out_manager  ! I/O manager
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
    USE domvvl          ! variable volume
    USE ldftra          ! lateral mixing type
@@ -50,6 +48,7 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   
-   SUBROUTINE tra_zdf_imp( kt, p2dt )
+ 
+   SUBROUTINE tra_zdf_imp( kt    , cdtype, p2dt,    &
+      &                    ptrab , ptraa , kjpt     )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_zdf_imp  ***
@@ -71,5 +70,5 @@
       !!                  associated with the lateral mixing, through the
       !!                  update of avt)
-      !!      The vertical diffusion of tracers (t & s) is given by:
+      !!      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).
@@ -78,25 +77,31 @@
       !!      Add this trend to the general trend ta,sa :
       !!         ta = ta + dz( avt dz(t) )
-      !!         (sa = sa + dz( avs dz(t) ) if lk_zdfddm=T )
+      !!         if lk_zdfddm=T, use avs for salinity or for passive tracers
+      !!         (sa = sa + dz( avs dz(t) ) 
       !!
       !!      Third part: recover avt resulting from the vertical physics
       !!      ==========  alone, for further diagnostics (for example to
       !!                  compute the turbocline depth in zdfmxl.F90).
-      !!         avt = zavt
+      !!         if lk_zdfddm=T, use avt = zavt
       !!         (avs = zavs if lk_zdfddm=T )
       !!
-      !! ** Action  : - Update (ta,sa) with before vertical diffusion trend
+      !! ** Action  : - Update (ta) with before vertical diffusion trend
       !!
       !!---------------------------------------------------------------------
+      !! * Modules used
       USE oce    , ONLY :   zwd   => ua   ! ua used as workspace
       USE oce    , ONLY :   zws   => va   ! va  -          -
-      !!
-      INTEGER                 , INTENT(in) ::   kt     ! ocean time-step index
-      REAL(wp), DIMENSION(jpk), INTENT(in) ::   p2dt   ! vertical profile of tracer time-step
-      !!
-      INTEGER  ::   ji, jj, jk            ! dummy loop indices
-      REAL(wp) ::   zavi, zrhs, znvvl     ! temporary scalars
-      REAL(wp) ::   ze3tb, ze3tn, ze3ta   ! variable vertical scale factors
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwi, zwt, zavsi   ! workspace arrays
+      !! * Arguments
+      INTEGER         , INTENT(in   )                                ::   kt             ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                                ::   cdtype         ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)                ::   p2dt        ! vertical profile of tracer time-step
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptrab          ! before and now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptraa          ! tracer trend 
+      !!
+      INTEGER  ::  ji, jj, jk, jn        ! dummy loop indices
+      REAL(wp) ::  zavi, zrhs, znvvl     ! temporary scalars
+      REAL(wp) ::  ze3tb, ze3tn, ze3ta   ! variable vertical scale factors
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwi, zwt   ! workspace arrays
       !!---------------------------------------------------------------------
 
@@ -107,14 +112,12 @@
          zavi = 0.e0      ! avoid warning at compilation phase when lk_ldfslp=F
       ENDIF
-
+      !
       ! I. Local initialization
       ! -----------------------
-      zwd  (1,:, : ) = 0.e0     ;     zwd  (jpi,:,:) = 0.e0
-      zws  (1,:, : ) = 0.e0     ;     zws  (jpi,:,:) = 0.e0
-      zwi  (1,:, : ) = 0.e0     ;     zwi  (jpi,:,:) = 0.e0
-      zwt  (1,:, : ) = 0.e0     ;     zwt  (jpi,:,:) = 0.e0
-      zavsi(1,:, : ) = 0.e0     ;     zavsi(jpi,:,:) = 0.e0
-      zwt  (:,:,jpk) = 0.e0     ;     zwt  ( : ,:,1) = 0.e0
-      zavsi(:,:,jpk) = 0.e0     ;     zavsi( : ,:,1) = 0.e0
+      zwd(1,:, : ) = 0.e0     ;     zwd(jpi,:,:) = 0.e0
+      zws(1,:, : ) = 0.e0     ;     zws(jpi,:,:) = 0.e0
+      zwi(1,:, : ) = 0.e0     ;     zwi(jpi,:,:) = 0.e0
+      zwt(1,:, : ) = 0.e0     ;     zwt(jpi,:,:) = 0.e0
+      zwt(:,:,jpk) = 0.e0     ;     zwt( : ,:,1) = 0.e0
 
       ! I.1 Variable volume : to take into account vertical variable vertical scale factors
@@ -130,233 +133,167 @@
       !     dk[ avt dk[ (t,s) ] ] diffusive trends
 
-
+      !
       ! II.0 Matrix construction
       ! ------------------------
-
+      DO jn = 1, kjpt
+         !
+         !  Matrix construction
+         ! ------------------------
+         IF( cdtype == 'TRA' .AND. jn == jp_tem )  THEN 
 #if defined key_ldfslp
-      ! update and save of avt (and avs if double diffusive mixing)
-      IF( l_traldf_rot ) THEN
-         DO jk = 2, jpkm1
+            ! update and save of avt (and avs if double diffusive mixing)
+            IF( l_traldf_rot ) THEN
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zavi = fsahtw(ji,jj,jk)                       &   ! vertical mixing coef. due to lateral mixing
+                           & * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                           &    + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
+                        zwt(ji,jj,jk) = avt(ji,jj,jk) + zavi              ! zwt=avt+zavi (total vertical mixing coef. on temperature)
+                     END DO
+                  END DO
+               END DO
+            ELSE                         ! no rotation but key_ldfslp defined
+               zwt  (:,:,:) = avt(:,:,:)
+            ENDIF
+#else
+            ! No isopycnal diffusion
+            zwt(:,:,:) = avt(:,:,:)           
+#endif
+            ! Diagonal, inferior, superior  (including the bottom boundary condition via avt masked)
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ze3ta =  ( 1. - znvvl ) +        znvvl   * fse3t_a(ji,jj,jk)   ! after scale factor at T-point
+                     ze3tn =         znvvl   + ( 1. - znvvl ) * 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)
+                 END DO
+               END DO
+            END DO
+            ! Surface boudary conditions
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zavi = fsahtw(ji,jj,jk)                       &   ! vertical mixing coef. due to lateral mixing
-                     & * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
-                     &    + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
-                  zwt(ji,jj,jk) = avt(ji,jj,jk) + zavi              ! zwt=avt+zavi (total vertical mixing coef. on temperature)
-# if defined key_zdfddm
-                  zavsi(ji,jj,jk) = fsavs(ji,jj,jk) + zavi          ! dd mixing: zavsi = total vertical mixing coef. on salinity
-# endif
-               END DO
-            END DO
-         END DO
-      ELSE                         ! no rotation but key_ldfslp defined
-         zwt  (:,:,:) = avt(:,:,:)
-# if defined key_zdfddm
-         zavsi(:,:,:) = avs(:,:,:)       ! avs /= avt (double diffusion mixing)
-# endif
-      ENDIF   
+                 ze3ta = ( 1. - znvvl ) +  znvvl * fse3t_a(ji,jj,1)    ! after scale factor at T-point
+                 zwi(ji,jj,1) = 0.e0
+                 zwd(ji,jj,1) = ze3ta - zws(ji,jj,1)
+               END DO
+            END DO
+            !
+         ELSE IF( ( cdtype == 'TRA' .AND. jn == jp_sal ) .OR. ( cdtype == 'TRC' .AND. jn == 1 ) ) THEN
+#if defined key_ldfslp
+            ! update and save of avt (and avs if double diffusive mixing)
+            IF( l_traldf_rot ) THEN
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zavi = fsahtw(ji,jj,jk)                       &   ! vertical mixing coef. due to lateral mixing
+                           & * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                           &    + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
+                        zwt(ji,jj,jk) = fsavs(ji,jj,jk) + zavi              ! zwt=avt+zavi (total vertical mixing coef. on temperature)
+                     END DO
+                  END DO
+               END DO
+            ELSE                         ! no rotation but key_ldfslp defined
+               zwt  (:,:,:) = fsavs(:,:,:)
+            ENDIF
 #else
-      ! No isopycnal diffusion
-      zwt(:,:,:) = avt(:,:,:)
-# if defined key_zdfddm
-      zavsi(:,:,:) = avs(:,:,:)
-# endif
-
+            ! No isopycnal diffusion
+            zwt(:,:,:) = fsavs(:,:,:)           
 #endif
-
-      ! Diagonal, inferior, superior  (including the bottom boundary condition via avt masked)
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ze3ta =  ( 1. - znvvl )   &                            ! after scale factor at T-point
-                  &   +        znvvl    * fse3t_a(ji,jj,jk) 
-               ze3tn =    znvvl          &                            ! now   scale factor at T-point
-                  &   + ( 1. - znvvl ) * fse3t_n(ji,jj,jk)
-               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)
-            END DO
-         END DO
-      END DO
-
-      ! Surface boudary conditions
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ze3ta = ( 1. - znvvl )        &                           ! after scale factor at T-point
-               &   +       znvvl      * fse3t_a(ji,jj,1) 
-            zwi(ji,jj,1) = 0.e0
-            zwd(ji,jj,1) = ze3ta - zws(ji,jj,1)
-         END DO
-      END DO
-
-
-      ! II.1. Vertical diffusion on t
-      ! ---------------------------
-
-      !! Matrix inversion from the first level
-      !!----------------------------------------------------------------------
-      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
-      !
-      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
-      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
-      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
-      !        (        ...               )( ...  ) ( ...  )
-      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
-      !
-      !   m is decomposed in the product of an upper and lower triangular matrix
-      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
-      !   The second member is in 2d array zwy
-      !   The solution is in 2d array zwx
-      !   The 3d arry zwt is a work space array
-      !   zwy is used and then used as a work space array : its value is modified!
-
-      ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            zwt(ji,jj,1) = zwd(ji,jj,1)
-         END DO
-      END DO
-      DO jk = 2, jpkm1
+            ! Diagonal, inferior, superior  (including the bottom boundary condition via avt masked)
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ze3ta =  ( 1. - znvvl ) +        znvvl   * fse3t_a(ji,jj,jk)   ! after scale factor at T-point
+                     ze3tn =         znvvl   + ( 1. - znvvl ) * 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)
+                 END DO
+               END DO
+            END DO
+            ! Surface boudary conditions
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                 ze3ta = ( 1. - znvvl ) +  znvvl * fse3t_a(ji,jj,1)    ! after scale factor at T-point
+                 zwi(ji,jj,1) = 0.e0
+                 zwd(ji,jj,1) = ze3ta - zws(ji,jj,1)
+               END DO
+            END DO
+            !
+         END IF
+
+         ! II.1. Vertical diffusion on tracer
+         ! ---------------------------
+
+         !! Matrix inversion from the first level
+         !!----------------------------------------------------------------------
+         !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+         !
+         !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+         !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+         !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+         !        (        ...               )( ...  ) ( ...  )
+         !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+         !
+         !   m is decomposed in the product of an upper and lower triangular matrix
+         !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+         !   The second member is in 2d array zwy
+         !   The solution is in 2d array zwx
+         !   The 3d arry zwt is a work space array
+         !   zwy is used and then used as a work space array : its value is modified!
+         
+         ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
-               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)  /zwt(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-
-      ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,1)
-            ze3tn = ( 1. - znvvl ) + znvvl * fse3t(ji,jj,1)
-            ta(ji,jj,1) = ze3tb * tb(ji,jj,1) + p2dt(1) * ze3tn * ta(ji,jj,1)
-         END DO
-      END DO
-      DO jk = 2, jpkm1
+               zwt(ji,jj,1) = zwd(ji,jj,1)
+            END DO
+         END DO
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)  /zwt(ji,jj,jk-1)
+               END DO
+            END DO
+         END DO
+         
+         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
-               ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,jk)
-               ze3tn = ( 1. - znvvl ) + znvvl * fse3t  (ji,jj,jk)
-               zrhs = ze3tb * tb(ji,jj,jk) + p2dt(jk) * ze3tn * ta(ji,jj,jk)   ! zrhs=right hand side 
-               ta(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * ta(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-
-      ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
-      ! Save the masked temperature after in ta
-      ! (c a u t i o n:  temperature not its trend, Leap-frog scheme done it will not be done in tranxt)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            ta(ji,jj,jpkm1) = ta(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
-         END DO
-      END DO
-      DO jk = jpk-2, 1, -1
+               ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,1)
+               ze3tn = ( 1. - znvvl ) + znvvl * fse3t(ji,jj,1)
+               ptraa(ji,jj,1,jn) = ze3tb * ptrab(ji,jj,1,jn) + p2dt(1) * ze3tn * ptraa(ji,jj,1,jn)
+            END DO
+         END DO
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,jk)
+                  ze3tn = ( 1. - znvvl ) + znvvl * fse3t  (ji,jj,jk)
+                  zrhs = ze3tb * ptrab(ji,jj,jk,jn) + p2dt(jk) * ze3tn * ptraa(ji,jj,jk,jn)   ! zrhs=right hand side 
+                  ptraa(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * ptraa(ji,jj,jk-1,jn)
+               END DO
+            END DO
+         END DO
+         
+         ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
+         ! Save the masked temperature after in ta
+         ! (c a u t i o n:  temperature not its trend, Leap-frog scheme done it will not be done in tranxt)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
-               ta(ji,jj,jk) = ( ta(ji,jj,jk) - zws(ji,jj,jk) * ta(ji,jj,jk+1) ) / zwt(ji,jj,jk) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! II.2 Vertical diffusion on salinity
-      ! -----------------------------------
-
-#if defined key_zdfddm
-      ! Rebuild the Matrix as avt /= avs
-
-      ! Diagonal, inferior, superior  (including the bottom boundary condition via avs masked)
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ze3ta =  ( 1. - znvvl )                        &         ! after scale factor at T-point
-                  &   +        znvvl   * fse3t_a(ji,jj,jk)           
-               ze3tn =    znvvl                               &         ! now   scale factor at T-point
-                  &   + ( 1. - znvvl ) * fse3t_n(ji,jj,jk)
-               zwi(ji,jj,jk) = - p2dt(jk) * zavsi(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) )
-               zws(ji,jj,jk) = - p2dt(jk) * zavsi(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) )
-               zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! Surface boudary conditions
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ze3ta = ( 1. - znvvl ) + znvvl * fse3t_a(ji,jj,1)
-            zwi(ji,jj,1) = 0.e0
-            zwd(ji,jj,1) = ze3ta - zws(ji,jj,1)
-         END DO
-      END DO
-#endif
-
-
-      !! Matrix inversion from the first level
-      !!----------------------------------------------------------------------
-      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
-      !
-      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
-      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
-      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
-      !        (        ...               )( ...  ) ( ...  )
-      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
-      !
-      !   m is decomposed in the product of an upper and lower triangular
-      !   matrix
-      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
-      !   The second member is in 2d array zwy
-      !   The solution is in 2d array zwx
-      !   The 3d arry zwt is a work space array
-      !   zwy is used and then used as a work space array : its value is modified!
-
-      ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            zwt(ji,jj,1) = zwd(ji,jj,1)
-         END DO
-      END DO
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)  /zwt(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-
-      ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            ze3tb = ( 1. - znvvl )   &                                           ! before scale factor at T-point
-               &   +  znvvl       * fse3t_b(ji,jj,1)
-            ze3tn = ( 1. - znvvl ) + znvvl * fse3t  (ji,jj,1)                    ! now    scale factor at T-point
-            sa(ji,jj,1) = ze3tb * sb(ji,jj,1) + p2dt(1) * ze3tn * sa(ji,jj,1)
-         END DO
-      END DO
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ze3tb = ( 1. - znvvl )   &                                        ! before scale factor at T-point
-                  &   +  znvvl       * fse3t_b(ji,jj,jk)
-               ze3tn = ( 1. - znvvl ) + znvvl * fse3t  (ji,jj,jk)                ! now    scale factor at T-point
-               zrhs = ze3tb * sb(ji,jj,jk) + p2dt(jk) * ze3tn * sa(ji,jj,jk)     ! zrhs=right hand side
-               sa(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *sa(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-
-      ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
-      ! Save the masked temperature after in ta
-      ! (c a u t i o n:  temperature not its trend, Leap-frog scheme done it will not be done in tranxt)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            sa(ji,jj,jpkm1) = sa(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
-         END DO
-      END DO
-      DO jk = jpk-2, 1, -1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               sa(ji,jj,jk) = ( sa(ji,jj,jk) - zws(ji,jj,jk) * sa(ji,jj,jk+1) ) / zwt(ji,jj,jk) * tmask(ji,jj,jk)
-            END DO
-         END DO
+               ptraa(ji,jj,jpkm1,jn) = ptraa(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
+            END DO
+         END DO
+         DO jk = jpk-2, 1, -1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  ptraa(ji,jj,jk,jn) = ( ptraa(ji,jj,jk,jn) - zws(ji,jj,jk) * ptraa(ji,jj,jk+1,jn) ) &
+                  &                    / zwt(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
       END DO
       !
Index: /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/zpshde.F90
===================================================================
--- /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 2023)
+++ /branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 2024)
@@ -4,7 +4,15 @@
    !! z-coordinate - partial step : Horizontal Derivative
    !!==============================================================================
+   !! History :
+   !!       OPA   8.5  !  2002-04  (A. Bozec)  Original code
+   !!             8.5  !  2002-08  (G. Madec E. Durand)  Optimization and Free form
+   !!             9.0  !  2004-03  (C. Ethe)  adapted for passive tracers
+   !!      NEMO   3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!==============================================================================
    
    !!----------------------------------------------------------------------
    !!   zps_hde      :  Horizontal DErivative of T, S and rd at the last
+   !!                   ocean level (Z-coord. with Partial Steps)
+   !!   zps_hde_trc  :  Horizontal DErivative of passive tracers at the last
    !!                   ocean level (Z-coord. with Partial Steps)
    !!----------------------------------------------------------------------
@@ -22,4 +30,8 @@
    !! * Routine accessibility
    PUBLIC zps_hde          ! routine called by step.F90
+   PUBLIC zps_hde_init     ! routine called by opa.F90
+#if defined key_top
+   PUBLIC zps_hde_trc 
+#endif
 
    !! * module variables
@@ -37,5 +49,4 @@
    !!----------------------------------------------------------------------
 CONTAINS
-
    SUBROUTINE zps_hde ( kt, ptem, psal, prd ,   &
                             pgtu, pgsu, pgru,   &
@@ -84,48 +95,18 @@
       !!              - pgtv, pgsv, pgrv: horizontal gradient of T, S
       !!                and rd at V-points 
-      !!
-      !! History :
-      !!   8.5  !  02-04  (A. Bozec)  Original code
-      !!   8.5  !  02-08  (G. Madec E. Durand)  Optimization and Free form
       !!----------------------------------------------------------------------
       !! * Arguments
       INTEGER, INTENT( in ) ::   kt ! ocean time-step index
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
-         ptem, psal, prd            ! 3D T, S and rd fields
-      REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   &
-         pgtu, pgsu, pgru,       &  ! horizontal grad. of T, S and rd at u- 
-         pgtv, pgsv, pgrv           ! and v-points of the partial step level
-
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in )  :: ptem, psal, prd  ! 3D T, S and rd fields
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT( out ) :: pgtu, pgsu, pgru !  horizontal grad. of T, S and rd at u-point 
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT( out ) :: pgtv, pgsv, pgrv !  horizontal grad. of T, S and rd at v-point 
       !! * Local declarations
-      INTEGER ::   ji, jj,       &  ! Dummy loop indices
-                   iku,ikv          ! partial step level at u- and v-points
-      REAL(wp), DIMENSION(jpi,jpj) ::   &
-         zti, ztj, zsi, zsj,     &  ! interpolated value of T, S 
-         zri, zrj,               &  ! and rd
-         zhgi, zhgj                 ! depth of interpolation for eos2d
-      REAL(wp) ::   &
-         ze3wu, ze3wv,           &  ! temporary scalars
-         zmaxu1, zmaxu2,         &  !    "         "
-         zmaxv1, zmaxv2             !    "         "
-
-      ! Initialization (first time-step only): compute mbatu and mbatv
-      IF( kt == nit000 ) THEN
-         mbatu(:,:) = 0
-         mbatv(:,:) = 0
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               mbatu(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1, 2 )
-               mbatv(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1, 2 )
-            END DO
-         END DO
-         zti(:,:) = FLOAT( mbatu(:,:) )
-         ztj(:,:) = FLOAT( mbatv(:,:) )
-         ! lateral boundary conditions: T-point, sign unchanged
-         CALL lbc_lnk( zti , 'U', 1. )
-         CALL lbc_lnk( ztj , 'V', 1. )
-         mbatu(:,:) = MAX( INT( zti(:,:) ), 2 )
-         mbatv(:,:) = MAX( INT( ztj(:,:) ), 2 )
-      ENDIF
-      
+      INTEGER ::   ji , jj          ! Dummy loop indices
+      INTEGER ::   iku, ikv         ! partial step level at u- and v-points
+      REAL(wp), DIMENSION(jpi,jpj) ::   zti, ztj, zsi, zsj   ! interpolated value of T, S
+      REAL(wp), DIMENSION(jpi,jpj) ::   zri, zrj             ! interpolated value of rd
+      REAL(wp), DIMENSION(jpi,jpj) ::   zhgi, zhgj           ! depth of interpolation for eos2d
+      REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv                 ! temporary scalars
+
 
       ! Interpolation of T and S at the last ocean level
@@ -140,18 +121,13 @@
             iku = mbatu(ji,jj)
             ikv = mbatv(ji,jj)
-
             ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
             ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
-            zmaxu1 =  ze3wu / fse3w(ji+1,jj  ,iku)
-            zmaxu2 = -ze3wu / fse3w(ji  ,jj  ,iku)
-            zmaxv1 =  ze3wv / fse3w(ji  ,jj+1,ikv)
-            zmaxv2 = -ze3wv / fse3w(ji  ,jj  ,ikv)
 
             ! i- direction
-
             IF( ze3wu >= 0. ) THEN      ! case 1
                ! interpolated values of T and S
-               zti(ji,jj) = ptem(ji+1,jj,iku) + zmaxu1 * ( ptem(ji+1,jj,iku-1) - ptem(ji+1,jj,iku) )
-               zsi(ji,jj) = psal(ji+1,jj,iku) + zmaxu1 * ( psal(ji+1,jj,iku-1) - psal(ji+1,jj,iku) )
+               zmaxu =  ze3wu / fse3w(ji+1,jj,iku)
+               zti(ji,jj) = ptem(ji+1,jj,iku) + zmaxu * ( ptem(ji+1,jj,iku-1) - ptem(ji+1,jj,iku) )
+               zsi(ji,jj) = psal(ji+1,jj,iku) + zmaxu * ( psal(ji+1,jj,iku-1) - psal(ji+1,jj,iku) )
                ! depth of the partial step level
                zhgi(ji,jj) = fsdept(ji,jj,iku)
@@ -162,6 +138,7 @@
             ELSE                        ! case 2
                ! interpolated values of T and S
-               zti(ji,jj) = ptem(ji,jj,iku) + zmaxu2 * ( ptem(ji,jj,iku-1) - ptem(ji,jj,iku) )
-               zsi(ji,jj) = psal(ji,jj,iku) + zmaxu2 * ( psal(ji,jj,iku-1) - psal(ji,jj,iku) )
+               zmaxu =  -ze3wu / fse3w(ji,jj,iku)
+               zti(ji,jj) = ptem(ji,jj,iku) + zmaxu * ( ptem(ji,jj,iku-1) - ptem(ji,jj,iku) )
+               zsi(ji,jj) = psal(ji,jj,iku) + zmaxu * ( psal(ji,jj,iku-1) - psal(ji,jj,iku) )
                ! depth of the partial step level
                zhgi(ji,jj) = fsdept(ji+1,jj,iku)
@@ -172,9 +149,9 @@
 
             ! j- direction
-
             IF( ze3wv >= 0. ) THEN      ! case 1
                ! interpolated values of T and S
-               ztj(ji,jj) = ptem(ji,jj+1,ikv) + zmaxv1 * ( ptem(ji,jj+1,ikv-1) - ptem(ji,jj+1,ikv) )
-               zsj(ji,jj) = psal(ji,jj+1,ikv) + zmaxv1 * ( psal(ji,jj+1,ikv-1) - psal(ji,jj+1,ikv) )
+               zmaxv =  ze3wv / fse3w(ji,jj+1,ikv)
+               ztj(ji,jj) = ptem(ji,jj+1,ikv) + zmaxv * ( ptem(ji,jj+1,ikv-1) - ptem(ji,jj+1,ikv) )
+               zsj(ji,jj) = psal(ji,jj+1,ikv) + zmaxv * ( psal(ji,jj+1,ikv-1) - psal(ji,jj+1,ikv) )
                ! depth of the partial step level
                zhgj(ji,jj) = fsdept(ji,jj,ikv) 
@@ -185,6 +162,7 @@
             ELSE                        ! case 2
                ! interpolated values of T and S
-               ztj(ji,jj) = ptem(ji,jj,ikv) + zmaxv2 * ( ptem(ji,jj,ikv-1) - ptem(ji,jj,ikv) )
-               zsj(ji,jj) = psal(ji,jj,ikv) + zmaxv2 * ( psal(ji,jj,ikv-1) - psal(ji,jj,ikv) ) 
+               zmaxv =  -ze3wv / fse3w(ji,jj,ikv)
+               ztj(ji,jj) = ptem(ji,jj,ikv) + zmaxv * ( ptem(ji,jj,ikv-1) - ptem(ji,jj,ikv) )
+               zsj(ji,jj) = psal(ji,jj,ikv) + zmaxv * ( psal(ji,jj,ikv-1) - psal(ji,jj,ikv) ) 
                ! depth of the partial step level
                zhgj(ji,jj) = fsdept(ji,jj+1,ikv) 
@@ -238,4 +216,119 @@
    END SUBROUTINE zps_hde
 
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   SUBROUTINE zps_hde_trc ( kt, kjpt, ptra, pgtru, pgtrv )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE zps_hde_trc  ***
+      !!                    
+      !! ** Purpose :   Compute the horizontal derivative of passive tracers
+      !!      TRA at u- and v-points with a linear interpolation for z-coordinate
+      !!      with partial steps.
+      !!
+      !! ** Method  :   the same for T & S
+      !!
+      !! ** Action  : - pgtru : horizontal gradient of TRA at U-points 
+      !!              - pgtrv : horizontal gradient of TRA at V-points 
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER                              , INTENT( in )  ::  kt    ! ocean time-step index
+      INTEGER                              , INTENT( in )  ::  kjpt  ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT( in )  ::  ptra  ! 4D tracers fields
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT( out ) ::  pgtru, pgtrv  ! horizontal grad. of TRA u- and v-points 
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jn      ! Dummy loop indices
+      INTEGER  ::   iku, ikv        ! partial step level at u- and v-points
+      REAL(wp) ::   ztrai, ztraj, ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      DO jn = 1, kjpt
+         ! Interpolation of passive tracers at the last ocean level
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               ! last level
+               iku = mbatu(ji,jj)
+               ikv = mbatv(ji,jj)
+               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
+               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+
+               ! i- direction
+               IF( ze3wu >= 0. ) THEN      ! case 1
+                  zmaxu =  ze3wu / fse3w(ji+1,jj,iku)
+                  ! interpolated values of passive tracers
+                  ztrai = ptra(ji+1,jj,iku,jn) + zmaxu * ( ptra(ji+1,jj,iku-1,jn) - ptra(ji+1,jj,iku,jn) )
+                  ! gradient of passive tracers
+                  pgtru(ji,jj,jn) = umask(ji,jj,1) * ( ztrai - ptra(ji,jj,iku,jn) )
+               ELSE                        ! case 2
+                  zmaxu = -ze3wu / fse3w(ji,jj,iku)
+                  ! interpolated values of passive tracers
+                  ztrai = ptra(ji,jj,iku,jn) + zmaxu * ( ptra(ji,jj,iku-1,jn) - ptra(ji,jj,iku,jn) )
+                  ! gradient of passive tracers
+                  pgtru(ji,jj,jn) = umask(ji,jj,1) * ( ptra(ji+1,jj,iku,jn) - ztrai )
+               ENDIF
+
+               ! j- direction
+               IF( ze3wv >= 0. ) THEN      ! case 1
+                  zmaxv =  ze3wv / fse3w(ji,jj+1,ikv)
+                  ! interpolated values of passive tracers
+                  ztraj = ptra(ji,jj+1,ikv,jn) + zmaxv * ( ptra(ji,jj+1,ikv-1,jn) - ptra(ji,jj+1,ikv,jn) )
+                  ! gradient of passive tracers
+                  pgtrv(ji,jj,jn) = vmask(ji,jj,1) * ( ztraj - ptra(ji,jj,ikv,jn) )
+               ELSE                        ! case 2
+                  zmaxv =  -ze3wv / fse3w(ji,jj,ikv)
+                  ! interpolated values of passive tracers
+                  ztraj = ptra(ji,jj,ikv,jn) + zmaxv * ( ptra(ji,jj,ikv-1,jn) - ptra(ji,jj,ikv,jn) )
+                  ! gradient of passive tracers
+                  pgtrv(ji,jj,jn) = vmask(ji,jj,1) * ( ptra(ji,jj+1,ikv,jn) - ztraj )
+               ENDIF
+# if ! defined key_vectopt_loop
+            END DO
+# endif
+         END DO
+
+         ! Lateral boundary conditions on each gradient
+         CALL lbc_lnk( pgtru(:,:,jn) , 'U', -1. )
+         CALL lbc_lnk( pgtrv(:,:,jn) , 'V', -1. )
+
+      END DO
+
+   END SUBROUTINE zps_hde_trc
+#endif
+
+   SUBROUTINE zps_hde_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE zps_hde_init  ***
+      !!
+      !! ** Purpose : Computation of bottom ocean level index at U- and V-points 
+      !!                    
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj           ! Dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj) :: zti, ztj     !  temporary arrays 
+      !!----------------------------------------------------------------------
+
+      mbatu(:,:) = 0
+      mbatv(:,:) = 0
+      DO jj = 1, jpjm1
+         DO ji = 1, fs_jpim1   ! vector opt.
+            mbatu(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1, 2 )
+            mbatv(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1, 2 )
+         END DO
+      END DO
+      zti(:,:) = FLOAT( mbatu(:,:) )
+      ztj(:,:) = FLOAT( mbatv(:,:) )
+      ! lateral boundary conditions: T-point, sign unchanged
+      CALL lbc_lnk( zti , 'U', 1. )
+      CALL lbc_lnk( ztj , 'V', 1. )
+      mbatu(:,:) = MAX( INT( zti(:,:) ), 2 )
+      mbatv(:,:) = MAX( INT( ztj(:,:) ), 2 )
+
+   END SUBROUTINE zps_hde_init
    !!======================================================================
 END MODULE zpshde
