Index: /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
===================================================================
--- /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 3565)
+++ /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 3566)
@@ -1,3 +1,3 @@
-#define SPONGE
+#define SPONGE && define SPONGE_TOP
 
 Module agrif_opa_sponge
@@ -13,6 +13,8 @@
    PRIVATE
 
-   PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn
-
+   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn
+
+  !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.3 , NEMO Consortium (2010)
@@ -27,11 +29,8 @@
       !!   *** ROUTINE Agrif_Sponge_Tra ***
       !!---------------------------------------------
-#include "domzgr_substitute.h90"
       !!
       INTEGER :: ji,jj,jk,jn
-      INTEGER :: spongearea
       REAL(wp) :: timecoeff
       REAL(wp) :: ztsa, zabe1, zabe2, zbtr
-      REAL(wp), POINTER, DIMENSION(:,:    ) :: localviscsponge
       REAL(wp), POINTER, DIMENSION(:,:    ) :: ztu, ztv
       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab
@@ -39,5 +38,5 @@
 
 #if defined SPONGE
-      CALL wrk_alloc( jpi, jpj, localviscsponge, ztu, ztv )
+      CALL wrk_alloc( jpi, jpj, ztu, ztv )
       CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  )
 
@@ -52,72 +51,5 @@
       tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:)
 
-      spongearea = 2 + 2 * Agrif_irhox()
-
-      localviscsponge = 0.
-      
-      IF (.NOT. spongedoneT) THEN
-         spe1ur(:,:) = 0.
-         spe2vr(:,:) = 0.
-
-      IF ((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO ji = 2, spongearea
-            localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2)
-         ENDDO
-	 
-	 spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) &
-	       * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:)
-
-         spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + &
-	          localviscsponge(2:spongearea,2:jpj)) &
-	        * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1)
-      ENDIF
-
-      IF ((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO ji = nlci-spongearea + 1,nlci-1
-            localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2)
-         ENDDO
-	 
-	 spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + &
-	        localviscsponge(nlci-spongearea + 2:nlci-1,:)) &
-	       * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:)
-
-         spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) &
-	           + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) &
-	        * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1)
-      ENDIF
-
-
-      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO jj = 2, spongearea
-            localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2)
-         ENDDO
-	 
-	 spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + &
-	        localviscsponge(2:jpi,2:spongearea)) &
-	       * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea)
-
-         spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + &
-	          localviscsponge(:,3:spongearea)) &
-	        * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1)
-      ENDIF
-
-      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO jj = nlcj-spongearea + 1,nlcj-1
-            localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2)
-         ENDDO
-	 
-	 spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + &
-	         localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) &
-	       * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1)
-
-         spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + &
-	         localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) &
-	        * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2)
-      ENDIF
-      
-         spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))
-
-         spongedoneT = .TRUE.
-      ENDIF
+      CALL Agrif_Sponge
 
       DO jn = 1, jpts
@@ -147,5 +79,5 @@
       ENDDO
 
-      CALL wrk_dealloc( jpi, jpj, localviscsponge, ztu, ztv )
+      CALL wrk_dealloc( jpi, jpj, ztu, ztv )
       CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  )
 #endif
@@ -157,11 +89,8 @@
       !!   *** ROUTINE Agrif_Sponge_dyn ***
       !!---------------------------------------------
-#include "domzgr_substitute.h90"
       !!
       INTEGER :: ji,jj,jk
-      INTEGER :: spongearea
       REAL(wp) :: timecoeff
       REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
-      REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge
       REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff
       REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff
@@ -169,5 +98,4 @@
 
 #if defined SPONGE
-      CALL wrk_alloc( jpi, jpj, localviscsponge )
       CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )
 
@@ -180,5 +108,5 @@
       Agrif_UseSpecialValue = .FALSE.
 
-      ubdiff(:,:,:) = (ub(:,:,:) - ztab(:,:,:))*umask(:,:,:)
+      ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:) ) * umask(:,:,:)
 
       ztab = 0.e0
@@ -188,74 +116,11 @@
       Agrif_UseSpecialValue = .FALSE.
 
-      vbdiff(:,:,:) = (vb(:,:,:) - ztab(:,:,:))*vmask(:,:,:)
-
-      spongearea = 2 + 2 * Agrif_irhox()
-
-      localviscsponge = 0.
-
-      IF (.NOT. spongedoneU) THEN
-         spe1ur2(:,:) = 0.
-         spe2vr2(:,:) = 0.
-
-      IF ((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO ji = 2, spongearea
-            localviscsponge(ji,:) = visc_dyn * (spongearea-ji)/real(spongearea-2)
-         ENDDO
-	 
-	 spe1ur2(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:))
-
-         spe2vr2(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + &
-	          localviscsponge(2:spongearea,2:jpj))
-      ENDIF
-
-      IF ((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO ji = nlci-spongearea + 1,nlci-1
-            localviscsponge(ji,:) = visc_dyn * (ji - (nlci-spongearea+1))/real(spongearea-2)
-         ENDDO
-	 
-	 spe1ur2(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + &
-	        localviscsponge(nlci-spongearea + 2:nlci-1,:))
-
-         spe2vr2(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) &
-	           + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj))
-      ENDIF
-
-
-      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO jj = 2, spongearea
-            localviscsponge(:,jj) = visc_dyn * (spongearea-jj)/real(spongearea-2)
-         ENDDO
-	 
-	 spe1ur2(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + &
-	        localviscsponge(2:jpi,2:spongearea))
-
-         spe2vr2(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + &
-	          localviscsponge(:,3:spongearea))
-      ENDIF
-
-      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO jj = nlcj-spongearea + 1,nlcj-1
-            localviscsponge(:,jj) = visc_dyn * (jj - (nlcj-spongearea+1))/real(spongearea-2)
-         ENDDO
-	 
-	 spe1ur2(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + &
-	         localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1))
-
-         spe2vr2(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + &
-	         localviscsponge(:,nlcj-spongearea + 2:nlcj-1))
-      ENDIF
-
-         spongedoneU = .TRUE.
-	 
-	  spbtr3(:,:) = 1./( e1f(:,:) * e2f(:,:))
-      ENDIF
-      
-      IF (.NOT. spongedoneT) THEN
-        spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))      
-      ENDIF
-      
-      DO jk=1,jpkm1
-      ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:)
-      vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:)
+      vbdiff(:,:,:) = ( vb(:,:,:) - ztab(:,:,:) ) * vmask(:,:,:)
+
+      CALL Agrif_Sponge
+
+      DO jk = 1,jpkm1
+         ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:)
+         vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:)
       ENDDO
       
