Index: trunk/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- trunk/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 784)
+++ trunk/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 785)
@@ -75,6 +75,5 @@
       INTEGER  ::   ji, jj, jk              ! dummy loop indices
       REAL(wp) ::                        &  ! temporary scalar
-         ztai, ztaj, ztak,               &  !    "         "   
-         zsai, zsaj, zsak,               &  !    "         "   
+         ztat, zsat,                     &  !    "         "   
          z_hdivn_x, z_hdivn_y, z_hdivn
       REAL(wp) ::   &
@@ -158,17 +157,20 @@
       ! total advective trend
       DO jk = 1, jpkm1
+         z2dtt = z2 * rdttra(jk)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               ! i- j- horizontal & k- vertical advective trends
-               ztai = - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  ) ) * zbtr
-               ztaj = - ( ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  ) ) * zbtr
-               ztak = - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr
-               zsai = - ( zsu(ji,jj,jk) - zsu(ji-1,jj  ,jk  ) ) * zbtr
-               zsaj = - ( zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  ) ) * zbtr
-               zsak = - ( zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr
                ! total intermediate advective trends
-               zti(ji,jj,jk) = ztai + ztaj + ztak
-               zsi(ji,jj,jk) = zsai + zsaj + zsak
+               ztat = - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )   &
+                  &     + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   &
+                  &     + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr
+               zsat = - ( zsu(ji,jj,jk) - zsu(ji-1,jj  ,jk  )   & 
+                  &     + zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  )   &
+                  &     + zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr
+               ! update and guess with monotonic sheme
+               ta(ji,jj,jk) =  ta(ji,jj,jk) + ztat
+               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsat
+               zti (ji,jj,jk) = ( tb(ji,jj,jk) + z2dtt * ztat ) * tmask(ji,jj,jk)
+               zsi (ji,jj,jk) = ( sb(ji,jj,jk) + z2dtt * zsat ) * tmask(ji,jj,jk)
             END DO
          END DO
@@ -222,17 +224,4 @@
          !
       ENDIF
-
-      ! update and guess with monotonic sheme
-      DO jk = 1, jpkm1
-         z2dtt = z2 * rdttra(jk)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ta(ji,jj,jk) =  ta(ji,jj,jk) + zti(ji,jj,jk)
-               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsi(ji,jj,jk)
-               zti (ji,jj,jk) = ( tb(ji,jj,jk) + z2dtt * zti(ji,jj,jk) ) * tmask(ji,jj,jk)
-               zsi (ji,jj,jk) = ( sb(ji,jj,jk) + z2dtt * zsi(ji,jj,jk) ) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
 
       ! Lateral boundary conditions on zti, zsi   (unchanged sign)
@@ -290,15 +279,14 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.  
                zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               ! i- j- horizontal & k- vertical advective trends
-               ztai = - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )) * zbtr
-               ztaj = - ( ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )) * zbtr
-               ztak = - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1)) * zbtr
-               zsai = - ( zsu(ji,jj,jk) - zsu(ji-1,jj  ,jk  )) * zbtr
-               zsaj = - ( zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  )) * zbtr
-               zsak = - ( zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1)) * zbtr
-
+               ! total advective trends
+               ztat = - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )   &
+                  &     + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   &
+                  &     + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr
+               zsat = - ( zsu(ji,jj,jk) - zsu(ji-1,jj  ,jk  )   &
+                  &     + zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  )   &
+                  &     + zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr
                ! add them to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + ztai + ztaj + ztak
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsai + zsaj + zsak
+               ta(ji,jj,jk) = ta(ji,jj,jk) + ztat
+               sa(ji,jj,jk) = sa(ji,jj,jk) + zsat
             END DO
          END DO
@@ -396,5 +384,5 @@
       !!       in-space based differencing for fluid
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT( in ) ::   prdt                               ! ???
+      REAL(wp), INTENT( in ) ::   prdt   ! ???
       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( inout ) ::   &
          pbef,                            & ! before field
@@ -407,73 +395,55 @@
       INTEGER ::   ikm1
       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbetup, zbetdo
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbup, zbdo
       REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt
+      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv
+      REAL(wp) ::   zup, zdo
       !!----------------------------------------------------------------------
 
       zbig = 1.e+40
       zrtrn = 1.e-15
-      zbetup(:,:,:) = 0.e0   ;   zbetdo(:,:,:) = 0.e0  
+      zbetup(:,:,jpk) = 0.e0   ;   zbetdo(:,:,jpk) = 0.e0
+
 
       ! Search local extrema
       ! --------------------
-      ! large negative value (-zbig) inside land
-      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
-      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
-      ! search maximum in neighbourhood
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+      zbup = MAX( pbef * tmask - zbig * ( 1.e0 - tmask ),   &
+         &        paft * tmask - zbig * ( 1.e0 - tmask )  )
+      zbdo = MIN( pbef * tmask + zbig * ( 1.e0 - tmask ),   &
+         &        paft * tmask + zbig * ( 1.e0 - tmask )  )
+
       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)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! positive & negative part of the flux
+
+               ! search maximum in neighbourhood
+               zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
+                  &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   &
+                  &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   &
+                  &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  )
+
+               ! search minimum in neighbourhood
+               zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   &
+                  &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   &
+                  &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   &
+                  &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  )
+
+               ! positive part of the flux
                zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   &
                   & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   &
                   & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
+
+               ! negative part of the flux
                zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   &
                   & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   &
                   & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
+
                ! up & down beta terms
                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
-               zbetup(ji,jj,jk) = ( 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
+               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
+               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt
             END DO
          END DO
@@ -490,28 +460,20 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               za = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
-               zb = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
-               zc = 0.5 * ( 1.e0 + SIGN( 1.e0, paa(ji,jj,jk) ) )
-               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb )
-
-               za = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
-               zb = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
-               zc = 0.5 * ( 1.e0 + SIGN( 1.e0, pbb(ji,jj,jk) ) )
-               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb )
-            END DO
-         END DO
-      END DO
-
+               zau = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+               zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) )
+               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1.e0 - zcu) * zbu )
+
+               zav = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+               zbv = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) )
+               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1.e0 - zcv) * zbv )
 
       ! 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.
-
-               za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
-               zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
-               zc = 0.5 * ( 1.e0 + SIGN( 1.e0, pcc(ji,jj,jk) ) )
-               pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb )
+               za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
+               zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
+               zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) )
+               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1.e0 - zc) * zb )
             END DO
          END DO
@@ -521,5 +483,4 @@
       CALL lbc_lnk( paa, 'U', -1. )      ! changed sign
       CALL lbc_lnk( pbb, 'V', -1. )      ! changed sign
-      CALL lbc_lnk( pcc, 'W',  1. )      ! NO changed sign
       !
    END SUBROUTINE nonosc
