Index: trunk/NEMO/TOP_SRC/TRP/trcadv_cen2.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcadv_cen2.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcadv_cen2.F90	(revision 941)
@@ -0,0 +1,406 @@
+MODULE trcadv_cen2
+   !!======================================================================
+   !!                       ***  MODULE  trcadv_cen2  ***
+   !! Ocean passive tracers:  horizontal & vertical advective tracer trend
+   !!======================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_adv_cen2 : update the tracer trend with the horizontal
+   !!                  and vertical advection trends using a 2nd order 
+   !!                  centered finite difference scheme
+   !!----------------------------------------------------------------------
+   USE oce_trc             ! ocean dynamics and active tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE trcbbl              ! advective passive tracers in the BBL
+   USE prtctl_trc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_adv_cen2    ! routine called by trcstp.F90
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   upsmsk    !: mixed upstream/centered scheme near some straits
+   !                                                   !  and in closed seas (orca 2 and 4 configurations)
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   !!----------------------------------------------------------------------
+   !!   Default option :             2nd order centered scheme (k-j-i loop)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE trc_adv_cen2( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_cen2  ***
+      !!                 
+      !! ** Purpose :   Compute the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations.
+      !!
+      !! ** Method  :   The advection is evaluated by a second order centered
+      !!      scheme using now fields (leap-frog scheme). In specific areas
+      !!      (vicinity of major river mouths, some straits, or where tn is
+      !!      is approaching the freezing point) it is mixed with an upstream
+      !!      scheme for stability reasons.
+      !!        Part 0 : compute the upstream / centered flag
+      !!                 (3D array, zind, defined at T-point (0<zind<1))
+      !!        Part I : horizontal advection
+      !!      * centered flux:
+      !!         * s-coordinate (ln_sco=T) or
+      !!         * z-coordinate with partial steps (ln_zps=T),
+      !!        the vertical scale factors e3. are inside the derivatives:
+      !!               zcenu = e2u*e3u  un  mi(tn)
+      !!               zcenv = e1v*e3v  vn  mj(tn)
+      !!         * z-coordinate (default key), e3t=e3u=e3v:
+      !!               zcenu = e2u  un  mi(tn)
+      !!               zcenv = e1v  vn  mj(tn)
+      !!      * horizontal advective trend (divergence of the fluxes)
+      !!         * s-coordinate (ln_sco=T) or
+      !!         * z-coordinate with partial steps (ln_zps=T)
+      !!               ztra = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }
+      !!         * z-coordinate (default key), e3t=e3u=e3v:
+      !!               ztra = 1/(e1t*e2t) { di-1[zwx] + dj-1[zwy] }
+      !!      * Add this trend now to the general trend of tracer tra:
+      !!              tra = tra + ztra
+      !!      * trend diagnostic ('key_trc_diatrd'): the trend is saved
+      !!      for diagnostics. The trends saved is expressed as
+      !!      Uh.gradh(T)
+      !!
+      !!         Part II : vertical advection
+      !!      For any tracer  the advective trend is computed as follows :
+      !!            ztra = 1/e3t dk+1[ zwz ]
+      !!      where the vertical advective flux, zwz, is given by :
+      !!            zwz = zcofk * zupst + (1-zcofk) * zcent
+      !!      with 
+      !!        zupsv = upstream flux = wn * (trb(k) or trb(k-1) ) [wn>0 or <0]
+      !!        zcenu = centered flux = wn * mk(trn)
+      !!         The surface boundary condition is : 
+      !!      rigid-lid (default option) : zero advective flux
+      !!      free-surf ("key_fresurf_cstvol") : wn(:,:,1) * trn(:,:,1)
+      !!         Add this trend now to the general trend of tracer tra :
+      !!            tra = tra + ztra
+      !!         Trend diagnostic ('key_trc_diatrd'): the trend is saved for
+      !!      diagnostics. The trends saved is expressed as :
+      !!             save trend =  w.gradz(T) = ztra - trn divn.
+      !!
+      !! ** Action : - update tra with the now advective tracer trends
+      !!             - save the trends in trtrd ('key_trc_diatrd')
+      !!
+      !! History :
+      !!   8.2  !  01-08  (M-A Filiberti, and M.Levy)  trahad+trazad = traadv 
+      !!   8.5  !  02-06  (G. Madec, C. Ethe)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce_trc            , zwx => ua,  &  ! use ua as workspace
+         &                     zwy => va      ! use va as workspace
+#if defined key_trcbbl_adv
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  &  ! temporary arrays
+         &         zun, zvn, zwn
+#else
+      USE oce_trc            , zun => un,  &  ! When no bbl, zun == un
+         &                     zvn => vn,  &  ! When no bbl, zvn == vn
+         &                     zwn => wn      ! When no bbl, zwn == wn
+#endif
+
+ 
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+ 
+      !! * Local save
+      REAL(wp), DIMENSION(jpi,jpj), SAVE ::   &
+         zbtr2
+ 
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk, jn             ! dummy loop indices
+      REAL(wp) ::                           &
+         zbtr, ztra, zfui, zfvj,            &  ! temporary scalars
+         zhw, ze3tr, zcofi, zcofj,          &  !    "         "
+         zupsut, zupsvt,                    &  !    "         "
+         zfp_ui, zfp_vj, zfm_ui, zfm_vj,    &  !    "         "
+         zcofk, zupst, zcent,               &  !    "         "
+         zfp_w, zfm_w,                      &  !    "         "
+         zcenut, zcenvt                        ! 
+
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zind                              ! temporary workspace arrays
+#if defined key_trc_diatrd
+      REAL(wp) ::                           &
+         ztai, ztaj,                        &  ! temporary scalars
+         zfui1, zfvj1                          !    "         "
+#endif
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_adv_cen2 : 2nd order centered advection scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case'
+         IF(lwp) WRITE(numout,*)
+ 
+         upsmsk(:,:) = 0.e0                              ! not upstream by default
+         IF( cp_cfg == "orca" )   CALL ups_orca_set      ! set mixed Upstream/centered scheme near some straits
+         !                                               ! and in closed seas (orca2 and orca4 only)
+         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
+      ENDIF
+
+#if defined key_trcbbl_adv
+
+      ! Advective bottom boundary layer 
+      ! -------------------------------
+      zun(:,:,:) = un(:,:,:) - u_trc_bbl(:,:,:)
+      zvn(:,:,:) = vn(:,:,:) - v_trc_bbl(:,:,:)
+      zwn(:,:,:) = wn(:,:,:) + w_trc_bbl(:,:,:)
+#endif
+
+      ! Upstream / centered scheme indicator
+      ! ------------------------------------
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zind(ji,jj,jk) = MAX (   &
+                  rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows)
+                  upsmsk(ji,jj)                      &  ! some of some straits
+#if defined key_lim3 || defined key_lim2
+                  !                                     ! below ice covered area (if tn < "freezing"+0.1 )
+                  , MAX(  0., SIGN( 1., fzptn(ji,jj) + 0.1 - tn(ji,jj,jk) )  ) * tmask(ji,jj,jk)   &
+#endif
+                  &                  )
+            END DO
+         END DO
+      END DO
+
+
+
+      DO jn = 1, jptra
+         ! I. Horizontal advective fluxes
+         ! ------------------------------
+         
+         ! Second order centered tracer flux at u and v-points
+         
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            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
+#if ! defined key_zco
+                  zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
+                  zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
+#else
+                  zfui = 0.5 * e2u(ji,jj) * zun(ji,jj,jk)
+                  zfvj = 0.5 * e1v(ji,jj) * zvn(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 )
+                  zupsut = zfp_ui * trb(ji,jj,jk,jn) + zfm_ui * trb(ji+1,jj  ,jk,jn)
+                  zupsvt = zfp_vj * trb(ji,jj,jk,jn) + zfm_vj * trb(ji  ,jj+1,jk,jn)
+                  ! centered scheme
+                  zcenut = zfui * ( trn(ji,jj,jk,jn) + trn(ji+1,jj  ,jk,jn) )
+                  zcenvt = zfvj * ( trn(ji,jj,jk,jn) + trn(ji  ,jj+1,jk,jn) )
+                  ! mixed centered / upstream scheme
+                  zwx(ji,jj,jk) = zcofi * zupsut + (1.-zcofi) * zcenut
+                  zwy(ji,jj,jk) = zcofj * zupsvt + (1.-zcofj) * zcenvt                
+               END DO
+            END DO
+
+
+            ! 2. Tracer flux divergence at t-point added to the general trend
+            ! -------------------------
+
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+#if ! defined key_zco
+                  zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk)
+#else
+                  zbtr = zbtr2(ji,jj) 
+#endif
+                  ! 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
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+
+#if defined key_trc_diatrd 
+                  ! recompute the trends in i- and j-direction as Uh gradh(T)
+#if ! defined key_zco
+                  zfui = 0.5 * e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk)
+                  zfui1= 0.5 * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk)
+                  zfvj = 0.5 * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * zvn(ji,jj  ,jk)
+                  zfvj1= 0.5 * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * zvn(ji,jj-1,jk)
+# else
+                  zfui = 0.5 * e2u(ji  ,jj) * zun(ji,  jj,jk)
+                  zfui1= 0.5 * e2u(ji-1,jj) * zun(ji-1,jj,jk)
+                  zfvj = 0.5 * e1v(ji,jj  ) * zvn(ji,jj  ,jk)
+                  zfvj1= 0.5 * e1v(ji,jj-1) * zvn(ji,jj-1,jk)
+# endif
+                  ztai = - zbtr * ( zfui  * ( trn(ji+1,jj  ,jk,jn) - trn(ji,  jj,jk,jn) )   &
+                     &                + zfui1 * ( trn(ji,  jj,  jk,jn) - trn(ji-1,jj,jk,jn) ) )
+                  ztaj = - zbtr * ( zfvj  * ( trn(ji  ,jj+1,jk,jn) - trn(ji,jj  ,jk,jn) )    &
+                     &                + zfvj1 * ( trn(ji  ,jj  ,jk,jn) - trn(ji,jj-1,jk,jn) ) )
+                  ! save i- and j- advective trends computed as Uh gradh(T)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = ztai
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = ztaj
+#endif
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+      ENDDO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('centered2 - had')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+      
+      ! II. Vertical advection
+      ! ----------------------
+      DO jn = 1, jptra
+
+         ! Bottom value : flux set to zero
+         zwx(:,:,jpk) = 0.e0 
+
+         ! Surface value
+         IF ( lk_dynspg_rl ) THEN       ! rigid lid : flux set to zero
+            zwx(:,:, 1 ) = 0.e0  
+         ELSE                           ! free surface-constant volume
+            zwx(:,:, 1 ) = zwn(:,:,1) * trn(:,:,1,jn)
+         ENDIF
+
+         ! 1. Vertical advective fluxes
+         ! ----------------------------
+
+         ! Second order centered tracer flux at w-point
+
+         DO jk = 2, jpk
+            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) )
+                  ! velocity * 1/2
+                  zhw = 0.5 * zwn(ji,jj,jk)
+                  ! upstream scheme
+                  zfp_w = zhw + ABS( zhw )
+                  zfm_w = zhw - ABS( zhw )
+                  zupst = zfp_w * trb(ji,jj,jk,jn) + zfm_w * trb(ji,jj,jk-1,jn)
+                  ! centered scheme
+                  zcent = zhw * ( trn(ji,jj,jk,jn) + trn(ji,jj,jk-1,jn) )
+                  ! centered scheme
+                  zwx(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent
+               END DO
+            END DO
+         END DO
+
+
+         ! 2. 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.
+                  ze3tr = 1. / fse3t(ji,jj,jk)
+                  ! vertical advective trends
+                  ztra = - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
+                  ! add it to the general tracer trends
+                  tra(ji,jj,jk,jn) =  tra(ji,jj,jk,jn) + ztra
+#if defined key_trc_diatrd 
+                  ! save the vertical advective trends computed as w gradz(T)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
+#endif
+               END DO
+            END DO
+         END DO
+
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('centered - zad')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_adv_cen2
+
+   SUBROUTINE ups_orca_set
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ups_orca_set  ***
+      !!
+      !! ** Purpose :   add a portion of upstream scheme in area where the
+      !!                centered scheme generates too strong overshoot
+      !!
+      !! ** Method  :   orca (R4 and R2) confiiguration setting. Set upsmsk
+      !!                array to nozero value in some straith.
+      !!
+      !! ** Action : - upsmsk set to 1 at some strait, 0 elsewhere for orca
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers
+      !!----------------------------------------------------------------------
+
+      ! mixed upstream/centered scheme near river mouths
+      ! ------------------------------------------------
+      SELECT CASE ( jp_cfg )
+      !                                        ! =======================
+      CASE ( 4 )                               !  ORCA_R4 configuration
+         !                                     ! =======================
+         !                                          ! Gibraltar Strait
+         ii0 =  70   ;   ii1 =  71
+         ij0 =  52   ;   ij1 =  53   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+         !
+         !                                     ! =======================
+      CASE ( 2 )                               !  ORCA_R2 configuration
+         !                                     ! =======================
+         !                                          ! Gibraltar Strait
+         ij0 = 102   ;   ij1 = 102
+         ii0 = 138   ;   ii1 = 138   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.20
+         ii0 = 139   ;   ii1 = 139   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
+         ii0 = 140   ;   ii1 = 140   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+         ij0 = 101   ;   ij1 = 102
+         ii0 = 141   ;   ii1 = 141   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+         !                                          ! Bab el Mandeb Strait
+         ij0 =  87   ;   ij1 =  88
+         ii0 = 164   ;   ii1 = 164   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.10
+         ij0 =  88   ;   ij1 =  88
+         ii0 = 163   ;   ii1 = 163   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+         ii0 = 162   ;   ii1 = 162   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
+         ii0 = 160   ;   ii1 = 161   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+         ij0 =  89   ;   ij1 =  89
+         ii0 = 158   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+         ij0 =  90   ;   ij1 =  90
+         ii0 = 160   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+         !                                          ! Sound Strait
+         ij0 = 116   ;   ij1 = 116
+         ii0 = 145   ;   ii1 = 147   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+         !
+      END SELECT
+
+   END SUBROUTINE ups_orca_set
+
+#else
+
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_adv_cen2( kt )  
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_adv_cen2: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_adv_cen2
+#endif
+   !!======================================================================
+END MODULE trcadv_cen2
Index: trunk/NEMO/TOP_SRC/TRP/trcadv_muscl.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcadv_muscl.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcadv_muscl.F90	(revision 941)
@@ -0,0 +1,356 @@
+MODULE trcadv_muscl
+   !!==============================================================================
+   !!                       ***  MODULE  trcadv_muscl  ***
+   !! Ocean passive tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_adv_muscl : update the tracer trend with the horizontal
+   !!                   and vertical advection trends using MUSCL scheme
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc         ! ocean dynamics and active tracers variables
+   USE trc             ! ocean passive tracers variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE trcbbl          ! advective passive tracers in the BBL
+   USE lib_mpp
+   USE prtctl_trc      ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC trc_adv_muscl  ! routine called by trcstp.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcadv_muscl.F90,v 1.13 2007/10/12 09:26:30 opalod Exp $ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_adv_muscl( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE trc_adv_muscl  ***
+      !!          
+      !! ** Purpose :   Compute the now trend due to total advection of any pas-
+      !!      sive tracer using a MUSCL scheme (Monotone Upstream-centered Scheme
+      !!      for Conservation Laws) and add it to the general tracer trend.
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  : - update tra with the now advective tracer trends
+      !!              - save trends in trtrd ('key_trc_diatrd')
+      !!
+      !! References :                
+      !!      Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
+      !!	IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
+      !!
+      !! History :
+      !!        !  06-00  (A.Estublier)  for passive tracers
+      !!   9.0  !  03-04  (C. Ethe, G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * modules used
+#if defined key_trcbbl_adv
+      USE oce_trc            , zun => ua,  &  ! use ua as workspace
+         &                     zvn => va      ! use va as workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwn
+#else
+      USE oce_trc            , zun => un,  &  ! When no bbl, zun == un
+                               zvn => vn,  &  !              zvn == vn
+                               zwn => wn      !              zwn == wn
+#endif
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk,jn            ! dummy loop indices
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   &
+         zt1, zt2, ztp1, ztp2
+
+      REAL(wp) ::   zu, zv, zw, zeu, zev, zew, zbtr, ztra
+      REAL(wp) ::   z0u, z0v, z0w
+      REAL(wp) ::   zzt1, zzt2, zalpha, z2dtt
+#if defined key_trc_diatrd
+      REAL(wp) ::   ztai, ztaj
+      REAL(wp) ::   zfui, zfvj
+#endif
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+
+      IF( kt == nittrc000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_adv : MUSCL advection scheme'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+ 
+
+#if defined key_trcbbl_adv
+      ! Advective bottom boundary layer
+      ! -------------------------------
+      zun(:,:,:) = un (:,:,:) - u_trc_bbl(:,:,:)
+      zvn(:,:,:) = vn (:,:,:) - v_trc_bbl(:,:,:)
+      zwn(:,:,:) = wn (:,:,:) + w_trc_bbl(:,:,:)
+#endif
+
+ 
+
+      DO jn = 1, jptra
+#if defined key_trc_diatrd
+        DO jk = 1,jpk
+           DO jj = 1,jpj
+              DO ji = 1,jpi
+                 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = 0.
+                 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = 0.
+                 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = 0.
+              END DO
+            END DO
+          END DO
+#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) * ( trb(ji+1,jj,jk,jn) - trb(ji,jj,jk,jn) )
+                  zt2(ji,jj,jk) = vmask(ji,jj,jk) * ( trb(ji,jj+1,jk,jn) - trb(ji,jj,jk,jn) )
+               END DO
+            END DO
+         END DO
+         ! bottom values
+         zt1(:,:,jpk) = 0.e0
+         zt2(:,:,jpk) = 0.e0
+
+         ! lateral boundary conditions on zt1, zt2
+         CALL lbc_lnk( zt1, 'U', -1. )   
+         CALL lbc_lnk( zt2, '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) ) )
+                  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) ) )
+               END DO
+            END DO
+         END DO
+         ! bottom values
+         ztp1(:,:,jpk) = 0.e0
+         ztp2(:,:,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) ) )
+
+                  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) ) )
+
+               END DO
+            END DO
+         END DO
+
+         ! Advection terms
+         ! interior values
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! volume fluxes
+#if ! defined key_zco
+                  zeu = e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
+                  zev = e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
+#else
+                  zeu = e2u(ji,jj) * zun(ji,jj,jk)
+                  zev = e1v(ji,jj) * zvn(ji,jj,jk)
+#endif
+                  ! MUSCL fluxes
+                  z2dtt = rdttra(jk) * FLOAT(ndttrc)
+                  z0u = SIGN( 0.5, zun(ji,jj,jk) )            
+                  zalpha = 0.5 - z0u
+                  zu  = z0u - 0.5 * zun(ji,jj,jk) * z2dtt / e1u(ji,jj)
+                  zzt1 = trb(ji+1,jj,jk,jn) + zu*ztp1(ji+1,jj,jk)
+                  zzt2 = trb(ji  ,jj,jk,jn) + zu*ztp1(ji  ,jj,jk)
+                  zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
+                  z0v = SIGN( 0.5, zvn(ji,jj,jk) )            
+                  zalpha = 0.5 - z0v
+                  zv  = z0v - 0.5 * zvn(ji,jj,jk) * z2dtt / e2v(ji,jj)
+                  zzt1 = trb(ji,jj+1,jk,jn) + zv*ztp2(ji,jj+1,jk)
+                  zzt2 = trb(ji,jj  ,jk,jn) + zv*ztp2(ji,jj  ,jk)
+                  zt2(ji,jj,jk) = zev * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
+               END DO
+            END DO
+         END DO
+
+         ! lateral boundary conditions on zt1, zt2 (changed sign)
+         CALL lbc_lnk( zt1, 'U', -1. ) 
+         CALL lbc_lnk( zt2, 'V', -1. ) 
+
+         ! Compute and 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)*fse3t(ji,jj,jk) )
+#else
+                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
+#endif
+                  ! horizontal advective trends
+                  ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk  )   &
+                     &            + zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk  ) )
+                  ! add it to the general tracer trends
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+#if defined key_trc_diatrd
+                  ! recompute the trends in i- and j-direction as Uh gradh(T)
+#if ! defined key_zco
+                  zfui =  e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   &
+                     & -  e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)
+                  zfvj =  e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vn(ji,jj  ,jk)   &
+                     & -  e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)
+#   else
+                  zfui = e2u(ji  ,jj) * un(ji,  jj,jk)   &
+                     & - e2u(ji-1,jj) * un(ji-1,jj,jk)
+                  zfvj = e1v(ji,jj  ) * vn(ji,jj  ,jk)   &
+                     & - e1v(ji,jj-1) * vn(ji,jj-1,jk)
+#   endif
+                  ztai =-zbtr * (  zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk) - trn(ji,jj,jk,jn) * zfui  )
+                  ztaj =-zbtr * (  zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk) - trn(ji,jj,jk,jn) * zfvj  )
+                  ! save i- and j- advective trends computed as Uh gradh(T)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = ztai
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = ztaj
+#endif
+               END DO
+            END DO
+         END DO
+      ENDDO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('muscl - had')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+         ! II. Vertical advective fluxes
+         ! -----------------------------
+
+      DO jn = 1, jptra
+         ! First guess of the slope
+         ! interior values
+         DO jk = 2, jpkm1
+            zt1(:,:,jk) = tmask(:,:,jk) * ( trb(:,:,jk-1,jn) - trb(:,:,jk,jn) )
+         END DO
+         ! surface and bottom boundary conditions
+         zt1 (:,:, 1 ) = 0.e0 
+         zt1 (:,:,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) ) )
+               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  ) ) )
+               END DO
+            END DO
+         END DO
+         ! surface values
+         ztp1(:,:,1) = 0. 
+         ! vertical advective flux
+         ! interior values
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  z2dtt = rdttra(jk) * FLOAT(ndttrc)
+                  zew = zwn(ji,jj,jk+1)
+                  z0w = SIGN( 0.5, zwn(ji,jj,jk+1) )
+                  zalpha = 0.5 + z0w
+                  zw  = z0w - 0.5 * zwn(ji,jj,jk+1)*z2dtt / fse3w(ji,jj,jk+1)
+                  zzt1 = trb(ji,jj,jk+1,jn) + zw*ztp1(ji,jj,jk+1)
+                  zzt2 = trb(ji,jj,jk  ,jn) + zw*ztp1(ji,jj,jk  )
+                  zt1(ji,jj,jk+1) = zew * ( zalpha * zzt1 + (1.-zalpha)*zzt2 )
+               END DO
+            END DO
+         END DO
+         ! surface values
+         IF( lk_dynspg_rl ) THEN        ! rigid lid : flux set to zero
+            zt1(:,:, 1 ) = 0.e0
+         ELSE                           ! free surface
+            zt1(:,:, 1 ) = zwn(:,:,1) * trb(:,:,1,jn)
+         ENDIF
+
+         ! bottom values
+         zt1(:,:,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
+                  ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
+                  ! add it to the general tracer trends
+                  tra(ji,jj,jk,jn) =  tra(ji,jj,jk,jn) + ztra
+#if defined key_trc_diatrd
+                  ! save the vertical advective trends computed as w gradz(T)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
+#endif
+               END DO
+            END DO
+         END DO
+
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('muscl - zad')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+END SUBROUTINE trc_adv_muscl
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_adv_muscl( kt )  
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_adv_muscl: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_adv_muscl
+#endif
+
+   !!======================================================================
+END MODULE trcadv_muscl
Index: trunk/NEMO/TOP_SRC/TRP/trcadv_muscl2.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcadv_muscl2.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcadv_muscl2.F90	(revision 941)
@@ -0,0 +1,411 @@
+MODULE trcadv_muscl2
+   !!==============================================================================
+   !!                       ***  MODULE  trcadv_muscl2  ***
+   !! Ocean passive tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   tra_adv_muscl2 : update the tracer trend with the horizontal
+   !!                    and vertical advection trends using MUSCL2 scheme
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc         ! ocean dynamics and active tracers variables
+   USE trc             ! ocean passive tracers variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE trcbbl          ! advective passive tracers in the BBL
+   USE prtctl_trc          ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC trc_adv_muscl2        ! routine called by trcstp.F90
+
+   !! * Module variable
+   REAL(wp), DIMENSION(jpk) ::   &
+      rdttrc                     ! vertical profile of tracer time-step
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_adv_muscl2( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_adv_muscl2  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to total advection of passi-
+      !!      ve tracer using a MUSCL scheme (Monotone Upstream-
+      !!      Centered Scheme for Conservation Laws) and add it to the general
+      !!      tracer trend.
+      !!
+      !! ** Method : MUSCL scheme plus centered scheme at ocean boundaries
+      !!
+      !! ** Action : - update tra with the now advective tracer trends
+      !!             - save trends in trtrd ('key_trc_diatrd')
+      !!
+      !! References :                
+      !!      Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
+      !!	IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
+      !!
+      !! History :
+      !!        !  06-00  (A.Estublier)  for passive tracers
+      !!   9.0  !  03-04  (C. Ethe, G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * modules used
+#if defined key_trcbbl_adv
+      USE oce_trc            , zun => ua,  &  ! use ua as workspace
+         &                     zvn => va      ! use va as workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwn
+#else
+      USE oce_trc            , zun => un,  &  ! When no bbl, zun == un
+                               zvn => vn,  &  !              zvn == vn
+                               zwn => wn      !              zwn == wn
+#endif
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk,jn               ! dummy loop indices
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   &
+         zt1, zt2, ztp1, ztp2
+      REAL(wp) ::   zu, zv, zw, zeu, zev, zew, zbtr, ztra
+      REAL(wp) ::   z0u, z0v, z0w
+      REAL(wp) ::   zzt1, zzt2, zalpha
+
+#if defined key_trc_diatrd
+      REAL(wp) ::   ztai, ztaj
+      REAL(wp) ::   zfui, zfvj
+#endif
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      IF( kt == nittrc000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_adv_muscl2 : MUSCL2 advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)
+      ENDIF
+      
+#if defined key_trcbbl_adv        
+      ! Advective bottom boundary layer
+      ! -------------------------------
+      zun(:,:,:) = un (:,:,:) - u_trc_bbl(:,:,:)
+      zvn(:,:,:) = vn (:,:,:) - v_trc_bbl(:,:,:)
+      zwn(:,:,:) = wn (:,:,:) + w_trc_bbl( :,:,:)
+#endif
+
+
+      DO jn = 1, jptra
+
+         ! 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) * ( trb(ji+1,jj,jk,jn) - trb(ji,jj,jk,jn) )
+                  zt2(ji,jj,jk) = vmask(ji,jj,jk) * ( trb(ji,jj+1,jk,jn) - trb(ji,jj,jk,jn) )
+               END DO
+            END DO
+         END DO
+         ! bottom values
+         zt1(:,:,jpk) = 0.e0
+         zt2(:,:,jpk) = 0.e0
+
+         ! lateral boundary conditions on zt1, zt2  (changed sign)
+         CALL lbc_lnk( zt1, 'U', -1. )
+         CALL lbc_lnk( zt2, '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) ) )
+                  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) ) )
+               END DO
+            END DO
+         END DO
+         ! bottom values
+         ztp1(:,:,jpk) = 0.e0 
+         ztp2(:,:,jpk) = 0.e0
+
+         ! Slopes limitation
+         DO jk = 1, jpkm1
+            DO jj = 2, jpj
+               DO ji = fs_2, fs_jpim1   ! 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) ) )
+
+                  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) ) )
+               END DO
+            END DO
+         END DO
+
+         ! Advection terms
+         ! interior values
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! volume fluxes
+#if ! defined key_zco
+                  zeu = e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
+                  zev = e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
+#else
+                  zeu = e2u(ji,jj) * zun(ji,jj,jk)
+                  zev = e1v(ji,jj) * zvn(ji,jj,jk)
+#endif
+                  ! MUSCL fluxes
+                  z0u = SIGN( 0.5, zun(ji,jj,jk) )            
+                  zalpha = 0.5 - z0u
+                  zu  = z0u - 0.5 * zun(ji,jj,jk) * rdttrc(jk) / e1u(ji,jj)
+                  zzt1 = trb(ji+1,jj,jk,jn) + zu*ztp1(ji+1,jj,jk)
+                  zzt2 = trb(ji  ,jj,jk,jn) + zu*ztp1(ji  ,jj,jk)
+                  zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
+
+                  z0v = SIGN( 0.5, zvn(ji,jj,jk) )            
+                  zalpha = 0.5 - z0v
+                  zv  = z0v - 0.5 * zvn(ji,jj,jk) * rdttrc(jk) / e2v(ji,jj)
+                  zzt1 = trb(ji,jj+1,jk,jn) + zv*ztp2(ji,jj+1,jk)
+                  zzt2 = trb(ji,jj  ,jk,jn) + zv*ztp2(ji,jj  ,jk)
+                  zt2(ji,jj,jk) = zev * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
+
+               END DO
+            END DO
+         END DO
+
+
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+#if ! defined key_zco
+                  zev = e1v(ji,jj) * fse3v(ji,jj,jk)
+                  IF( umask(ji,jj,jk) == 0. ) THEN
+                     IF( zun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
+                        zt1(ji+1,jj,jk) = e2u(ji+1,jj)* fse3u(ji+1,jj,jk)   &
+                           &            * zun(ji+1,jj,jk) * ( trb(ji+1,jj,jk,jn) + trb(ji+2,jj,jk,jn) ) * 0.5
+                     ENDIF
+                     IF( zun(ji-1,jj,jk) < 0. ) THEN
+                        zt1(ji-1,jj,jk) = e2u(ji-1,jj)* fse3u(ji-1,jj,jk)   &
+                           &            * zun(ji-1,jj,jk) * ( trb(ji-1,jj,jk,jn) + trb(ji  ,jj,jk,jn) ) * 0.5
+                     ENDIF
+                  ENDIF
+                  IF( vmask(ji,jj,jk) == 0. ) THEN
+                     IF( zvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
+                        zt2(ji,jj+1,jk) = e1v(ji,jj+1) * fse3v(ji,jj+1,jk)   &
+                           &            * zvn(ji,jj+1,jk) * ( trb(ji,jj+1,jk,jn) + trb(ji,jj+2,jk,jn) ) * 0.5
+                     ENDIF
+                     IF( zvn(ji,jj-1,jk) < 0. ) THEN
+                        zt2(ji,jj-1,jk) = e1v(ji,jj-1)* fse3v(ji,jj-1,jk)   &
+                           &            * zvn(ji,jj-1,jk) * ( trb(ji,jj-1,jk,jn) + trb(ji  ,jj,jk,jn) ) * 0.5
+                     ENDIF
+                  ENDIF
+
+#else
+                  IF( umask(ji,jj,jk) == 0. ) THEN
+                     IF( zun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
+                        zt1(ji+1,jj,jk) = e2u(ji+1,jj) * zun(ji+1,jj,jk) * ( trb(ji+1,jj,jk,jn) + trb(ji+2,jj,jk,jn) ) * 0.5
+                     ENDIF
+                     IF( zun(ji-1,jj,jk) < 0. ) THEN
+                        zt1(ji-1,jj,jk) = e2u(ji-1,jj) * zun(ji-1,jj,jk) * ( trb(ji-1,jj,jk,jn) + trb(ji  ,jj,jk,jn) ) * 0.5
+                     ENDIF
+                  ENDIF
+                  IF( vmask(ji,jj,jk) == 0. ) THEN
+                     IF( zvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
+                        zt2(ji,jj+1,jk) = e1v(ji,jj+1) * zvn(ji,jj+1,jk) * ( trb(ji,jj+1,jk,jn) + trb(ji,jj+2,jk,jn) ) * 0.5
+                     ENDIF
+                     IF( zvn(ji,jj-1,jk) < 0. ) THEN
+                        zt2(ji,jj-1,jk) = e1v(ji,jj-1) * zvn(ji,jj-1,jk) * ( trb(ji,jj-1,jk,jn) + trb(ji  ,jj,jk,jn) ) * 0.5
+                     ENDIF
+                  ENDIF
+#endif
+               END DO
+            END DO
+         END DO
+
+         ! lateral boundary conditions on zt1, zt2   (changed sign)
+         CALL lbc_lnk( zt1, 'U', -1. )
+         CALL lbc_lnk( zt2, 'V', -1. )
+
+         ! Compute and 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)*fse3t(ji,jj,jk) )
+#else
+                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
+#endif
+                  ! horizontal advective trends
+                  ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk  )   &
+                     &            + zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk  ) )
+                  ! add it to the general tracer trends
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+#if defined key_trc_diatrd
+                  ! recompute the trends in i- and j-direction as Uh gradh(T)
+#if ! defined key_zco
+                  zfui =  e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   &
+                     & -  e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)
+                  zfvj =  e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vn(ji,jj  ,jk)   &
+                     & -  e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)
+#   else
+                  zfui = e2u(ji  ,jj) * un(ji,  jj,jk)   &
+                     & - e2u(ji-1,jj) * un(ji-1,jj,jk)
+                  zfvj = e1v(ji,jj  ) * vn(ji,jj  ,jk)   &
+                     & - e1v(ji,jj-1) * vn(ji,jj-1,jk)
+#   endif
+                  ztai =-zbtr * (  zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk) - trn(ji,jj,jk,jn) * zfui  )
+                  ztaj =-zbtr * (  zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk) - trn(ji,jj,jk,jn) * zfvj  )
+                  ! save i- and j- advective trends computed as Uh gradh(T)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = ztai
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = ztaj
+
+#endif
+               END DO
+            END DO
+         END DO
+      ENDDO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('muscl2 - had')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+      ! II. Vertical advective fluxes
+      ! -----------------------------
+
+      DO jn = 1, jptra
+
+         ! First guess of the slope
+         ! interior values
+         DO jk = 2, jpkm1
+            zt1(:,:,jk) = tmask(:,:,jk) * ( trb(:,:,jk-1,jn) - trb(:,:,jk,jn) )
+         END DO
+         ! surface and bottom boundary conditions
+         zt1 (:,:, 1 ) = 0.e0 
+         zt1 (:,:,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) ) )
+               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  ) ) )
+               END DO
+            END DO
+         END DO
+
+         ! surface values
+         ztp1(:,:,1) = 0. 
+
+         ! vertical advective flux
+         ! interior values
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zew = zwn(ji,jj,jk+1)
+                  z0w = SIGN( 0.5, zwn(ji,jj,jk+1) )
+                  zalpha = 0.5 + z0w
+                  zw  = z0w - 0.5 * zwn(ji,jj,jk+1)* rdttrc(jk)/ fse3w(ji,jj,jk+1)
+                  zzt1 = trb(ji,jj,jk+1,jn) + zw*ztp1(ji,jj,jk+1)
+                  zzt2 = trb(ji,jj,jk  ,jn) + zw*ztp1(ji,jj,jk  )
+                  zt1(ji,jj,jk+1) = zew * ( zalpha * zzt1 + (1.-zalpha)*zzt2 )
+               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( zwn(ji,jj,jk) > 0. ) THEN
+                        zt1(ji,jj,jk) = zwn(ji,jj,jk) * ( trb(ji,jj,jk-1,jn) + trb(ji,jj,jk,jn) ) * 0.5
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+         ! surface values
+         IF( lk_dynspg_rl ) THEN        ! rigid lid : flux set to zero
+            zt1(:,:, 1 ) = 0.e0
+         ELSE                           ! free surface
+            zt1(:,:, 1 ) = zwn(:,:,1) * trb(:,:,1,jn)
+         ENDIF
+
+         ! bottom values
+         zt1(:,:,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
+                  ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
+                  ! add it to the general tracer trends
+                  tra(ji,jj,jk,jn) =  tra(ji,jj,jk,jn) + ztra
+#if defined key_trc_diatrd
+                  ! save the vertical advective trends computed as w gradz(T)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
+#endif
+               END DO
+            END DO
+         END DO
+
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('muscl2 - zad')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_adv_muscl2
+
+#else
+
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_adv_muscl2( kt ) 
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_adv_muscl2: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_adv_muscl2
+#endif
+
+   !!======================================================================
+END MODULE trcadv_muscl2
Index: trunk/NEMO/TOP_SRC/TRP/trcadv_smolar.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcadv_smolar.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcadv_smolar.F90	(revision 941)
@@ -0,0 +1,531 @@
+MODULE trcadv_smolar
+   !!==============================================================================
+   !!                       ***  MODULE  trcadv_smolar  ***
+   !! Ocean passive tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_adv_smolar : update the passive tracer trend with the horizontal
+   !!                  and vertical advection trends using a Smolarkiewicz 
+   !!                  FCT scheme
+   !!----------------------------------------------------------------------
+   USE oce_trc             ! ocean dynamics and active tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE lbclnk              ! ocean lateral boundary conditions (or mpp link)
+   USE trcbbl              ! advective passive tracers in the BBL
+   USE prtctl_trc      ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_adv_smolar    ! routine called by trcstp.F90
+
+   REAL(wp), DIMENSION(jpk) ::   rdttrc       ! vertical profile of tracer time-step
+ 
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_adv_smolar( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_adv_smolar  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to total advection of passi-
+      !!      ve tracer using a Smolarkiewicz FCT (Flux Corrected Transport ) 
+      !!      scheme and add it to the general tracer trend.
+      !!
+      !! ** Method : Computation of not exactly the advection but the
+      !!             transport term, i.e.  div(u*tra). 
+      !!             Computes the now horizontal and vertical advection with
+      !!             the complete 3d method.
+      !! 
+      !!       note: - sc is an empirical factor to be used with care
+      !!             - this advection scheme needs an euler-forward time scheme
+      !!
+      !! ** Action : - update tra with the now advective tracer trends
+      !!             - save trends in trtrd ('key_trc_diatrd')
+      !!
+      !! References :                
+      !!     Piotr K. Smolarkiewicz, 1983,
+      !!       "A simple positive definit advection
+      !!        scheme with small IMPLICIT diffusion"
+      !!        Monthly Weather Review, pp 479-486
+      !!
+      !! History :
+      !!         !  87-06 (pa-dl) Original
+      !!         !  91-11 (G. Madec)
+      !!         !  94-08 (A. Czaja)
+      !!         !  95-09 (M. Levy) passive tracers
+      !!         !  98-03 (M.A. Foujols) lateral boundary conditions
+      !!         !  99-02 (M.A. Foujols) lbc in conjonction with ORCA
+      !!         !  00-05 (MA Foujols) add lbc for tracer trends
+      !!         !  00-10 (MA Foujols and E.Kestenare) INCLUDE instead of routine
+      !!         !  01-05 (E.Kestenare) fix bug in trtrd indexes
+      !!         !  02-05 (M-A Filiberti, and M.Levy) correction in trtrd computation
+      !!   9.0   !  03-04  (C. Ethe)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * modules used
+#if defined key_trcbbl_adv
+      USE oce_trc            , zun => ua,  &  ! use ua as workspace
+         &                     zvn => va      ! use va as workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwn
+#else
+      USE oce_trc            , zun => un,  &  ! When no bbl, zun == un
+                               zvn => vn,  &  !              zvn == vn
+                               zwn => wn      !              zwn == wn
+#endif
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !! * Local declarations
+      INTEGER :: ji, jj, jk,jt, jn            ! dummy loop indices
+
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   &      
+         zti, ztj,              &
+         zaa, zbb, zcc,         &
+         zx , zy , zz ,         &
+         zkx, zky, zkz,         &
+         zbuf
+
+#if defined key_trc_diatrd
+      REAL(wp) :: zgm, zgz
+#endif
+
+      REAL(wp) :: zbtr, ztra
+      REAL(wp) :: zfp_ui, zfp_vj, zfm_ui, zfm_vj, zfp_w, zfm_w
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+
+      IF( kt == nittrc000  .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_adv_smolar : SMOLARKIEWICZ advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         rdttrc(:) = rdttra(:) * FLOAT(ndttrc)
+      ENDIF
+
+
+#if defined key_trcbbl_adv        
+      ! Advective bottom boundary layer
+      ! -------------------------------
+      zun(:,:,:) = un (:,:,:) - u_trc_bbl(:,:,:)
+      zvn(:,:,:) = vn (:,:,:) - v_trc_bbl(:,:,:)
+      zwn(:,:,:) = wn (:,:,:) + w_trc_bbl( :,:,:)
+#endif
+
+      ! tracer loop parallelized (macrotasking)
+      ! =======================================
+      
+      DO jn = 1, jptra
+         
+         ! 1. tracer flux in the 3 directions
+         ! ----------------------------------
+         
+         ! 1.1 mass flux at u v and t-points and initialization
+
+        DO jk = 1,jpk
+
+           DO jj = 1,jpj
+              DO ji = 1,jpi
+                 zaa(ji,jj,jk) = e2u(ji,jj)*fse3u(ji,jj,jk) * zun(ji,jj,jk)
+                 zbb(ji,jj,jk) = e1v(ji,jj)*fse3v(ji,jj,jk) * zvn(ji,jj,jk)
+                 zcc(ji,jj,jk) = e1t(ji,jj)*e2t(ji,jj)      * zwn(ji,jj,jk)
+                 zbuf(ji,jj,jk) = 0.
+                 ztj(ji,jj,jk) = 0.
+                 zx(ji,jj,jk) = 0.
+                 zy(ji,jj,jk) = 0.
+                 zz(ji,jj,jk) = 0.
+                 zti(ji,jj,jk) = trn(ji,jj,jk,jn)
+#if defined key_trc_diatrd
+                 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = 0.
+                 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = 0.
+                 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = 0.
+#endif
+              END DO
+           END DO
+           
+           ! 1.2 calcul of intermediate field with an upstream advection scheme
+           !     and mass fluxes calculated above
+           
+           ! calcul of tracer flux in the i and j direction
+           
+           DO jj=1,jpj
+              zkx(  1,jj,jk)=0.
+              zkx(jpi,jj,jk)=0.
+           END DO
+           
+           DO ji=1,jpi
+              zky(ji,  1,jk)=0.
+              zky(ji,jpj,jk)=0.
+           END DO
+           
+           DO jj = 2,jpjm1
+              DO ji = 2,jpim1
+                 zfp_ui = 0.5 * ( zaa(ji,jj,jk) + ABS( zaa(ji,jj,jk) ) )
+                 zfp_vj = 0.5 * ( zbb(ji,jj,jk) + ABS( zbb(ji,jj,jk) ) )
+                 zfm_ui = 0.5 * ( zaa(ji,jj,jk) - ABS( zaa(ji,jj,jk) ) )
+                 zfm_vj = 0.5 * ( zbb(ji,jj,jk) - ABS( zbb(ji,jj,jk) ) )            
+                 zkx(ji,jj,jk) = zfp_ui * zti(ji,jj,jk) + zfm_ui * zti(ji+1,jj  ,jk) 
+                 zky(ji,jj,jk) = zfp_vj * zti(ji,jj,jk) + zfm_vj * zti(ji    ,jj+1,jk)             
+              END DO
+           END DO
+
+        END DO
+
+         ! II. Vertical advection
+         ! ----------------------
+
+         ! Surface value
+         IF( lk_dynspg_rl ) THEN        ! rigid lid : flux set to zero
+            zkz(:,:, 1 ) = 0.e0  
+         ELSE                           ! free surface
+            zkz(:,:, 1 ) = zwn(:,:,1) * trn(:,:,1,jn) * tmask(ji,jj,1)
+         ENDIF
+
+        DO jk = 2,jpk
+          DO jj = 1,jpj
+            DO ji = 1,jpi
+               zfp_w = 0.5 * ( zcc(ji,jj,jk) + ABS( zcc(ji,jj,jk) ) )
+               zfm_w = 0.5 * ( zcc(ji,jj,jk) - ABS( zcc(ji,jj,jk) ) )        
+               zkz(ji,jj,jk) = zfp_w * zti(ji,jj,jk) + zfm_w * zti(ji,jj,jk-1)     
+            END DO
+          END DO
+        END DO
+
+! ... Lateral boundary conditions on zk[xy]
+      CALL lbc_lnk( zkx, 'U', -1. )
+      CALL lbc_lnk( zky, 'V', -1. )
+
+
+! 2. calcul of after field using an upstream advection scheme
+! -----------------------------------------------------------
+
+        DO jk = 1,jpkm1
+          DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+              zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk))
+              ztj(ji,jj,jk) = -zbtr*    &
+     &            ( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk)  &
+     &            + zky(ji,jj,jk) - zky(ji,jj - 1,jk)  &
+     &            + zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) )
+#if defined key_trc_diatrd
+              IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -  &
+     &                       zbtr*( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk) )
+
+              IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -  &
+     &            zbtr*( zky(ji,jj,jk) - zky(ji,jj - 1,jk) )
+
+              IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -  &
+     &            zbtr*( zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) )
+#endif
+            END DO
+          END DO
+        END DO
+
+! 2.1 start of antidiffusive correction loop
+
+        DO jt = 1,ncortrc
+
+! 2.2 calcul of intermediary field zti
+
+          DO jk = 1,jpkm1
+            DO jj = 2,jpjm1
+              DO ji = 2,jpim1
+                zti(ji,jj,jk) = zti(ji,jj,jk)+rdttrc(jk)*ztj(ji,jj,jk)
+                zbuf(ji,jj,jk) = zbuf(ji,jj,jk) + ztj(ji,jj,jk)
+              END DO
+            END DO
+          END DO
+
+! ... Lateral boundary conditions on zti
+      CALL lbc_lnk( zti, 'T', 1. )
+
+
+! 2.3 calcul of the antidiffusive flux
+
+          DO jk = 1,jpkm1
+            DO jj = 2,jpjm1
+              DO ji = 2,jpim1
+                zx(ji,jj,jk) = ( abs(zaa(ji,jj,jk)) - rdttrc(jk)       &
+     &              *zaa(ji,jj,jk)**2/                          &
+     &              (e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) )  &
+     &              *(zti(ji + 1,jj,jk) - zti( ji ,jj,jk))      &
+     &              /(zti( ji ,jj,jk) + zti(ji + 1,jj,jk) + rtrn)    &
+     &              * rsc
+
+                zy(ji,jj,jk) = ( abs(zbb(ji,jj,jk)) - rdttrc(jk)       &
+     &              *zbb(ji,jj,jk)**2/                          &
+     &              (e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) )  &
+     &              *(zti(ji,jj + 1,jk) - zti(ji, jj ,jk))      &
+     &              /(zti(ji, jj ,jk) + zti(ji,jj + 1,jk) + rtrn)    &
+     &              * rsc
+              END DO
+            END DO
+          END DO
+
+          DO jk = 2,jpkm1
+            DO jj = 2,jpjm1
+              DO ji = 2,jpim1
+                zz(ji,jj,jk) = ( abs(zcc(ji,jj,jk)) - rdttrc(jk)*zcc(ji,jj,jk)**2  &  
+     &              /( e1t(ji,jj)*e2t(ji,jj)*fse3w(ji,jj,jk) ) ) &
+     &               *( zti(ji,jj,jk) - zti(ji,jj,jk - 1) )/  &
+     &                ( zti(ji,jj,jk) + zti(ji,jj,jk - 1) + rtrn )* rsc*( -1.)
+              END DO
+            END DO
+          END DO
+
+! 2.4 cross terms
+
+          IF (crosster) THEN
+              DO jk = 2,jpkm1
+                DO jj = 2,jpjm1
+                  DO ji = 2,jpim1
+                    zx(ji,jj,jk) = zx(ji,jj,jk) &
+     &                  - 0.5*rdttrc(jk)*rsc*zaa(ji,jj,jk)*0.25* &
+     &                  (    (zbb(ji  ,jj - 1,jk  ) + zbb(ji + 1,jj - 1 &
+     &                  ,jk  ) + zbb(ji + 1,jj  ,jk  ) + zbb(ji  ,jj  &
+     &                  ,jk))* (zti(ji  ,jj + 1,jk  ) + zti(ji + 1,jj + &
+     &                  1,jk  ) - zti(ji + 1,jj - 1,jk  ) - zti(ji  ,jj &
+     &                  - 1,jk  ))/ (zti(ji  ,jj + 1,jk  ) + zti(ji + 1 &
+     &                  ,jj + 1,jk  ) + zti(ji + 1,jj - 1,jk  ) + zti(ji &
+     &                  ,jj - 1,jk  ) + rtrn) + (zcc(ji  ,jj  ,jk  ) + &
+     &                  zcc(ji + 1,jj  ,jk  ) + zcc(ji  ,jj  ,jk + 1) + &
+     &                  zcc(ji + 1,jj  ,jk + 1))* (zti(ji  ,jj  ,jk - 1) &
+     &                  + zti(ji + 1,jj  ,jk - 1) - zti(ji  ,jj  ,jk + 1 &
+     &                  )- zti(ji + 1,jj  ,jk + 1))/ (zti(ji  ,jj  ,jk - &
+     &                  1) + zti(ji + 1,jj  ,jk - 1) + zti(ji  ,jj  ,jk &
+     &                  +1) + zti(ji + 1,jj  ,jk + 1) + rtrn))/(e1u(ji &
+     &                  ,jj)*e2u(ji,jj)*fse3u(ji,jj,jk))*vmask(ji  ,jj - &
+     &                  1,jk  )*vmask(ji + 1,jj - 1,jk  )*vmask(ji + 1 &
+     &                  ,jj,jk)*vmask(ji  ,jj  ,jk  )*tmask(ji  ,jj  ,jk &
+     &                  )*tmask(ji + 1,jj  ,jk  )*tmask(ji  ,jj  ,jk + 1 &
+     &                  )*tmask(ji + 1,jj  ,jk + 1)
+
+                    zy(ji,jj,jk) = zy(ji,jj,jk)    &   
+     &                  - 0.5*rdttrc(jk)*rsc*zbb(ji,jj,jk)*0.25*    &   
+     &                  (    (zaa(ji - 1,jj  ,jk  ) + zaa(ji - 1,jj + 1    &   
+     &                  ,jk  ) + zaa(ji  ,jj  ,jk  ) + zaa(ji  ,jj + 1    &   
+     &                  ,jk))* (zti(ji + 1,jj + 1,jk  ) + zti(ji + 1,jj    &   
+     &                  ,jk  ) - zti(ji - 1,jj + 1,jk  ) - zti(ji - 1,jj    &   
+     &                  ,jk  ))/ (zti(ji + 1,jj + 1,jk  ) + zti(ji + 1    &   
+     &                  ,jj  ,jk  ) + zti(ji - 1,jj + 1,jk  ) + zti(ji    &   
+     &                  - 1,jj  ,jk  ) + rtrn) + (zcc(ji  ,jj  ,jk  )    &   
+     &                  + zcc(ji  ,jj  ,jk + 1) + zcc(ji  ,jj + 1,jk  )    &   
+     &                  + zcc(ji  ,jj + 1,jk + 1))* (zti(ji  ,jj  ,jk -    &   
+     &                  1) + zti(ji  ,jj + 1,jk - 1) - zti(ji  ,jj  ,jk    &   
+     &                  +1) - zti(ji  ,jj + 1,jk + 1))/ (zti(ji  ,jj    &   
+     &                  ,jk- 1) + zti(ji  ,jj + 1,jk - 1) + zti(ji  ,jj    &   
+     &                  ,jk+ 1) + zti(ji  ,jj + 1,jk + 1) + rtrn))    &   
+     &                  /(e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk))    &   
+     &                  *umask(ji - 1,jj,jk  )*umask(ji - 1,jj + 1,jk  )    &   
+     &                  *umask(ji  ,jj,jk  )*umask(ji  ,jj + 1,jk  )    &   
+     &                  *tmask(ji  ,jj,jk)*tmask(ji  ,jj  ,jk + 1)    &   
+     &                  *tmask(ji  ,jj + 1,jk)*tmask(ji  ,jj + 1,jk + 1)      
+
+                    zz(ji,jj,jk) = zz(ji,jj,jk)    &   
+     &                  - 0.5*rdttrc(jk)*rsc*zcc(ji,jj,jk)*0.25*    &   
+     &                  (    (zaa(ji - 1,jj  ,jk  ) + zaa(ji  ,jj  ,jk    &   
+     &                  ) + zaa(ji  ,jj  ,jk - 1) + zaa(ji - 1,jj  ,jk -    &   
+     &                  1))*(zti(ji + 1,jj  ,jk - 1) + zti(ji + 1,jj    &   
+     &                  ,jk  ) - zti(ji - 1,jj  ,jk  ) - zti(ji - 1,jj    &   
+     &                  ,jk - 1))/(zti(ji + 1,jj  ,jk - 1) + zti(ji + 1    &   
+     &                  ,jj,jk  ) + zti(ji - 1,jj  ,jk  ) + zti(ji - 1    &   
+     &                  ,jj,jk - 1) + rtrn) + (zbb(ji  ,jj - 1,jk  )    &   
+     &                  + zbb(ji  ,jj  ,jk  ) + zbb(ji  ,jj  ,jk - 1)    &   
+     &                  + zbb(ji  ,jj - 1,jk - 1))*(zti(ji  ,jj + 1,jk -    &   
+     &                  1) + zti(ji  ,jj + 1,jk  ) - zti(ji  ,jj - 1,jk    &   
+     &                  ) - zti(ji  ,jj - 1,jk - 1))/(zti(ji  ,jj + 1,jk    &   
+     &                  - 1) + zti(ji  ,jj + 1,jk  ) + zti(ji  ,jj - 1    &   
+     &                  ,jk  ) + zti(ji  ,jj - 1,jk - 1) + rtrn))    &   
+     &                  /(e1t(ji,jj)*e2t(ji,jj)*fse3w(ji,jj,jk))    &   
+     &                  *umask(ji - 1,jj,jk  )*umask(ji  ,jj  ,jk  )    &   
+     &                  *umask(ji  ,jj,jk- 1)*umask(ji - 1,jj  ,jk - 1)    &   
+     &                  *vmask(ji  ,jj- 1,jk)*vmask(ji  ,jj  ,jk  )    &   
+     &                  *vmask(ji  ,jj  ,jk-1)*vmask(ji  ,jj - 1,jk - 1)       
+                  END DO
+                END DO
+              END DO
+
+              DO jj = 2,jpjm1
+                DO ji = 2,jpim1
+                  zx(ji,jj,1) = zx(ji,jj,1)    &   
+     &                - 0.5*rdttrc(jk)*rsc*zaa(ji,jj,1)*0.25*    &   
+     &                ( (zbb(ji  ,jj - 1,1  ) + zbb(ji + 1,jj - 1,1  )    &   
+     &                + zbb(ji + 1,jj  ,1  ) + zbb(ji  ,jj  ,1  ))    &   
+     &                *(zti(ji  ,jj + 1,1  ) + zti(ji + 1,jj + 1,1  )    &   
+     &                - zti(ji + 1,jj - 1,1  ) - zti(ji  ,jj - 1,1  ))    &   
+     &                /(zti(ji  ,jj + 1,1  ) + zti(ji + 1,jj + 1,1  )    &   
+     &                + zti(ji + 1,jj - 1,1  ) + zti(ji  ,jj - 1,1  ) +    &   
+     &                rtrn))/(e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,1))    &   
+     &                *vmask(ji  ,jj - 1,1  )*vmask(ji + 1,jj - 1,1  )    &   
+     &                *vmask(ji + 1,jj  ,1  )*vmask(ji  ,jj  ,1  )    
+
+                 zy(ji,jj,1) = zy(ji,jj,1)    &   
+     &                - 0.5*rdttrc(jk)*rsc*zbb(ji,jj,1)*0.25*    &   
+     &                ( (zaa(ji-1  ,jj ,1  ) + zaa(ji - 1,jj + 1,1  )    &   
+     &                + zaa(ji ,jj  ,1  ) + zaa(ji  ,jj + 1  ,1  ))    &   
+     &                *(zti(ji + 1,jj + 1,1  ) + zti(ji + 1,jj ,1  )    &   
+     &                - zti(ji - 1,jj + 1,1  ) - zti(ji - 1,jj ,1  ))    &   
+     &                /(zti(ji + 1,jj + 1,1  ) + zti(ji + 1,jj ,1  )    &   
+     &                + zti(ji - 1,jj + 1,1  ) + zti(ji - 1,jj ,1  ) +    &   
+     &                rtrn))/(e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,1))    &   
+     &                *umask(ji - 1,jj,1  )*umask(ji - 1,jj + 1,1  )    &   
+     &                *umask(ji    ,jj,1  )*umask(ji  ,jj + 1 ,1  )    
+
+                END DO
+              END DO
+          ENDIF
+
+          ! ... Lateral boundary conditions on z[xyz]
+          CALL lbc_lnk( zx, 'U', -1. )
+          CALL lbc_lnk( zy, 'V', -1. )
+          CALL lbc_lnk( zz, 'W',  1. )
+
+! 2.4 reinitialization
+
+          DO jk = 1,jpk
+            DO jj = 1,jpj
+              DO ji = 1,jpi
+                zaa(ji,jj,jk) = zx(ji,jj,jk)
+                zbb(ji,jj,jk) = zy(ji,jj,jk)
+                zcc(ji,jj,jk) = zz(ji,jj,jk)
+              END DO
+            END DO
+          END DO
+
+! 2.5 calcul of the final field:
+!    advection by antidiffusive mass fluxes and an upstream scheme
+
+          DO jk = 1,jpk
+             DO jj = 2,jpjm1
+                DO ji = 2,jpim1
+                   zfp_ui = 0.5 * ( zaa(ji,jj,jk) + ABS( zaa(ji,jj,jk) ) )
+                   zfp_vj = 0.5 * ( zbb(ji,jj,jk) + ABS( zbb(ji,jj,jk) ) )
+                   zfm_ui = 0.5 * ( zaa(ji,jj,jk) - ABS( zaa(ji,jj,jk) ) )
+                   zfm_vj = 0.5 * ( zbb(ji,jj,jk) - ABS( zbb(ji,jj,jk) ) )            
+                   zkx(ji,jj,jk) = zfp_ui * zti(ji,jj,jk) + zfm_ui * zti(ji+1,jj  ,jk) 
+                   zky(ji,jj,jk) = zfp_vj * zti(ji,jj,jk) + zfm_vj * zti(ji    ,jj+1,jk)             
+                END DO
+             END DO
+          END DO
+
+          DO jk = 2,jpk
+             DO jj = 1,jpj
+                DO ji = 1,jpi
+                   zfp_w = 0.5 * ( zcc(ji,jj,jk) + ABS( zcc(ji,jj,jk) ) )
+                   zfm_w = 0.5 * ( zcc(ji,jj,jk) - ABS( zcc(ji,jj,jk) ) )       
+                   zkz(ji,jj,jk) = zfp_w * zti(ji,jj,jk) + zfm_w * zti(ji,jj,jk-1)     
+                END DO
+             END DO
+          END DO
+
+
+! ... Lateral boundary conditions on zk[xy]
+      CALL lbc_lnk( zkx, 'U', -1. )
+      CALL lbc_lnk( zky, 'V', -1. )
+
+
+! 2.6. calcul of after field using an upstream advection scheme
+
+          DO jk = 1,jpkm1
+            DO jj = 2,jpjm1
+              DO ji = 2,jpim1
+                zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk))
+                ztj(ji,jj,jk) = -zbtr*     &  
+     &              ( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk)    &  
+     &              + zky(ji,jj,jk) - zky(ji,jj - 1,jk)    &  
+     &              + zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) )
+#if defined key_trc_diatrd
+                IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -    &  
+     &              zbtr*( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk) )   
+
+                IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -    &  
+     &              zbtr*( zky(ji,jj,jk) - zky(ji,jj - 1,jk) )
+
+                IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -    &  
+     &              zbtr*( zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) )
+#endif
+              END DO
+            END DO
+          END DO
+
+! 2.6 END of antidiffusive correction loop
+
+        END DO
+
+! 3. trend due to horizontal and vertical advection of tracer jn
+! --------------------------------------------------------------
+
+        DO jk = 1,jpk
+          DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+              ztra = ( zbuf(ji,jj,jk) + ztj(ji,jj,jk) ) * tmask(ji,jj,jk)
+              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+            END DO
+          END DO
+        END DO
+
+! 4.0 convert the transport trend into advection trend
+! ----------------------------------------------------
+
+#if defined key_trc_diatrd
+        DO jk = 1,jpk
+          DO jj = 2,jpjm1
+            DO  ji = 2,jpim1
+              zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk))
+              zgm = zbtr * trn(ji,jj,jk,jn) *     &  
+     &            ( zun(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk)    &  
+     &            -zun(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk))
+
+              zgz = zbtr * trn(ji,jj,jk,jn) *     &  
+     &            ( zvn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk)    &  
+     &            -zvn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk))
+
+              IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) + zgm
+              IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) + zgz
+              IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3)    &  
+     &            - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
+            END DO
+          END DO
+        END DO
+
+        ! Lateral boundary conditions on trtrd:
+
+        IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),1), 'T', 1. )
+        IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),2), 'T', 1. )
+        IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),3), 'T', 1. )
+#endif
+
+ 
+        ! END of tracer loop
+        ! ==================
+     ENDDO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('smolar - adv')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+     
+  END SUBROUTINE trc_adv_smolar
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_adv_smolar( kt ) 
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_adv_smolar: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_adv_smolar
+#endif
+
+   !!======================================================================
+END MODULE trcadv_smolar
Index: trunk/NEMO/TOP_SRC/TRP/trcadv_tvd.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcadv_tvd.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcadv_tvd.F90	(revision 941)
@@ -0,0 +1,499 @@
+MODULE trcadv_tvd
+   !!==============================================================================
+   !!                       ***  MODULE  trcadv_tvd  ***
+   !! Ocean passive tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_adv_tvd  : update the passive tracer trend with the horizontal
+   !!                  and vertical advection trends using a TVD scheme
+   !!   nonosc       : compute monotonic tracer fluxes by a nonoscillatory
+   !!                  algorithm 
+   !!----------------------------------------------------------------------
+   USE oce_trc             ! ocean dynamics and active tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE lbclnk              ! ocean lateral boundary conditions (or mpp link)
+   USE trcbbl              ! advective passive tracers in the BBL
+   USE prtctl_trc      ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC trc_adv_tvd    ! routine called by trcstp.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_adv_tvd( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_tvd  ***
+      !! 
+      !! **  Purpose :   Compute the now trend due to total advection of 
+      !!       tracers and add it to the general trend of tracer equations
+      !!
+      !! **  Method  :   TVD scheme, i.e. 2nd order centered scheme with
+      !!       corrected flux (monotonic correction)
+      !!       note: - this advection scheme needs a leap-frog time scheme
+      !!
+      !! ** Action : - update tra with the now advective tracer trends
+      !!             - save the trends in trtrd ('key_trc_diatrd)
+      !!
+      !! History :
+      !!        !  95-12  (L. Mortier)  Original code
+      !!        !  00-01  (H. Loukos)  adapted to ORCA 
+      !!        !  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
+      !!   9.0  !  02-06  (C. Ethe, G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+#if defined key_trcbbl_adv
+      USE oce_trc            , zun => ua,  &  ! use ua as workspace
+         &                     zvn => va      ! use va as workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwn
+#else
+      USE oce_trc            , zun => un,  &  ! When no bbl, zun == un
+                               zvn => vn,  &  !             zvn == vn
+                               zwn => wn      !             zwn == wn
+#endif
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk,jn           ! dummy loop indices
+
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zti, ztu, ztv, ztw                ! temporary workspace
+
+      REAL(wp) ::   &
+         z2dtt, zbtr, zeu, zev, zew, z2, &  ! temporary scalar
+         zfp_ui, zfp_vj, zfp_wk,         &  !    "         "
+         zfm_ui, zfm_vj, zfm_wk             !    "         "
+
+#if defined key_trc_diatrd
+       REAL(wp) :: &
+          zgm, zgz
+#endif
+
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      zti(:,:,:) = 0.e0
+
+      IF( kt == nittrc000  .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_adv_tvd : TVD advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN
+         z2=1.
+      ELSE
+         z2=2.
+      ENDIF
+
+#if defined key_trcbbl_adv
+      ! Advective Bottom boundary layer: add the velocity
+      ! -------------------------------------------------
+      zun(:,:,:) = un (:,:,:) - u_trc_bbl(:,:,:)
+      zvn(:,:,:) = vn (:,:,:) - v_trc_bbl(:,:,:)
+      zwn(:,:,:) = wn (:,:,:) + w_trc_bbl(:,:,:)
+#endif
+
+      DO jn = 1, jptra
+
+         ! 1. Bottom value : flux set to zero
+         ! ---------------
+         ztu(:,:,jpk) = 0.e0
+         ztv(:,:,jpk) = 0.e0
+         ztw(:,:,jpk) = 0.e0
+         zti(:,:,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) * zun(ji,jj,jk)
+                  zev = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(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 * trb(ji,jj,jk,jn) + zfm_ui * trb(ji+1,jj  ,jk,jn)
+                  ztv(ji,jj,jk) = zfp_vj * trb(ji,jj,jk,jn) + zfm_vj * trb(ji  ,jj+1,jk,jn)
+               END DO
+            END DO
+         END DO
+
+         ! upstream tracer flux in the k direction
+         ! Surface value
+         IF( lk_dynspg_rl ) THEN   ! rigid lid : flux set to zero
+            ztw(:,:,1) = 0.e0
+         ELSE                      ! free surface 
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zew = e1t(ji,jj) * e2t(ji,jj) * zwn(ji,jj,1)
+                  ztw(ji,jj,1) = zew * trb(ji,jj,1,jn)
+               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) * zwn(ji,jj,jk)
+                  zfp_wk = zew + ABS( zew )
+                  zfm_wk = zew - ABS( zew )
+                  ztw(ji,jj,jk) = zfp_wk * trb(ji,jj,jk,jn) + zfm_wk * trb(ji,jj,jk-1,jn)
+               END DO
+            END DO
+         END DO
+
+         ! total advective 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) )
+                  zti(ji,jj,jk) = - ( 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
+
+#if defined key_trc_diatrd
+                  IF ( luttrd(jn) ) &
+                     trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -  &
+                        &                          zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) )                     
+                  IF ( luttrd(jn) ) &
+                     trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -  &
+                        &                          zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )                     
+                  IF ( luttrd(jn) ) &
+                     trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -  &
+                        &                          zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )
+#endif
+               END DO
+            END DO
+         END DO
+
+
+         ! update and guess with monotonic sheme
+         DO jk = 1, jpkm1
+            z2dtt = z2 * rdttra(jk) * FLOAT(ndttrc)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  tra(ji,jj,jk,jn) =  tra(ji,jj,jk,jn) + zti(ji,jj,jk)
+                  zti (ji,jj,jk) = ( trb(ji,jj,jk,jn) + z2dtt * zti(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. )
+
+         ! 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) * zun(ji,jj,jk)
+                  zev = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
+                  ztu(ji,jj,jk) = zeu * ( trn(ji,jj,jk,jn) + trn(ji+1,jj,jk,jn) ) - ztu(ji,jj,jk)
+                  ztv(ji,jj,jk) = zev * ( trn(ji,jj,jk,jn) + trn(ji,jj+1,jk,jn) ) - ztv(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+         ! antidiffusive flux on k
+         ! Surface value
+         ztw(:,:,1) = 0.
+
+         ! Interior value
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * zwn(ji,jj,jk)
+                  ztw(ji,jj,jk) = zew * ( trn(ji,jj,jk,jn) + trn(ji,jj,jk-1,jn) ) - ztw(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+         ! Lateral bondary conditions
+         CALL lbc_lnk( ztu, 'U', -1. )
+         CALL lbc_lnk( ztv, 'V', -1. )
+         CALL lbc_lnk( ztw, 'W',  1. )
+
+         ! 4. monotonicity algorithm
+         ! -------------------------
+         CALL nonosc( trb(:,:,:,jn), ztu, ztv, ztw, zti, 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) )
+#if defined key_trc_diatrd
+                  IF ( luttrd(jn) ) &
+                     trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -  &
+                        &                          zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) )                     
+                  IF ( luttrd(jn) ) &
+                     trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -  &
+                        &                          zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )                     
+                  IF ( luttrd(jn) ) &
+                     trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -  &
+                        &                          zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )
+#endif
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)   &
+                     &         - ( 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
+               END DO
+            END DO
+         END DO
+         ! 6.0 convert the transport trend into advection trend
+         ! ----------------------------------------------------
+         
+#if defined key_trc_diatrd
+         DO jk = 1,jpk
+            DO jj = 2,jpjm1
+               DO  ji = 2,jpim1
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  zgm = zbtr * trn(ji,jj,jk,jn) *     &
+                     &         (  zun(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk)    &
+                     &          - zun(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) )
+                  
+                  zgz = zbtr * trn(ji,jj,jk,jn) *     &
+                     &         (  zvn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk)    &
+                     &          - zvn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) )
+                  
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) + zgm
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) + zgz
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3)    &
+                     &            - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         
+         ! Lateral boundary conditions on trtrd:
+         
+         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),1), 'T', 1. )
+         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),2), 'T', 1. )
+         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),3), 'T', 1. )
+#endif
+
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('tvd - adv')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_adv_tvd
+
+
+   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, prdt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE nonosc  ***
+      !!     
+      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
+      !!       scheme and the before field by a nonoscillatory algorithm 
+      !!
+      !! **  Method  :   ... ???
+      !!       warning : pbef and paft must be masked, but the boundaries
+      !!       conditions on the fluxes are not necessary zalezak (1979)
+      !!       drange (1995) multi-dimensional forward-in-time and upstream-
+      !!       in-space based differencing for fluid
+      !!
+      !! History :
+      !!        !  97-04  (L. Mortier) Original code
+      !!        !  00-02  (H. Loukos)  rewritting for opa8
+      !!        !  00-10  (M.A Foujols, E. Kestenare)  lateral b.c.
+      !!        !  01-07  (E. Durand G. Madec)  adapted for T & S
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), INTENT( in ) ::   &
+         prdt                               ! ???
+      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
+         pcc                                ! monotonic flux in the k direction
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk               ! dummy loop indices
+      INTEGER ::   ikm1
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbetup, zbetdo
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt
+      !!----------------------------------------------------------------------
+
+      zbig = 1.e+40
+      zrtrn = 1.e-15
+      zbetup(:,:,:) = 0.e0   ;   zbetdo(:,:,:) = 0.e0
+
+      ! Search local extrema
+      ! --------------------
+      ! large negative value (-zbig) inside land
+      ! large negative value (-zbig) inside land
+      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
+      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
+      ! search maximum in neighbourhood
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbetup(ji,jj,jk) = MAX(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
+                  &                     pbef(ji-1,jj  ,jk  ), pbef(ji+1,jj  ,jk  ),   &
+                  &                     paft(ji-1,jj  ,jk  ), paft(ji+1,jj  ,jk  ),   &
+                  &                     pbef(ji  ,jj-1,jk  ), pbef(ji  ,jj+1,jk  ),   &
+                  &                     paft(ji  ,jj-1,jk  ), paft(ji  ,jj+1,jk  ),   &
+                  &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
+                  &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
+            END DO
+         END DO
+      END DO
+      ! large positive value (+zbig) inside land
+      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
+      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
+      ! search minimum in neighbourhood
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbetdo(ji,jj,jk) = MIN(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
+                  &                     pbef(ji-1,jj  ,jk  ), pbef(ji+1,jj  ,jk  ),   &
+                  &                     paft(ji-1,jj  ,jk  ), paft(ji+1,jj  ,jk  ),   &
+                  &                     pbef(ji  ,jj-1,jk  ), pbef(ji  ,jj+1,jk  ),   &
+                  &                     paft(ji  ,jj-1,jk  ), paft(ji  ,jj+1,jk  ),   &
+                  &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
+                  &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
+            END DO
+         END DO
+      END DO
+
+      ! restore masked values to zero
+      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:)
+      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:)
+ 
+
+      ! 2. Positive and negative part of fluxes and beta terms
+      ! ------------------------------------------------------
+
+      DO jk = 1, jpkm1
+         z2dtt = prdt * rdttra(jk) * FLOAT(ndttrc)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! positive & negative part of the flux
+               zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
+               zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
+               ! up & down beta terms
+               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
+               zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt
+               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt
+            END DO
+         END DO
+      END DO
+
+      ! lateral boundary condition on zbetup & zbetdo   (unchanged sign)
+      CALL lbc_lnk( zbetup, 'T', 1. )
+      CALL lbc_lnk( zbetdo, 'T', 1. )
+
+
+      ! 3. monotonic flux in the i direction, i.e. paa
+      ! ----------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zc = paa(ji,jj,jk)
+               IF( zc >= 0. ) THEN
+                  za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+                  paa(ji,jj,jk) = za * zc
+               ELSE
+                  zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+                  paa(ji,jj,jk) = zb * zc
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! lateral boundary condition on paa   (changed sign)
+      CALL lbc_lnk( paa, 'U', -1. )
+
+
+      ! 4. monotonic flux in the j direction, i.e. pbb
+      ! ----------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zc = pbb(ji,jj,jk)
+               IF( zc >= 0. ) THEN
+                  za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+                  pbb(ji,jj,jk) = za * zc
+               ELSE
+                  zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+                  pbb(ji,jj,jk) = zb * zc
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! lateral boundary condition on pbb   (changed sign)
+      CALL lbc_lnk( pbb, 'V', -1. )
+
+
+      ! monotonic flux in the k direction, i.e. pcc
+      ! -------------------------------------------
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zc = pcc(ji,jj,jk)
+               IF( zc >= 0. ) THEN
+                  za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
+                  pcc(ji,jj,jk) = za * zc
+               ELSE
+                  zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
+                  pcc(ji,jj,jk) = zb * zc
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! lateral boundary condition on pcc   (unchanged sign)
+      CALL lbc_lnk( pcc, 'W', 1. )
+
+   END SUBROUTINE nonosc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_adv_tvd( kt )  
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_adv_tvd: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_adv_tvd
+#endif
+
+   !!======================================================================
+END MODULE trcadv_tvd
Index: trunk/NEMO/TOP_SRC/TRP/trcbbc.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcbbc.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcbbc.F90	(revision 941)
@@ -0,0 +1,237 @@
+MODULE trcbbc
+   !!======================================================================
+   !!                       ***  MODULE  trcbbc  ***
+   !! Ocean passive tracers:  bottom boundary condition
+   !!======================================================================
+#if  defined key_top  &&  defined key_trcbbc
+   !!----------------------------------------------------------------------
+   !!   'key_top' and 'key_trcbbc'       TOP model and geothermal heat flux
+   !!----------------------------------------------------------------------
+   !!   trc_bbc      : update the tracer trend at ocean bottom 
+   !!   trc_bbc_init : initialization of geothermal heat flux trend
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc             ! ocean dynamics and active tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE prtctl_trc          ! Print control for debbuging
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC trc_bbc          ! routine called by trcstp.F90
+
+   !! to be transfert in the namelist ???!   
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbc = .TRUE.   !: bbc flag
+
+   !! * Module variables
+   INTEGER ::                       & !!! ** bbc namelist (nambbc) **
+      ngeo_trc_flux = 1                    ! Geothermal flux (0:no flux, 1:constant flux,
+      !                                !                  2:read in file )
+   REAL(wp) ::                      & !!! ** bbc namlist **
+      ngeo_trc_flux_const = 86.4e-3        ! Constant value of geothermal heat flux
+
+   INTEGER, DIMENSION(jpi,jpj) ::   &
+      nbotlevt                         ! ocean bottom level index at T-pt
+   REAL(wp), DIMENSION(jpi,jpj) ::  &
+      qgh_trd                          ! geothermal heating trend
+ 
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!  TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_bbc( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_bbc  ***
+      !!
+      !! ** Purpose :   Compute the bottom boundary contition on passive tracer 
+      !!      associated with geothermal heating and add it to the general
+      !!      trend of tracers equations.
+      !!
+      !! ** Method  :   The geothermal heat flux set to its constant value of 
+      !!       86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
+      !!       The temperature trend associated to this heat flux through the
+      !!       ocean bottom can be computed once and is added to the temperature
+      !!       trend juste above the bottom at each time step:
+      !!            tra = tra + Qsf / (rau0 rcp e3T) for k= mbathy -1
+      !!       Where Qsf is the geothermal heat flux.
+      !!
+      !! ** Action  : - update the temperature trends tra with the trend of
+      !!                the ocean bottom boundary condition
+      !!
+      !! References :
+      !!      Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
+      !!
+      !! History :
+      !!   8.1  !  99-10  (G. Madec)  original code
+      !!   8.5  !  02-08  (G. Madec)  free form + modules
+      !!   9.0  !  04-03  (C. Ethe)  adpated for passive tracers
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
+
+      !! * Local declarations
+#if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+      INTEGER ::   ji, jn                  ! dummy loop indices
+#else
+      INTEGER ::   ji, jj, jn              ! dummy loop indices
+#endif
+      REAL(wp) ::   ztra                ! temporary scalar
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      ! 0. Initialization
+      IF( kt == nittrc000 )   CALL trc_bbc_init
+
+      ! 1. Add the geothermal heat flux trend on temperature
+
+      SELECT CASE ( ngeo_trc_flux )
+
+      CASE ( 1:2 )                !  geothermal heat flux
+
+         DO jn = 1, jptra
+#if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+               tra(ji,1,nbotlevt(ji,1),jn) = tra(ji,1,nbotlevt(ji,1),jn) + qgh_trd(ji,1)
+            END DO
+#else
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  tra(ji,jj,nbotlevt(ji,jj),jn) = tra(ji,jj,nbotlevt(ji,jj),jn) + qgh_trd(ji,jj)
+               END DO
+            END DO
+#endif
+         END DO
+
+         IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+            WRITE(charout, FMT="('bbc')")
+            CALL prt_ctl_trc_info(charout)
+            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         ENDIF
+      END SELECT
+
+   END SUBROUTINE trc_bbc
+
+
+   SUBROUTINE trc_bbc_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_bbc_init  ***
+      !!
+      !! ** Purpose :   Compute once for all the trend associated with geo-
+      !!      thermal heating that will be applied at each time step at the
+      !!      bottom ocean level
+      !!
+      !! ** Method  :   Read the namtrabbc namelist and check the parameters.
+      !!      called at the first time step (nittrc000)
+      !!
+      !! ** Input   : - Namlist namtrcbbc
+      !!              - NetCDF file  : passivetrc_geothermal_heating.nc 
+      !!                               ( if necessary )
+      !!
+      !! ** Action  : - compute the heat geothermal trend qgh_trd
+      !!              - compute the bottom ocean level nbotlevt
+      !!
+      !! history :
+      !!  8.5  ! 02-11 (A. Bozec) original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE iom
+
+      !! * local declarations
+      CHARACTER (len=32) ::   clname
+      INTEGER  ::   ji, jj              ! dummy loop indices
+      INTEGER  ::   inum = 11           ! temporary logical unit
+
+      NAMELIST/namtrcbbc/ngeo_trc_flux, ngeo_trc_flux_const 
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist nambbc : bottom momentum boundary condition
+      REWIND ( numnamtra )
+      READ   ( numnamtra, namtrcbbc )
+
+      ! Control print
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'trc_bbc : Passive tracers Bottom Boundary Condition (bbc)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~   Geothermal heatflux'
+      IF(lwp) WRITE(numout,*) '          Namelist namtrcbbc : set bbc parameters'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '             Geothermal flux           ngeo_trc_flux       = ', ngeo_trc_flux
+      IF(lwp) WRITE(numout,*) '             Constant geothermal flux  ngeo_trc_flux_const = ', ngeo_trc_flux_const
+      IF(lwp) WRITE(numout,*)
+
+      ! level of the ocean bottom at T-point
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 )
+         END DO
+      END DO
+
+      ! initialization of geothermal heat flux
+
+      SELECT CASE ( ngeo_trc_flux )
+
+      CASE ( 0 )                ! no geothermal heat flux
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '             *** no geothermal heat flux'
+
+      CASE ( 1 )                ! constant flux
+         IF(lwp) WRITE(numout,*) '             *** constant heat flux  =   ', ngeo_trc_flux_const
+         qgh_trd(:,:) = ngeo_trc_flux_const
+
+      CASE ( 2 )                ! variable geothermal heat flux
+         ! read the geothermal fluxes in mW/m2
+         CALL iom_open ( 'geothermal_heating_trc.nc', inum )
+         CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd )
+         CALL iom_close (inum)
+
+         qgh_trd(:,:) = qgh_trd(:,:) * 1.e-3 ! conversion in W/m2
+
+      CASE DEFAULT
+         WRITE(ctmp1,*) '     bad flag value for ngeo_flux = ', ngeo_flux
+         CALL ctl_stop( ctmp1 )
+
+      END SELECT
+
+      ! geothermal heat flux trend
+
+      SELECT CASE ( ngeo_trc_flux )
+
+      CASE ( 1:2 )                !  geothermal heat flux
+
+#if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+         DO ji = 1, jpij   ! vector opt. (forced unrolling)
+            qgh_trd(ji,1) = ro0cpr * qgh_trd(ji,1) / fse3t(ji,1,nbotlevt(ji,1) )
+         END DO
+#else
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               qgh_trd(ji,jj) = ro0cpr * qgh_trd(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj))
+            END DO
+         END DO
+#endif
+
+      END SELECT
+
+   END SUBROUTINE trc_bbc_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbc = .FALSE.  !: bbc flag
+CONTAINS
+   SUBROUTINE trc_bbc( kt )           ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_bbc: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bbc
+#endif
+
+   !!======================================================================
+END MODULE trcbbc
Index: trunk/NEMO/TOP_SRC/TRP/trcbbl.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcbbl.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcbbl.F90	(revision 941)
@@ -0,0 +1,555 @@
+MODULE trcbbl
+   !!==============================================================================
+   !!                       ***  MODULE  trcbbl  ***
+   !! Ocean passive tracers physics :  advective and/or diffusive bottom boundary 
+   !!                                  layer scheme
+   !!==============================================================================
+#if  defined key_top && ( defined key_trcbbl_dif   ||   defined key_trcbbl_adv ) && ! defined key_c1d
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   'key_top'         and                                    TOP models
+   !!   'key_trcbbl_dif'   or               diffusive bottom boundary layer
+   !!   'key_trcbbl_adv'                    advective bottom boundary layer
+   !!----------------------------------------------------------------------
+   !!   trc_bbl_dif  : update the passive tracer trends due to the bottom
+   !!                  boundary layer (diffusive only)
+   !!   trc_bbl_adv  : update the passive tracer trends due to the bottom
+   !!                  boundary layer (advective and/or diffusive)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc             ! ocean dynamics and active tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE trctrp_lec      ! passive tracers transport
+   USE prtctl_trc          ! Print control for debbuging
+   USE eosbn2
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trc_bbl_dif    ! routine called by step.F90
+   PUBLIC trc_bbl_adv    ! routine called by step.F90
+
+   !! * Shared module variables
+# if defined key_trcbbl_dif
+   LOGICAL, PUBLIC, PARAMETER ::    &  !:
+      lk_trcbbl_dif = .TRUE.   !: advective bottom boundary layer flag
+
+# else
+   LOGICAL, PUBLIC, PARAMETER ::    &  !:
+      lk_trcbbl_dif = .FALSE.  !: advective bottom boundary layer flag
+# endif
+
+# if defined key_trcbbl_adv
+   LOGICAL, PUBLIC, PARAMETER ::    &  !:
+      lk_trcbbl_adv = .TRUE.   !: advective bottom boundary layer flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !:
+       u_trc_bbl, v_trc_bbl, &  !: velocity involved in exhanges in the advective BBL
+       w_trc_bbl                !: vertical increment of velocity due to advective BBL
+       !                        !  only affect tracer vertical advection
+# else
+   LOGICAL, PUBLIC, PARAMETER ::    &  !:
+      lk_trcbbl_adv = .FALSE.  !: advective bottom boundary layer flag
+# endif
+
+   !! * Module variables
+   INTEGER, DIMENSION(jpi,jpj) ::   &  !:
+      mbkt, mbku, mbkv                 ! ???
+
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_bbl_dif( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_bbl_dif  ***
+      !!
+      !! ** Purpose :   Compute the before tracer 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
+      !!      a downslope velocity of 20 cm/s if the condition for slope
+      !!      convection is satified)
+      !!      Add this before trend to the general trend tra of the 
+      !!      botton ocean tracer point:
+      !!         tra = tra + difft
+      !!
+      !! ** Action  : - update tra at the bottom level with the bottom
+      !!                boundary layer trend
+      !!
+      !! References :
+      !!     Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!
+      !! 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
+      !!   9.0  !  04-03  (C. Ethe)   Adaptation for passive tracers
+      !!----------------------------------------------------------------------
+      !! * Arguments 
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !! * Local declarations
+      INTEGER ::   ji, jj,jn                ! 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
+         zgdrho, zbtr, ztra
+      REAL(wp), DIMENSION(jpi,jpj) ::    &
+        zki, zkj, zkx, zky,    &  ! temporary workspace arrays
+        ztnb, zsnb, zdep,                &
+        ztrb, zahu, zahv
+      CHARACTER (len=22) :: charout
+      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 == nittrc000 )   CALL trc_bbl_init
+
+
+      ! 0. 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   &&   ! defined key_mpp_omp
+      jj = 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)
+            zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level
+#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+         END DO
+#  endif
+      END DO
+
+      IF( ln_zps ) THEN      ! partial steps correction
+
+#   if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+         jj = 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) = atrcbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1)
+               zahv(ji,jj) = atrcbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1)
+#   if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+            END DO
+#   endif
+         END DO
+      ELSE                  ! z-coordinate - full steps or s-coordinate
+#   if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+         jj = 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) = atrcbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1)
+               zahv(ji,jj) = atrcbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1)
+#   if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+            END DO
+#   endif
+         END DO
+     ENDIF
+
+!!
+!!     OFFLINE VERSION OF DIFFUSIVE BBL
+!!
+#if defined key_off_tra
+
+      ! 2. Additional second order diffusive trends
+      ! -------------------------------------------
+
+      DO jn = 1, jptra
+         ! first derivative (gradient)
+         
+#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+         jj = 1
+         DO ji = 1, jpij   ! vector opt. (forced unrolling)
+#  else
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+#  endif
+               ik = mbkt(ji,jj) 
+               ztrb(ji,jj) = trb(ji,jj,ik,jn) * tmask(ji,jj,1)
+#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+            END DO
+#  endif
+         END DO
+
+#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+#  else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+#  endif
+               zkx(ji,jj) = bblx(ji,jj) * zahu(ji,jj) * ( ztrb(ji+1,jj) - ztrb(ji,jj) )
+               zky(ji,jj) = bbly(ji,jj) * zahv(ji,jj) * ( ztrb(ji,jj+1) - ztrb(ji,jj) )
+#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+            END DO
+#  endif
+         END DO
+!!
+!!  ONLINE VERSION OF DIFFUSIVE BBL
+!!
+#else
+      ! 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 ( neos )
+
+      	CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+#  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)
+#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+         END DO
+#  endif
+      END DO
+
+#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+#  else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+#  endif
+            ! 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)
+#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+         END DO
+#  endif
+      END DO
+
+	CASE ( 1 )               ! Linear formulation function of temperature only
+
+#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+      jj = 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 =  ( 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)
+#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+         END DO
+#  endif
+      END DO
+
+#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+#  else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+#  endif
+            ! 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)
+
+#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+         END DO
+#  endif
+      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 = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   &
+                     -  ralpha*( 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)
+        END DO
+      END DO
+
+      DO jj = 1, jpjm1
+        DO ji = 1, fs_jpim1   ! vector opt.
+            ! local density gradient along j-bathymetric slope
+            zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   &
+                     -  ralpha*( 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)
+         END DO
+      END DO
+
+
+      CASE DEFAULT
+
+         WRITE(ctmp1,*) '          bad flag value for neos = ', neos
+         CALL ctl_stop( ctmp1 )
+
+      END SELECT
+      
+      ! 2. Additional second order diffusive trends
+      ! -------------------------------------------
+
+      DO jn = 1, jptra
+         ! first derivative (gradient)
+
+#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+         jj = 1
+         DO ji = 1, jpij   ! vector opt. (forced unrolling)
+#  else
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+#  endif
+               ik = mbkt(ji,jj)
+               ztrb(ji,jj) = trb(ji,jj,ik,jn) * tmask(ji,jj,1)
+#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+            END DO
+#  endif
+         END DO
+#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+         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) * ( ztrb(ji+1,jj) - ztrb(ji,jj) )
+               zky(ji,jj) = zkj(ji,jj) * ( ztrb(ji,jj+1) - ztrb(ji,jj) )
+#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+            END DO
+#  endif
+         END DO
+#endif
+
+         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) )
+               
+            END SELECT
+            
+         ENDIF
+         
+         ! second derivative (divergence) and add to the general tracer trend
+#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+         jj = 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) )
+               ztra = (  zkx(ji,jj) - zkx(ji-1,jj  )    &
+                  &    + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr
+               tra(ji,jj,ik,jn) = tra(ji,jj,ik,jn) + ztra
+#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+            END DO
+#  endif
+         END DO
+
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('bbl - dif')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_bbl_dif
+
+# if defined key_trcbbl_adv
+   !!----------------------------------------------------------------------
+   !!   'key_trcbbl_adv'                    advective bottom boundary layer
+   !!----------------------------------------------------------------------
+#  include "trcbbl_adv.h90"
+# else
+   !!----------------------------------------------------------------------
+   !!   Default option :                 NO advective bottom boundary layer
+   !!----------------------------------------------------------------------
+   SUBROUTINE trc_bbl_adv (kt )              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_bbl_adv: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bbl_adv
+# endif
+
+   SUBROUTINE trc_bbl_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_bbl_init  ***
+      !!
+      !! ** Purpose :   Initialization for the bottom boundary layer scheme.
+      !!
+      !!
+      !! History :
+      !!    8.5  !  02-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj      ! dummy loop indices
+
+      REAL(wp),  DIMENSION(jpi,jpj) :: zmbk  
+
+      !!----------------------------------------------------------------------
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            mbkt(ji,jj) = MAX( mbathy(ji,jj) - 1, 1 )   ! vertical index of the bottom ocean T-level
+         END DO
+      END DO
+      
+      DO jj = 1, jpjm1
+         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 )
+         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_trcbbl_adv
+      w_trc_bbl(:,:,:) = 0.e0    ! initialisation of w_trc_bbl to zero
+# endif
+
+   END SUBROUTINE trc_bbl_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      No bottom boundary layer scheme
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_dif = .FALSE.   !: diff bbl flag
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_adv = .FALSE.   !: adv  bbl flag
+CONTAINS
+   SUBROUTINE trc_bbl_dif (kt )              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_bbl_dif: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bbl_dif
+   SUBROUTINE trc_bbl_adv (kt )              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_bbl_adv: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bbl_adv
+#endif
+
+   !!======================================================================
+END MODULE trcbbl
Index: trunk/NEMO/TOP_SRC/TRP/trcbbl_adv.h90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcbbl_adv.h90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcbbl_adv.h90	(revision 941)
@@ -0,0 +1,490 @@
+   !!----------------------------------------------------------------------
+   !!                     ***  trcbbl_adv.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE trc_bbl_adv( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_bbl_adv  ***
+      !!                   
+      !! ** Purpose :   Compute the before tracer 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 : tra =tra + 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 tra of the
+      !!      botton ocean tracer point:
+      !!              tra = tra + difft
+      !!
+      !! ** Action  : - update tra at the bottom level with the bottom
+      !!                boundary layer trend
+      !!
+      !! References :
+      !!     Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!
+      !! History :
+      !!   8.5  !  02-12  (A. de Miranda, G. Madec)  Original Code 
+      !!   9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines )
+      !!   9.0  !  04-03  (C. Ethe) Adaptation for Passive tracers 
+      !!----------------------------------------------------------------------     
+      !gh
+      
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt        ! ocean time-step 
+      
+      !! * Local declarations
+      INTEGER :: ji, jj, jk, jn            ! dummy loop indices
+      INTEGER :: ik, iku, ikv              ! temporary integers
+
+      REAL(wp) ::   &
+         zsign, zt, zs, zh, zalbet,     &  ! temporary scalars
+         zgdrho, zbtr, ztra                !    "         " 
+      REAL(wp), DIMENSION(jpi,jpj) ::   &  
+      	 ztnb, zsnb, zdep, ztrb  	   ! temporary workspace arrays 
+      REAL(wp), DIMENSION(jpi,jpj) ::   &  ! temporary workspace arrays
+         zalphax, zwu, zunb,            &  !    "                  "
+         zalphay, zwv, zvnb,            &  !    "                  "
+         zwx, zwy, zww, zwz,            &  !    "                  "
+         zti, zsi ,ztmin,ztmax, zsmin,zsmax!    "                  "
+	                           !    "                  "
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zhdivn                            ! temporary workspace arrays
+      REAL(wp) ::   &
+         zfui, zfvj, zbt,  zsigna,  	&  ! temporary scalars
+	 iku1,iku2,ikv1,ikv2,  		&  ! temporary scalars
+	 ze3u,ze3v,  			&  ! temporary scalars
+	 z2,z2dtt           			! temporary scalars
+      REAL(wp) ::   &
+         fsalbt, pft, pfs, pfh             ! statement function
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+      ! 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 trc_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   &&   ! defined key_mpp_omp
+      jj = 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)   	! masked now T at the ocean bottom 
+            zsnb(ji,jj) = sn(ji,jj,ik)  	! masked now S at the ocean bottom
+            zdep(ji,jj) = fsdept(ji,jj,ik)                 ! depth of the ocean bottom T-level
+!gh
+            zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) 
+            zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
+#if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+         END DO
+#endif
+      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 ( neos )
+
+      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)
+        END DO
+      END DO
+
+      DO jj = 1, jpjm1
+        DO ji = 1, fs_jpim1   ! vector opt.
+      !   ... 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.
+            ! 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) )
+!gh            ! masked ratio alpha/beta
+            ! local density 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)
+         END DO
+      END DO
+
+      DO jj = 1, jpjm1
+        DO ji = 1, fs_jpim1   ! vector opt.
+            ! 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) )
+!gh             ! masked ratio alpha/beta
+            ! 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 = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   &
+                     -  ralpha*( 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)
+        END DO
+      END DO
+
+      DO jj = 1, jpjm1
+        DO ji = 1, fs_jpim1   ! vector opt.
+	   ! local density gradient along j-bathymetric slope
+            zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   &
+                   -    ralpha*( 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 DEFAULT
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+
+      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_trc_bbl(:,:,:) = 0.e0
+       v_trc_bbl(:,:,:) = 0.e0
+       
+       
+!gh	  
+       IF( ln_zps ) THEN
+      ! partial steps correction   
+      
+#if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+       jj = 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_trc_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) * ze3u / fse3u(ji,jj,iku)
+                v_trc_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * ze3v / fse3v(ji,jj,ikv)       
+             ENDIF
+#if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+          END DO
+#endif
+       END DO
+
+      ! lateral boundary conditions on u_trc_bbl and v_trc_bbl   (changed sign)
+       CALL lbc_lnk( u_trc_bbl, 'U', -1. )   ;   CALL lbc_lnk( v_trc_bbl, 'V', -1. )
+       
+    ELSE    ! z-coordinate - full steps or s-coordinate	 
+       ! if not partial step loop over the whole domain no lbc call
+
+#if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+      jj = 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_trc_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) 
+               v_trc_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv)       
+            ENDIF
+#if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+         END DO
+#endif
+          END DO
+       
+       ENDIF
+       
+       DO jn = 1, jptra
+
+#if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+          jj = 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
+                ztrb(ji,jj) = trb(ji,jj,ik,jn) * tmask(ji,jj,1)    ! masked now T at the ocean bottom 
+#if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+             END DO
+#endif
+          END DO
+
+
+
+          ! 5. Along sigma advective trend
+          ! -------------------------------
+          ! ... Second order centered tracer flux at u and v-points
+       
+# if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+          jj = 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_trc_bbl(ji,jj,iku)
+                zfvj = e1v(ji,jj) * fse3v(ji,jj,ikv) * v_trc_bbl(ji,jj,ikv)
+                ! upstream scheme
+                zwx(ji,jj) = ( ( zfui + ABS( zfui ) ) * ztrb(ji  ,jj  )   &
+                   &          +( zfui - ABS( zfui ) ) * ztrb(ji+1,jj  ) ) * 0.5
+                zwy(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * ztrb(ji  ,jj  )   &
+                   &          +( zfvj - ABS( zfvj ) ) * ztrb(ji  ,jj+1) ) * 0.5
+#if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+             END DO
+#endif
+          END DO
+	  
+# if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+          jj = 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
+                ztra = - zbtr * (  zwx(ji,jj) - zwx(ji-1,jj  )   &
+                   &             + zwy(ji,jj) - zwy(ji  ,jj-1)  )
+ 
+                ! add it to the general tracer trends
+                tra(ji,jj,ik,jn) = tra(ji,jj,ik,jn) + ztra
+#if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+             END DO
+#endif
+          END DO
+	  
+        END DO
+	
+        IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('bbl - adv')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF         
+       
+       ! 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   ! vertor opt.
+                zwu(ji,jj) = -e2u(ji,jj) * u_trc_bbl(ji,jj,jk) * fse3u(ji,jj,jk)
+                zwv(ji,jj) = -e1v(ji,jj) * v_trc_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
+!gh
+       IF( ln_zps ) THEN 
+	  
+# if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+          jj = 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
+#if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+             END DO
+#endif
+          END DO
+	
+       ELSE
+
+# if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+          jj = 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) 
+#if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+             END DO
+#endif
+          END DO
+       ENDIF
+
+# if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+       jj = 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
+
+# if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+          END DO
+# endif
+       END DO
+
+       ! 7. compute additional vertical velocity to be used in t boxes
+       ! -------------------------------------------------------------
+       
+       ! ... Computation from the bottom
+       ! Note that w_trc_bbl(:,:,jpk) has been set to 0 in trc_bbl_init
+       DO jk = jpkm1, 1, -1
+          DO jj= 2, jpjm1
+             DO ji = fs_2, fs_jpim1   ! vector opt.
+                w_trc_bbl(ji,jj,jk) = w_trc_bbl(ji,jj,jk+1) - fse3t(ji,jj,jk)*zhdivn(ji,jj,jk)
+             END DO
+          END DO
+       END DO
+
+      ! Boundary condition on w_bbl   (unchanged sign)
+      CALL lbc_lnk( w_trc_bbl, 'W', 1. )
+
+   END SUBROUTINE trc_bbl_adv
Index: trunk/NEMO/TOP_SRC/TRP/trcdmp.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 941)
@@ -0,0 +1,843 @@
+MODULE trcdmp
+   !!======================================================================
+   !!                       ***  MODULE  trcdmp  ***
+   !! Ocean physics: internal restoring trend on passive tracers
+   !!======================================================================
+#if  defined key_top  &&  defined key_trcdmp 
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!   'key_trcdmp'                                       internal damping
+   !!----------------------------------------------------------------------
+   !!   trc_dmp      : update the tracer trend with the internal damping
+   !!   trc_dmp_init : initialization, namlist read, parameters control
+   !!   trccof_zoom  : restoring coefficient for zoom domain
+   !!   trccof       : restoring coefficient for global domain
+   !!   cofdis       : compute the distance to the coastline
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and tracers variables
+   USE trc             ! ocean passive tracers variables
+   USE trctrp_lec      ! passive tracers transport
+   USE trcdta
+   USE prtctl_trc      ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trc_dmp   ! routine called by step.F90
+
+   !! * Shared module variables
+   LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .TRUE.    !: internal damping flag
+
+   REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   &
+      restotr         ! restoring coeff. on tracers (s-1)
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.12 2007/10/12 09:26:30 opalod Exp $ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_dmp( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_dmp  ***
+      !!                  
+      !! ** Purpose :   Compute the passive tracer trend due to a newtonian damping
+      !!      of the tracer field towards given data field and add it to the
+      !!      general tracer trends.
+      !!
+      !! ** Method  :   Newtonian damping towards trdta computed 
+      !!      and add to the general tracer trends:
+      !!                     trn = tra + restotr * (trdta - trb)
+      !!         The trend is computed either throughout the water column
+      !!      (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or
+      !!      below the well mixed layer (nlmdmptr=2)
+      !!
+      !! ** Action  : - update the tracer trends tra with the newtonian 
+      !!                damping trends.
+      !!              - save the trends in trtrd ('key_trc_diatrd')
+      !!
+      !! History :
+      !!   7.0  !         (G. Madec)  Original code
+      !!        !  96-01  (G. Madec) 
+      !!        !  97-05  (H. Loukos)  adapted for passive tracers
+      !!   8.5  !  02-08  (G. Madec )  free form + modules
+      !!   9.0  !  04-03  (C. Ethe)    free form + modules
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk, jn     ! dummy loop indices
+      REAL(wp) ::   ztest, ztra, zdt   ! temporary scalars
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      ! 0. Initialization (first time-step only)
+      !    --------------
+      IF( kt == nittrc000 ) CALL trc_dmp_init
+
+      ! 1. Newtonian damping trends on tracer fields
+      ! --------------------------------------------
+      !    compute the newtonian damping trends depending on nmldmptr
+
+!!!      zdt  = rdt * FLOAT( ndttrc )
+
+      ! Initialize the input fields for newtonian damping
+      CALL dta_trc( kt )
+
+      DO jn = 1, jptra
+
+         IF( lutini(jn) ) THEN
+
+            SELECT CASE ( nmldmptr )
+
+            CASE( 0 )                ! newtonian damping throughout the water column
+
+               DO jk = 1, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        ztra = restotr(ji,jj,jk,jn) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) )
+                        ! add the trends to the general tracer trends
+!!                        trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) + ztra * zdt
+                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+#    if defined key_trc_diatrd
+                        ! save the trends for diagnostics
+                        IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc-1) = ztra
+#    endif
+                     END DO
+                  END DO
+               END DO
+
+            CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s)
+               DO jk = 1, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        ztest = avt(ji,jj,jk) - 5.e-4
+                        IF( ztest < 0. ) THEN
+                           ztra = restotr(ji,jj,jk,jn) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) )
+                        ELSE
+                           ztra = 0.e0
+                        ENDIF
+                        ! add the trends to the general tracer trends
+!!                        trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) + ztra * zdt
+                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
+#    if defined key_trc_diatrd
+                        ! save the trends for diagnostics
+                        IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc-1) = ztra
+#    endif
+                     END DO
+                  END DO
+               END DO
+
+            CASE ( 2 )                ! no damping in the mixed layer 
+               DO jk = 1, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
+                           ztra = restotr(ji,jj,jk,jn) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) )
+                        ELSE
+                           ztra = 0.e0
+                        ENDIF
+                        ! add the trends to the general tracer trends
+!!                        trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) + ztra * zdt
+                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+#    if defined key_trc_diatrd
+                        ! save the trends for diagnostics
+                        IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc-1) = ztra
+#    endif
+                     END DO
+                  END DO
+               END DO
+               
+            END SELECT
+
+         ENDIF
+
+      END DO
+
+     IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('dmp')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+  
+      trb(:,:,:,:) = trn(:,:,:,:)
+   
+   END SUBROUTINE trc_dmp
+
+
+   SUBROUTINE trc_dmp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_dmp_init  ***
+      !! 
+      !! ** Purpose :   Initialization for the newtonian damping 
+      !!
+      !! ** Method  :   read the nammbf namelist and check the parameters
+      !!      called by trc_dmp at the first timestep (nit000)
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( ndmptr )
+
+      CASE ( -1 )               ! ORCA: damping in Red & Med Seas only
+         IF(lwp) WRITE(numout,*) '          tracer damping in the Med & Red seas only'
+
+      CASE ( 1:90 )             ! Damping poleward of 'ndmptr' degrees
+         IF(lwp) WRITE(numout,*) '          tracer damping poleward of', ndmptr, ' degrees'
+
+      CASE DEFAULT
+         WRITE(ctmp1,*) '          bad flag value for ndmp = ', ndmp
+         CALL ctl_stop(ctmp1)
+
+      END SELECT
+
+
+      SELECT CASE ( nmldmptr )
+
+      CASE ( 0 )                ! newtonian damping throughout the water column
+         IF(lwp) WRITE(numout,*) '          tracer damping throughout the water column'
+
+      CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s)
+         IF(lwp) WRITE(numout,*) '          no tracer damping in the turbocline'
+
+      CASE ( 2 )                ! no damping in the mixed layer 
+         IF(lwp) WRITE(numout,*) '          no tracer damping in the mixed layer'
+
+      CASE DEFAULT
+         WRITE(ctmp1,*) '          bad flag value for nmldmp = ', nmldmp
+         CALL ctl_stop(ctmp1)
+
+
+      END SELECT
+
+
+      ! 3. Damping coefficients initialization
+     ! --------------------------------------
+
+         IF( lzoom ) THEN
+            CALL trccof_zoom
+         ELSE
+            CALL trccof
+         ENDIF
+ 
+   END SUBROUTINE trc_dmp_init
+
+
+   SUBROUTINE trccof_zoom
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trccof_zoom  ***
+      !!
+      !! ** Purpose :   Compute the damping coefficient for zoom domain
+      !!
+      !! ** Method  : - set along closed boundary due to zoom a damping over
+      !!      6 points with a max time scale of 5 days.
+      !!              - ORCA arctic/antarctic zoom: set the damping along
+      !!      south/north boundary over a latitude strip.
+      !!
+      !! ** Action  : - restotr, the damping coeff. passive tracers
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  Original code
+      !!   9.0  !  04-03  (C. Ethe)   adapted for passive tracers
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, jn       ! dummy loop indices
+      REAL(wp) ::   &
+         zlat, zlat0, zlat1, zlat2     ! temporary scalar
+      REAL(wp), DIMENSION(6)  ::   &
+         zfact                         ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      zfact(1) =  1.
+      zfact(2) =  1. 
+      zfact(3) = 11./12.
+      zfact(4) =  8./12.
+      zfact(5) =  4./12.
+      zfact(6) =  1./12.
+      zfact(:) = zfact(:) / ( 5. * rday )    ! 5 days max restoring time scale
+
+      restotr(:,:,:,:) = 0.e0
+
+      ! damping along the forced closed boundary over 6 grid-points
+      DO jn = 1, 6
+         IF( lzoom_w )   restotr( mi0(jn+jpizoom):mi1(jn+jpizoom), : , : , : ) = zfact(jn) ! west  closed
+         IF( lzoom_s )   restotr( : , mj0(jn+jpjzoom):mj1(jn+jpjzoom), : , : ) = zfact(jn) ! south closed 
+         IF( lzoom_e )   restotr( mi0(jpiglo+jpizoom-1-jn):mi1(jpiglo+jpizoom-1-jn) , : , : , : ) &
+                       &              = zfact(jn)                                 ! east  closed 
+         IF( lzoom_n )   restotr( : , mj0(jpjglo+jpjzoom-1-jn):mj1(jpjglo+jpjzoom-1-jn) , : , : ) &
+                       &              = zfact(jn)                                 ! north closed
+      END DO
+
+
+      IF( lzoom_arct .AND. lzoom_anta ) THEN
+
+         ! ====================================================
+         !  ORCA configuration : arctic zoom or antarctic zoom
+         ! ====================================================
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp .AND. lzoom_arct ) WRITE(numout,*) '              trccof_zoom : ORCA    Arctic zoom'
+         IF(lwp .AND. lzoom_arct ) WRITE(numout,*) '              trccof_zoom : ORCA Antarctic zoom'
+         IF(lwp) WRITE(numout,*)
+
+         ! ... Initialization : 
+         !     zlat0 : latitude strip where resto decreases
+         !     zlat1 : resto = 1 before zlat1
+         !     zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2
+         restotr(:,:,:,:) = 0.e0
+         zlat0 = 10.
+         zlat1 = 30.
+         zlat2 = zlat1 + zlat0
+
+         ! ... Compute arrays resto ; value for internal damping : 5 days
+         DO jn = 1, jptra
+            DO jk = 2, jpkm1 
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zlat = ABS( gphit(ji,jj) )
+                     IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
+                        restotr(ji,jj,jk,jn) = 0.5 * ( 1./(5.*rday) ) *   &
+                           ( 1. - COS(rpi*(zlat2-zlat)/zlat0) ) 
+                     ELSE IF ( zlat < zlat1 ) THEN
+                        restotr(ji,jj,jk,jn) = 1./(5.*rday)
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+
+      ! ... Mask resto array
+        DO jn = 1, jptra
+           restotr(:,:,:,jn) = restotr(:,:,:,jn) * tmask(:,:,:)
+        END DO
+
+
+   END SUBROUTINE trccof_zoom
+
+   SUBROUTINE trccof
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trccof  ***
+      !!
+      !! ** Purpose :   Compute the damping coefficient
+      !!
+      !! ** Method  :   Arrays defining the damping are computed for each grid
+      !!      point passive tracers (restotr)
+      !!      Damping depends on distance to coast, depth and latitude
+      !!
+      !! ** Action  : - restotr, the damping coeff. for passive tracers
+      !!
+      !! History :
+      !!   5.0  !  91-03  (O. Marti, G. Madec)  Original code
+      !!        !  92-06  (M. Imbard)  doctor norme
+      !!        !  96-01  (G. Madec) statement function for e3
+      !!        !  98-07  (M. Imbard, G. Madec) ORCA version
+      !!        !  00-08  (G. Madec, D. Ludicone) 
+      !!   8.2  !  04-03  (H. Loukos) adapted for passive tracers
+      !!        !  04-02  (O. Aumont, C. Ethe) rewritten for debuging and update
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE iom
+      USE ioipsl
+
+      !! * Local declarations
+      INTEGER ::  ji, jj, jk, jn    ! dummy loop indices
+      INTEGER ::   itime
+      INTEGER ::  ii0, ii1, ij0, ij1  !    "          "
+      INTEGER ::   &
+         idmp,     &  ! logical unit for file restoring damping term
+         icot         ! logical unit for file distance to the coast
+
+      CHARACTER (len=32) ::  clname, clname2, clname3
+      REAL(wp) ::   &
+         zdate0, zinfl, zlon,         & ! temporary scalars
+         zlat, zlat0, zlat1, zlat2,   & !    "         "
+         zsdmp, zbdmp                   !    "         "
+      REAL(wp), DIMENSION(jpk) ::   &
+         gdept, zhfac
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zmrs
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zdct
+      !!----------------------------------------------------------------------
+
+      ! ====================================
+      !  ORCA configuration : global domain
+      ! ====================================
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '              trccof : Global domain of ORCA'
+      IF(lwp) WRITE(numout,*) '              ------------------------------'
+
+
+      ! ... Initialization : 
+      !   zdct()      : distant to the coastline
+      !   resto()     : array of restoring coeff. 
+      
+      zdct (:,:,:) = 0.e0
+      restotr(:,:,:,:) = 0.e0
+
+
+      IF ( ndmptr > 0 ) THEN
+
+         !    ------------------------------------
+         !     Damping poleward of 'ndmptr' degrees
+         !    ------------------------------------
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '              Damping poleward of ', ndmptr,' deg.'
+         IF(lwp) WRITE(numout,*)
+
+         ! ... Distance to coast (zdct)
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' dtacof : distance to coast file'
+         CALL iom_open ( 'dist.coast.trc.nc', icot )
+         IF( icot > 0 ) THEN
+            CALL iom_get ( icot, jpdom_data, 'Tcoast', zdct )
+            CALL iom_close (icot)
+         ELSE
+            !   ... Compute and save the distance-to-coast array (output in zdct)
+            CALL cofdis( zdct )
+         ENDIF
+
+
+         ! ... Compute arrays resto 
+         !      zinfl : distance of influence for damping term
+         !      zlat0 : latitude strip where resto decreases
+         !      zlat1 : resto = 0 between -zlat1 and zlat1
+         !      zlat2 : resto increases from 0 to 1 between |zlat1| and |zlat2|
+         !          and resto = 1 between |zlat2| and 90 deg.
+         zinfl = 1000.e3
+         zlat0 = 10
+         zlat1 = ndmptr
+         zlat2 = zlat1 + zlat0
+
+         DO jn = 1, jptra
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zlat = ABS( gphit(ji,jj) )
+                  IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
+                     restotr(ji,jj,1,jn) = 0.5 * ( 1. - COS(rpi*(zlat-zlat1)/zlat0 ) )
+                  ELSEIF ( zlat > zlat2 ) THEN
+                     restotr(ji,jj,1,jn) = 1.
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+         !   ... North Indian ocean (20N/30N x 45E/100E) : resto=0
+         IF ( ndmptr == 20 ) THEN
+            DO jn = 1, jptra
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zlat = gphit(ji,jj)
+                     zlon = MOD( glamt(ji,jj), 360. )
+                     IF ( zlat1 < zlat .AND. zlat < zlat2 .AND.   &
+                        45.  < zlon .AND. zlon < 100. ) THEN
+                        restotr(ji,jj,1,jn) = 0.
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+         zsdmp = 1./(sdmptr * rday)
+         zbdmp = 1./(bdmptr * rday)
+         DO jn = 1, jptra
+            DO jk = 2, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zdct(ji,jj,jk) = MIN( zinfl, zdct(ji,jj,jk) )
+
+                     !   ... Decrease the value in the vicinity of the coast
+                     restotr(ji,jj,jk,jn) = restotr(ji,jj,1,jn)*0.5   &
+                        &                 * ( 1. - COS( rpi*zdct(ji,jj,jk)/zinfl) )
+
+                     !   ... Vertical variation from zsdmp (sea surface) to zbdmp (bottom)
+                     restotr(ji,jj,jk,jn) = restotr(ji,jj,jk,jn)   &
+                        &                 * ( zbdmp + (zsdmp-zbdmp)*EXP(-fsdept(ji,jj,jk)/hdmptr) )
+                  END DO
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+
+
+      IF( cp_cfg == "orca" .AND. ( ndmptr > 0 .OR. ndmptr == -1 ) ) THEN
+
+         !                                         ! =========================
+         !                                         !  Med and Red Sea damping
+         !                                         ! =========================
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) '              ORCA configuration: Damping in Med and Red Seas'
+
+
+         zmrs(:,:) = 0.e0                             ! damping term on the Med or Red Sea
+
+         SELECT CASE ( jp_cfg )
+            !                                           ! =======================
+         CASE ( 4 )                                     !  ORCA_R4 configuration 
+            !                                           ! =======================
+
+            ! Mediterranean Sea
+            ij0 =  50   ;   ij1 =  56
+            ii0 =  81   ;   ii1 =  91   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ij0 =  50   ;   ij1 =  55
+            ii0 =  75   ;   ii1 =  80   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ij0 =  52   ;   ij1 =  53
+            ii0 =  70   ;   ii1 =  74   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea
+            DO jk = 1, 17
+               zhfac (jk) = 0.5*( 1.- COS( rpi*(jk-1)/16. ) ) / rday
+            END DO
+            DO jk = 18, jpkm1
+               zhfac (jk) = 1./rday
+            END DO
+
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration 
+            !                                        ! =======================
+
+            ! Mediterranean Sea
+            ij0 =  96   ;   ij1 = 110
+            ii0 = 157   ;   ii1 = 181   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ij0 = 100   ;   ij1 = 110
+            ii0 = 144   ;   ii1 = 156   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ij0 = 100   ;   ij1 = 103
+            ii0 = 139   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ! Decrease before Gibraltar Strait
+            ij0 = 101   ;   ij1 = 102
+            ii0 = 139   ;   ii1 = 141   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.e0
+            ii0 = 142   ;   ii1 = 142   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0
+            ii0 = 143   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40e0
+            ii0 = 144   ;   ii1 = 144   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75e0
+            ! Red Sea
+            ij0 =  87   ;   ij1 =  96
+            ii0 = 147   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ! Decrease before Bab el Mandeb Strait
+            ij0 =  91   ;   ij1 =  91
+            ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.80e0
+            ij0 =  90   ;   ij1 =  90
+            ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40e0
+            ij0 =  89   ;   ij1 =  89
+            ii0 = 158   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0
+            ij0 =  88   ;   ij1 =  88
+            ii0 = 160   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.e0
+            ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea
+            DO jk = 1, 17
+               zhfac (jk) = 0.5*( 1.- COS( rpi*(jk-1)/16. ) ) / rday
+            END DO
+            DO jk = 18, jpkm1
+               zhfac (jk) = 1./rday
+            END DO
+
+            !                                        ! =======================
+         CASE ( 05 )                                 !  ORCA_R05 configuration
+            !                                        ! =======================
+
+            ! Mediterranean Sea
+            ii0 = 568   ;   ii1 = 574 
+            ij0 = 324   ;   ij1 = 333   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ii0 = 575   ;   ii1 = 658
+            ij0 = 314   ;   ij1 = 366   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ! Black Sea (remaining part
+            ii0 = 641   ;   ii1 = 651
+            ij0 = 367   ;   ij1 = 372   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ! Decrease before Gibraltar Strait
+            ii0 = 324   ;   ii1 = 333
+            ij0 = 565   ;   ij1 = 565   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0
+            ij0 = 566   ;   ij1 = 566   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
+            ij0 = 567   ;   ij1 = 567   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75
+            ! Red Sea
+            ii0 = 641   ;   ii1 = 665
+            ij0 = 270   ;   ij1 = 310   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ! Decrease before Bab el Mandeb Strait
+            ii0 = 666   ;   ii1 = 675
+            ij0 = 270   ;   ij1 = 290   
+            DO ji = mi0(ii0), mi1(ii1)
+               zmrs( ji , mj0(ij0):mj1(ij1) ) = 0.1 * ABS( FLOAT(ji - mi1(ii1)) )
+            END DO
+            zsdmp = 1./(sdmptr * rday)
+            zbdmp = 1./(bdmptr * rday)
+            DO jk = 1, jpk
+               zhfac (jk) = ( zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(1,1,jk)/hdmptr) )
+            END DO
+
+            !                                       ! ========================
+         CASE ( 025 )                               !  ORCA_R025 configuration 
+
+            CALL ctl_stop( ' Not yet implemented in ORCA_R025' ) 
+
+         END SELECT
+
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               restotr(:,:,jk,jn) = zmrs(:,:) * zhfac(jk) + ( 1. - zmrs(:,:) ) * restotr(:,:,jk,jn)
+            END DO
+
+            ! Mask resto array and set to 0 first and last levels
+            restotr(:,:, : ,jn) = restotr(:,:,:,jn) * tmask(:,:,:)
+            restotr(:,:, 1 ,jn) = 0.e0
+            restotr(:,:,jpk,jn) = 0.e0
+         END DO
+
+      ELSE
+         !    ------------
+         !     No damping
+         !    ------------
+         CALL ctl_stop( 'Choose a correct value of ndmp or DO NOT defined key_tradmp' )
+
+      ENDIF
+
+        !    ----------------------------
+         !     Create Print damping array
+         !    ----------------------------
+         
+         ! ndmpftr   : = 1 create a damping.coeff NetCDF file
+
+      IF( ndmpftr == 1 ) THEN
+         DO jn = 1, jptra
+            IF(lwp) WRITE(numout,*) '  create damping.coeff.nc file  ',jn
+            itime   = 0
+            clname3 = 'damping.coeff'//ctrcnm(jn)
+            CALL ymds2ju( 0     , 1     , 1      , 0.e0 , zdate0 )
+            CALL restini( 'NONE', jpi   , jpj    , glamt, gphit,    &
+           &              jpk   , gdept , clname3, itime, zdate0,   &
+           &              rdt   , idmp  , domain_id=nidom)
+            CALL restput( idmp, 'Resto', jpi, jpj, jpk, 0 , restotr(:,:,:,jn)  )
+            CALL restclo( idmp )
+         END DO
+      ENDIF
+
+
+   END SUBROUTINE trccof
+
+
+   SUBROUTINE cofdis ( pdct )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE cofdis  ***
+      !!
+      !! ** Purpose :   Compute the distance between ocean T-points and the
+      !!      ocean model coastlines. Save the distance in a NetCDF file.
+      !!
+      !! ** Method  :   For each model level, the distance-to-coast is 
+      !!      computed as follows : 
+      !!       - The coastline is defined as the serie of U-,V-,F-points
+      !!      that are at the ocean-land bound.
+      !!       - For each ocean T-point, the distance-to-coast is then 
+      !!      computed as the smallest distance (on the sphere) between the 
+      !!      T-point and all the coastline points.
+      !!       - For land T-points, the distance-to-coast is set to zero.
+      !!      C A U T I O N : Computation not yet implemented in mpp case.
+      !!
+      !! ** Action  : - pdct, distance to the coastline (argument)
+      !!              - NetCDF file 'trc.dist.coast.nc' 
+      !!        
+      !! History :
+      !!   7.0  !  01-02  (M. Imbard)  Original code
+      !!   8.1  !  01-02  (G. Madec, E. Durand)
+      !!   8.5  !  02-08  (G. Madec, E. Durand)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
+         pdct                     ! distance to the coastline
+
+      !! * local declarations
+      INTEGER :: ji, jj, jk, jl      ! dummy loop indices
+      INTEGER :: iju, ijt            ! temporary integers
+      INTEGER :: icoast, itime
+      INTEGER ::   &
+         icot         ! logical unit for file distance to the coast
+      LOGICAL, DIMENSION(jpi,jpj) ::   &
+         llcotu, llcotv, llcotf   ! ???
+      CHARACTER (len=32) ::   clname
+      REAL(wp) ::   zdate0
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zxt, zyt, zzt,                 &  ! cartesian coordinates for T-points
+         zmask                             
+      REAL(wp), DIMENSION(3*jpi*jpj) ::   &
+         zxc, zyc, zzc, zdis      ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      ! 0. Initialization
+      ! -----------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cofdis : compute the distance to coastline'
+      IF(lwp) WRITE(numout,*) '~~~~~~'
+      IF(lwp) WRITE(numout,*)
+      IF( lk_mpp ) &
+           & CALL ctl_stop('         Computation not yet implemented with key_mpp_...', &
+           &               '         Rerun the code on another computer or ', &
+           &               '         create the "dist.coast.nc" file using IDL' )
+
+
+      pdct(:,:,:) = 0.e0
+      zxt(:,:) = cos( rad * gphit(:,:) ) * cos( rad * glamt(:,:) )
+      zyt(:,:) = cos( rad * gphit(:,:) ) * sin( rad * glamt(:,:) )
+      zzt(:,:) = sin( rad * gphit(:,:) )
+
+
+      ! 1. Loop on vertical levels
+      ! --------------------------
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Define the coastline points (U, V and F)
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               zmask(ji,jj) =  ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) &
+                   &           + tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk) )
+               llcotu(ji,jj) = ( tmask(ji,jj,  jk) + tmask(ji+1,jj  ,jk) == 1. ) 
+               llcotv(ji,jj) = ( tmask(ji,jj  ,jk) + tmask(ji  ,jj+1,jk) == 1. ) 
+               llcotf(ji,jj) = ( zmask(ji,jj) > 0. ) .AND. ( zmask(ji,jj) < 4. )
+            END DO
+         END DO
+
+         ! Lateral boundaries conditions
+         llcotu(:, 1 ) = umask(:,  2  ,jk) == 1
+         llcotu(:,jpj) = umask(:,jpjm1,jk) == 1
+         llcotv(:, 1 ) = vmask(:,  2  ,jk) == 1
+         llcotv(:,jpj) = vmask(:,jpjm1,jk) == 1
+         llcotf(:, 1 ) = fmask(:,  2  ,jk) == 1
+         llcotf(:,jpj) = fmask(:,jpjm1,jk) == 1
+
+         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+            llcotu( 1 ,:) = llcotu(jpim1,:)
+            llcotu(jpi,:) = llcotu(  2  ,:)
+            llcotv( 1 ,:) = llcotv(jpim1,:)
+            llcotv(jpi,:) = llcotv(  2  ,:)
+            llcotf( 1 ,:) = llcotf(jpim1,:)
+            llcotf(jpi,:) = llcotf(  2  ,:)
+         ELSE
+            llcotu( 1 ,:) = umask(  2  ,:,jk) == 1
+            llcotu(jpi,:) = umask(jpim1,:,jk) == 1
+            llcotv( 1 ,:) = vmask(  2  ,:,jk) == 1
+            llcotv(jpi,:) = vmask(jpim1,:,jk) == 1
+            llcotf( 1 ,:) = fmask(  2  ,:,jk) == 1
+            llcotf(jpi,:) = fmask(jpim1,:,jk) == 1
+         ENDIF
+         IF( nperio == 3 .OR. nperio == 4 ) THEN
+            DO ji = 1, jpim1
+               iju = jpi - ji + 1
+               llcotu(ji,jpj  ) = llcotu(iju,jpj-2)
+               llcotf(ji,jpj-1) = llcotf(iju,jpj-2)
+               llcotf(ji,jpj  ) = llcotf(iju,jpj-3)
+            END DO
+            DO ji = jpi/2, jpi-1
+               iju = jpi - ji + 1
+               llcotu(ji,jpjm1) = llcotu(iju,jpjm1)
+            END DO
+            DO ji = 2, jpi
+               ijt = jpi - ji + 2
+               llcotv(ji,jpj-1) = llcotv(ijt,jpj-2)
+               llcotv(ji,jpj  ) = llcotv(ijt,jpj-3)
+            END DO
+         ENDIF
+         IF( nperio == 5 .OR. nperio == 6 ) THEN
+            DO ji = 1, jpim1
+               iju = jpi - ji
+               llcotu(ji,jpj  ) = llcotu(iju,jpj-1)
+               llcotf(ji,jpj  ) = llcotf(iju,jpj-2)
+            END DO
+            DO ji = jpi/2, jpi-1
+               iju = jpi - ji
+               llcotf(ji,jpjm1) = llcotf(iju,jpjm1)
+            END DO
+            DO ji = 1, jpi
+               ijt = jpi - ji + 1
+               llcotv(ji,jpj  ) = llcotv(ijt,jpj-1)
+            END DO
+            DO ji = jpi/2+1, jpi
+               ijt = jpi - ji + 1
+               llcotv(ji,jpjm1) = llcotv(ijt,jpjm1)
+            END DO
+         ENDIF
+
+         ! Compute cartesian coordinates of coastline points
+         ! and the number of coastline points
+
+         icoast = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( llcotf(ji,jj) ) THEN
+                  icoast = icoast + 1
+                  zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) )
+                  zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphif(ji,jj) )
+               ENDIF
+               IF( llcotu(ji,jj) ) THEN
+                  icoast = icoast+1
+                  zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) )
+                  zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphiu(ji,jj) )
+               ENDIF
+               IF( llcotv(ji,jj) ) THEN
+                  icoast = icoast+1
+                  zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) )
+                  zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphiv(ji,jj) )
+               ENDIF
+            END DO
+         END DO
+
+         ! Distance for the T-points
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tmask(ji,jj,jk) == 0. ) THEN
+                  pdct(ji,jj,jk) = 0.
+               ELSE
+                  DO jl = 1, icoast
+                     zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2   &
+                              + ( zyt(ji,jj) - zyc(jl) )**2   &
+                              + ( zzt(ji,jj) - zzc(jl) )**2
+                  END DO
+                  pdct(ji,jj,jk) = ra * SQRT( MINVAL( zdis(1:icoast) ) )
+               ENDIF
+            END DO
+         END DO
+         !                                                ! ===============
+      END DO                                              !   End of slab
+      !                                                   ! ===============
+
+
+      ! 2. Create the  distance to the coast file in NetCDF format
+      ! ----------------------------------------------------------    
+      clname = 'trc.dist.coast'
+      itime = 0
+      CALL ymds2ju( 0     , 1     , 1     , 0.e0 , zdate0 )
+      CALL restini( 'NONE', jpi   , jpj   , glamt, gphit ,   &
+                    jpk   , gdept , clname, itime, zdate0,   &
+                    rdt   , icot , domain_id=nidom         )
+      CALL restput( icot, 'Tcoast', jpi, jpj, jpk, 0, pdct )
+      CALL restclo( icot )
+
+   END SUBROUTINE cofdis
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO internal damping
+   !!----------------------------------------------------------------------
+   LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .FALSE.    !: internal damping flag
+CONTAINS
+   SUBROUTINE trc_dmp( kt )        ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_dmp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_dmp
+#endif
+
+   !!======================================================================
+END MODULE trcdmp
Index: trunk/NEMO/TOP_SRC/TRP/trcldf_bilap.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcldf_bilap.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcldf_bilap.F90	(revision 941)
@@ -0,0 +1,231 @@
+MODULE trcldf_bilap
+   !!==============================================================================
+   !!                   ***  MODULE  trcldf_bilap  ***
+   !! TOP :  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_ldf_bilap : update the tracer trend with the horizontal diffusion
+   !!                   using a iso-level biharmonic operator
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc         ! ocean dynamics and active tracers variables
+   USE trc             ! ocean passive tracers variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl_trc      ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trc_ldf_bilap   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_bilap.F90,v 1.12 2007/10/12 09:26:30 opalod Exp $ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE trc_ldf_bilap( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_ldf_bilap  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal tracer tra 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 passive tracer is given by:
+      !!       * s-coordinate, the vertical scale 
+      !!      factors e3. are inside the derivatives:
+      !!      Laplacian of trb:
+      !!         zlt   = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(trb) ]
+      !!                                  + dj-1[ e1v*e3v/e2v dj(trb) ]  }
+      !!      Multiply by the eddy diffusivity coef. and insure lateral bc:
+      !!        zlt   = ahtt * zlt
+      !!        call to lbc_lnk
+      !!      Bilaplacian (laplacian of zlt):
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(zlt) ]
+      !!                                  + dj-1[ e1v*e3v/e2v dj(zlt) ]  }
+      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
+      !!      Laplacian of trb:
+      !!         zlt   = 1/(e1t*e2t) {  di-1[ e2u/e1u di(trb) ]
+      !!                              + dj-1[ e1v/e2v dj(trb) ] }
+      !!      Multiply by the eddy diffusivity coef. and insure lateral bc:
+      !!        zlt   = ahtt * zlt
+      !!        call to lbc_lnk
+      !!      Bilaplacian (laplacian of zlt):
+      !!         difft = 1/(e1t*e2t) {  di-1[ e2u/e1u di(zlt) ]
+      !!                              + dj-1[ e1v/e2v dj(zlt) ]  }
+      !!
+      !!      Add this trend to the general trend tra :
+      !!         tra = tra + difft 
+      !!
+      !! ** Action : - Update tra arrays with the before iso-level
+      !!               biharmonic mixing trend.
+      !!             - Save the trends in trtrd ('key_trc_diatrd')
+      !!
+      !! 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
+      !!        !  00-05  (MA Foujols) add lbc for tracer trends
+      !!        !  00-10  (MA Foujols E. Kestenare) use passive tracer coefficient
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!   9.0  !  04-03  (C. Ethe )  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, jn             ! dummy loop indices
+      INTEGER ::   iku, ikv                   ! temporary integers
+
+      REAL(wp) ::   ztra     ! temporary scalars
+
+      REAL(wp), DIMENSION(jpi,jpj) ::   & 
+         zeeu, zeev, zbtr, zlt                 ! workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
+         ztu, ztv                              ! workspace
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_ldf_bilap : iso-level biharmonic operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+      ! 
+
+      DO jn = 1, jptra
+                                                          ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+
+            ! 0. Initialization of metric arrays (for z- or s-coordinates)
+            ! ----------------------------------
+
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+#if ! defined key_zco 
+                  ! s-coordinates, vertical scale factor are used
+                  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)
+#else
+                  ! z-coordinates, no vertical scale factors
+                  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)
+#endif
+               END DO
+            END DO
+
+
+            ! 1. Laplacian
+            ! ------------
+
+            ! First derivative (gradient)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( trb(ji+1,jj  ,jk,jn) - trb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zeev(ji,jj) * ( trb(ji  ,jj+1,jk,jn) - trb(ji,jj,jk,jn) )
+               END DO
+            END DO
+
+            IF( ln_zps ) THEN
+               DO jj = 1, jpj-1
+                  DO ji = 1, jpi-1
+                     ! 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) * gtru(ji,jj,jn)
+                     ENDIF
+                     IF( ikv == jk ) THEN
+                        ztv(ji,jj,jk) = zeev(ji,jj) * gtrv(ji,jj,jn)
+                     ENDIF
+                  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)  )
+               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) = fsahtrt(ji,jj,jk) * zlt(ji,jj)
+               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
+                  ztra = zbtr(ji,jj) * (  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
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+#if defined key_trc_diatrd
+                  ! save the horizontal diffusive trends
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),4) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr(ji,jj)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),5) = (  ztv(ji,jj,jk) - ztv(ji-1,jj,jk) ) * zbtr(ji,jj)
+#endif
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           ! Horizontal slab
+         !                                                ! ===============
+#if defined key_trc_diatrd
+         ! Lateral boundary conditions on the laplacian zlt   (unchanged sgn)
+         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),5), 'T', 1. )  
+#endif
+      END DO
+
+     IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('ldf - bilap')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_ldf_bilap
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ldf_bilap( kt )  
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_ldf_bilap: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_ldf_bilap
+#endif
+   !!==============================================================================
+END MODULE trcldf_bilap
Index: trunk/NEMO/TOP_SRC/TRP/trcldf_bilapg.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcldf_bilapg.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcldf_bilapg.F90	(revision 941)
@@ -0,0 +1,372 @@
+MODULE trcldf_bilapg
+   !!==============================================================================
+   !!                       ***  MODULE  trcldf_bilapg  ***
+   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+#if defined key_top && defined key_ldfslp
+   !!----------------------------------------------------------------------
+   !!   'key_top'        and                                     TOP models
+   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   trc_ldf_bilapg : update the tracer trend with the horizontal diffusion
+   !!                    using an horizontal biharmonic operator in s-coordinate 
+   !!   ldfght         :  ???
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc             ! ocean dynamics and tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE lbclnk              ! ocean lateral boundary condition (or mpp link)
+   USE prtctl_trc          ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trc_ldf_bilapg    ! routine called by step.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+
+   SUBROUTINE trc_ldf_bilapg( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE trc_ldf_bilapg  ***
+      !!                    
+      !! ** Purpose :   Compute the before horizontal passive tracer diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The lateral diffusive trends is provided by a 4th order
+      !!      operator rotated along geopotential surfaces. It is computed
+      !!      using before fields (forward in time) and geopotential slopes
+      !!      computed in routine inildf.
+      !!         -1- compute the geopotential harmonic operator applied to
+      !!      trb and multiply it by the eddy diffusivity coefficient
+      !!      (done by a call to ldfght routine, result in wk1 array).
+      !!      Applied the domain lateral boundary conditions by call to lbc_lnk
+      !!         -2- compute the geopotential harmonic operator applied to
+      !!      wk1 by a second call to ldfght routine (result in wk3 array).
+      !!         -3- Add this trend to the general trend (ta,sa):
+      !!            tra = tra + wk3
+      !!
+      !! ** Action : - Update tra arrays with the before geopotential 
+      !!               biharmonic mixing trend.
+      !!             - Save the trends  in trtrd ('key_trc_diatrd')
+      !!
+      !! History :
+      !!   8.0  !  97-07  (G. Madec)  Original code
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!   9.0  !  04-03  (C. Ethe)  adapted for passive tracers
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk,jn              ! dummy loop indices
+      REAL(wp) ::  ztra                       ! workspace   
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   &
+         wk1, wk2               ! work array used for rotated biharmonic
+                                ! operator on tracers and/or momentum
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_ldf_bilapg : horizontal biharmonic operator in s-coordinate'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
+      ENDIF
+
+      ! 1. Laplacian of passive tracers trb * aht
+      ! ----------------------------- 
+      ! rotated harmonic operator applied to trb 
+      ! and multiply by aht (output in wk1 )
+
+      CALL ldfght ( trb, wk1, 1 )
+
+      DO jn = 1, jptra
+      ! Lateral boundary conditions on wk1   (unchanged sign)
+         CALL lbc_lnk( wk1(:,:,:,jn) , 'T', 1. )
+      END DO
+
+      ! 2. Bilaplacian of trb
+      ! -------------------------
+      ! rotated harmonic operator applied to wk1 (output in wk2 )
+
+      CALL ldfght ( wk1, wk2, 2 )
+
+
+      DO jn = 1, jptra
+         ! 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
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + wk2(ji,jj,jk,jn)
+#if defined key_trc_diatrd
+                  ! save the horizontal diffusive trends
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = wk2(ji,jj,jk,jn)
+#endif
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+      END DO
+
+     IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('ldf - bilapg')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_ldf_bilapg
+
+
+   SUBROUTINE ldfght ( pt, plt, kaht )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldfght  ***
+      !!          
+      !! ** Purpose :   Apply a geopotential harmonic operator to pt and 
+      !!      multiply it by the eddy diffusivity coefficient (if kaht=1).
+      !!      Routine only used in s-coordinates (l_sco=T) with bilaplacian
+      !!      operator (ln_traldf_bilap=T) acting along geopotential surfaces
+      !!      (ln_traldf_hor).
+      !!
+      !! ** Method  :   The harmonic operator rotated along geopotential 
+      !!      surfaces is applied to pt using the slopes of geopotential
+      !!      surfaces computed in inildf routine. The result is provided in
+      !!      plt arrays. It is computed in 2 steps:
+      !!
+      !!      First step: horizontal part of the operator. It is computed on
+      !!      ==========  pt as follows (idem on ps)
+      !!      horizontal fluxes :
+      !!         zftu = e2u*e3u/e1u di[ pt ] - e2u*uslp dk[ mi(mk(pt)) ]
+      !!         zftv = e1v*e3v/e2v dj[ pt ] - e1v*vslp dk[ mj(mk(pt)) ]
+      !!      take the horizontal divergence of the fluxes (no divided by
+      !!      the volume element :
+      !!         plt  = di-1[ zftu ] +  dj-1[ zftv ]
+      !!
+      !!      Second step: vertical part of the operator. It is computed on
+      !!      ===========  pt as follows (idem on ps)
+      !!      vertical fluxes :
+      !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pt ]
+      !!              -     e2t     *       wslpi        di[ mi(mk(pt)) ]
+      !!              -     e1t     *       wslpj        dj[ mj(mk(pt)) ]
+      !!      take the vertical divergence of the fluxes add it to the hori-
+      !!      zontal component, divide the result by the volume element and
+      !!      if kaht=1, multiply by the eddy diffusivity coefficient:
+      !!         plt  = aht / (e1t*e2t*e3t) { plt + dk[ zftw ] }
+      !!      else:
+      !!         plt  =  1  / (e1t*e2t*e3t) { plt + dk[ zftw ] }
+      !!
+      !! * 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
+      !!   9.0  !  04-03  (C. Ethe)  adapted for passive tracers
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra), INTENT( in  ) ::   &
+         pt               ! tracer fields before for 1st call
+      !                   ! and laplacian of these fields for 2nd call.
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra), INTENT( out ) ::   &
+         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,jn             ! dummy loop indices
+      REAL(wp) ::   &
+         zabe1, zabe2, zmku, zmkv,     &  ! temporary scalars
+         zbtr, ztah, ztav, &
+         zcof0, zcof1, zcof2,          &
+         zcof3, zcof4
+
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zftu, zftv ,                   &  ! workspace
+         zdkt, zdk1t
+
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zftw,                          &  ! workspace
+         zdit, zdjt, zdj1t
+
+      !!----------------------------------------------------------------------
+
+
+      DO jn = 1, jptra
+         !                               ! ********** !   ! ===============
+         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)= 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) - zftv(ji,jj-1)
+                  plt(ji,jj,jk,jn) = ztah
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+         !                             ! ************ !   ! ===============
+         DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
+            !                          ! ************ !   ! ===============
+
+            ! II.1 horizontal tracer gradient
+            ! -------------------------------
+
+            DO jk = 1, jpk
+               DO ji = 1, jpim1
+                  zdit (ji,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj  ,jk,jn) ) * umask(ji,jj  ,jk)
+                  zdjt (ji,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj  ,jk,jn) ) * vmask(ji,jj  ,jk)
+                  zdj1t(ji,jk) = ( pt(ji  ,jj  ,jk,jn) - pt(ji,jj-1,jk,jn) ) * vmask(ji,jj-1,jk)
+               END DO
+            END DO
+
+
+            ! II.2 Vertical fluxes
+            ! --------------------
+
+            ! Surface and bottom vertical fluxes set to zero
+            zftw(:, 1 ) = 0.e0
+            zftw(:,jpk) = 0.e0
+
+            ! interior (2=<jk=<jpk-1)
+            DO jk = 2, jpkm1
+               DO ji = 2, jpim1
+                  zcof0 = 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 = fsahtrt(ji,jj,jk) / ( 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) 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. / ( 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
+
+#else  
+   !!----------------------------------------------------------------------
+   !!   Dummy module :             NO rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ldf_bilapg( kt )               ! Dummy routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_ldf_bilapg: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_ldf_bilapg
+#endif
+
+   !!==============================================================================
+END MODULE trcldf_bilapg
Index: trunk/NEMO/TOP_SRC/TRP/trcldf_iso.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcldf_iso.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcldf_iso.F90	(revision 941)
@@ -0,0 +1,254 @@
+MODULE trcldf_iso
+   !!==============================================================================
+   !!                    ***  MODULE  trcldf_iso  ***
+   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+#if defined key_top && defined key_ldfslp 
+   !!----------------------------------------------------------------------
+   !!   'key_top'          and                                   TOP models
+   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   trc_ldf_iso : update the tracer trend with the horizontal component
+   !!                 of iso neutral laplacian operator or horizontal 
+   !!                 laplacian operator in s-coordinate
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc      ! ocean dynamics and tracers variables
+   USE trc          ! ocean passive tracers variables
+   USE prtctl_trc   ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trc_ldf_iso  ! routine called by step.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_iso.F90,v 1.10 2007/10/12 09:26:30 opalod Exp $ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_ldf_iso( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_ldf_iso  ***
+      !! 
+      !! ** Purpose :   Compute the before horizontal tracer  diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The horizontal component of the lateral diffusive trends 
+      !!      is provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      horizontal fluxes associated with the rotated lateral mixing:
+      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
+      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
+      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
+      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
+      !!      add horizontal Eddy Induced advective fluxes (lk_traldf_eiv=T):
+      !!         zftu = zftu - dk-1[ aht e2u mi(wslpi) ] mi( tb ) 
+      !!         zftv = zftv - dk-1[ aht e1v mj(wslpj) ] mj( tb ) 
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
+      !!      Add this trend to the general trend tra :
+      !!         tra = tra + difft
+      !!
+      !! ** Action  : - Update tra arrays with the before isopycnal or
+      !!                geopotential s-coord harmonic mixing trend.
+      !!              - Save the trends in trtrd ('key_trc_diatrd')
+      !!
+      !! History :
+      !!        !  94-08  (G. Madec, M. Imbard)
+      !!        !  97-05  (G. Madec)  split into traldf and trazdf
+      !!        !  98-03  (L. Bopp, MA Foujols) passive tracer generalisation
+      !!        !  00-10  (MA Foujols E Kestenare) USE passive tracer coefficient
+      !!   8.5  !  02-08  (G. Madec)  Free form, F90
+      !!   9.0  !  04-03  (C. Ethe)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce_trc       , zftu => ua,  &  ! use ua as workspace
+         &                zfsu => va      ! use va as workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk,jn             ! dummy loop indices
+      REAL(wp) ::   &
+         zabe1, zabe2, zcof1, zcof2,   &  ! temporary scalars
+         zmsku, zmskv, zbtr,           &
+#if defined key_trcldf_eiv
+         zcg1, zcg2, zuwk, zvwk,       &
+         zuwk1, zvwk1,                 &
+#endif
+         ztra
+
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zdkt, zdk1t            ! workspace
+
+#if defined key_trcldf_eiv
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zftug, zftvg
+
+#if defined key_trc_diatrd
+      REAL(wp) ::   &
+         ztagu, ztagv
+#endif
+
+#endif
+
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zftv                       ! workspace
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_ldf_iso : iso neutral lateral diffusion or'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   horizontal laplacian diffusion in s-coordinate'
+#if defined key_trcldf_eiv && defined key_diaeiv
+         u_trc_eiv(:,:,:) = 0.e0
+         v_trc_eiv(:,:,:) = 0.e0
+#endif
+      ENDIF
+
+
+      DO jn = 1, jptra
+
+         !                                                ! ===============
+         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(:,:) = ( trb(:,:,jk,jn) - trb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+
+            IF( jk == 1 ) THEN
+               zdkt(:,:) = zdk1t(:,:)
+            ELSE
+               zdkt(:,:) = ( trb(:,:,jk-1,jn) - trb(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+
+
+            ! 2. Horizontal fluxes
+            ! --------------------
+
+            DO jj = 1 , jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe1 = ( fsahtru(ji,jj,jk) + ahtrb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
+                  zabe2 = ( fsahtrv(ji,jj,jk) + ahtrb0 ) * 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 = -fsahtru(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
+                  zcof2 = -fsahtrv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+
+                  zftu(ji,jj,jk) = umask(ji,jj,jk) * (   zabe1 * (   trb(ji+1,jj,jk,jn) - trb(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 * (   trb(ji,jj+1,jk,jn) - trb(ji,jj,jk,jn)  )   &
+                     &                              + zcof2 * (   zdkt (ji,jj+1) + zdk1t(ji,jj)      &
+                     &                                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  )
+
+               END DO
+            END DO
+
+#   if defined key_trcldf_eiv
+            !                              ! ---------------------------------------!
+            !                              ! Eddy induced vertical advective fluxes !
+            !                              ! ---------------------------------------!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk  ) ) * fsaeitru(ji,jj,jk  ) * umask(ji,jj,jk  )
+                  zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj,jk+1) ) * fsaeitru(ji,jj,jk+1) * umask(ji,jj,jk+1)
+                  zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk  ) ) * fsaeitrv(ji,jj,jk  ) * vmask(ji,jj,jk  )
+                  zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji,jj+1,jk+1) ) * fsaeitrv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
+
+                  zcg1= -0.25 * e2u(ji,jj) * umask(ji,jj,jk) * ( zuwk-zuwk1 )
+                  zcg2= -0.25 * e1v(ji,jj) * vmask(ji,jj,jk) * ( zvwk-zvwk1 )
+
+                  zftug(ji,jj) = zcg1 * ( trb(ji+1,jj,jk,jn) + trb(ji,jj,jk,jn) )
+                  zftvg(ji,jj) = zcg2 * ( trb(ji,jj+1,jk,jn) + trb(ji,jj,jk,jn) )
+
+                  zftu(ji,jj,jk) = zftu(ji,jj,jk) + zftug(ji,jj)
+                  zftv(ji,jj,jk) = zftv(ji,jj,jk) + zftvg(ji,jj)
+
+#   if defined key_diaeiv
+                  u_trc_eiv(ji,jj,jk) = -2. * zcg1 / ( e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  v_trc_eiv(ji,jj,jk) = -2. * zcg2 / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
+#   endif
+               END DO
+            END DO
+#   endif
+
+            ! 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) )
+                  ztra = zbtr * (  zftu(ji,jj,jk) - zftu(ji-1,jj  ,jk)   &
+                     &          + zftv(ji,jj,jk) - zftv(ji  ,jj-1,jk)  )
+                  tra (ji,jj,jk,jn) = tra (ji,jj,jk,jn) + ztra
+#if defined key_trc_diatrd
+                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),4) = ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk  ) ) * zbtr
+                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),5) = ( zftv(ji,jj,jk) - zftv(ji,jj-1,jk  ) ) * zbtr
+#endif
+               END DO
+            END DO
+
+#if defined key_trc_diatrd
+#   if defined key_trcldf_eiv
+            DO jj = 2 , jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr= 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztagu = ( zftug(ji,jj) - zftug(ji-1,jj  ) ) * zbtr
+                  ztagv = ( zftvg(ji,jj) - zftvg(ji  ,jj-1) ) * zbtr
+                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),4) = trtrd(ji,jj,jk,ikeep(jn),4) - ztagu
+                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),5) = trtrd(ji,jj,jk,ikeep(jn),5) - ztagv
+                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),7) = ztagu
+                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),8) = ztagv
+               END DO
+             END DO
+#   endif
+#endif
+
+            !                                          ! ===============
+         END DO                                        !   End of slab  
+         !                                             ! ===============
+
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('ldf - iso')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_ldf_iso
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :             No rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ldf_iso( kt )               ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_ldf_iso: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_ldf_iso
+#endif
+
+   !!==============================================================================
+END MODULE trcldf_iso
Index: trunk/NEMO/TOP_SRC/TRP/trcldf_iso_zps.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcldf_iso_zps.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcldf_iso_zps.F90	(revision 941)
@@ -0,0 +1,275 @@
+MODULE trcldf_iso_zps
+   !!==============================================================================
+   !!                   ***  MODULE  trcldf_iso_zps  ***
+   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+#if defined key_top &&  defined key_ldfslp 
+   !!----------------------------------------------------------------------
+   !!   'key_top'          and                                   TOP models
+   !!   'key_ldfslp'               slope of the lateral diffusive direction
+   !!----------------------------------------------------------------------
+   !!   trc_ldf_iso_zps : update the tracer trend with the horizontal 
+   !!                     component of a iso-neutral laplacian operator
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc             ! ocean dynamics and active tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE prtctl_trc          ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC trc_ldf_iso_zps  ! routine called by step.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_iso_zps.F90,v 1.11 2007/10/12 09:26:30 opalod Exp $ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_ldf_iso_zps( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_ldf_iso_zps  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal tracer  diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The horizontal component of the lateral diffusive trends 
+      !!      is provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      horizontal fluxes associated with the rotated lateral mixing:
+      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
+      !!               - aht       e2u*uslp    dk[ mi(mk(trb)) ]
+      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
+      !!               - aht       e2u*vslp    dk[ mj(mk(trb)) ]
+      !!      add horizontal Eddy Induced advective fluxes (lk_traldf_eiv=T):
+      !!         zftu = zftu - dk-1[ aht e2u mi(wslpi) ] mi( trb ) 
+      !!         zftv = zftv - dk-1[ aht e1v mj(wslpj) ] mj( trb ) 
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
+      !!      Add this trend to the general trend tra :
+      !!         tra = tra + difft
+      !!
+      !!      'key_trdtra' defined: the trend is saved for diagnostics.
+      !!
+      !!      macro-tasked on horizontal slab (jk-loop).
+      !!
+      !! ** Action :
+      !!         Update tra arrays with the before along level biharmonic
+      !!      mixing trend.
+      !!         Save in trtrd arrays the trends if 'key_trc_diatrd' defined
+      !!
+      !! 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  !  04-03  (C. Ethe)  adapted for passive tracers
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce_trc       , zftu => ua,  &  ! use ua as workspace
+         &                zfsu => va      ! use va as workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk,jn          ! dummy loop indices
+      INTEGER ::   iku, ikv               ! temporary integer
+      REAL(wp) ::   &
+         zabe1, zabe2, zcof1, zcof2,   &  ! temporary scalars
+         zmsku, zmskv, zbtr, ztra       
+
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zdkt , zdk1t                     ! temporary workspace
+
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
+         zftv, zgtbu, zgtbv               ! temporary workspace
+
+#if defined key_trcldf_eiv
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zftug, zftvg                    ! temporary workspace
+
+      REAL(wp) ::   &
+         zuwk, zvwk,                   &
+         zuwk1, zvwk1,                 &
+         zcg1,zcg2
+
+#if defined key_trc_diatrd
+      REAL(wp) ::   &
+         ztagu, ztagv
+#endif
+
+#endif
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_ldf_iso_zps : iso neutral laplacian diffusion in '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~   z-coordinates with partial steps'
+#if defined key_trcldf_eiv && defined key_diaeiv
+         u_trc_eiv(:,:,:) = 0.e0
+         v_trc_eiv(:,:,:) = 0.e0
+#endif
+      ENDIF
+
+      DO jn = 1, jptra
+
+#if defined key_trcldf_eiv && key_trc_diatrd
+         ztagu = 0.e0
+         ztagv = 0.e0
+#endif
+
+         ! Horizontal passive tracer gradient 
+         DO jk = 1, jpk
+            DO jj = 1, jpj-1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zgtbu(ji,jj,jk) = tmask(ji,jj,jk) * ( trb(ji+1,jj  ,jk,jn) - trb(ji,jj,jk,jn) )
+                  zgtbv(ji,jj,jk) = tmask(ji,jj,jk) * ( trb(ji  ,jj+1,jk,jn) - trb(ji,jj,jk,jn) )
+               END DO
+            END DO
+         END DO
+         ! partial steps correction at the last level 
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+               ! last level
+               iku = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
+               ikv = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
+               zgtbu(ji,jj,iku) = gtru(ji,jj,jn)               
+               zgtbv(ji,jj,ikv) = gtrv(ji,jj,jn)               
+            END DO
+         END DO
+
+         !                                                ! ===============
+         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(:,:) = ( trb(:,:,jk,jn) - trb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+
+            IF( jk == 1 ) THEN
+               zdkt(:,:) = zdk1t(:,:)
+            ELSE
+               zdkt(:,:) = ( trb(:,:,jk-1,jn) - trb(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+
+
+            ! 2. Horizontal fluxes
+            ! --------------------
+
+            DO jj = 1 , jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe1 = ( fsahtru(ji,jj,jk) + ahtrb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
+                  zabe2 = ( fsahtrv(ji,jj,jk) + ahtrb0 ) * 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 = -fsahtru(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
+                  zcof2 = -fsahtrv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+
+                  zftu(ji,jj,jk) = umask(ji,jj,jk) * (  zabe1 * zgtbu(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 * zgtbv(ji,jj,jk)   &
+                     &                                + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
+                     &                                           + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  )
+               END DO
+            END DO
+
+# if defined key_trcldf_eiv
+            ! ---------------------------------------!
+            ! Eddy induced vertical advective fluxes !
+            ! ---------------------------------------!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj  ,jk  ) ) * fsaeitru(ji,jj,jk  ) * umask(ji,jj,jk  )
+                  zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj  ,jk+1) ) * fsaeitru(ji,jj,jk+1) * umask(ji,jj,jk+1)
+                  zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji  ,jj+1,jk  ) ) * fsaeitrv(ji,jj,jk  ) * vmask(ji,jj,jk  )
+                  zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji  ,jj+1,jk+1) ) * fsaeitrv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
+
+                  zcg1= -0.25 * e2u(ji,jj) * umask(ji,jj,jk) * ( zuwk-zuwk1 )
+                  zcg2= -0.25 * e1v(ji,jj) * vmask(ji,jj,jk) * ( zvwk-zvwk1 )
+
+                  zftug(ji,jj) = zcg1 * ( trb(ji+1,jj,jk,jn) + trb(ji,jj,jk,jn) )
+                  zftvg(ji,jj) = zcg2 * ( trb(ji,jj+1,jk,jn) + trb(ji,jj,jk,jn) )
+
+                  zftu(ji,jj,jk) = zftu(ji,jj,jk) + zftug(ji,jj)
+                  zftv(ji,jj,jk) = zftv(ji,jj,jk) + zftvg(ji,jj)
+
+#   if defined key_diaeiv
+                  u_trc_eiv(ji,jj,jk) = -2. * zcg1 / ( e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  v_trc_eiv(ji,jj,jk) = -2. * zcg2 / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
+#   endif
+               END DO
+            END DO
+# endif
+
+            ! 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) )
+                  ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
+                  tra (ji,jj,jk,jn) = tra (ji,jj,jk,jn) + ztra
+#if defined key_trc_diatrd
+                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),4) = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,  jj,jk) )
+                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),5) = zbtr * ( zftv(ji,jj,jk) - zftv(ji  ,jj-1,jk) )
+#endif
+               END DO
+            END DO
+#if defined key_trc_diatrd
+#   if defined key_trcldf_eiv
+            DO jj = 2 , jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr= 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztagu = ( zftug(ji,jj) - zftug(ji-1,jj  ) ) * zbtr
+                  ztagv = ( zftvg(ji,jj) - zftvg(ji  ,jj-1) ) * zbtr
+                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),4) = trtrd(ji,jj,jk,ikeep(jn),4) - ztagu
+                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),5) = trtrd(ji,jj,jk,ikeep(jn),5) - ztagv
+                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),7) = ztagu
+                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),8) = ztagv
+               END DO
+            END DO
+#   endif
+#endif
+            !                                          ! ===============
+         END DO                                        !   End of slab  
+         !                                             ! ===============
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('ldf - iso/zps')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_ldf_iso_zps
+
+#else
+   !!----------------------------------------------------------------------
+   !!   default option :   Dummy code   NO rotation of the diffusive tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ldf_iso_zps( kt )               ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_ldf_iso_zps: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_ldf_iso_zps
+#endif
+
+   !!==============================================================================
+END MODULE trcldf_iso_zps
Index: trunk/NEMO/TOP_SRC/TRP/trcldf_lap.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcldf_lap.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcldf_lap.F90	(revision 941)
@@ -0,0 +1,166 @@
+MODULE trcldf_lap
+   !!==============================================================================
+   !!                       ***  MODULE  trcldf_lap  ***
+   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_ldf_lap  : update the tracer trend with the horizontal diffusion
+   !!                 using a iso-level harmonic (laplacien) operator.
+   !!----------------------------------------------------------------------
+   USE oce_trc             ! ocean dynamics and active tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE prtctl_trc          ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trc_ldf_lap  ! routine called by step.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+
+   SUBROUTINE trc_ldf_lap( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_ldf_lap  ***
+      !!                   
+      !! ** Purpose :   Compute the before horizontal tracer diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   Second order diffusive operator evaluated using before
+      !!      fields (forward time scheme). The horizontal diffusive trends of 
+      !!      the passive tracer is given by:
+      !!       * s-coordinate, the vertical scale 
+      !!      factors e3. are inside the derivatives:
+      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(trb) ]
+      !!                                   + dj-1[ aht e1v*e3v/e2v dj(trb) ] }
+      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
+      !!          difft = 1/(e1t*e2t) {  di-1[ aht e2u/e1u di(trb) ]
+      !!                               + dj-1[ aht e1v/e2v dj(trb) ] }
+      !!      Add this trend to the general tracer trend tra :
+      !!          tra = tra + difft
+      !!
+      !! ** Action  : - Update tra arrays with the before iso-level 
+      !!                harmonic mixing trend.
+      !!              - Save the trends in trtrd ('key_trc_diatrd')
+      !!
+      !! History :
+      !!   1.0  !  87-06  (P. Andrich, D. L Hostis)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  95-02  (M. Levy)    passive tracers
+      !!        !  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-03  (C. Ethe)   passive tracer
+      !!----------------------------------------------------------------------
+      USE oce_trc          , ztu => ua,  &  ! use ua as workspace
+         &                   ztv => 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,jn         ! dummy loop indices
+      REAL(wp) ::   &
+         zabe1, zabe2, zbtr              ! temporary scalars
+
+      REAL(wp) ::   &
+         ztra, ztrax, ztray              ! workspace
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+      
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_ldf_lap : iso-level laplacian diffusion'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+         ze1ur(:,:) = e2u(:,:) / e1u(:,:)
+         ze2vr(:,:) = e1v(:,:) / e2v(:,:)
+         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
+      ENDIF
+ 
+      DO jn = 1, jptra
+         
+         !                                                  ! =============
+         DO jk = 1, jpkm1                                   ! Vertical slab
+            !                                               ! =============
+            ! 1. First derivative (gradient)
+            ! -------------------
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  IF ( ln_sco ) THEN
+                     zabe1 = fsahtru(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) * fse3u(ji,jj,jk)
+                     zabe2 = fsahtrv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) * fse3v(ji,jj,jk)
+                  ELSE
+                     zabe1 = fsahtru(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj)
+                     zabe2 = fsahtrv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj)
+                  ENDIF
+                  ztu(ji,jj,jk) = zabe1 * ( trb(ji+1,jj  ,jk,jn) - trb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zabe2 * ( trb(ji  ,jj+1,jk,jn) - trb(ji,jj,jk,jn) )
+               END DO
+            END DO
+
+
+            ! 2. Second derivative (divergence)
+            ! --------------------
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF ( ln_sco ) THEN
+                     zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk)
+                  ELSE
+                     zbtr = zbtr2(ji,jj)
+                  ENDIF
+                  ! horizontal diffusive trends
+                  ztrax = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) )
+                  ztray = zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )
+
+                  ! add it to the general tracer trends
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztrax + ztray
+
+#if defined key_trc_diatrd
+                  ! save the horizontal diffusive trends
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),4) = ztrax
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),5) = ztray
+#endif
+               END DO
+            END DO
+            !                                               ! =============
+         END DO                                             !  End of slab  
+         !                                                  ! =============
+
+      END DO
+
+     IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('ldf - lap')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_ldf_lap
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ldf_lap( kt )  
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_ldf_lap: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_ldf_lap
+#endif
+
+   !!==============================================================================
+END MODULE trcldf_lap
Index: trunk/NEMO/TOP_SRC/TRP/trcnxt.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 941)
@@ -0,0 +1,182 @@
+MODULE trcnxt
+   !!======================================================================
+   !!                       ***  MODULE  trcnxt  ***
+   !! Ocean passive tracers:  time stepping on passives tracers
+   !!======================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_nxt     : time stepping on passive tracers
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc         ! ocean dynamics and tracers variables
+   USE trc             ! ocean passive tracers variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE trctrp_lec      ! pasive tracers transport
+   USE prtctl_trc      ! Print control for debbuging
+   USE agrif_top_update
+   USE agrif_top_interp
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trc_nxt          ! routine called by step.F90
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nxt( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trcnxt  ***
+      !!
+      !! ** Purpose :   Compute the passive tracers fields at the 
+      !!      next time-step from their temporal trends and swap the fields.
+      !! 
+      !! ** Method  :   Apply lateral boundary conditions on (ua,va) through 
+      !!      call to lbc_lnk routine
+      !!   default:
+      !!      arrays swap
+      !!         (trn) = (tra) ; (tra) = (0,0)
+      !!         (trb) = (trn) 
+      !!
+      !!   For Arakawa or TVD Scheme : 
+      !!      A Asselin time filter applied on now tracers (trn) to avoid
+      !!      the divergence of two consecutive time-steps and tr arrays
+      !!      to prepare the next time_step:
+      !!         (trb) = (trn) + atfp [ (trb) + (tra) - 2 (trn) ]
+      !!         (trn) = (tra) ; (tra) = (0,0)
+      !!
+      !!
+      !! ** Action  : - update trb, trn
+      !!
+      !! History :
+      !!   7.0  !  91-11  (G. Madec)  Original code
+      !!        !  93-03  (M. Guyon)  symetrical conditions
+      !!        !  95-02  (M. Levy)   passive tracers 
+      !!        !  96-02  (G. Madec & M. Imbard)  opa release 8.0
+      !!   8.0  !  96-04  (A. Weaver)  Euler forward step
+      !!   8.2  !  99-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!        !  02-11  (C. Talandier, A-M Treguier) Open boundaries
+      !!   9.0  !  04-03  (C. Ethe) passive tracers 
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zfact            ! temporary scalar
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      IF( kt == nittrc000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_nxt : time stepping on passive tracers'
+      ENDIF
+
+
+      DO jn = 1, jptra
+
+         ! 0. Lateral boundary conditions on tra (T-point, unchanged sign)
+         ! ---------------------------------============
+         CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )   
+         
+         !                                                ! ===============
+         DO jk = 1, jpk                                   ! Horizontal slab
+            !                                             ! ===============
+            ! 1. Leap-frog scheme (only in explicit case, otherwise the 
+            ! -------------------  time stepping is already done in trczdf)
+            IF( l_trczdf_exp .AND. ( ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN
+               zfact = 2. * rdttra(jk) * FLOAT(ndttrc) 
+               IF( neuler == 0 .AND. kt == nittrc000 ) zfact = rdttra(jk) * FLOAT(ndttrc) 
+               tra(:,:,jk,jn) = ( trb(:,:,jk,jn) + zfact * tra(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+
+         END DO
+
+#if defined key_obc
+        CALL ctl_stop( '          Passive tracers and Open Boundary condition can not be used together ' &
+           &           '          Check in trc_nxt routine' )
+#endif
+
+#if defined key_agrif
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      ! Update tracers 
+      CALL Agrif_trc( kt )
+      !                                                ! ===============
+      DO jn = 1, jptra                                 ! Horizontal slab
+         !                                             ! ===============
+#endif
+
+         DO jk = 1, jpk  
+
+            ! 2. Time filter and swap of arrays
+            ! ---------------------------------
+            IF ( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN
+
+               IF( neuler == 0 .AND. kt == nittrc000 ) THEN
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
+                        trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)
+                        tra(ji,jj,jk,jn) = 0.
+                     END DO
+                  END DO
+               ELSE
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        trb(ji,jj,jk,jn) = atfp  * ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) + atfp1 * trn(ji,jj,jk,jn)
+                        trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)
+                        tra(ji,jj,jk,jn) = 0.
+                     END DO
+                  END DO
+               ENDIF
+
+            ELSE
+!  case of smolar scheme or muscl
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     trb(ji,jj,jk,jn) = tra(ji,jj,jk,jn)
+                     trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)
+                     tra(ji,jj,jk,jn) = 0.
+                  END DO
+               END DO
+
+            ENDIF
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('nxt')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+
+#if defined key_agrif
+      IF (.NOT.Agrif_Root())    CALL Agrif_Update_Trc( kt )
+#endif      
+
+
+   END SUBROUTINE trc_nxt
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nxt( kt )  
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_nxt: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_nxt
+#endif
+   !!======================================================================
+END MODULE trcnxt
Index: trunk/NEMO/TOP_SRC/TRP/trcrad.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 941)
@@ -0,0 +1,148 @@
+MODULE trcrad
+   !!======================================================================
+   !!                       ***  MODULE  trcrad  ***
+   !! Ocean passive tracers:  correction of negative concentrations
+   !!======================================================================
+   !! History :   -   !  01-01  (O. Aumont & E. Kestenare)  Original code
+   !!            1.0  !  04-03  (C. Ethe)  free form F90
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_rad    : correction of negative concentrations
+   !!----------------------------------------------------------------------
+   USE oce_trc             ! ocean dynamics and tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE lib_mpp
+   USE prtctl_trc          ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_rad        ! routine called by trcstp.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Id: trcrad.F90 776 2007-12-19 14:10:14Z gm $ 
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+
+   SUBROUTINE trc_rad( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_rad  ***
+      !!
+      !! ** Purpose :   "crappy" routine to correct artificial negative
+      !!              concentrations due to isopycnal scheme
+      !!
+      !! ** Method  : - PISCES or LOBSTER: Set negative concentrations to zero
+      !!                while computing the corresponding tracer content that
+      !!                is added to the tracers. Then, adjust the tracer 
+      !!                concentration using a multiplicative factor so that 
+      !!                the total tracer concentration is preserved.
+      !!              - CFC: simply set to zero the negative CFC concentration
+      !!                (the total CFC content is not strictly preserved)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index      
+      !!
+      INTEGER  ::  ji, jj, jk, jn     ! dummy loop indices
+      REAL(wp) :: zvolk, ztrcorb, ztrmasb   ! temporary scalars
+      REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         "
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations '
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      IF( lk_cfc ) THEN                         ! CFC model
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) )
+                     trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) )
+                  END DO
+               END DO
+            END DO
+         END DO
+      ENDIF 
+
+      IF( lk_pisces .OR. lk_lobster ) THEN      ! PISCES or LOBSTER bio-model
+         DO jn = 1, jptra
+            ztrcorb = 0.e0
+            ztrmasb = 0.e0
+            ztrcorn = 0.e0
+            ztrmasn = 0.e0
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zvolk  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)   &
+# if defined key_off_degrad
+                        &   * facvol(ji,jj,jk)   &
+# endif
+                        &   * tmask(ji,jj,jk) * tmask_i(ji,jj)
+
+                     ztrcorb = ztrcorb + MIN( 0., trb(ji,jj,jk,jn) )  * zvolk
+                     ztrcorn = ztrcorn + MIN( 0., trn(ji,jj,jk,jn) )  * zvolk
+
+                     trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) )
+                     trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) )
+
+                     ztrmasb = ztrmasb + trb(ji,jj,jk,jn) * zvolk
+                     ztrmasn = ztrmasn + trn(ji,jj,jk,jn) * zvolk
+                  END DO
+               END DO
+            END DO
+            IF( lk_mpp ) THEN
+               CALL mpp_sum( ztrcorb )      ! sum over the global domain
+               CALL mpp_sum( ztrcorn )      ! sum over the global domain
+               CALL mpp_sum( ztrmasb )      ! sum over the global domain
+               CALL mpp_sum( ztrmasn )      ! sum over the global domain
+            ENDIF
+
+            IF( ztrcorb /= 0 ) THEN
+               zcoef = 1. + ztrcorb / ztrmasb
+               DO jk = 1, jpkm1
+                  trb(:,:,jk,jn) = trb(:,:,jk,jn) * zcoef * tmask(:,:,jk)
+               END DO
+            ENDIF
+
+            IF( ztrcorn /= 0 ) THEN
+               zcoef = 1. + ztrcorn / ztrmasn
+               DO jk = 1, jpkm1
+                  trn(:,:,jk,jn) = trn(:,:,jk,jn) * zcoef * tmask(:,:,jk)
+               END DO
+            ENDIF
+            !
+         END DO
+         !
+      ENDIF
+      !
+      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('rad')")
+         CALL prt_ctl_trc_info( charout )
+         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+      ENDIF
+      !
+   END SUBROUTINE trc_rad
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                         NO TOP model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_rad( kt )              ! Empty routine
+      INTEGER, INTENT(in) ::   kt
+      WRITE(*,*) 'trc_rad: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_rad
+#endif
+   
+   !!======================================================================
+END MODULE trcrad
Index: trunk/NEMO/TOP_SRC/TRP/trcsbc.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 941)
@@ -0,0 +1,122 @@
+MODULE trcsbc
+   !!==============================================================================
+   !!                       ***  MODULE  trcsbc  ***
+   !! Ocean passive tracers:  surface boundary condition
+   !!==============================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_sbc      : update the tracer trend at ocean surface
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc             ! ocean dynamics and active tracers variables
+   USE trc                 ! ocean  passive tracers variables
+   USE prtctl_trc          ! Print control for debbuging
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trc_sbc              ! routine called by step.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcsbc.F90,v 1.10 2007/10/12 09:26:30 opalod Exp $ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_sbc ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_sbc  ***
+      !!                   
+      !! ** Purpose :   Compute the tracer surface boundary condition trend of
+      !!      (concentration/dilution effect) and add it to the general 
+      !!       trend of tracer equations.
+      !!
+      !! ** Method :
+      !!      * concentration/dilution effect:
+      !!            The surface freshwater flux modify the ocean volume
+      !!         and thus the concentration of a tracer as :
+      !!            tra = tra + emp * trn / e3t   for k=1
+      !!         where emp, the surface freshwater budget (evaporation minus
+      !!         precipitation minus runoff) given in kg/m2/s is divided
+      !!         by 1000 kg/m3 (density of plain water) to obtain m/s.
+      !!
+      !! ** Action  : - Update the 1st level of tra with the trend associated
+      !!                with the tracer surface boundary condition 
+      !!
+      !! History :
+      !!   8.2  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code
+      !!   8.2  !  01-02  (D. Ludicone)  sea ice and free surface
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!   9.0  !  04-03  (C. Ethe)  adapted for passive tracers
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jn           ! dummy loop indices
+      REAL(wp) ::   ztra, zsrau, zse3t   ! temporary scalars
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      ! 0. initialization
+      zsrau = 1. / rauw
+      IF( .NOT. ln_sco )  zse3t = 1. / fse3t(1,1,1)
+#if defined key_trc_diatrd
+      DO jn = 1, jptra
+        IF (luttrd(jn)) trtrd(:,:,:,ikeep(jn),jpdiatrc) = 0.0
+      END DO
+#endif
+
+      DO jn = 1, jptra
+         ! 1. Concentration dillution effect on tra
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               IF( ln_sco ) zse3t = 1. / fse3t(ji,jj,1)
+               ! concent./dilut. effect
+               ztra = emps(ji,jj) * zsrau * trn(ji,jj,1,jn) * zse3t * tmask(ji,jj,1)
+               
+               ! add the trend to the general tracer trend
+               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ztra
+#if defined key_trc_diatrd
+               IF (luttrd(jn)) trtrd(ji,jj,1,ikeep(jn),jpdiatrc) = trtrd(ji,jj,1,jn,jpdiatrc) + ztra
+#endif
+            END DO
+         END DO
+         
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('sbc')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_sbc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      NO passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sbc (kt)              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sbc
+#endif
+   
+   !!======================================================================
+END MODULE trcsbc
Index: trunk/NEMO/TOP_SRC/TRP/trcstp.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trcstp.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trcstp.F90	(revision 941)
@@ -0,0 +1,84 @@
+MODULE trcstp
+   !!======================================================================
+   !!                       ***  MODULE trcstp  ***
+   !! Time-stepping    : time loop of opa for passive tracer
+   !!======================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   trc_stp      : passive tracer system time-stepping
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc          ! ocean dynamics and active tracers variables
+   USE trc              ! ocean passive tracers variables 
+   USE trctrp           ! passive tracers transport
+   USE trcsms           ! passive tracers sources and sinks
+   USE prtctl_trc       ! Print control for debbuging
+   USE trcdia
+   USE trcdit
+   USE trcrst
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trc_stp           ! called by step
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcstp.F90,v 1.12 2007/02/21 12:58:25 opalod Exp $ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_stp( kt, kindic )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_stp  ***
+      !!                      
+      !! ** Purpose : Time loop of opa for passive tracer
+      !! 
+      !! ** Method  : 
+      !!              Compute the passive tracers trends 
+      !!              Update the passive tracers
+      !!
+      !! History :
+      !!   9.0  !  04-03  (C. Ethe)  Original
+      !!-------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index
+      INTEGER, INTENT( in ) ::  kindic
+      CHARACTER (len=25)    ::  charout
+
+      ! this ROUTINE is called only every ndttrc time step
+      IF( MOD( kt , ndttrc ) /= 0 ) RETURN
+
+      IF(ln_ctl) THEN
+         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
+         CALL prt_ctl_trc_info(charout)
+      ENDIF
+
+                       CALL trc_rst_opn( kt )       ! Open tracer restart file 
+
+                       CALL trc_sms( kt )           ! tracers: sink and source
+
+                       CALL trc_trp( kt )           ! transport of passive tracers
+
+      IF( lrst_trc )   CALL trc_rst_wri( kt )       ! write tracer restart file
+
+                       CALL trc_dia( kt, kindic )   ! diagnostics
+
+
+   END SUBROUTINE trc_stp
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO passive tracers
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_stp( kt )        ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_stp
+#endif
+
+   !!======================================================================
+END MODULE trcstp
Index: trunk/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 941)
@@ -0,0 +1,142 @@
+MODULE trctrp
+   !!======================================================================
+   !!                       ***  MODULE trctrp  ***
+   !! Ocean Physics    : manage the passive tracer transport
+   !!======================================================================
+   !! History :   1.0  !  2004-03 (C. Ethe) Original code
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_trp        : passive tracer transport
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers variables
+   USE trc             ! ocean passive tracers variables 
+   USE trctrp_lec      ! passive tracers transport parameters
+   USE prtctl_trc     ! Print control for debbuging
+
+   USE trcbbl          ! bottom boundary layer               (trc_bbl routine)
+   USE trcdmp          ! internal damping                    (trc_dmp routine)
+
+   USE trcldf_bilapg   ! lateral mixing               (trc_ldf_bilapg routine)
+   USE trcldf_bilap    ! lateral mixing                (trc_ldf_bilap routine)
+   USE trcldf_iso      ! lateral mixing                  (trc_ldf_iso routine)
+   USE trcldf_iso_zps  ! lateral mixing              (trc_ldf_iso_zps routine)
+   USE trcldf_lap      ! lateral mixing                  (trc_ldf_lap routine)
+ 
+   USE trcnxt          ! time-stepping                       (trc_nxt routine)
+   USE trcrad          ! positivity                          (trc_rad routine)
+
+   USE trcadv_cen2     ! 2nd order centered advection   (trc_adv_cen2 routine)
+   USE trcadv_muscl    ! MUSCL advection               (trc_adv_muscl routine)
+   USE trcadv_muscl2   ! MUSCL2 advection             (trc_adv_muscl2 routine)
+   USE trcadv_tvd      ! TVD advection                   (trc_adv_tvd routine)
+   USE trcadv_smolar   ! SMOLAR advection             (trc_adv_smolar routine)
+
+   USE trczdf_exp      ! vertical diffusion              (trc_zdf_exp routine)
+   USE trczdf_imp      ! vertical diffusion              (trc_zdf_exp routine)
+   USE trczdf_iso      ! vertical diffusion              (trc_zdf_exp routine)
+   USE trczdf_iso_vopt ! vertical diffusion              (trc_zdf_exp routine)
+   USE trcsbc          ! surface boundary condition          (trc_sbc routine)
+
+   USE zpshde_trc      ! partial step: hor. derivative   (zps_hde_trc routine)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_trp    ! called by trc_stp
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Id: trctrp.F90 773 2007-12-17 16:55:32Z gm $ 
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_trp( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_trp  ***
+      !!                      
+      !! ** Purpose :   Management of passive tracers transport
+      !! 
+      !! ** Method  : - Compute the passive tracers trends 
+      !!              - Update the passive tracers
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index
+      !!
+      CHARACTER (len=25) :: charout
+      !! ---------------------------------------------------------------------
+
+                               CALL trc_sbc( kt )            ! surface boundary condition
+# if defined key_trcbbc
+!!gm bug : this should be control during the initialisation phase, not here!
+       CALL ctl_stop( '  Bottom heat flux not yet implemented with passive tracer         ' &
+           &          '  Check in trc_trp routine ' )
+# endif 
+      !                                                      ! bottom boundary condition
+      IF( lk_trcbbl_dif    )   CALL trc_bbl_dif( kt )            ! diffusive bottom boundary layer scheme
+      IF( lk_trcbbl_adv    )   CALL trc_bbl_adv( kt )            ! advective (and/or diffusive) bottom boundary layer scheme
+
+      IF( lk_trcdmp        )   CALL trc_dmp( kt )            ! internal damping trends
+
+      !                                                      ! horizontal & vertical advection
+      IF( ln_trcadv_cen2   )   CALL trc_adv_cen2  ( kt )         ! 2nd order centered scheme
+      IF( ln_trcadv_muscl  )   CALL trc_adv_muscl ( kt )         ! MUSCL scheme
+      IF( ln_trcadv_muscl2 )   CALL trc_adv_muscl2( kt )         ! MUSCL2 scheme
+      IF( ln_trcadv_tvd    )   CALL trc_adv_tvd   ( kt )         ! TVD scheme
+      IF( ln_trcadv_smolar )   CALL trc_adv_smolar( kt )         ! SMOLARKIEWICZ scheme
+
+ 
+      IF( n_cla == 1   ) THEN
+!!gm bug : this should be control during the initialisation phase, not here!
+         WRITE(ctmp1,*) ' Cross Land Advection not yet implemented with passive tracer n_cla = ',n_cla
+         CALL ctl_stop( ctmp1 )
+      ENDIF
+
+      !                                                      ! lateral mixing 
+      IF( l_trcldf_bilapg  )   CALL trc_ldf_bilapg ( kt )        ! s-coord. horizontal bilaplacian
+      IF( l_trcldf_bilap   )   CALL trc_ldf_bilap  ( kt )        ! iso-level bilaplacian 
+      IF( l_trcldf_iso     )   CALL trc_ldf_iso    ( kt )        ! iso-neutral laplacian 
+      IF( l_trcldf_iso_zps )   CALL trc_ldf_iso_zps( kt )        ! partial step iso-neutral laplacian
+      IF( l_trcldf_lap     )   CALL trc_ldf_lap    ( kt )        ! iso-level laplacian
+ 
+      !                                                      ! vertical diffusion
+      IF( l_trczdf_exp     )   CALL trc_zdf_exp     ( kt )       ! explicit time stepping (time splitting scheme)
+      IF( l_trczdf_imp     )   CALL trc_zdf_imp     ( kt )       ! implicit time stepping (euler backward)
+      IF( l_trczdf_iso     )   CALL trc_zdf_iso     ( kt )       ! isopycnal
+      IF( l_trczdf_iso_vo  )   CALL trc_zdf_iso_vopt( kt )       ! vector opt. isopycnal
+
+                               CALL trc_nxt( kt )            ! tracer fields at next time step
+ 
+                               CALL trc_rad( kt )            ! Correct artificial negative concentrations
+      !                                                      ! especially useful when isopycnal mixing is used
+      !                                                      
+
+      IF( ln_zps .AND. .NOT. lk_trc_c1d )   &              ! Partial steps: now horizontal gradient of passive
+         &                     CALL zps_hde_trc( kt, trb, gtru, gtrv )       ! tracers at the bottom ocean level
+      !
+      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('TRP')")
+         CALL prt_ctl_trc_info( charout )
+         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm )
+      ENDIF
+      !
+   END SUBROUTINE trc_trp
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                        No TOP models
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_trp( kt )              ! Empty routine
+      INTEGER, INTENT(in) ::   kt
+      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_trp
+#endif
+   
+   !!======================================================================
+END MODULE trctrp
Index: trunk/NEMO/TOP_SRC/TRP/trctrp_ctl.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trctrp_ctl.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trctrp_ctl.F90	(revision 941)
@@ -0,0 +1,330 @@
+MODULE trctrp_ctl
+   !!======================================================================
+   !!                       ***  MODULE  trctrp_ctl  ***
+   !! TOP :   transport option control
+   !!======================================================================
+   !! History :   1.0  !  2004-03 (C. Ethe) Original code
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_trp_ctl  : control the different options of transport
+   !!   trc_adv_ctl  : control the different options of the advection
+   !!   trc_ldf_ctl  : control the different options of the lateral diffusion
+   !!   trc_zdf_ctl  : control the different options of the vertical diffusion
+   !!   trc_dmp_ctl  : control the different options of the internal damping
+   !!----------------------------------------------------------------------
+   USE oce_trc       ! ocean dynamics and active tracers variables
+   USE trc           ! ocean passive tracers variables
+   USE trctrp_lec    ! passive tracers transport
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_trp_ctl   ! called by ???
+
+#if defined key_trcldf_eiv
+      LOGICAL, PARAMETER ::   lk_trcldf_eiv   = .TRUE.   !: eddy induced velocity flag
+#else   
+      LOGICAL, PARAMETER ::   lk_trcldf_eiv   = .FALSE.  !: eddy induced velocity flag
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Id: trctrp_ctl.F90 772 2007-12-17 11:59:33Z gm $ 
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_trp_ctl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_trp_ctl  ***
+      !!                
+      !! ** Purpose :   Control the consistency between cpp options for 
+      !!                tracer transport
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+
+      CALL trc_adv_ctl      ! Control of Advection scheme options
+
+      CALL trc_ldf_ctl      ! Control of Lateral diffusion scheme options
+
+      CALL trc_zdf_ctl      ! Control of Vertival diffusion scheme options
+
+      !                     ! Control of Newtonian damping  options
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' *** Tracer damping option'
+      ENDIF
+#if defined key_trcdmp
+      IF(lwp) WRITE(numout,*) '     key_trcdmp is defined:   Check trcdmp ROUTINE '
+      CALL trc_dmp_ctl
+#else
+      IF(lwp) WRITE(numout,*) '     No tracer damping'
+#endif
+      !
+   END SUBROUTINE trc_trp_ctl
+
+
+   SUBROUTINE trc_adv_ctl
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_ctl  ***
+      !!                
+      !! ** Purpose :   Control the consistency between cpp options for 
+      !!              tracer advection schemes
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio
+      !!----------------------------------------------------------------------
+
+      ! Control of Advection scheme options
+      ! -----------------------------------
+     IF( lk_trc_c1d ) THEN
+         ln_trcadv_cen2   = .FALSE.    ;  ln_trcadv_tvd    = .FALSE. ; ln_trcadv_muscl  = .FALSE.
+         ln_trcadv_muscl2 = .FALSE.    ;  ln_trcadv_smolar = .FALSE.
+         IF(lwp) WRITE(numout,*) ' *** 1D configuration : No advection on passive tracers '
+         IF(lwp) WRITE(numout,*) 
+      ELSE
+         ioptio = 0
+         IF( ln_trcadv_cen2   )   ioptio = ioptio + 1
+         IF( ln_trcadv_tvd    )   ioptio = ioptio + 1
+         IF( ln_trcadv_muscl  )   ioptio = ioptio + 1
+         IF( ln_trcadv_muscl2 )   ioptio = ioptio + 1
+         IF( ln_trcadv_smolar )   ioptio = ioptio + 1
+         
+         IF( lk_esopa ) THEN
+            IF(lwp) WRITE(numout,*) ' esopa control : the use of all scheme is forced'
+            ln_trcadv_cen2   = .TRUE.
+            ln_trcadv_tvd    = .TRUE.
+            ln_trcadv_muscl  = .TRUE.
+            ln_trcadv_muscl2 = .TRUE.
+            ln_trcadv_smolar = .TRUE.
+         ELSEIF( ioptio > 1 .OR. ioptio == 0 ) THEN
+            CALL ctl_stop( '  Choose one advection scheme in namelist nam_trcadv' )
+         ENDIF
+         
+         IF( n_cla == 1 .AND. .NOT. ln_trcadv_cen2 ) &
+            &    CALL ctl_stop( '    cross-land advection only with 2nd order advection scheme ' )
+      ENDIF
+      !
+   END SUBROUTINE trc_adv_ctl
+
+
+   SUBROUTINE trc_ldf_ctl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_ldf_ctl  ***
+      !! 
+      !! ** Purpose :   Control the consistency between cpp options for 
+      !!      tracer lateral diffusion 
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio               ! ???
+      LOGICAL ::   ll_print = .FALSE.   ! =T print eddy coef. in numout      
+      !!----------------------------------------------------------------------
+
+      ! Parameter control
+
+      IF( .NOT. ln_trcldf_diff .OR. lk_trc_c1d ) THEN
+         l_trcldf_lap = .FALSE.   ;   l_trcldf_bilap   = .FALSE.   ;   l_trcldf_bilapg  = .FALSE.
+         l_trcldf_iso = .FALSE.   ;   l_trcldf_iso_zps = .FALSE.
+         l_trczdf_iso = .FALSE.   ;   l_trczdf_iso_vo  = .FALSE.
+         IF(lwp ) WRITE(numout,*) '*** No lateral diffusion on passive tracers '
+         IF(lwp ) WRITE(numout,*) 
+      ELSE
+         ! control the input
+         ioptio = 0
+         IF( ln_trcldf_lap   )   ioptio = ioptio + 1
+         IF( ln_trcldf_bilap )   ioptio = ioptio + 1
+         IF( ioptio /= 1 )   CALL ctl_stop( '    use ONE of the 2 lap/bilap operator type on tracer' )
+         
+         ioptio = 0
+         IF( ln_trcldf_level )   ioptio = ioptio + 1
+         IF( ln_trcldf_hor   )   ioptio = ioptio + 1
+         IF( ln_trcldf_iso   )   ioptio = ioptio + 1
+         IF( ioptio /= 1 )   CALL ctl_stop( '   use only ONE direction (level/hor/iso)' )
+         
+         ! ... Choice of the lateral scheme used
+         IF( lk_trcldf_eiv ) THEN
+            IF(lwp) WRITE(numout,*) '          eddy induced velocity on tracers'
+            IF( .NOT.ln_trcldf_iso .OR. ln_trcldf_bilap ) &
+               &      CALL ctl_stop( ' the eddy induced velocity on tracers ',&
+               &                     'requires isopycnal laplacian diffusion' )
+         ENDIF
+         
+         IF( ln_sco ) THEN          ! s-coordinates: rotation required for horizontal or isopycnal mixing
+            IF( ( ln_trcldf_iso .OR. ln_trcldf_hor ) .AND. .NOT.lk_ldfslp ) &
+               &      CALL ctl_stop( '  the rotation of the diffusive tensor require key_ldfslp' )
+         ELSE                       ! z-coordinates with/without partial step:
+            ln_trcldf_level = ln_trcldf_level .OR. ln_trcldf_hor      ! level diffusion = horizontal diffusion
+            ln_trcldf_hor   = .FALSE.
+            IF(lwp) WRITE(numout,*) '          horizontal mixing in z-coord or partial steps: force ln_trcldf_level = T'
+            IF(lwp) WRITE(numout,*) '                                                  and    force ln_trcldf_hor   = F'
+            IF( ln_trcldf_iso .AND. .NOT.lk_ldfslp ) &            ! rotation required for isopycnal mixing
+               &      CALL ctl_stop( ' the rotation of the diffusive tensor require key_ldfslp' )
+         ENDIF
+         
+         l_trcldf_lap     =  ln_trcldf_lap   .AND. ln_trcldf_level     ! iso-level   laplacian operator
+         l_trcldf_bilap   =  ln_trcldf_bilap .AND. ln_trcldf_level     ! iso-level bilaplacian operator
+         l_trcldf_bilapg  =  ln_trcldf_bilap .AND. ln_trcldf_hor       ! geopotential bilap. (s-coord)
+         l_trcldf_iso     =  ln_trcldf_lap   .AND.                  &  ! laplacian operator
+            &              ( ln_trcldf_iso   .OR.  ln_trcldf_hor )  &  ! iso-neutral (z-coord) or horizontal (s-coord)
+            &                                     .AND. .NOT.ln_zps
+         l_trcldf_iso_zps =  ln_trcldf_lap   .AND.                  &  ! laplacian operator
+            &              ( ln_trcldf_iso   .OR.  ln_trcldf_hor )  &  ! iso-neutral (partial steps)
+            &                                .AND. ln_zps              ! or geopotential in mixed partial steps/s-coord
+         l_trczdf_iso    = .FALSE.
+         l_trczdf_iso_vo = .FALSE.
+         IF( l_trcldf_iso     )   l_trczdf_iso = .TRUE.
+         IF( l_trcldf_iso_zps )   l_trczdf_iso = .TRUE.
+#if defined key_vectopt_memory
+         IF( l_trczdf_iso ) THEN
+            l_trczdf_iso    = .FALSE.
+            l_trczdf_iso_vo = .TRUE.
+         ENDIF
+#endif
+         
+         ioptio = 0
+         IF( l_trcldf_lap     )   ioptio = ioptio + 1
+         IF( l_trcldf_bilap   )   ioptio = ioptio + 1
+         IF( l_trcldf_bilapg  )   ioptio = ioptio + 1
+         IF( l_trcldf_iso     )   ioptio = ioptio + 1
+         IF( l_trcldf_iso_zps )   ioptio = ioptio + 1
+         IF( ioptio /= 1 ) &
+            &   CALL ctl_stop( '  this combination of operator and direction has not been implemented' )
+         
+         IF( lk_esopa ) THEN
+            l_trcldf_lap = .TRUE.   ;   l_trcldf_bilap   = .TRUE.   ;   l_trcldf_bilapg  = .TRUE.
+            l_trcldf_iso = .TRUE.   ;   l_trcldf_iso_zps = .TRUE.
+            l_trczdf_iso = .TRUE.   ;   l_trczdf_iso_vo  = .TRUE.
+            IF(lwp ) WRITE(numout,*) '          esopa test: use all lateral physics options'
+         ENDIF
+         
+         ! ... Space variation of eddy coefficients
+         ioptio = 0
+#if defined key_traldf_c3d || defined key_off_degrad
+         IF(lwp) WRITE(numout,*) 'tracer mixing coef. = F( latitude, longitude, depth)'
+         ioptio = ioptio + 1
+#endif
+#if defined key_traldf_c2d && ! defined key_off_degrad
+         IF(lwp) WRITE(numout,*) 'tracer mixing coef. = F( latitude, longitude)'
+         ioptio = ioptio + 1
+#endif
+#if defined key_traldf_c1d && ! defined key_off_degrad
+         IF(lwp) WRITE(numout,*) 'tracer mixing coef. = F( depth )'
+         ioptio = ioptio + 1
+         IF( ln_sco ) &
+            &  CALL ctl_stop( '    key_traldf_c1d cannot be used in s-coordinate ' )
+#endif
+         IF( ioptio == 0 ) THEN
+            IF(lwp) WRITE(numout,*) ' tracer mixing coef. = constant (default option)'
+         ELSEIF( ioptio > 1 ) THEN
+            CALL ctl_stop( '  use only one of the following keys:',   &
+               &                 ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d' )
+         ENDIF
+         
+         IF( l_trcldf_bilap .OR. l_trcldf_bilapg ) THEN
+            IF(lwp) WRITE(numout,*) '  biharmonic tracer diffusion'
+            IF( ahtrc0 > 0 .AND. .NOT. lk_esopa ) &
+               &  CALL ctl_stop( '  The horizontal diffusivity coef. aht0 must be negative' )
+         ELSE
+            IF(lwp) WRITE(numout,*) ' harmonic tracer diffusion (default)'
+            IF( ahtrc0 < 0 .AND. .NOT. lk_esopa ) &
+               &  CALL ctl_stop( ' The horizontal diffusivity coef. aht0 must be positive' )
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE trc_ldf_ctl
+
+
+   SUBROUTINE trc_zdf_ctl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_zdf_ctl  ***
+      !! 
+      !! ** Purpose :   Control the consistency between cpp options for 
+      !!              tracer vertical diffusion
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+
+      ! Parameter & key controls
+      ! ------------------------
+      ! ... vertical mixing
+      ! time stepping scheme (N.B. TKE && KPP scheme => force the use of implicit scheme)
+#if defined key_zdftke || defined key_zdfkpp
+      l_trczdf_exp = .FALSE.          ! use implicit scheme
+      l_trczdf_imp = .TRUE. 
+#else
+      IF( ln_trc_zdfexp  ) THEN  
+         l_trczdf_exp = .TRUE.           ! use explicit scheme
+         l_trczdf_imp = .FALSE.
+      ELSE
+         l_trczdf_exp = .FALSE.          ! use implicit scheme
+         l_trczdf_imp = .TRUE. 
+      ENDIF
+#endif
+
+      IF( l_trczdf_iso .OR. l_trczdf_iso_vo ) THEN  
+         l_trczdf_exp = .FALSE.          ! iso-neutral diffusion : 
+         l_trczdf_imp = .FALSE.          ! implicit scheme included in iso-neutral routine
+      ENDIF
+
+#if defined key_esopa
+      l_trczdf_exp = .TRUE.           ! esopa: use all options
+      l_trczdf_imp = .TRUE.
+#endif
+      !
+   END SUBROUTINE trc_zdf_ctl
+
+
+   SUBROUTINE trc_dmp_ctl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_dmp_ctl  ***
+      !! 
+      !! ** Purpose :    Control the consistency between cpp options for 
+      !!              tracer newtonian damping 
+      !!----------------------------------------------------------------------
+#if defined key_trcdmp
+
+      SELECT CASE ( ndmptr )
+      !
+      CASE ( -1 )               ! ORCA: damping in Red & Med Seas only
+         IF(lwp) WRITE(numout,*) '          tracer damping in the Med & Red seas only'
+         !
+      CASE ( 1:90 )             ! Damping poleward of 'ndmptr' degrees
+         IF(lwp) WRITE(numout,*) '          tracer damping poleward of', ndmptr, ' degrees'
+         !
+      CASE DEFAULT
+         WRITE(ctmp1,*) '          bad flag value for nmldmp = ', ndmptr
+         CALL ctl_stop(ctmp1)
+         !
+      END SELECT
+
+      SELECT CASE ( nmldmptr )
+      !
+      CASE ( 0 )                ! newtonian damping throughout the water column
+         IF(lwp) WRITE(numout,*) '          tracer damping throughout the water column'
+         !
+      CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s)
+         IF(lwp) WRITE(numout,*) '          no tracer damping in the turbocline'
+         !
+      CASE ( 2 )                ! no damping in the mixed layer 
+         IF(lwp) WRITE(numout,*) '          no tracer damping in the mixed layer'
+         !
+      CASE DEFAULT
+         WRITE(ctmp1,*) '          bad flag value for nmldmp = ', nmldmptr
+         CALL ctl_stop(ctmp1)
+         !
+      END SELECT
+#endif
+      !
+   END SUBROUTINE trc_dmp_ctl
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                        No TOP models
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_trp_ctl             ! Empty routine
+   END SUBROUTINE trc_trp_ctl
+#endif
+   
+  !!======================================================================
+END MODULE trctrp_ctl
Index: trunk/NEMO/TOP_SRC/TRP/trctrp_lec.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trctrp_lec.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trctrp_lec.F90	(revision 941)
@@ -0,0 +1,191 @@
+MODULE trctrp_lec
+   !!======================================================================
+   !!                       ***  MODULE  trctrp_lec  ***
+   !! TOP :   namelist read options for transport
+   !!======================================================================
+   !! History :   1.0  !  2004-03  (C. Ethe)  Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_trp_lec  : read the passive tracer namelist for transport
+   !!----------------------------------------------------------------------
+   USE oce_trc             ! ocean dynamics and active tracers variables
+   USE trc                 ! ocean passive tracers variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_trp_lec    ! routine called by step module
+ 
+   !                                                  !!: ** Advection (nam_traadv) **
+   LOGICAL , PUBLIC ::   ln_trcadv_cen2   = .FALSE.   !: 2nd order centered scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_tvd    = .FALSE.   !: TVD scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_muscl  = .FALSE.   !: MUSCL scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_muscl2 = .FALSE.   !: MUSCL2 scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_smolar = .TRUE.    !: Smolarkiewicz scheme flag
+
+   !                                                 !!: **  bottom boundary layer (nambbl) **
+   REAL(wp), PUBLIC ::   atrcbbl = 1.e+3              ! lateral coeff. for bottom boundary layer scheme (m2/s)
+
+   !                                                 !!: ** lateral mixing namelist (nam_trcldf) **
+   LOGICAL , PUBLIC ::   ln_trcldf_diff  = .FALSE.    !: flag of perform or not the lateral diff.
+   LOGICAL , PUBLIC ::   ln_trcldf_lap   = .TRUE.     !: laplacian operator
+   LOGICAL , PUBLIC ::   ln_trcldf_bilap = .FALSE.    !: bilaplacian operator
+   LOGICAL , PUBLIC ::   ln_trcldf_level = .FALSE.    !: iso-level direction
+   LOGICAL , PUBLIC ::   ln_trcldf_hor   = .FALSE.    !: horizontal (geopotential) direction
+   LOGICAL , PUBLIC ::   ln_trcldf_iso   = .TRUE.     !: iso-neutral direction
+
+   !                                                 !!: flag of the lateral diff. scheme used
+   LOGICAL , PUBLIC ::   l_trcldf_lap                 !: iso-level laplacian operator
+   LOGICAL , PUBLIC ::   l_trcldf_bilap               !: iso-level bilaplacian operator
+   LOGICAL , PUBLIC ::   l_trcldf_bilapg              !: geopotential bilap. (s-coord)
+   LOGICAL , PUBLIC ::   l_trcldf_iso                 !: iso-neutral laplacian or horizontal lapacian (s-coord)
+   LOGICAL , PUBLIC ::   l_trczdf_iso                 !: idem for the vertical component
+   LOGICAL , PUBLIC ::   l_trczdf_iso_vo              !: idem with vectopt_memory
+   LOGICAL , PUBLIC ::   l_trcldf_iso_zps             !: iso-neutral laplacian (partial steps)
+
+   !                                                 !!: ** Vertical diffusion (nam_trczdf) **
+   LOGICAL , PUBLIC ::   ln_trczdf_exp = .FALSE.      !: explicit vertical diffusion scheme flag
+
+   !                                                 !!: ** vertical diffusion (namzdf) **
+   INTEGER , PUBLIC ::   n_trczdf_exp = 3             !: number of sub-time step (explicit time stepping)
+
+   LOGICAL , PUBLIC ::   l_trczdf_exp     = .FALSE.   !: explicit vertical diffusion
+   LOGICAL , PUBLIC ::   l_trczdf_imp     = .FALSE.   !: implicit vertical diffusion
+
+#if defined key_trcdmp
+   !                                                 !!: ** newtonian damping namelist (nam_trcdmp) **
+   INTEGER  , PUBLIC ::   ndmptr   =   -1             !: = 0/-1/'latitude' for damping over tracers
+   INTEGER  , PUBLIC ::   ndmpftr  =    2             !: = 1 create a damping.coeff NetCDF file 
+   INTEGER  , PUBLIC ::   nmldmptr =    0             !: = 0/1/2 flag for damping in the mixed layer
+
+   !                                                 !!: ** newtonian damping (namdmp) **
+   REAL(wp) , PUBLIC ::   sdmptr   =   50.            !: surface time scale for internal damping (days)
+   REAL(wp) , PUBLIC ::   bdmptr   =  360.            !: bottom time scale for internal damping (days)
+   REAL(wp) , PUBLIC ::   hdmptr   =  800.            !: depth of transition between sdmp and bdmp (meters)
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id: trctrp_lec.F90 772 2007-12-17 11:59:33Z gm $ 
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_trp_lec
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_trp_lec  ***
+      !!                
+      !! ** Purpose :   Read Namelist for tracer transport option
+      !!----------------------------------------------------------------------
+      NAMELIST/namtrcadv/ ln_trcadv_cen2 , ln_trcadv_tvd,   &
+         &                 ln_trcadv_muscl, ln_trcadv_muscl2, ln_trcadv_smolar
+#if  defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
+      NAMELIST/namtrcbbl/ atrcbbl
+#endif
+      NAMELIST/namtrcldf/  ln_trcldf_diff  , ln_trcldf_lap  , ln_trcldf_bilap, &
+         &                 ln_trcldf_level, ln_trcldf_hor, ln_trcldf_iso,   &
+         &                 ahtrc0, ahtrb0, aeivtr0, trcrat
+      NAMELIST/namtrczdf/ ln_trczdf_exp, n_trczdf_exp
+#if defined key_trcdmp
+      NAMELIST/namtrcdmp/ ndmptr, ndmpftr, nmldmptr, sdmptr, bdmptr, hdmptr
+#endif
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_trp_lec: read namelist for tracer transport'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
+
+      !                                ! tracer advection scheme
+      REWIND( numnat )                 !   ! Read Namelist namtrcadv
+      READ  ( numnat, namtrcadv )
+
+      IF(lwp) THEN                     !   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrcadv : chose a advection scheme for tracers'
+         WRITE(numout,*) '      2nd order advection scheme     ln_trcadv_cen2   = ', ln_trcadv_cen2
+         WRITE(numout,*) '      TVD advection scheme           ln_trcadv_tvd    = ', ln_trcadv_tvd
+         WRITE(numout,*) '      MUSCL  advection scheme        ln_trcadv_muscl  = ', ln_trcadv_muscl
+         WRITE(numout,*) '      MUSCL2 advection scheme        ln_trcadv_muscl2 = ', ln_trcadv_muscl2
+         WRITE(numout,*) '      SMOLARKIEWICZ advection scheme ln_trcadv_smolar = ', ln_trcadv_smolar
+      ENDIF
+
+#if  defined key_trcbbl_dif
+      !                                ! Bottom boundary layer 
+      REWIND( numnat )                 !   ! Read Namelist namtrcbbl
+      READ  ( numnat, namtrcbbl )
+
+      IF(lwp) THEN                     !   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrcbbl : set Diffusive Bottom Boundary Layer parameters'
+         WRITE(numout,*) '      bottom boundary layer coef.    atrcbbl = ', atrcbbl
+# if defined key_trcbbl_adv
+         WRITE(numout,*) '   * Advective Bottom Boundary Layer'
+# endif
+      ENDIF
+#endif
+
+      !                                ! Lateral physics on tracers   
+      REWIND( numnat )                 !   ! Read Namelist namtrcldf
+      READ  ( numnat, namtrcldf )
+
+      IF(lwp) THEN                     !   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrcldf : set lateral mixing parameters (type, direction, coefficients)'
+         WRITE(numout,*) '      perform lateral diffusion or not               ln_trcldf_diff  = ', ln_trcldf_diff
+         WRITE(numout,*) '      laplacian operator                             ln_trcldf_lap   = ', ln_trcldf_lap
+         WRITE(numout,*) '      bilaplacian operator                           ln_trcldf_bilap = ', ln_trcldf_bilap
+         WRITE(numout,*) '      iso-level                                      ln_trcldf_level = ', ln_trcldf_level
+         WRITE(numout,*) '      horizontal (geopotential)                      ln_trcldf_hor   = ', ln_trcldf_hor
+         WRITE(numout,*) '      iso-neutral                                    ln_trcldf_iso   = ', ln_trcldf_iso
+         WRITE(numout,*) '      lateral eddy diffusivity                              ahtrc0   = ', ahtrc0
+         WRITE(numout,*) '      background hor. diffusivity                            ahtrb0  = ', ahtrb0
+         WRITE(numout,*) '      eddy induced velocity coef.                           aeivtr0  = ', aeivtr0
+         WRITE(numout,*) '      ratio between passive and active tracer diffusion coef  trcrat = ', trcrat
+      ENDIF
+
+      !                                ! Vertical mixing
+      REWIND( numnat )                 !   ! Read namtrczdf namelist
+      READ  ( numnat, namtrczdf )
+
+      IF(lwp) THEN                     !   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrczdf : set vertical diffusion parameters'
+         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp
+         WRITE(numout,*) '      number of time step               n_trczdf_exp = ', n_trczdf_exp
+      ENDIF
+
+# if defined key_trcdmp
+      !                                ! passive tracres damping term
+      REWIND( numnat )                 !   ! Read Namelist namtdp
+      READ  ( numnat, namtrcdmp )
+      IF( lzoom )   nmldmptr = 0           ! restoring to climatology at closed north or south boundaries
+
+      IF(lwp) THEN                     !   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrcdmp : set damping parameter'
+         WRITE(numout,*) '      tracers damping option         ndmptr   = ', ndmptr
+         WRITE(numout,*) '      create a damping.coeff file    ndmpftr  = ', ndmpftr
+         WRITE(numout,*) '      mixed layer damping option     nmldmptr = ', nmldmptr, '(zoom: forced to 0)'
+         WRITE(numout,*) '      surface time scale (days)      sdmptr   = ', sdmptr
+         WRITE(numout,*) '      bottom time scale (days)       bdmptr   = ', bdmptr
+         WRITE(numout,*) '      depth of transition (meters)   hdmptr   = ', hdmptr
+      ENDIF
+#endif
+      !
+   END SUBROUTINE trc_trp_lec
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                         No TOP model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_trp_lec              ! Empty routine
+   END SUBROUTINE trc_trp_lec
+#endif
+
+  !!======================================================================
+END MODULE trctrp_lec
Index: trunk/NEMO/TOP_SRC/TRP/trczdf_exp.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trczdf_exp.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trczdf_exp.F90	(revision 941)
@@ -0,0 +1,187 @@
+MODULE trczdf_exp
+   !!==============================================================================
+   !!                    ***  MODULE  trczdf_exp  ***
+   !! Ocean passive tracers:  vertical component of the tracer mixing trend using
+   !!                        an explicit time-stepping (time spllitting scheme)
+   !!==============================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_zdf_exp  : update the tracer trend with the vertical diffusion
+   !!                  using an explicit time stepping
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc          ! ocean dynamics and active tracers variables
+   USE trc              ! ocean passive tracers variables
+   USE trctrp_lec       ! passive tracers transport
+   USE prtctl_trc          ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trc_zdf_exp          ! routine called by step.F90
+
+   !! * Module variable
+   REAL(wp), DIMENSION(jpk) ::   &
+      rdttrc                     ! vertical profile of 2 x tracer time-step
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_zdf_exp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_zdf_exp  ***
+      !!                   
+      !! ** Purpose :   Compute the trend due to the vertical tracer mixing 
+      !!      using an explicit time stepping and add it to the general trend 
+      !!      of the tracer equations.
+      !!
+      !! ** Method  :   The vertical diffusion of tracers  is given by:
+      !!         difft = dz( avt dz(trb) ) = 1/e3t dk+1( avt/e3w dk(trb) )
+      !!      It is evaluated with an Euler scheme, using a time splitting
+      !!      technique.
+      !!      Surface and bottom boundary conditions: no diffusive flux on
+      !!      both tracers (bottom, applied through the masked field avt).
+      !!      Add this trend to the general trend tra :
+      !!          tra = tra + dz( avt dz(t) ) if lk_zdfddm= T)
+      !!
+      !! ** Action : - Update tra with the before vertical diffusion trend
+      !!             - Save the trends  in trtrd ('key_trc_diatrd')
+      !!
+      !! History :
+      !!   6.0  !  90-10  (B. Blanke)  Original code
+      !!   7.0  !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)  correction on tracer trend loops
+      !!        !  96-01  (G. Madec)  statement function for e3
+      !!        !  97-05  (G. Madec)  vertical component of isopycnal
+      !!        !  97-07  (G. Madec)  geopotential diffusion in s-coord
+      !!        !  98-03  (L. Bopp MA Foujols) passive tracer generalisation
+      !!        !  00-05  (MA Foujols) add lbc for tracer trends
+      !!        !  00-06  (O Aumont)  correct isopycnal scheme suppress
+      !!        !                     avt multiple correction
+      !!        !  00-08  (G. Madec)  double diffusive mixing
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!   9.0  !  04-03  (C. Ethe )  adapted for passive tracers
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+      
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, jl, jn             ! dummy loop indices
+      REAL(wp) ::   &
+         zlavmr,                 &  ! ???
+         zave3r, ze3tr,          &  ! ???
+         ztra                  !
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zwx, zwy
+      CHARACTER (len=22) :: charout
+      !!---------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_zdf_exp : vertical tracer mixing'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
+         ! time step = 2 rdttra with Arakawa or TVD advection scheme
+         IF( neuler == 0 .AND. kt == nittrc000 ) THEN
+            rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)             ! restarting with Euler time stepping
+         ELSEIF( kt <= nittrc000 + ndttrc ) THEN
+            rdttrc(:) = 2. * rdttra(:) * FLOAT(ndttrc)         ! leapfrog
+         ENDIF
+      ELSE
+         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)      
+      ENDIF
+
+
+      zlavmr = 1. / FLOAT( n_trczdf_exp )
+
+      DO jn = 1, jptra
+
+         !                                                ! ===============
+         DO jj = 2, jpjm1                                 !  Vertical slab
+            !                                             ! ===============
+            ! 1. Initializations
+            ! ------------------
+
+            ! Surface & bottom boundary conditions: no flux
+            DO ji = 2, jpim1
+               zwy(ji, 1 ) = 0.e0
+               zwy(ji,jpk) = 0.e0
+            END DO
+
+            ! zwx and zwz arrays set to before tracer values
+            DO jk = 1, jpk
+               DO ji = 2, jpim1
+                  zwx(ji,jk) = trb(ji,jj,jk,jn)
+               END DO
+            END DO
+
+
+            ! 2. Time splitting loop
+            ! ----------------------
+
+            DO jl = 1, n_trczdf_exp
+
+               ! first vertical derivative
+               ! double diffusion: fstravs(ji,jj,jk) = avt(ji,jj,jk) /= avs (key_trc_zdfddm) 
+               !                   fstravs(ji,jj,jk) = avs(ji,jj,jk) = avt
+               DO jk = 2, jpk
+                  DO ji = 2, jpim1
+                     zave3r = 1.e0 / fse3w(ji,jj,jk) 
+                     zwy(ji,jk) = fstravs(ji,jj,jk) * ( zwx(ji,jk-1) - zwx(ji,jk) ) * zave3r
+                  END DO
+               END DO
+
+
+               ! trend estimation at kt+l*2*rdt/n_zdfexp
+               DO jk = 1, jpkm1
+                  DO ji = 2, jpim1
+                     ze3tr = zlavmr / fse3t(ji,jj,jk)
+                     ! 2nd vertical derivative
+                     ztra = ( zwy(ji,jk) - zwy(ji,jk+1) ) * ze3tr
+                     ! update the tracer trends
+                     tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+                     ! update tracer fields at kt+l*2*rdt/n_trczdf_exp
+                     zwx(ji,jk) = zwx(ji,jk) + rdttrc(jk) * ztra * tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('zdf - exp')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_zdf_exp
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      NO passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_zdf_exp (kt )              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_zdf_exp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_zdf_exp
+#endif
+   
+   !!==============================================================================
+END MODULE trczdf_exp
Index: trunk/NEMO/TOP_SRC/TRP/trczdf_imp.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trczdf_imp.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trczdf_imp.F90	(revision 941)
@@ -0,0 +1,277 @@
+MODULE trczdf_imp
+   !!==============================================================================
+   !!                    ***  MODULE  trczdf_imp  ***
+   !! Ocean passive tracers:  vertical component of the tracer mixing trend
+   !!==============================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_zdf_imp  : update the tracer trend with the vertical diffusion
+   !!                  using an implicit time-stepping.
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc             ! ocean dynamics and active tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE trctrp_lec          ! passive tracers transport
+   USE prtctl_trc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trc_zdf_imp          ! routine called by step.F90
+
+   !! * Module variable
+   REAL(wp), DIMENSION(jpk) ::   &
+      rdttrc                     ! vertical profile of 2 x tracer time-step
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_zdf_imp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_zdf_imp  ***
+      !!
+      !! ** Purpose :   Compute the trend due to the vertical tracer mixing 
+      !!      using an implicit time stepping and add it to the general trend
+      !!      of the tracer equations.
+      !!
+      !! ** Method  :   The vertical diffusion of tracers tra is given by:
+      !!          difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(tra) )
+      !!      It is thus evaluated using a backward time scheme
+      !!      Surface and bottom boundary conditions: no diffusive flux on
+      !!      both tracers (bottom, applied through the masked field avt).
+      !!      Add this trend to the general trend tra :
+      !!          tra = tra + dz( avt dz(t) )
+      !!         (tra = tra + dz( avs dz(t) ) if lk_zdfddmtrc=T)
+      !!
+      !! ** Action  : - Update tra with the before vertical diffusion trend
+      !!              - save the trends in trtrd ('key_trc_diatrd')
+      !!
+      !! History :
+      !!   6.0  !  90-10  (B. Blanke)  Original code
+      !!   7.0  !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)  correction on tracer trend loops
+      !!        !  96-01  (G. Madec)  statement function for e3
+      !!        !  97-05  (G. Madec)  vertical component of isopycnal
+      !!        !  97-07  (G. Madec)  geopotential diffusion in s-coord
+      !!        !  98-03  (L. Bopp MA Foujols) passive tracer generalisation
+      !!        !  00-05  (MA Foujols) add lbc for tracer trends
+      !!        !  00-06  (O Aumont)  correct isopycnal scheme suppress
+      !!        !                     avt multiple correction
+      !!        !  00-08  (G. Madec)  double diffusive mixing
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!   9.0  !  04-03  (C. Ethe )  adapted for passive tracers
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+      INTEGER ::   ikst, ikenm2, ikstp1
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, jn             ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zwd, zws, zwi,          &  ! ???
+         zwx, zwy, zwt              ! ???
+      REAL(wp) ::  ztra      ! temporary scalars
+
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   &
+         ztrd
+      CHARACTER (len=22) :: charout
+      !!---------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_zdf_implicit : vertical tracer mixing'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
+         ! time step = 2 rdttra with Arakawa or TVD advection scheme
+         IF( neuler == 0 .AND. kt == nittrc000 ) THEN
+            rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)             ! restarting with Euler time stepping
+         ELSEIF( kt <= nittrc000 + ndttrc ) THEN
+            rdttrc(:) = 2. * rdttra(:) * FLOAT(ndttrc)         ! leapfrog
+         ENDIF
+      ELSE
+         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)      
+      ENDIF
+
+      DO jn = 1 , jptra
+
+	 ! Initialisation     
+	 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(  :,:,1) = 0.e0     ;     zwt(  :,:,jpk) = 0.e0
+         !                                          
+         ! 0. Matrix construction
+         ! ----------------------
+
+         ! 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.
+                  zwi(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk  ) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) )
+                  zws(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk+1) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )
+                  zwd(ji,jj,jk) = 1. - 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
+               zwi(ji,jj,1) = 0.e0
+               zwd(ji,jj,1) = 1. - zws(ji,jj,1)
+            END DO
+         END DO
+         
+         ! Second member construction
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1     
+               DO ji = fs_2, fs_jpim1
+                  zwy(ji,jj,jk) = trb(ji,jj,jk,jn) + rdttrc(jk) * tra(ji,jj,jk,jn)
+               END DO
+            END DO
+         END DO
+         
+         
+         ! 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!
+         !
+         !   N.B. the starting vertical index (ikst) is equal to 1 except for
+         !   the resolution of tke matrix where surface tke value is prescribed
+         !   so that ikstrt=2.
+        ikst = 1
+        ikstp1 = ikst + 1
+        ikenm2 = jpk - 2
+        
+        DO jj = 2, jpjm1
+           DO ji = fs_2, fs_jpim1
+              zwt(ji,jj,ikst) = zwd(ji,jj,ikst)
+           END DO
+        END DO
+        
+        DO jk = ikstp1, 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
+        
+        DO jk = ikstp1, jpkm1
+           DO jj = 2, jpjm1
+              DO ji = fs_2, fs_jpim1
+                 zwy(ji,jj,jk) = zwy(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * zwy(ji,jj,jk-1)
+              END DO
+           END DO
+        END DO
+        
+        DO jj = 2, jpjm1
+           DO ji = fs_2, fs_jpim1
+              zwx(ji,jj,jpkm1) = zwy(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+           END DO
+        END DO
+        
+        DO jk = ikenm2, ikst, -1
+           DO jj = 2, jpjm1
+              DO ji = fs_2, fs_jpim1
+                 zwx(ji,jj,jk) = ( zwy(ji,jj,jk) - zws(ji,jj,jk) * zwx(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+              END DO
+           END DO
+        END DO
+
+         
+#if defined key_trc_diatrd
+         ! Compute and save the vertical diffusive of tracers trends
+#  if defined key_trcldf_iso
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ztra = ( zwx(ji,jj,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - tra(ji,jj,jk,jn) + trtrd(ji,jj,jk,ikeep(jn),6)
+               END DO
+            END DO
+         END DO
+#  else
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ztra = ( zwx(ji,jj,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - tra(ji,jj,jk,jn)
+               END DO
+            END DO
+         END DO
+#  endif
+#endif  
+         ! Save the masked passive tracer after in tra
+         ! (c a u t i o n:  tracer not its trend, Leap-frog scheme done
+         !                  it will not be done in tranxt)
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  tra(ji,jj,jk,jn) = zwx(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+         IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+            ztrd(:,:,:,:) = 0.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztrd(ji,jj,jk,jn) = ( zwx(ji,jj,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('zdf - imp')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=ztrd, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_zdf_imp
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      NO passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_zdf_imp (kt )              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_zdf_imp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_zdf_imp
+#endif
+   
+!!==============================================================================
+END MODULE trczdf_imp
Index: trunk/NEMO/TOP_SRC/TRP/trczdf_iso.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trczdf_iso.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trczdf_iso.F90	(revision 941)
@@ -0,0 +1,462 @@
+MODULE trczdf_iso
+   !!==============================================================================
+   !!                    ***  MODULE  trczdf_iso  ***
+   !! Ocean passive tracers:  vertical component of the tracer mixing trend
+   !!==============================================================================
+#if defined key_top  &&  ( defined key_ldfslp   ||   defined key_esopa )
+   !!----------------------------------------------------------------------
+   !!   'key_top'       and                                      TOP models
+   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   trc_zdf_iso  : update the tracer trend with the vertical part of 
+   !!                  the isopycnal or geopotential s-coord. operator and
+   !!                  the vertical diffusion
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc          ! ocean dynamics and tracers variables
+   USE trc              ! ocean passive tracers variables 
+   USE lbclnk           ! ocean lateral boundary conditions (or mpp link)
+   USE trctrp_lec       ! passive tracers transport
+   USE prtctl_trc          ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC trc_zdf_iso    ! routine called by step.F90
+
+   !! * Module variable
+   REAL(wp), DIMENSION(jpk) ::   &
+      rdttrc                     ! vertical profile of 2 x tracer time-step
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trczdf_iso.F90,v 1.13 2007/10/12 09:26:30 opalod Exp $ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_zdf_iso( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_zdf_iso  ***
+      !!
+      !! ** Purpose :
+      !!     Compute the trend due to the vertical tracer diffusion inclu-
+      !!     ding the vertical component of lateral mixing (only for second
+      !!     order operator, for fourth order it is already computed and
+      !!     add to the general trend in trcldf.F) and add it to the general
+      !!     trend of the tracer equations.
+      !!
+      !! ** Method :
+      !!         The vertical component of the lateral diffusive trends is
+      !!      provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      First part: vertical trends associated with the lateral mixing
+      !!      ==========  (excluding the vertical flux proportional to dk[t] )
+      !!      vertical fluxes associated with the rotated lateral mixing:
+      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(trb)) ]
+      !!                     + e1t*wslpj dj[ mj(mk(trb)) ]  }
+      !!      save avt coef. resulting from vertical physics alone in zavt:
+      !!         zavt = avt
+      !!      update and save in zavt the vertical eddy viscosity coefficient:
+      !!         avt = avt + wslpi^2+wslj^2
+      !!      add vertical Eddy Induced advective fluxes ('lk_trcldf_eiv=T):
+      !!         zftw = zftw + { di[aht e2u mi(wslpi)]
+      !!                    +dj[aht e1v mj(wslpj)] } mk(trb)
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ] 
+      !!      Add this trend to the general trend tra :
+      !!         tra = tra + difft
+      !!
+      !!      Second part: vertical trend associated with the vertical physics
+      !!      ===========  (including the vertical flux proportional to dk[t]
+      !!                  associated with the lateral mixing, through the
+      !!                  update of avt)
+      !!      The vertical diffusion of tracers tra  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.
+      !!      Surface and bottom boundary conditions: no diffusive flux on
+      !!      both tracers (bottom, applied through the masked field avt).
+      !!      Add this trend to the general trend tra  :
+      !!         tra = tra + dz( avt dz(t) )
+      !!         (tra = tra + dz( avs dz(t) ) if lk_trc_zdfddm=T )
+      !!
+      !!      Third part: recover avt resulting from the vertical physics
+      !!      ==========  alone, for further diagnostics (for example to
+      !!                  compute the turbocline depth in diamld).
+      !!         avt = zavt
+      !!         (avs = zavs if lk_trc_zdfddm=T )
+      !!
+      !!      'key_trc_diatrd' defined: trend saved for futher diagnostics.
+      !!
+      !!      macro-tasked on vertical slab (jj-loop)
+      !!
+      !! ** Action :
+      !!         Update tra arrays with the before vertical diffusion trend
+      !!         Save in trtrd arrays the trends if 'key_trc_diatrd' defined
+      !!
+      !! History :
+      !!   7.0  !  91-11  (G. Madec)  Original code
+      !!        !  92-06  (M. Imbard)  correction on tracer trend loops
+      !!        !  96-01  (G. Madec)  statement function for e3
+      !!        !  97-05  (G. Madec)  vertical component of isopycnal
+      !!        !  97-07  (G. Madec)  geopotential diffusion in s-coord
+      !!        !  98-03  (L. Bopp MA Foujols) passive tracer generalisation
+      !!        !  00-05  (MA Foujols) add lbc for tracer trends
+      !!        !  00-06  (O Aumont)  correct isopycnal scheme suppress
+      !!        !                     avt multiple correction
+      !!        !  00-08  (G. Madec)  double diffusive mixing
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!   9.0  !  04-03  (C. Ethe )  adapted for passive tracers
+      !!---------------------------------------------------------------------
+      !! * Modules used
+      USE oce_trc               ,   &
+         zavs => va
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, jn                 ! dummy loop indices
+      INTEGER ::   ikst, ikenm2, ikstp1       ! temporary integers
+      INTEGER ::   iku, ikv, ikv1             ! temporary integers
+
+      REAL(wp) ::   ztra
+      REAL(wp) ::   &
+         ztavg,                 &  ! ???
+         zcoef0, zcoef3,        &  ! ???
+         zcoef4, zavi,          &  ! ???
+         zbtr, zmku, zmkv,      &  !
+         ztav
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zwd, zws, zwi,         &  ! ???
+         zwx, zwy, zwz, zwt        ! ???
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         ztfw, zdit, zdjt, zdj1t
+#if defined key_trcldf_eiv   ||   defined key_esopa
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         ztfwg
+
+      REAL(wp) ::         &
+         zcoeg3,          &
+         zuwk, zvwk,      &
+         zuwki, zvwki
+#endif
+      CHARACTER (len=22) :: charout
+      !!---------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_zdf_iso : vertical mixing (including isopycnal component)'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+#if defined key_trcldf_eiv && defined key_diaeiv
+         w_trc_eiv(:,:,:) = 0.e0
+#endif
+      ENDIF
+
+      ! 0.0  Local constant initialization
+      ! --------------------------------
+      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
+         ! time step = 2 rdttra with Arakawa or TVD advection scheme
+         IF( neuler == 0 .AND. kt == nittrc000 ) THEN
+            rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)             ! restarting with Euler time stepping
+         ELSEIF( kt <= nittrc000 + ndttrc ) THEN
+            rdttrc(:) = 2. * rdttra(:) * FLOAT(ndttrc)         ! leapfrog
+         ENDIF
+      ELSE
+         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)      
+      ENDIF
+
+
+
+      ! 0.1 Save avs in zavs to recover avs in output files
+      !---------------------------------------------------
+      zavs(:,:,:) = fstravs(:,:,:)
+
+
+
+      DO jn = 1, jptra
+
+         ztavg = 0.e0
+
+         !                                                ! ===============
+         DO jj = 2, jpjm1                                 !  Vertical slab
+            !                                             ! ===============
+
+            ! I. vertical trends associated with the lateral mixing
+            ! =====================================================
+            !  (excluding the vertical flux proportional to dk[t]
+
+
+            ! I.1 horizontal tracer gradient
+            ! ------------------------------
+
+            DO jk = 1, jpkm1
+               DO ji = 1, jpim1
+                  ! i-gradient of passive tracer at jj
+                  zdit (ji,jk) = ( trb(ji+1,jj,jk,jn)-trb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                  ! j-gradient of passive tracer at jj
+                  zdjt (ji,jk) = ( trb(ji,jj+1,jk,jn)-trb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+                  ! j-gradient of passive tracer at jj+1
+                  zdj1t(ji,jk) = ( trb(ji,jj,jk,jn)-trb(ji,jj-1,jk,jn) ) * vmask(ji,jj-1,jk)
+               END DO
+            END DO
+
+            IF( ln_zps ) THEN
+               ! partial steps correction at the bottom ocean level 
+               DO ji = 1, jpim1
+                  ! last ocean level
+                  iku  = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
+                  ikv  = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
+                  ikv1 = MIN( mbathy(ji,jj), mbathy(ji  ,jj-1) ) - 1
+                  ! i-gradient of of passive tracer at jj
+                  zdit (ji,iku) = gtru(ji,jj,jn)
+                  ! j-gradient of of passive tracer at jj
+                  zdjt (ji,ikv) = gtrv(ji,jj,jn) 
+                  ! j-gradient of of passive tracer at jj+1
+                  zdj1t(ji,ikv1)= gtrv(ji,jj-1,jn)
+               END DO
+            ENDIF
+
+            ! I.2 Vertical fluxes
+            ! -------------------
+
+            ! Surface and bottom vertical fluxes set to zero
+            ztfw(:, 1 ) = 0.e0
+            ztfw(:,jpk) = 0.e0
+
+#if defined key_trcldf_eiv
+            ztfwg(:, 1 ) = 0.e0
+            ztfwg(:,jpk) = 0.e0
+#endif
+
+            ! interior (2=<jk=<jpk-1)
+            DO jk = 2, jpkm1
+               DO ji = 2, jpim1
+                  zcoef0 = - fsahtw(ji,jj,jk) * tmask(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. )
+
+                  zcoef3 = zcoef0 * e2t(ji,jj) * zmku * wslpi (ji,jj,jk)
+                  zcoef4 = zcoef0 * e1t(ji,jj) * zmkv * wslpj (ji,jj,jk)
+
+                  ztfw(ji,jk) = zcoef3 * ( zdit (ji  ,jk-1) + zdit (ji-1,jk)     &
+                     &                    +zdit (ji-1,jk-1) + zdit (ji  ,jk) )   &
+                     &        + zcoef4 * ( zdjt (ji  ,jk-1) + zdj1t(ji  ,jk)     &
+                     &                    +zdj1t(ji  ,jk-1) + zdjt (ji  ,jk) )
+
+               END DO
+            END DO
+
+
+            ! I.3  update and save of avt (and avs if double diffusive mixing)
+            ! ---------------------------
+
+            DO jk = 2, jpkm1
+               DO ji = 2, jpim1
+
+                  zavi = fsahtw(ji,jj,jk)*( wslpi(ji,jj,jk)*wslpi(ji,jj,jk)   &
+                     &                     +wslpj(ji,jj,jk)*wslpj(ji,jj,jk) )
+
+                  ! add isopycnal vertical coeff. to avs
+                  fstravs(ji,jj,jk) = fstravs(ji,jj,jk) + zavi
+
+               END DO
+            END DO
+
+#if defined key_trcldf_eiv
+            !                              ! ---------------------------------------!
+            !                              ! Eddy induced vertical advective fluxes !
+            !                              ! ---------------------------------------!
+#if defined key_traldf_c2d || defined key_traldf_c3d || defined key_off_degrad
+            DO jk = 2, jpkm1
+               DO ji = 2, jpim1
+                  zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) )   &
+                     &  * fsaeitru(ji-1,jj,jk) * e2u(ji-1,jj)*umask(ji-1,jj,jk)
+                  zuwk  = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) )   &
+                     &  * fsaeitru(ji  ,jj,jk) * e2u(ji  ,jj)*umask(ji  ,jj,jk)
+                  zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) )   &
+                     &  * fsaeitrv(ji,jj-1,jk) * e1v(ji,jj-1)*vmask(ji,jj-1,jk)
+                  zvwk  = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) )   &
+                     &  * fsaeitrv(ji,jj  ,jk) * e1v(ji  ,jj)*vmask(ji  ,jj,jk)
+
+                  zcoeg3 = + 0.25 * tmask(ji,jj,jk) * ( zuwk - zuwki + zvwk - zvwki )
+
+                  ztfwg(ji,jk) = + zcoeg3 * ( trb(ji,jj,jk,jn) + trb(ji,jj,jk-1,jn) ) 
+                  ztfw(ji,jk) = ztfw(ji,jk) + ztfwg(ji,jk)
+
+# if defined key_diaeiv
+                  w_trc_eiv(ji,jj,jk) = -2. *  zcoeg3 / ( e1t(ji,jj)*e2t(ji,jj) )
+# endif
+               END DO
+            END DO
+
+#else
+            DO jk = 2, jpkm1
+               DO ji = 2, jpim1
+                  zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) )   &
+                     &  * e2u(ji-1,jj)*umask(ji-1,jj,jk)
+                  zuwk  = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) )   &
+                     &  * e2u(ji  ,jj)*umask(ji  ,jj,jk)
+                  zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) )   &
+                     &  * e1v(ji,jj-1)*vmask(ji,jj-1,jk)
+                  zvwk  = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) )   &
+                     &  * e1v(ji  ,jj)*vmask(ji  ,jj,jk)
+
+                  zcoeg3 = + 0.25 * tmask(ji,jj,jk) * fsaeitrw(ji,jj,jk)   &
+                     &            * ( zuwk - zuwki + zvwk - zvwki )
+
+                  ztfwg(ji,jk) = + zcoeg3 * ( trb(ji,jj,jk,jn) + trb(ji,jj,jk-1,jn) )
+                  ztfw(ji,jk) = ztfw(ji,jk) + ztfwg(ji,jk)
+
+# if defined key_diaeiv
+                  w_trc_eiv(ji,jj,jk) = -2. *  zcoeg3 / ( e1t(ji,jj)*e2t(ji,jj) )
+# endif
+               END DO
+            END DO
+#endif
+
+#endif
+
+
+            ! I.5 Divergence of vertical fluxes added to the general tracer trend
+            ! -------------------------------------------------------------------
+
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+                  ztav = (  ztfw(ji,jk) - ztfw(ji,jk+1)  ) * zbtr
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztav
+
+#if defined key_trc_diatrd
+#   if defined key_trcldf_eiv
+                  ztavg = ( ztfwg(ji,jk) - ztfwg(ji,jk+1) ) * zbtr
+                  !  WARNING trtrd(ji,jj,jk,6) used for vertical gent velocity trend
+                  !                           not for damping !!!
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),9) = ztavg
+#   endif
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztav - ztavg
+#endif
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('zdf - 1')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+      DO jn = 1, jptra
+         !                                                ! ===============
+         DO jj = 2, jpjm1                                 !  Vertical slab
+            !                                             ! ===============
+
+            ! II. Vertical trend associated with the vertical physics
+            ! =======================================================
+            !     (including the vertical flux proportional to dk[t] associated
+            !      with the lateral mixing, through the avt update)
+            !     dk[ avt dk[ (t,s) ] ] diffusive trends
+
+
+            ! Diagonal, inferior, superior
+            ! (including the bottom boundary condition via avs masked)
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  zwi(ji,jk) = - rdttrc(jk) * fstravs(ji,jj,jk  )   &
+                     /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) )
+                  zws(ji,jk) = - rdttrc(jk) * fstravs(ji,jj,jk+1)   &
+                     /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )
+                  zwd(ji,jk) = 1. - zwi(ji,jk) - zws(ji,jk)
+               END DO
+            END DO
+
+            ! Surface boudary conditions
+            DO ji = 2, jpim1
+               zwi(ji,1) = 0.e0
+               zwd(ji,1) = 1. - zws(ji,1)
+            END DO
+
+            ! Second member construction
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  zwy(ji,jk) = trb(ji,jj,jk,jn) + rdttrc(jk) * tra(ji,jj,jk,jn)
+               END DO
+            END DO
+
+            ! Matrix inversion from the first level
+            ikst = 1
+#   include "zdf.matrixsolver.h90"
+#if defined key_trc_diatrd
+            ! Compute and save the vertical diffusive of tracers trends
+#  if defined key_trcldf_iso
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  ztra = ( zwx(ji,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - tra(ji,jj,jk,jn) + trtrd(ji,jj,jk,ikeep(jn),6)
+               END DO
+            END DO
+#  else
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  ztra = ( zwx(ji,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - tra(ji,jj,jk,jn)
+               END DO
+            END DO
+#  endif
+#endif
+            ! Save the masked passive tracer after in tra
+            ! (c a u t i o n:  tracer not its trend, Leap-frog scheme done
+            !                  it will not be done in tranxt)
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  tra(ji,jj,jk,jn) = zwx(ji,jk)  * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+      END DO
+
+
+
+      ! III. recover the avt (avs) resulting from vertical physics only
+      !---------------------------------------------------------------
+      fstravs(:,:,:) = zavs(:,:,:)
+
+      
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('zdf - 2')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_zdf_iso
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module               NO rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_zdf_iso( kt )              ! empty routine
+      WRITE(*,*) 'trc_zdf_iso: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_zdf_iso
+#endif
+
+   !!==============================================================================
+END MODULE trczdf_iso
Index: trunk/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90	(revision 941)
@@ -0,0 +1,574 @@
+MODULE trczdf_iso_vopt
+   !!==============================================================================
+   !!                 ***  MODULE  trczdf_iso_vopt  ***
+   !! Ocean passive tracers:  vertical component of the tracer mixing trend
+   !!==============================================================================
+#if defined key_top  &&  ( defined key_ldfslp   ||   defined key_esopa )
+   !!----------------------------------------------------------------------
+   !!   'key_top'      and                                       TOP models
+   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   trc_zdf_iso_vopt : Update the tracer trend with the vertical part of 
+   !!                  the isopycnal or geopotential s-coord. operator and
+   !!                  the vertical diffusion. vector optimization, use
+   !!                  k-j-i loops.
+   !!   trc_zdf_iso  :
+   !!   trc_zdf_zdf  :
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc         ! ocean dynamics and tracers variables
+   USE trc             ! ocean passive tracers variables 
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE trctrp_lec      ! passive tracers transport
+   USE prtctl_trc          ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trc_zdf_iso_vopt   !  routine called by step.F90
+
+   !! * Module variables
+   REAL(wp), DIMENSION(jpk) ::  &
+      rdttrc                          ! vertical profile of 2 x time-step
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90,v 1.12 2007/10/12 09:26:30 opalod Exp $ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE trc_zdf_iso_vopt( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_zdf_iso_vopt  ***
+      !!
+      !! ** Purpose :
+      !! ** Method  :
+      !! ** Action  :
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!   9.0  !  04-03  (C. Ethe)   adapted for passive tracers
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      CHARACTER (len=22) :: charout
+      !!---------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'trc_zdf_iso_vopt : vertical mixing computation'
+         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~~~~~   is  iso-neutral diffusion : implicit vertical time stepping'
+#if defined key_trcldf_eiv && defined key_diaeiv 
+         w_trc_eiv(:,:,:) = 0.e0
+#endif
+      ENDIF
+
+
+      ! I. vertical extra-diagonal part of the rotated tensor
+      ! -----------------------------------------------------
+
+      CALL trc_zdf_iso
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('zdf - 1')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+      ! II. vertical diffusion (including the vertical diagonal part of the rotated tensor)
+      ! ----------------------
+
+      CALL trc_zdf_zdf( kt )
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('zdf - 2')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      ENDIF
+
+   END SUBROUTINE trc_zdf_iso_vopt
+
+
+   SUBROUTINE trc_zdf_zdf( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE trc_zdf_zdf  ***
+      !!                    
+      !! ** Purpose :   Compute the trend due to the vertical tracer diffusion
+      !!     including the vertical component of lateral mixing (only for 2nd
+      !!     order operator, for fourth order it is already computed and add
+      !!     to the general trend in traldf.F) and add it to the general trend
+      !!     of the tracer equations.
+      !!
+      !! ** Method  :   The vertical component of the lateral diffusive trends
+      !!      is provided by a 2nd order operator rotated along neural or geo-
+      !!      potential surfaces to which an eddy induced advection can be 
+      !!      added. It is computed using before fields (forward in time) and 
+      !!      isopycnal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      Second part: vertical trend associated with the vertical physics
+      !!      ===========  (including the vertical flux proportional to dk[t]
+      !!                  associated with the lateral mixing, through the
+      !!                  update of avt)
+      !!      The vertical diffusion of tracers  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=tra).
+      !!      Surface and bottom boundary conditions: no diffusive flux on
+      !!      both tracers (bottom, applied through the masked field avt).
+      !!      Add this trend to the general trend tra :
+      !!         tra = tra + dz( avt dz(t) )
+      !!         (tra = tra + dz( avs dz(t) ) if lk_trc_zdfddm=T )
+      !!
+      !!      Third part: recover avt resulting from the vertical physics
+      !!      ==========  alone, for further diagnostics (for example to
+      !!                  compute the turbocline depth in diamld).
+      !!         avt = zavt
+      !!         (avs = zavs if lk_trc_zdfddm=T )
+      !!
+      !!      'key_trdtra' defined: trend saved for futher diagnostics.
+      !!
+      !!      macro-tasked on vertical slab (jj-loop)
+      !!
+      !! ** Action  : - Update tra with before vertical diffusion trend
+      !!              - Save the trend in trtrd  ('key_trc_diatrd')
+      !!
+      !! History :
+      !!   6.0  !  90-10  (B. Blanke)  Original code
+      !!   7.0  !  91-11 (G. Madec)
+      !!        !  92-06 (M. Imbard) correction on tracer trend loops
+      !!        !  96-01 (G. Madec) statement function for e3
+      !!        !  97-05 (G. Madec) vertical component of isopycnal
+      !!        !  97-07 (G. Madec) geopotential diffusion in s-coord
+      !!        !  98-03  (L. Bopp MA Foujols) passive tracer generalisation
+      !!        !  00-05  (MA Foujols) add lbc for tracer trends
+      !!        !  00-06  (O Aumont)  correct isopycnal scheme suppress
+      !!        !                     avt multiple correction
+      !!        !  00-08  (G. Madec)  double diffusive mixing
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!   9.0  !  04-03  (C. Ethe )  adapted for passive tracers
+      !!---------------------------------------------------------------------
+      !! * Modules used
+      USE oce_trc, ONLY :   zwd   => ua,  &  ! ua, va used as
+                            zws   => va      ! workspace
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk,jn                ! dummy loop indices
+      REAL(wp) ::   &
+         zavi, zrhs                          ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zwi, zwt, zavsi                     ! temporary workspace arrays
+      REAL(wp) ::    ztra              !temporary scalars
+#  if defined key_trc_diatrd
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrd
+#  endif
+      !!---------------------------------------------------------------------
+
+
+      ! I. Local constant initialization
+      ! --------------------------------
+      ! ... time step = 2 rdttra ex
+      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
+         ! time step = 2 rdttra with Arakawa or TVD advection scheme
+         IF( neuler == 0 .AND. kt == nittrc000 ) THEN
+            rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)             ! restarting with Euler time stepping
+         ELSEIF( kt <= nittrc000 + ndttrc ) THEN
+            rdttrc(:) = 2. * rdttra(:) * FLOAT(ndttrc)         ! leapfrog
+         ENDIF
+      ELSE
+         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)      
+      ENDIF
+
+      DO jn = 1, jptra
+         
+         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(  :,:,1)=0.e0     ;     zwt(:,:,jpk)= 0.e0
+         zavsi( 1 ,:,:)=0.e0   ;     zavsi(jpi,:,:)=0.e0 
+         zavsi(  :,:,1)=0.e0   ;     zavsi(:,:,jpk)=0.e0
+
+#  if defined key_trc_diatrd
+         ! save the tra trend
+         ztrd(:,:,:) = tra(:,:,:,jn)
+#  endif
+
+         ! II. Vertical trend associated with the vertical physics
+         ! =======================================================
+         !     (including the vertical flux proportional to dk[t] associated
+         !      with the lateral mixing, through the avt update)
+         !     dk[ avt dk[ (t,s) ] ] diffusive trends
+
+
+         ! II.0 Matrix construction
+         ! ------------------------        
+         ! update and save of avt (and avs if double diffusive mixing)
+         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)  )
+                  zavsi(ji,jj,jk) = fstravs(ji,jj,jk) + zavi        ! dd mixing: zavsi = total vertical mixing coef. on tracer
+
+               END DO
+            END DO
+         END DO
+
+
+         ! II.2 Vertical diffusion on tracer
+         ! ---------------------------========
+
+         ! 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.
+                  zwi(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk  ) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) )
+                  zws(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk+1) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )
+                  zwd(ji,jj,jk) = 1. - 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.
+               zwi(ji,jj,1) = 0.e0
+               zwd(ji,jj,1) = 1. - zws(ji,jj,1)
+            END DO
+         END DO
+
+         !! 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
+               tra(ji,jj,1,jn) = trb(ji,jj,1,jn) + rdttrc(1) * tra(ji,jj,1,jn)
+            END DO
+         END DO
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zrhs = trb(ji,jj,jk,jn) + rdttrc(jk) * tra(ji,jj,jk,jn)   ! zrhs=right hand side
+                  tra(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * tra(ji,jj,jk-1,jn)
+               END DO
+            END DO
+         END DO
+
+         ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
+         ! Save the masked passive tracer after in tra
+         ! (c a u t i o n: passive tracer not its trend, Leap-frog scheme done it will not be done in tranxt)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               tra(ji,jj,jpkm1,jn) = tra(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
+                  tra(ji,jj,jk,jn) = ( tra(ji,jj,jk,jn) - zws(ji,jj,jk) * tra(ji,jj,jk+1,jn) ) / zwt(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+#if defined key_trc_diatrd
+         ! Compute and save the vertical diffusive passive tracer trends
+#  if defined key_trcldf_iso 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ztra = ( tra(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - ztrd(ji,jj,jk) + trtrd(ji,jj,jk,ikeep(jn),6)
+               END DO
+            END DO
+         END DO
+#  else
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ztra = ( tra(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - ztrd(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#  endif
+#endif
+
+      END DO
+
+   END SUBROUTINE trc_zdf_zdf
+
+
+   SUBROUTINE trc_zdf_iso
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_zdf_iso  ***
+      !!
+      !! ** Purpose :
+      !!     Compute the trend due to the vertical tracer diffusion inclu-
+      !!     ding the vertical component of lateral mixing (only for second
+      !!     order operator, for fourth order it is already computed and
+      !!     add to the general trend in traldf.F) and add it to the general
+      !!     trend of the tracer equations.
+      !!
+      !! ** Method :
+      !!         The vertical component of the lateral diffusive trends is
+      !!      provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      First part: vertical trends associated with the lateral mixing
+      !!      ==========  (excluding the vertical flux proportional to dk[t] )
+      !!      vertical fluxes associated with the rotated lateral mixing:
+      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(trb)) ]
+      !!                     + e1t*wslpj dj[ mj(mk(trb)) ]  }
+      !!      save avt coef. resulting from vertical physics alone in zavt:
+      !!         zavt = avt
+      !!      update and save in zavt the vertical eddy viscosity coefficient:
+      !!         avt = avt + wslpi^2+wslj^2
+      !!      add vertical Eddy Induced advective fluxes (lk_traldf_eiv=T):
+      !!         zftw = zftw + { di[aht e2u mi(wslpi)]
+      !!                    +dj[aht e1v mj(wslpj)] } mk(trb)
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ] 
+      !!      Add this trend to the general trend tra :
+      !!         tra = tra + difft
+      !!
+      !! ** Action :
+      !!         Update tra arrays with the before vertical diffusion trend
+      !!         Save in trtrd arrays the trends if 'key_trc_diatrd' defined
+      !!
+      !! History :
+      !!   6.0  !  90-10  (B. Blanke)  Original code
+      !!   7.0  !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard) correction on tracer trend loops
+      !!        !  96-01  (G. Madec) statement function for e3
+      !!        !  97-05  (G. Madec) vertical component of isopycnal
+      !!        !  97-07  (G. Madec) geopotential diffusion in s-coord
+      !!        !  98-03  (L. Bopp MA Foujols) passive tracer generalisation
+      !!        !  00-05  (MA Foujols) add lbc for tracer trends
+      !!        !  00-06  (O Aumont)  correct isopycnal scheme suppress
+      !!        !                     avt multiple correction
+      !!        !  00-08  (G. Madec)  double diffusive mixing
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!   9.0  !  04-03  (C. Ethe )  adapted for passive tracers
+      !!---------------------------------------------------------------------
+      !! * Modules used
+      USE oce_trc, ONLY :   zwx => ua,  &  ! use ua, va as
+                            zwy => va      ! workspace arrays
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk,jn       ! dummy loop indices
+      INTEGER ::   iku, ikv
+      REAL(wp) ::   &
+         ztavg,                  &  ! temporary scalars
+         zcoef0, zcoef3,         &  !    "         "
+         zcoef4,                 &  !    "         "
+         zbtr, zmku, zmkv,       &  !    "         "
+#if defined key_trcldf_eiv
+         zcoeg3,                 &  !    "         "
+         zuwki, zvwki,           &  !    "         "
+         zuwk, zvwk,             &  !    "         "
+#endif
+         ztav
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zwz, zwt, ztfw             ! temporary workspace arrays
+      !!---------------------------------------------------------------------
+
+      DO jn = 1, jptra
+
+         ! 0. Local constant initialization
+         ! --------------------------------
+         ztavg = 0.e0
+
+         zwx( 1 ,:,:)=0.e0     ;     zwx(jpi,:,:)=0.e0
+         zwy( 1 ,:,:)=0.e0     ;     zwy(jpi,:,:)=0.e0
+         zwz( 1 ,:,:)=0.e0     ;     zwz(jpi,:,:)=0.e0
+         zwt( 1 ,:,:)=0.e0     ;     zwt(jpi,:,:)=0.e0
+         ztfw( 1 ,:,:)=0.e0    ;     ztfw(jpi,:,:)=0.e0
+
+         ! I. Vertical trends associated with lateral mixing
+         ! -------------------------------------------------
+         !    (excluding the vertical flux proportional to dk[t] )
+
+
+         ! I.1 horizontal tracer gradient
+         ! ------------------------------
+
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! i-gradient of passive tracer at ji
+                  zwx (ji,jj,jk) = ( trb(ji+1,jj,jk,jn)-trb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                  ! j-gradient of passive tracer at jj
+                  zwy (ji,jj,jk) = ( trb(ji,jj+1,jk,jn)-trb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_zps ) THEN
+            ! partial steps correction at the bottom ocean level 
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! last ocean level
+                  iku  = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
+                  ikv  = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
+                  ! i-gradient of passive tracer
+                  zwx (ji,jj,iku) = gtru(ji,jj,jn)
+                  ! j-gradient of passive tracer
+                  zwy (ji,jj,ikv) = gtrv(ji,jj,jn)  
+               END DO
+            END DO
+         ENDIF
+
+
+         ! I.2 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)
+
+                  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.  )
+
+                  zcoef3 = zcoef0 * e2t(ji,jj) * zmku * wslpi (ji,jj,jk)
+                  zcoef4 = zcoef0 * e1t(ji,jj) * zmkv * wslpj (ji,jj,jk)
+
+                  ztfw(ji,jj,jk) = zcoef3 * (   zwx(ji  ,jj  ,jk-1) + zwx(ji-1,jj  ,jk)      &
+                     &                        + zwx(ji-1,jj  ,jk-1) + zwx(ji  ,jj  ,jk)  )   &
+                     &           + zcoef4 * (   zwy(ji  ,jj  ,jk-1) + zwy(ji  ,jj-1,jk)      &
+                     &                        + zwy(ji  ,jj-1,jk-1) + zwy(ji  ,jj  ,jk)  )
+               END DO
+            END DO
+         END DO
+
+#if defined key_trcldf_eiv
+         !                              ! ---------------------------------------!
+         !                              ! Eddy induced vertical advective fluxes !
+         !                              ! ---------------------------------------!
+         zwx(:,:, 1 ) = 0.e0
+         zwx(:,:,jpk) = 0.e0
+
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+#   if defined key_traldf_c2d || defined key_traldf_c3d  || defined key_off_degrad
+                  zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) )   &
+                     &  * fsaeitru(ji-1,jj,jk) * e2u(ji-1,jj) * umask(ji-1,jj,jk)
+                  zuwk  = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) )   &
+                     &  * fsaeitru(ji  ,jj,jk) * e2u(ji  ,jj) * umask(ji  ,jj,jk)
+                  zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) )   &
+                     &  * fsaeitrv(ji,jj-1,jk) * e1v(ji,jj-1) * vmask(ji,jj-1,jk)
+                  zvwk  = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) )   &
+                     &  * fsaeitrv(ji,jj  ,jk) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
+
+                  zcoeg3 = + 0.25 * tmask(ji,jj,jk) * ( zuwk - zuwki + zvwk - zvwki )
+#   else
+                  zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) )   &
+                     &  * e2u(ji-1,jj) * umask(ji-1,jj,jk)
+                  zuwk  = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) )   &
+                     &  * e2u(ji  ,jj) * umask(ji  ,jj,jk)
+                  zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) )   &
+                     &  * e1v(ji,jj-1) * vmask(ji,jj-1,jk)
+                  zvwk  = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) )   &
+                     &  * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
+
+                  zcoeg3 = + 0.25 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk)   &
+                     &            * ( zuwk - zuwki + zvwk - zvwki )
+#   endif
+                  zwx(ji,jj,jk) = + zcoeg3 * ( trb(ji,jj,jk,jn) + trb(ji,jj,jk-1,jn) )
+
+                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + zwx(ji,jj,jk)
+#   if defined key_diaeiv
+                  w_trc_eiv(ji,jj,jk) = -2. * zcoeg3 / ( e1t(ji,jj)*e2t(ji,jj) )
+#   endif
+               END DO
+            END DO
+         END DO
+#endif
+
+         ! 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) )
+                  ztav = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztav
+#if defined key_trc_diatrd
+#   if defined key_trcldf_eiv
+                  ztavg = ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * zbtr
+                  !  WARNING trtrd(ji,jj,jk,7) used for vertical gent velocity trend  not for damping !!!
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),9) = ztavg
+#   endif
+                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztav - ztavg
+#endif
+               END DO
+            END DO
+         END DO
+
+      END DO
+
+   END SUBROUTINE trc_zdf_iso
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :             NO rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_zdf_iso_vopt( kt )              ! empty routine
+      WRITE(*,*) 'trc_zdf_iso_vopt: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_zdf_iso_vopt
+#endif
+
+   !!==============================================================================
+END MODULE trczdf_iso_vopt
Index: trunk/NEMO/TOP_SRC/TRP/zpshde_trc.F90
===================================================================
--- trunk/NEMO/TOP_SRC/TRP/zpshde_trc.F90	(revision 941)
+++ trunk/NEMO/TOP_SRC/TRP/zpshde_trc.F90	(revision 941)
@@ -0,0 +1,201 @@
+MODULE zpshde_trc
+   !!==============================================================================
+   !!                       ***  MODULE zpshde_trc   ***
+   !! Ocean passive tracers: 
+   !!==============================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!                  z-coordinate with partial steps
+   !!----------------------------------------------------------------------
+   !!   zps_hde_trc  :  Horizontal DErivative of passive tracers at the last
+   !!                   ocean level (Z-coord. with Partial Steps)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce_trc         ! ocean dynamics and tracers variables
+   USE trc             ! ocean passive tracers variables
+   USE lbclnk          ! lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC zps_hde_trc          ! routine called by step.F90
+
+   !! * module variables
+   INTEGER, DIMENSION(jpi,jpj) ::   &
+      mbatu, mbatv      ! bottom ocean level index at U- and V-points
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE zps_hde_trc ( kt, 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  :   In z-coord with partial steps, scale factors on last 
+      !!      levels are different for each grid point, so that TRA points 
+      !!      are not at the same depth as in z-coord. To have horizontal
+      !!      gradients again, we interpolate TRA at the good depth : 
+      !!      Linear interpolation of TRA  
+      !!         Computation of di(trb) and dj(trb) by vertical interpolation:
+      !!          di(tra) = tra~ - tra(i,j,k) or tra(i+1,j,k) - tra~
+      !!          dj(tra) = tra~ - tra(i,j,k) or tra(i,j+1,k) - tra~
+      !!         This formulation computes the two cases:
+      !!                 CASE 1                   CASE 2  
+      !!         k-1  ___ ___________   k-1   ___ ___________
+      !!                  TRAi  TRA~             TRA~  TRAi+1
+      !!                  _____                        _____
+      !!         k        |   |TRAi+1   k         TRAi |   |
+      !!                  |   |____                ____|   |
+      !!              ___ |   |   |           ___  |   |   |
+      !!                  
+      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
+      !!      tra~ = tra(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(TRAi+1)/e3w(i+1)
+      !!    ( tra~ = tra(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(TRAj+1)/e3w(j+1))
+      !!          or
+      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
+      !!       tra~ = tra(i,j,k) + (e3w(i) - e3w(i+1)) * dk(TRAi)/e3w(i )
+      !!     ( tra~ = tra(i,j,k) + (e3w(j) - e3w(j+1)) * dk(TRAj)/e3w(j ) )
+      !!      
+      !!
+      !! ** Action  : - pgtru : horizontal gradient of TRA at U-points 
+      !!              - pgtrv : horizontal gradient of TRA at V-points 
+      !!
+      !! History :
+      !!   8.5  !  02-04  (A. Bozec)  Original code
+      !!   8.5  !  02-08  (G. Madec E. Durand)  Optimization and Free form
+      !!   9.0  !  04-03  (C. Ethe)  adapted for passive tracers
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt ! ocean time-step index
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra), INTENT( in ) ::   &
+         ptra                       ! 4D tracers fields
+      REAL(wp), DIMENSION(jpi,jpj,jptra), INTENT( out ) ::   &
+         pgtru,                 &  ! horizontal grad. of TRA u- and v-points 
+         pgtrv                     ! of the partial step level
+
+      !! * Local declarations
+      INTEGER ::   ji, jj,jn,     &  ! Dummy loop indices
+                   iku,ikv          ! partial step level at u- and v-points
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zti, ztj                   ! tempory arrays
+
+      REAL(wp), DIMENSION(jpi,jpj,jptra) ::   &
+         ztrai, ztraj               ! interpolated value of TRA
+
+      REAL(wp) ::   &
+         ze3wu, ze3wv,           &  ! temporary scalars
+         zmaxu1, zmaxu2,         &  !    "         "
+         zmaxv1, zmaxv2             !    "         "
+      !!----------------------------------------------------------------------
+
+      ! Initialization (first time-step only): compute mbatu and mbatv
+      IF( kt == nittrc000 ) 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
+      
+
+      DO jn = 1, jptra
+         ! Interpolation of passive tracers at the last ocean level
+# if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+         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)
+               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 passive tracers
+                  ztrai(ji,jj,jn) = ptra(ji+1,jj,iku,jn) + zmaxu1 * ( 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(ji,jj,jn) - ptra(ji,jj,iku,jn) )
+               ELSE                        ! case 2
+                  ! interpolated values of passive tracers
+                  ztrai(ji,jj,jn) = ptra(ji,jj,iku,jn) + zmaxu2 * ( 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 (ji,jj,jn) )
+               ENDIF
+
+               ! j- direction
+
+               IF( ze3wv >= 0. ) THEN      ! case 1
+                  ! interpolated values of passive tracers
+                  ztraj(ji,jj,jn) = ptra(ji,jj+1,ikv,jn) + zmaxv1 * ( 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(ji,jj,jn) - ptra(ji,jj,ikv,jn) )
+               ELSE                        ! case 2
+                  ! interpolated values of passive tracers
+                  ztraj(ji,jj,jn) = ptra(ji,jj,ikv,jn) + zmaxv2 * ( 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(ji,jj,jn) )
+               ENDIF
+# if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+            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
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+   USE par_kind
+CONTAINS
+   SUBROUTINE zps_hde_trc ( kt, ptra, pgtru, pgtrv ) ! Empty routine
+      INTEGER, INTENT( in) :: kt
+      REAL(wp), DIMENSION(:,:,:,:) :: ptra
+      REAL(wp) :: pgtru, pgtrv
+      WRITE(*,*) 'zps_hde_trc: You should not have seen this print! error?',   &
+         kt, ptra, pgtru, pgtrv
+   END SUBROUTINE zps_hde_trc
+#endif
+
+   !!======================================================================
+END MODULE zpshde_trc