@@ -272,11 +137,8 @@
             DO ji = 2, jpim1   ! vector opt.
                zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-               hdivdiff(ji,jj,jk) =   &
-                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * & 
-                  ubdiff(ji,jj,jk) - e2u(ji-1,jj  )* &
-                  fse3u(ji-1,jj  ,jk)  * ubdiff(ji-1,jj  ,jk)       &
-                  + e1v(ji,jj)*fse3v(ji,jj,jk) * &
-                  vbdiff(ji,jj,jk) - e1v(ji  ,jj-1)* &
-                  fse3v(ji  ,jj-1,jk)  * vbdiff(ji  ,jj-1,jk)  ) * zbtr
+               hdivdiff(ji,jj,jk) =  (  e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) * ubdiff(ji  ,jj  ,jk)     &
+                  &                   - e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) * ubdiff(ji-1,jj  ,jk)     &
+                  &                   + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * vbdiff(ji  ,jj  ,jk)     &
+                  &                   - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * vbdiff(ji  ,jj-1,jk)  ) * zbtr
             END DO
          END DO
@@ -286,6 +148,6 @@
                zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk)
                rotdiff(ji,jj,jk) = (  e2v(ji+1,jj  ) * vbdiff(ji+1,jj  ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk)    &
-                  &              - e1u(ji  ,jj+1) * ubdiff(ji  ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk)  ) &
-                  &           * fmask(ji,jj,jk) * zbtr
+                  &                 - e1u(ji  ,jj+1) * ubdiff(ji  ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk)  ) &
+                  &               * fmask(ji,jj,jk) * zbtr
             END DO
          END DO
@@ -298,15 +160,10 @@
          DO jj = 2, jpjm1
             DO ji = 2, jpim1   ! vector opt.
-               ze2u = rotdiff (ji,jj,jk)
-               ze1v = hdivdiff(ji,jj,jk)
                ! horizontal diffusive trends
-               zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
-                  + ( hdivdiff(ji+1,jj,jk) - ze1v      &
-                  ) / e1u(ji,jj)
-
-               zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
-                  + ( hdivdiff(ji,jj+1,jk) - ze1v    &
-                  ) / e2v(ji,jj)
-
+               zua = - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
+                     + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk) ) / e1u(ji,jj)
+
+               zva = + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
+                     + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) / e2v(ji,jj)
                ! add it to the general momentum trends
                ua(ji,jj,jk) = ua(ji,jj,jk) + zua
@@ -317,17 +174,130 @@
       END DO                                           !   End of slab
       !                                                ! ===============
-      CALL wrk_dealloc( jpi, jpj, localviscsponge )
       CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )
-
 #endif
 
    END SUBROUTINE Agrif_Sponge_dyn
 
+   SUBROUTINE Agrif_Sponge
+      !!---------------------------------------------
+      !!   *** ROUTINE  Agrif_Sponge ***
+      !!---------------------------------------------
+      INTEGER  :: ji,jj,jk
+      INTEGER  :: ispongearea, ilci, ilcj
+      REAL(wp) :: z1spongearea
+      REAL(wp), POINTER, DIMENSION(:,:) :: zlocalviscsponge
+
+#if defined SPONGE || defined SPONGE_TOP
+
+      CALL wrk_alloc( jpi, jpj, zlocalviscsponge )
+
+      ispongearea  = 2 + 2 * Agrif_irhox()
+      ilci = nlci - ispongearea
+      ilcj = nlcj - ispongearea 
+      z1spongearea = 1._wp / REAL( ispongearea - 2 )
+      spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
+
+      ! Tracers
+      IF( .NOT. spongedoneT ) THEN
+         zlocalviscsponge(:,:) = 0.
+         spe1ur(:,:) = 0.
+         spe2vr(:,:) = 0.
+
+         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
+            DO ji = 2, ispongearea
+               zlocalviscsponge(ji,:) = visc_tra * ( ispongearea-ji ) * z1spongearea
+            ENDDO
+            spe1ur(2:ispongearea-1,:      ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,:      ) + zlocalviscsponge(3:ispongearea,:    ) ) &
+               &                         * e2u(2:ispongearea-1,:      ) / e1u(2:ispongearea-1,:      )
+            spe2vr(2:ispongearea  ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea  ,1:jpjm1) + zlocalviscsponge(2:ispongearea,2:jpj) ) &
+               &                         * e1v(2:ispongearea  ,1:jpjm1) / e2v(2:ispongearea  ,1:jpjm1)
+         ENDIF
+
+         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
+            DO ji = ilci+1,nlci-1
+               zlocalviscsponge(ji,:) = visc_tra * (ji - (ilci+1) ) * z1spongearea
+            ENDDO
+  
+            spe1ur(ilci+1:nlci-2,:      ) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-2,:) + zlocalviscsponge(ilci+2:nlci-1,:) )  &
+               &                                   * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:)
+
+            spe2vr(ilci+1:nlci-1,1:jpjm1) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) + zlocalviscsponge(ilci+1:nlci-1,2:jpj  )  ) & 
+               &                                   * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1)
+         ENDIF
+
+         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
+            DO jj = 2, ispongearea
+               zlocalviscsponge(:,jj) = visc_tra * ( ispongearea-jj ) * z1spongearea
+            ENDDO
+            spe1ur(1:jpim1,2:ispongearea  ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea) + zlocalviscsponge(2:jpi,2:ispongearea) ) &
+               &                                * e2u(1:jpim1,2:ispongearea) / e1u(1:jpim1,2:ispongearea)
+   
+            spe2vr(:      ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1)     + zlocalviscsponge(:,3:ispongearea)     ) &
+               &                                  * e1v(:,2:ispongearea-1) / e2v(:,2:ispongearea-1)
+         ENDIF
+
+         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
+            DO jj = ilcj+1,nlcj-1
+               zlocalviscsponge(:,jj) = visc_tra * (jj - (ilcj+1) ) * z1spongearea
+            ENDDO
+            spe1ur(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) + zlocalviscsponge(2:jpi,ilcj+1:nlcj-1) ) &
+               &                                * e2u(1:jpim1,ilcj+1:nlcj-1) / e1u(1:jpim1,ilcj+1:nlcj-1)
+            spe2vr(:      ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2      ) + zlocalviscsponge(:,ilcj+2:nlcj-1)     ) &
+               &                                * e1v(:,ilcj+1:nlcj-2) / e2v(:,ilcj+1:nlcj-2)
+         ENDIF
+         spongedoneT = .TRUE.
+      ENDIF
+
+      ! Dynamics
+      IF( .NOT. spongedoneU ) THEN
+         zlocalviscsponge(:,:) = 0.
+         spe1ur2(:,:) = 0.
+         spe2vr2(:,:) = 0.
+
+         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
+            DO ji = 2, ispongearea
+               zlocalviscsponge(ji,:) = visc_dyn * ( ispongearea-ji ) * z1spongearea
+            ENDDO
+            spe1ur2(2:ispongearea-1,:      ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,:      ) + zlocalviscsponge(3:ispongearea,:    ) )
+            spe2vr2(2:ispongearea  ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea  ,1:jpjm1) + zlocalviscsponge(2:ispongearea,2:jpj) ) 
+         ENDIF
+
+         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
+            DO ji = ilci+1,nlci-1
+               zlocalviscsponge(ji,:) = visc_dyn * (ji - (ilci+1) ) * z1spongearea
+            ENDDO
+            spe1ur2(ilci+1:nlci-2,:      ) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-2,:) + zlocalviscsponge(ilci+2:nlci-1,:) )  
+            spe2vr2(ilci+1:nlci-1,1:jpjm1) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) + zlocalviscsponge(ilci+1:nlci-1,2:jpj  )  ) 
+         ENDIF
+
+         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
+            DO jj = 2, ispongearea
+               zlocalviscsponge(:,jj) = visc_dyn * ( ispongearea-jj ) * z1spongearea
+            ENDDO
+            spe1ur2(1:jpim1,2:ispongearea  ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea) + zlocalviscsponge(2:jpi,2:ispongearea) ) 
+            spe2vr2(:      ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1)     + zlocalviscsponge(:,3:ispongearea)     )
+         ENDIF
+
+         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
+            DO jj = ilcj+1,nlcj-1
+               zlocalviscsponge(:,jj) = visc_dyn * (jj - (ilcj+1) ) * z1spongearea
+            ENDDO
+            spe1ur2(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) + zlocalviscsponge(2:jpi,ilcj+1:nlcj-1) ) 
+            spe2vr2(:      ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2      ) + zlocalviscsponge(:,ilcj+2:nlcj-1)     )
+         ENDIF
+         spongedoneU = .TRUE.
+         spbtr3(:,:) = 1. / ( e1f(:,:) * e2f(:,:) )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zlocalviscsponge )
+      !
+#endif
+
+   END SUBROUTINE Agrif_Sponge
+
    SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
       !!---------------------------------------------
       !!   *** ROUTINE interptsn ***
       !!---------------------------------------------
-#  include "domzgr_substitute.h90"       
-      
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
@@ -341,6 +311,4 @@
       !!   *** ROUTINE interpun ***
       !!---------------------------------------------
-#  include "domzgr_substitute.h90"       
-      
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
@@ -354,6 +322,4 @@
       !!   *** ROUTINE interpvn ***
       !!---------------------------------------------
-#  include "domzgr_substitute.h90"       
-      
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
Index: /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
===================================================================
--- /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 3565)
+++ /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 3566)
@@ -27,49 +27,86 @@
 
    SUBROUTINE Agrif_trc
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_trc ***
-      !!---------------------------------------------
-      
-      INTEGER :: ji,jj,jk,jn
-      REAL(wp) :: zrhox
-      REAL(wp) :: alpha1, alpha2, alpha3, alpha4
-      REAL(wp) :: alpha5, alpha6, alpha7
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_Tra  ***
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3
+      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7
       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra
-           
-      IF (Agrif_Root()) RETURN
+      !!----------------------------------------------------------------------
+      !
+      IF( Agrif_Root() )   RETURN
 
       CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra )
 
-      Agrif_SpecialValue=0.
+      Agrif_SpecialValue    = 0.e0
       Agrif_UseSpecialValue = .TRUE.
-      ztra = 0.e0
+      ztra(:,:,:,:) = 0.e0
 
-      CALL Agrif_Bc_variable(ztra,trn_id, procname = interptrn )
+      CALL Agrif_Bc_variable( ztra, trn_id, procname=interptrn )
       Agrif_UseSpecialValue = .FALSE.
 
       zrhox = Agrif_Rhox()
 
-      alpha1 = (zrhox-1.)/2.
-      alpha2 = 1.-alpha1
+      alpha1 = ( zrhox - 1. ) * 0.5
+      alpha2 = 1. - alpha1
 
-      alpha3 = (zrhox-1)/(zrhox+1)
-      alpha4 = 1.-alpha3
+      alpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
+      alpha4 = 1. - alpha3
 
-      alpha6 = 2.*(zrhox-1.)/(zrhox+1.)
-      alpha7 = -(zrhox-1)/(zrhox+3)
+      alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+      alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
       alpha5 = 1. - alpha6 - alpha7
+      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
 
-      IF ((nbondi == 1).OR.(nbondi == 2)) THEN
-         tra(nlci,:,:,:) = alpha1 * ztra(nlci,:,:,:) + alpha2 * ztra(nlci-1,:,:,:)
-         DO jn=1,jptra 
-            DO jk=1,jpk      
-               DO jj=1,jpj
-                  IF (umask(nlci-2,jj,jk).EQ.0.) THEN
+         DO jn = 1, jptra
+            tra(nlci,:,:,jn) = alpha1 * ztra(nlci,:,:,jn) + alpha2 * ztra(nlci-1,:,:,jn)
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
                      tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
                   ELSE
                      tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                     IF (un(nlci-2,jj,jk).GT.0.) THEN
-                        tra(nlci-1,jj,jk,jn)=(alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) &
-                           +alpha7*tra(nlci-3,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
+                        tra(nlci-1,jj,jk,jn)=( alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn)  &
+                           &                 + alpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         ENDDO
+      ENDIF
+
+      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
+
+         DO jn = 1, jptra
+            tra(:,nlcj,:,jn) = alpha1 * ztra(:,nlcj,:,jn) + alpha2 * ztra(:,nlcj-1,:,jn)
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
+                     tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                  ELSE
+                     tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)
+                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
+                        tra(ji,nlcj-1,jk,jn)=( alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn)  &
+                           &                 + alpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         ENDDO
+      ENDIF
+      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
+         DO jn = 1, jptra
+            tra(1,:,:,jn) = alpha1 * ztra(1,:,:,jn) + alpha2 * ztra(2,:,:,jn)
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  IF( umask(2,jj,jk) == 0.e0 ) THEN
+                     tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
+                  ELSE
+                     tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)
+                     IF( un(2,jj,jk) < 0.e0 ) THEN
+                        tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn)+alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
                      ENDIF
                   ENDIF
@@ -79,62 +116,24 @@
       ENDIF
 
-      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
-         tra(:,nlcj,:,:) = alpha1 * ztra(:,nlcj,:,:) + alpha2 * ztra(:,nlcj-1,:,:)
-         DO jn=1, jptra            
-            DO jk=1,jpk      
+      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
+         DO jn = 1, jptra
+            tra(:,1,:,jn) = alpha1 * ztra(:,1,:,jn) + alpha2 * ztra(:,2,:,jn)
+            DO jk=1,jpk
                DO ji=1,jpi
-                  IF (vmask(ji,nlcj-2,jk).EQ.0.) THEN
-                     tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                  IF( vmask(ji,2,jk) == 0.e0 ) THEN
+                     tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
                   ELSE
-                     tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
-                     IF (vn(ji,nlcj-2,jk) .GT. 0.) THEN
-                        tra(ji,nlcj-1,jk,jn)=(alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) &
-                           +alpha7*tra(ji,nlcj-3,jk,jn))*tmask(ji,nlcj-1,jk)
+                     tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
+                     IF( vn(ji,2,jk) < 0.e0 ) THEN
+                        tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)+alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
                      ENDIF
                   ENDIF
                END DO
             END DO
-         END DO
+         ENDDO
       ENDIF
-
-      IF ((nbondi == -1).OR.(nbondi == 2)) THEN
-         tra(1,:,:,:) = alpha1 * ztra(1,:,:,:) + alpha2 * ztra(2,:,:,:)
-         DO jn=1, jptra
-            DO jk=1,jpk      
-               DO jj=1,jpj
-                  IF (umask(2,jj,jk).EQ.0.) THEN
-                     tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
-                  ELSE
-                     tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)        
-                     IF (un(2,jj,jk).LT.0.) THEN
-                        tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn) &
-                           +alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      ENDIF
-
-      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
-         tra(:,1,:,:) = alpha1 * ztra(:,1,:,:) + alpha2 * ztra(:,2,:,:)
-         DO jn=1, jptra  
-            DO jk=1,jpk      
-               DO ji=1,jpi
-                  IF (vmask(ji,2,jk).EQ.0.) THEN
-                     tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
-                  ELSE
-                     tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
-                     IF (vn(ji,2,jk) .LT. 0.) THEN
-                        tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)&
-                           +alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      ENDIF
-
+      !
       CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )
+      !
 
    END SUBROUTINE Agrif_trc
Index: /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
===================================================================
--- /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 3565)
+++ /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 3566)
@@ -8,4 +8,5 @@
    USE in_out_manager
    USE agrif_oce
+   USE agrif_opa_sponge
    USE trc
    USE lib_mpp
@@ -17,4 +18,6 @@
    PUBLIC Agrif_Sponge_Trc, interptrn
 
+  !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.3 , NEMO Consortium (2010)
@@ -29,16 +32,15 @@
       !!   *** ROUTINE Agrif_Sponge_Trc ***
       !!---------------------------------------------
-#include "domzgr_substitute.h90"
       !! 
-      INTEGER :: ji,jj,jk,jl
-      INTEGER :: spongearea
+      INTEGER :: ji,jj,jk,jn
       REAL(wp) :: timecoeff
       REAL(wp) :: ztra, zabe1, zabe2, zbtr
-      REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff, ztru, ztrv, ztab
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff
 
 #if defined SPONGE_TOP
-      CALL wrk_alloc( jpi, jpj, localviscsponge )
-      CALL wrk_alloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab )
+      CALL wrk_alloc( jpi, jpj, ztru, ztrv )
+      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff )
 
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
@@ -46,106 +48,39 @@
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .TRUE.
-      ztab = 0.e0
-      CALL Agrif_Bc_Variable(ztab, tra_id,calledweight=timecoeff,procname=interptrn)
+      ztabr = 0.e0
+      CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn)
       Agrif_UseSpecialValue = .FALSE.
 
-      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztab(:,:,:,:)
+      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:)
 
-      spongearea = 2 + 2 * Agrif_irhox()
+      CALL Agrif_sponge
 
-      localviscsponge = 0.
-      
-      IF (.NOT. spongedoneT) THEN
-         spe1ur(:,:) = 0.
-         spe2vr(:,:) = 0.
+      DO jn = 1, jptra
+         DO jk = 1, jpkm1
+            !
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
+                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
+                  ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                  ztrv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
+               ENDDO
+            ENDDO
 
-      IF ((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO ji = 2, spongearea
-            localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2)
+            DO jj = 2,jpjm1
+               DO ji = 2,jpim1
+                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
+                  ! horizontal diffusive trends
+                  ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1)  )
+                  ! add it to the general tracer trends
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !
          ENDDO
-	 
-	 spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) &
-	       * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:)
-
-         spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + &
-	          localviscsponge(2:spongearea,2:jpj)) &
-	        * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1)
-      ENDIF
-
-      IF ((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO ji = nlci-spongearea + 1,nlci-1
-            localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2)
-         ENDDO
-	 
-	 spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + &
-	        localviscsponge(nlci-spongearea + 2:nlci-1,:)) &
-	       * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:)
-
-         spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) &
-	           + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) &
-	        * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1)
-      ENDIF
-
-
-      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO jj = 2, spongearea
-            localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2)
-         ENDDO
-	 
-	 spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + &
-	        localviscsponge(2:jpi,2:spongearea)) &
-	       * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea)
-
-         spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + &
-	          localviscsponge(:,3:spongearea)) &
-	        * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1)
-      ENDIF
-
-      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO jj = nlcj-spongearea + 1,nlcj-1
-            localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2)
-         ENDDO
-	 
-	 spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + &
-	         localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) &
-	       * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1)
-
-         spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + &
-	         localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) &
-	        * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2)
-      ENDIF
-      
-         spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))
-
-         spongedoneT = .TRUE.
-      ENDIF
-
-      DO jl = 1, jptra
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
-               zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
-               ztru(ji,jj,jk,jl) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jl) - trbdiff(ji,jj,jk,jl) )
-               ztrv(ji,jj,jk,jl) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jl) - trbdiff(ji,jj,jk,jl) )
-            ENDDO
-         ENDDO
-
-         DO jj = 2,jpjm1
-            DO ji = 2,jpim1
-               zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-               ! horizontal diffusive trends
-               ztra = zbtr * (  ztru(ji,jj,jk,jl) - ztru(ji-1,jj,jk,jl)   &
-                  &          + ztrv(ji,jj,jk,jl) - ztrv(ji,jj-1,jk,jl)  )
-               ! add it to the general tracer trends
-               tra(ji,jj,jk,jl) = (tra(ji,jj,jk,jl) + ztra)
-            END DO
-         END DO
-
-      ENDDO
       ENDDO
  
-      CALL wrk_dealloc( jpi, jpj, localviscsponge )
-      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab )
+      CALL wrk_dealloc( jpi, jpj, ztru, ztrv )
+      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr )
 
 #endif
@@ -153,14 +88,12 @@
    END SUBROUTINE Agrif_Sponge_Trc
 
-   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,l1,l2)
+   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
       !!---------------------------------------------
       !!   *** ROUTINE interptn ***
       !!---------------------------------------------
-#  include "domzgr_substitute.h90"       
-      
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres
-
-      tabres(i1:i2,j1:j2,k1:k2,l1:l2) = trn(i1:i2,j1:j2,k1:k2,l1:l2)
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      !
+      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
 
    END SUBROUTINE interptrn
Index: /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
===================================================================
--- /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 3565)
+++ /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 3566)
@@ -38,5 +38,5 @@
 
 #if defined TWO_WAY
-      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztra )
+      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra )
 
       Agrif_UseSpecialValueInUpdate = .TRUE.
@@ -52,27 +52,25 @@
       nbcline_trc = nbcline_trc + 1
 
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztra )
+      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )
 #endif
 
    END SUBROUTINE Agrif_Update_Trc
 
-   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,l1,l2,before)
+   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
       !!---------------------------------------------
       !!   *** ROUTINE UpdateTrc ***
       !!---------------------------------------------
-#  include "domzgr_substitute.h90"
-
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2
-      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
    
-      INTEGER :: ji,jj,jk,jl
+      INTEGER :: ji,jj,jk,jn
 
-         IF (before) THEN
-            DO jl=l1,l2
-               DO jk=k1,k2
-                  DO jj=j1,j2
-                     DO ji=i1,i2
-                        tabres(ji,jj,jk,jl) = trn(ji,jj,jk,jl)
+         IF( before ) THEN
+            DO jn = n1, n2
+               DO jk = k1, k2
+                  DO jj = j1, j2
+                     DO ji = i1, i2
+                        tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
                      ENDDO
                   ENDDO
@@ -80,10 +78,10 @@
             ENDDO
          ELSE
-            DO jl=l1,l2
-               DO jk=k1,k2
-                  DO jj=j1,j2
-                     DO ji=i1,i2
-                        IF (tabres(ji,jj,jk,jl).NE.0.) THEN
-                           trn(ji,jj,jk,jl) = tabres(ji,jj,jk,jl) * tmask(ji,jj,jk)
+            DO jn = n1, n2
+               DO jk = k1, k2
+                  DO jj = j1, j2
+                     DO ji = i1, i2
+                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
+                           trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk)
                         ENDIF
                      ENDDO
Index: /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
===================================================================
--- /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 3565)
+++ /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 3566)
@@ -434,4 +434,5 @@
    USE dom_oce
    USE nemogcm
+   USE par_trc
    USE trc
    USE in_out_manager
@@ -457,5 +458,5 @@
    Agrif_SpecialValue=0.
    Agrif_UseSpecialValue = .TRUE.
-   Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.)
+   Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn)
    Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn)
    Agrif_UseSpecialValue = .FALSE.
@@ -515,5 +516,5 @@
    ENDIF
 
-   CALL Agrif_Update_trc(0)
+!ch   CALL Agrif_Update_trc(0)
    nbcline_trc = 0
    !
Index: /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
===================================================================
--- /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90	(revision 3565)
+++ /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90	(revision 3566)
@@ -30,4 +30,5 @@
    PUBLIC prt_ctl_info    ! called by all subroutines
    PUBLIC prt_ctl_init    ! called by opa.F90
+   PUBLIC sub_dom         ! called by opa.F90
 
    !!----------------------------------------------------------------------
@@ -419,8 +420,11 @@
          nrecil, nrecjl, nldil, nleil, nldjl, nlejl
 
-      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace
+      INTEGER, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace
       REAL(wp) ::   zidom, zjdom            ! temporary scalars
       !!----------------------------------------------------------------------
 
+      !
+      CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
+      !
       !  1. Dimension arrays for subdomains
       ! -----------------------------------
@@ -438,6 +442,4 @@
 #endif
 
-      ALLOCATE(ilcitl (isplt,jsplt))
-      ALLOCATE(ilcjtl (isplt,jsplt))
 
       nrecil  = 2 * jpreci
@@ -512,7 +514,4 @@
       ! -------------------------------
 
-      ALLOCATE(iimpptl(isplt,jsplt))
-      ALLOCATE(ijmpptl(isplt,jsplt))
-      
       iimpptl(:,:) = 1
       ijmpptl(:,:) = 1
@@ -572,5 +571,7 @@
       END DO
       !
-      DEALLOCATE( iimpptl, ijmpptl, ilcitl, ilcjtl )
+      !
+      CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
+      !
       !
    END SUBROUTINE sub_dom
Index: /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 3565)
+++ /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 3566)
@@ -118,9 +118,9 @@
       CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM
       CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA 
+# if defined key_top
+      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP
+# endif
 # if defined key_lim2
       CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM
-# endif
-# if defined key_top
-      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP
 # endif
 #endif
Index: /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
===================================================================
--- /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 3565)
+++ /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 3566)
@@ -34,5 +34,4 @@
    USE tranxt
 # if defined key_agrif
-   USE agrif_top_update
    USE agrif_top_interp
 # endif
@@ -146,9 +145,4 @@
       ENDIF
 
-#if defined key_agrif
-      ! Update tracer at AGRIF zoom boundaries
-      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Trc( kt )      ! children only
-#endif      
-
       ! trends computation
       IF( l_trdtrc ) THEN                                      ! trends
Index: /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 3565)
+++ /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 3566)
@@ -29,5 +29,6 @@
 
 #if defined key_agrif
-   USE agrif_top_sponge ! Momemtum and tracers sponges
+   USE agrif_top_sponge ! tracers sponges
+   USE agrif_top_update ! tracers updates
 #endif
 
@@ -76,4 +77,8 @@
                                 CALL trc_nxt( kstp )            ! tracer fields at next time step     
          IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations
+
+#if defined key_agrif
+      IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )   ! Update tracer at AGRIF zoom boundaries : children only
+#endif
          IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, gtru, gtrv )  ! Partial steps: now horizontal gradient of passive
                                                                 ! tracers at the bottom ocean level
@@ -98,7 +103,7 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE trc_trp( kt )              ! Empty routine
-      INTEGER, INTENT(in) ::   kt
-      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt
+   SUBROUTINE trc_trp( kstp )              ! Empty routine
+      INTEGER, INTENT(in) ::   kstp
+      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kstp
    END SUBROUTINE trc_trp
 #endif
Index: /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
===================================================================
--- /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 3565)
+++ /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 3566)
@@ -56,131 +56,5 @@
 
    !* model domain *
-   USE dom_oce , ONLY :   lzoom      => lzoom        !: zoom flag
-   USE dom_oce , ONLY :   lzoom_e    => lzoom_e      !: East  zoom type flag
-   USE dom_oce , ONLY :   lzoom_w    => lzoom_w      !: West  zoom type flag
-   USE dom_oce , ONLY :   lzoom_s    => lzoom_s      !: South zoom type flag
-   USE dom_oce , ONLY :   lzoom_n    => lzoom_n      !: North zoom type flag
-   USE dom_oce , ONLY :   lzoom_arct => lzoom_arct   !: ORCA    arctic zoom flag
-   USE dom_oce , ONLY :   lzoom_anta => lzoom_anta   !: ORCA antarctic zoom flag
-   USE dom_oce , ONLY :   nperio     =>   nperio     !: type of lateral boundary condition       
-   USE dom_oce , ONLY :   nimpp      =>   nimpp      !: i index for mpp-subdomain left bottom
-   USE dom_oce , ONLY :   njmpp      =>   njmpp      !: j index for mpp-subdomain left bottom
-   USE dom_oce , ONLY :   nproc      =>   nproc      !: number for local processor
-   USE dom_oce , ONLY :   narea      =>   narea      !: number for local area
-   USE dom_oce , ONLY :   mig        =>   mig        !: local  ==> global  domain i-indice
-   USE dom_oce , ONLY :   mjg        =>   mjg        !: local  ==> global  domain i-indice
-   USE dom_oce , ONLY :   mi0        =>   mi0        !: global ==> local domain i-indice 
-   USE dom_oce , ONLY :   mi1        =>   mi1        !: (mi0=1 and mi1=0 if the global indice is not in the local one)
-   USE dom_oce , ONLY :   mj0        =>   mj0        !: global ==> local domain j-indice 
-   USE dom_oce , ONLY :   mj1        =>   mj1        !: (mj0=1 and mj1=0 if the global indice is not in the local one)
-   USE dom_oce , ONLY :   nidom      =>   nidom
-   USE dom_oce , ONLY :   nimppt     => nimppt     !:i-indexes for each processor
-   USE dom_oce , ONLY :   njmppt     => njmppt       !:j-indexes for each processor
-   USE dom_oce , ONLY :   ibonit     => ibonit       !:i-processor neighbour existence
-   USE dom_oce , ONLY :   ibonjt     => ibonjt       !:j- processor neighbour existence 
-   USE dom_oce , ONLY :   nlci       => nlci         !:i- & j-dimensions of the local subdomain
-   USE dom_oce , ONLY :   nlcj       => nlcj         !:
-   USE dom_oce , ONLY :   nldi       => nldi         !:first and last indoor i- and j-indexes
-   USE dom_oce , ONLY :   nlei       => nlei         !:
-   USE dom_oce , ONLY :   nldj       => nldj         !:
-   USE dom_oce , ONLY :   nlej       => nlej         !:
-   USE dom_oce , ONLY :   nlcit      => nlcit        !:dimensions of every i-subdomain
-   USE dom_oce , ONLY :   nlcjt      => nlcjt        !:dimensions of every j-subdomain
-   USE dom_oce , ONLY :   nldit      => nldit        !:first indoor index for each i-domain 
-   USE dom_oce , ONLY :   nleit      => nleit        !:last indoor index for each i-domain 
-   USE dom_oce , ONLY :   nldjt      => nldjt        !:first indoor index for each j-domain 
-   USE dom_oce , ONLY :   nlejt      => nlejt        !:last indoor index for each j-domain 
- 
-   !* horizontal mesh *
-   USE dom_oce , ONLY :   glamt      =>   glamt      !: longitude of t-point (degre)  
-   USE dom_oce , ONLY :   glamu      =>   glamu      !: longitude of t-point (degre)  
-   USE dom_oce , ONLY :   glamv      =>   glamv      !: longitude of t-point (degre)  
-   USE dom_oce , ONLY :   glamf      =>   glamf      !: longitude of t-point (degre)  
-   USE dom_oce , ONLY :   gphit      =>   gphit      !: latitude  of t-point (degre)   
-   USE dom_oce , ONLY :   gphiu      =>   gphiu      !: latitude  of t-point (degre)   
-   USE dom_oce , ONLY :   gphiv      =>   gphiv      !: latitude  of t-point (degre)   
-   USE dom_oce , ONLY :   gphif      =>   gphif      !: latitude  of t-point (degre)   
-   USE dom_oce , ONLY :   e1t        =>   e1t        !: horizontal scale factors at t-point (m)  
-   USE dom_oce , ONLY :   e2t        =>   e2t        !: horizontal scale factors at t-point (m)   
-   USE dom_oce , ONLY :   e1e2t      =>   e1e2t      !: cell surface at t-point (m2)
-   USE dom_oce , ONLY :   e1u        =>   e1u        !: horizontal scale factors at u-point (m)
-   USE dom_oce , ONLY :   e2u        =>   e2u        !: horizontal scale factors at u-point (m)
-   USE dom_oce , ONLY :   e1v        =>   e1v        !: horizontal scale factors at v-point (m)
-   USE dom_oce , ONLY :   e2v        =>   e2v        !: horizontal scale factors at v-point (m)  
-
-   !* vertical mesh *
-   USE dom_oce , ONLY :   gdept_0    =>   gdept_0    !: reference depth of t-points (m)
-   USE dom_oce , ONLY :   e3t_0      =>   e3t_0      !: reference depth of t-points (m)  
-   USE dom_oce , ONLY :   e3w_0      =>   e3w_0      !: reference depth of w-points (m)
-   USE dom_oce , ONLY :   gdepw_0    =>   gdepw_0    !: reference depth of w-points (m)
-# if ! defined key_zco
-   USE dom_oce , ONLY :   gdep3w     =>  gdep3w      !: ???
-   USE dom_oce , ONLY :   gdept      =>  gdept       !: depth of t-points (m)
-   USE dom_oce , ONLY :   gdepw      =>  gdepw       !: depth of t-points (m)
-   USE dom_oce , ONLY :   e3t        =>  e3t         !: vertical scale factors at t-
-   USE dom_oce , ONLY :   e3u        =>  e3u         !: vertical scale factors at u-
-   USE dom_oce , ONLY :   e3v        =>  e3v         !: vertical scale factors v-
-   USE dom_oce , ONLY :   e3w        =>  e3w         !: w-points (m)
-   USE dom_oce , ONLY :   e3f        =>  e3f         !: f-points (m)
-   USE dom_oce , ONLY :   e3uw       =>  e3uw        !: uw-points (m)
-   USE dom_oce , ONLY :   e3vw       =>  e3vw        !: vw-points (m)
-# endif
-   USE dom_oce , ONLY :   ln_zps     =>  ln_zps      !: partial steps flag
-   USE dom_oce , ONLY :   ln_sco     =>  ln_sco      !: s-coordinate flag
-   USE dom_oce , ONLY :   ln_zco     =>  ln_zco      !: z-coordinate flag
-   USE dom_oce , ONLY :   hbatt      =>  hbatt       !: ocean depth at the vertical of  t-point (m)
-   USE dom_oce , ONLY :   hbatu      =>  hbatu       !: ocean depth at the vertical of  u-point (m)
-   USE dom_oce , ONLY :   hbatv      =>  hbatv       !: ocean depth at the vertical of w-point (m)
-   USE dom_oce , ONLY :   gsigt      =>  gsigt       !: model level depth coefficient at T-levels
-   USE dom_oce , ONLY :   gsigw      =>  gsigw       !: model level depth coefficient at W-levels
-   USE dom_oce , ONLY :   gsi3w      =>  gsi3w       !: model level depth coef at w-levels (defined as the sum of e3w)
-   USE dom_oce , ONLY :   esigt      =>  esigt       !: vertical scale factor coef. at t-levels
-   USE dom_oce , ONLY :   esigw      =>  esigw       !: vertical scale factor coef. at w-levels
-   USE dom_oce , ONLY :   lk_vvl     =>  lk_vvl      !: variable grid flag
-# if defined key_vvl
-   USE dom_oce , ONLY :   gdep3w_1   =>  gdep3w_1    !: ???
-   USE dom_oce , ONLY :   gdept_1    =>  gdept_1     !: depth of t-points (m)
-   USE dom_oce , ONLY :   gdepw_1    =>  gdepw_1     !: depth of t-points (m)
-   USE dom_oce , ONLY :   e3t_1      =>  e3t_1       !: vertical scale factors at t-
-   USE dom_oce , ONLY :   e3u_1      =>  e3u_1       !: vertical scale factors at u-
-   USE dom_oce , ONLY :   e3v_1      =>  e3v_1       !: vertical scale factors v-
-   USE dom_oce , ONLY :   e3w_1      =>  e3w_1       !: w-points (m)
-   USE dom_oce , ONLY :   e3f_1      =>  e3f_1       !: f-points (m)
-   USE dom_oce , ONLY :   e3uw_1     =>  e3uw_1      !: uw-points (m)
-   USE dom_oce , ONLY :   e3vw_1     =>  e3vw_1      !: vw-points (m)
-# endif
-   !* masks, bathymetry *
-   USE dom_oce , ONLY :   mbkt       =>   mbkt       !: vertical index of the bottom last T- ocean level
-   USE dom_oce , ONLY :   mbku       =>   mbku       !: vertical index of the bottom last U- ocean level
-   USE dom_oce , ONLY :   mbkv       =>   mbkv       !: vertical index of the bottom last V- ocean level
-   USE dom_oce , ONLY :   tmask_i    =>   tmask_i    !: Interior mask at t-points
-   USE dom_oce , ONLY :   tmask      =>   tmask      !: land/ocean mask at t-points
-   USE dom_oce , ONLY :   umask      =>   umask      !: land/ocean mask at u-points   
-   USE dom_oce , ONLY :   vmask      =>   vmask      !: land/ocean mask at v-points 
-   USE dom_oce , ONLY :   fmask      =>   fmask      !: land/ocean mask at f-points 
-
-   !* time domain *
-   USE dom_oce , ONLY :   neuler     =>   neuler     !: restart euler forward option (0=Euler)
-   USE dom_oce , ONLY :   rdt        =>   rdt        !: time step for the dynamics 
-   USE dom_oce , ONLY :   atfp       =>   atfp       !: asselin time filter parameter
-   USE dom_oce , ONLY :   atfp1      =>   atfp1      !: asselin time filter coeff. (atfp1= 1-2*atfp)
-   USE dom_oce , ONLY :   rdttra     =>   rdttra     !: vertical profile of tracer time step
-   !                                                 !: it is the accumulated duration of previous runs
-   !                                                 !: that may have been run with different time steps.
-   !* calendar variables *
-   USE dom_oce , ONLY :   nyear      =>   nyear      !: current year
-   USE dom_oce , ONLY :   nmonth     =>   nmonth     !: current month
-   USE dom_oce , ONLY :   nday       =>   nday       !: current day of the month
-   USE dom_oce , ONLY :   ndastp     =>   ndastp     !: time step date in yyyymmdd format
-   USE dom_oce , ONLY :   nday_year  =>   nday_year  !: current day counted from jan 1st of the current year
-   USE dom_oce , ONLY :   nsec_year  =>   nsec_year  !: current time step counted in second since 00h jan 1st of the current year
-   USE dom_oce , ONLY :   nsec_month =>   nsec_month !: current time step counted in second since 00h 1st day of the current month
-   USE dom_oce , ONLY :   nsec_day   =>   nsec_day   !: current time step counted in second since 00h of the current day
-   USE dom_oce , ONLY :   fjulday    =>   fjulday    !: julian day
-   USE dom_oce , ONLY :   adatrj     =>   adatrj     !: number of elapsed days since the begining of the whole simulation
-                                                     !: (cumulative duration of previous runs 
-                                                     !: that may have used different time-step size)
-   USE dom_oce , ONLY :   nyear_len  =>   nyear_len  !: length in days of the previous/current year
-   USE dom_oce , ONLY :   nmonth_len =>   nmonth_len !: length in days of the months of the current year
+   USE dom_oce 
 
 
@@ -217,6 +91,4 @@
    USE oce , ONLY :   grv     =>    grv     !: 
 #endif
-
-   USE dom_oce , ONLY :   nn_cla    =>  nn_cla        !: flag (0/1) for cross land advection 
 
    !* surface fluxes *
Index: /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90
===================================================================
--- /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90	(revision 3565)
+++ /branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90	(revision 3566)
@@ -17,4 +17,5 @@
    USE par_trc          ! TOP parameters
    USE oce_trc          ! ocean space and time domain variables
+   USE prtctl           ! print control for OPA
 
    IMPLICIT NONE
@@ -296,157 +297,4 @@
    END SUBROUTINE prt_ctl_trc_init
 
-
-   SUBROUTINE sub_dom
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE sub_dom  ***
-      !!                    
-      !! ** Purpose :   Lay out the global domain over processors. 
-      !!                CAUTION: 
-      !!                This part has been extracted from the mpp_init
-      !!                subroutine and names of variables/arrays have been 
-      !!                slightly changed to avoid confusion but the computation
-      !!                is exactly the same. Any modification about indices of
-      !!                each sub-domain in the mppini.F90 module should be reported 
-      !!                here.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!                Periodic condition is a function of the local domain position
-      !!                (global boundary or neighbouring domain) and of the global
-      !!                periodic
-      !!                Type :         jperio global periodic condition
-      !!                               nperio local  periodic condition
-      !!
-      !! ** Action  : - set domain parameters
-      !!                    nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlcil      : first dimension
-      !!                    nlcjl      : second dimension
-      !!                    nbondil    : mark for "east-west local boundary"
-      !!                    nbondjl    : mark for "north-south local boundary"
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj, js               ! dummy loop indices
-      INTEGER ::   ii, ij                   ! temporary integers
-      INTEGER ::   irestil, irestjl         !    "          "
-      INTEGER ::   ijpi  , ijpj, nlcil      ! temporary logical unit
-      INTEGER ::   nlcjl , nbondil, nbondjl
-      INTEGER ::   nrecil, nrecjl, nldil, nleil, nldjl, nlejl
-      REAL(wp) ::   zidom, zjdom            ! temporary scalars
-      INTEGER, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! temporary workspace
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
-      !
-      ! Dimension arrays for subdomains
-      ! -------------------------------
-      !  Computation of local domain sizes ilcitl() ilcjtl()
-      !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array (cf. par_oce.F90).
-
-      ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci
-      ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj
-
-      nrecil  = 2 * jpreci
-      nrecjl  = 2 * jprecj
-      irestil = MOD( jpiglo - nrecil , isplt )
-      irestjl = MOD( jpjglo - nrecjl , jsplt )
-
-      IF(  irestil == 0 )   irestil = isplt
-      DO jj = 1, jsplt
-         DO ji = 1, irestil
-            ilcitl(ji,jj) = ijpi
-         END DO
-         DO ji = irestil+1, isplt
-            ilcitl(ji,jj) = ijpi -1
-         END DO
-      END DO
-      
-      IF( irestjl == 0 )   irestjl = jsplt
-      DO ji = 1, isplt
-         DO jj = 1, irestjl
-            ilcjtl(ji,jj) = ijpj
-         END DO
-         DO jj = irestjl+1, jsplt
-            ilcjtl(ji,jj) = ijpj -1
-         END DO
-      END DO
-      
-      zidom = nrecil
-      DO ji = 1, isplt
-         zidom = zidom + ilcitl(ji,1) - nrecil
-      END DO
-      
-      zjdom = nrecjl
-      DO jj = 1, jsplt
-         zjdom = zjdom + ilcjtl(1,jj) - nrecjl
-      END DO
-
-      ! Index arrays for subdomains
-      ! ---------------------------
-
-      iimpptl(:,:) = 1
-      ijmpptl(:,:) = 1
-      
-      IF( isplt > 1 ) THEN
-         DO jj = 1, jsplt
-            DO ji = 2, isplt
-               iimpptl(ji,jj) = iimpptl(ji-1,jj) + ilcitl(ji-1,jj) - nrecil
-            END DO
-         END DO
-      ENDIF
-
-      IF( jsplt > 1 ) THEN
-         DO jj = 2, jsplt
-            DO ji = 1, isplt
-               ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ilcjtl(ji,jj-1)-nrecjl
-            END DO
-         END DO
-      ENDIF
-      
-      ! Subdomain description
-      ! ---------------------
-
-      DO js = 1, ijsplt
-         ii = 1 + MOD( js-1, isplt )
-         ij = 1 + (js-1) / isplt
-         nimpptl(js) = iimpptl(ii,ij)
-         njmpptl(js) = ijmpptl(ii,ij)
-         nlcitl (js) = ilcitl (ii,ij)     
-         nlcil       = nlcitl (js)     
-         nlcjtl (js) = ilcjtl (ii,ij)     
-         nlcjl       = nlcjtl (js)
-         nbondjl = -1                                    ! general case
-         IF( js   >  isplt          )   nbondjl = 0      ! first row of processor
-         IF( js   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor
-         IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction
-         ibonjtl(js) = nbondjl
-         
-         nbondil = 0                                     ! 
-         IF( MOD( js, isplt ) == 1 )   nbondil = -1      !
-         IF( MOD( js, isplt ) == 0 )   nbondil =  1      !
-         IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction
-         ibonitl(js) = nbondil
-         
-         nldil =  1   + jpreci
-         nleil = nlcil - jpreci
-         IF( nbondil == -1 .OR. nbondil == 2 )   nldil = 1
-         IF( nbondil ==  1 .OR. nbondil == 2 )   nleil = nlcil
-         nldjl =  1   + jprecj
-         nlejl = nlcjl - jprecj
-         IF( nbondjl == -1 .OR. nbondjl == 2 )   nldjl = 1
-         IF( nbondjl ==  1 .OR. nbondjl == 2 )   nlejl = nlcjl
-         nlditl(js) = nldil
-         nleitl(js) = nleil
-         nldjtl(js) = nldjl
-         nlejtl(js) = nlejl
-      END DO
-      !
-      CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
-      !
-   END SUBROUTINE sub_dom
- 
 #else
    !!----------------------------------------------------------------------
