Index: /codes/icosagcm/trunk/src/advect.f90
===================================================================
--- /codes/icosagcm/trunk/src/advect.f90	(revision 147)
+++ /codes/icosagcm/trunk/src/advect.f90	(revision 148)
@@ -11,8 +11,9 @@
   !==========================================================================
 
-  SUBROUTINE init_advect(normal,tangent)
+  SUBROUTINE init_advect(normal,tangent,one_over_sqrt_leng)
     IMPLICIT NONE
     REAL(rstd),INTENT(OUT) :: normal(3*iim*jjm,3)
     REAL(rstd),INTENT(OUT) :: tangent(3*iim*jjm,3)
+    REAL(rstd),INTENT(OUT) :: one_over_sqrt_leng(iim*jjm)
 
     INTEGER :: i,j,n
@@ -39,5 +40,9 @@
           tangent(n+u_ldown,:)=xyz_v(n+z_down,:)-xyz_v(n+z_ldown,:)
           tangent(n+u_ldown,:)=tangent(n+u_ldown,:)/sqrt(sum(tangent(n+u_ldown,:)**2)+1e-50)
-       END DO
+
+          one_over_sqrt_leng(n) = 1./sqrt(max(sum((xyz_v(n+z_up,:) - xyz_i(n,:))**2),sum((xyz_v(n+z_down,:) - xyz_i(n,:))**2), &
+                                          sum((xyz_v(n+z_rup,:) - xyz_i(n,:))**2),sum((xyz_v(n+z_rdown,:) - xyz_i(n,:))**2),  &
+                                          sum((xyz_v(n+z_lup,:) - xyz_i(n,:))**2),sum((xyz_v(n+z_ldown,:) - xyz_i(n,:))**2)) )
+       ENDDO
     ENDDO
 
@@ -46,15 +51,19 @@
   !=======================================================================================
 
-  SUBROUTINE compute_gradq3d(qi,gradq3d)
+  SUBROUTINE compute_gradq3d(qi,one_over_sqrt_leng,gradq3d)
+    USE trace
     IMPLICIT NONE
     REAL(rstd),INTENT(IN)  :: qi(iim*jjm,llm)
+    REAL(rstd),INTENT(IN)  :: one_over_sqrt_leng(iim*jjm)
     REAL(rstd),INTENT(OUT) :: gradq3d(iim*jjm,llm,3) 
     REAL(rstd) :: maxq,minq,minq_c,maxq_c 
-    REAL(rstd) :: alphamx,alphami,alpha	,maggrd,leng
+    REAL(rstd) :: alphamx,alphami,alpha	,maggrd
     REAL(rstd) :: leng1,leng2
     REAL(rstd) :: arr(2*iim*jjm)
+    REAL(rstd) :: ar(iim*jjm)
     REAL(rstd) :: gradtri(2*iim*jjm,llm,3) 
-    REAL(rstd) :: ar
     INTEGER :: i,j,n,k,ind,l
+
+    CALL trace_start("compute_gradq3d")
 
     ! TODO : precompute ar, drop arr as output argument of gradq ?
@@ -67,22 +76,29 @@
           DO i=ii_begin-1,ii_end+1
              n=(j-1)*iim+i   
-             CALL gradq(n,n+t_rup,n+t_lup,n+z_up,qi(:,l),gradtri(n+z_up,l,:),arr(n+z_up))
-             CALL gradq(n,n+t_ldown,n+t_rdown,n+z_down,qi(:,l),gradtri(n+z_down,l,:),arr(n+z_down))
+             CALL gradq(n,l,n+t_rup,n+t_lup,n+z_up,qi,gradtri(n+z_up,l,:),arr(n+z_up))
+             CALL gradq(n,l,n+t_ldown,n+t_rdown,n+z_down,qi,gradtri(n+z_down,l,:),arr(n+z_down))
           END DO
        END DO
     END DO
 
-    !      Do l =1,llm
-    DO j=jj_begin,jj_end
-       DO i=ii_begin,ii_end
-          n=(j-1)*iim+i
-          gradq3d(n,:,:) = gradtri(n+z_up,:,:) + gradtri(n+z_down,:,:)   +   &
-               gradtri(n+z_rup,:,:) +  gradtri(n+z_ldown,:,:)   +   & 
-               gradtri(n+z_lup,:,:)+    gradtri(n+z_rdown,:,:)  
-          ar = arr(n+z_up)+arr(n+z_lup)+arr(n+z_ldown)+arr(n+z_down)+arr(n+z_rdown)+arr(n+z_rup)
-          gradq3d(n,:,:) = gradq3d(n,:,:)/(ar+1.e-50) 
-       END DO
-    END DO
-    !	 END DO
+    DO j=jj_begin-1,jj_end+1
+      DO i=ii_begin-1,ii_end+1
+         n=(j-1)*iim+i   
+         ar(n) = arr(n+z_up)+arr(n+z_lup)+arr(n+z_ldown)+arr(n+z_down)+arr(n+z_rdown)+arr(n+z_rup)+1.e-50
+      ENDDO
+    ENDDO
+      
+    DO k=1,3
+      DO l =1,llm
+        DO j=jj_begin,jj_end
+           DO i=ii_begin,ii_end
+              n=(j-1)*iim+i
+              gradq3d(n,l,k) = ( gradtri(n+z_up,l,k) + gradtri(n+z_down,l,k)   +   &
+                                 gradtri(n+z_rup,l,k) +  gradtri(n+z_ldown,l,k)   +   & 
+                                 gradtri(n+z_lup,l,k)+    gradtri(n+z_rdown,l,k) ) / ar(n)  
+           END DO
+        END DO
+      END DO
+    ENDDO
 
     !============================================================================================= LIMITING 
@@ -94,9 +110,11 @@
              maggrd =  dot_product(gradq3d(n,l,:),gradq3d(n,l,:))
              maggrd = sqrt(maggrd) 
-             leng = max(sum((xyz_v(n+z_up,:) - xyz_i(n,:))**2),sum((xyz_v(n+z_down,:) - xyz_i(n,:))**2), &
-                  sum((xyz_v(n+z_rup,:) - xyz_i(n,:))**2),sum((xyz_v(n+z_rdown,:) - xyz_i(n,:))**2),  &
-                  sum((xyz_v(n+z_lup,:) - xyz_i(n,:))**2),sum((xyz_v(n+z_ldown,:) - xyz_i(n,:))**2))
-             maxq_c = qi(n,l) + maggrd*sqrt(leng)
-             minq_c = qi(n,l) - maggrd*sqrt(leng)
+!             leng = max(sum((xyz_v(n+z_up,:) - xyz_i(n,:))**2),sum((xyz_v(n+z_down,:) - xyz_i(n,:))**2), &
+!                  sum((xyz_v(n+z_rup,:) - xyz_i(n,:))**2),sum((xyz_v(n+z_rdown,:) - xyz_i(n,:))**2),  &
+!                  sum((xyz_v(n+z_lup,:) - xyz_i(n,:))**2),sum((xyz_v(n+z_ldown,:) - xyz_i(n,:))**2))
+!             maxq_c = qi(n,l) + maggrd*sqrt(leng(n))
+!             minq_c = qi(n,l) - maggrd*sqrt(leng(n))
+             maxq_c = qi(n,l) + maggrd*one_over_sqrt_leng(n)
+             minq_c = qi(n,l) - maggrd*one_over_sqrt_leng(n)
              maxq = max(qi(n,l),qi(n+t_right,l),qi(n+t_lup,l),qi(n+t_rup,l),qi(n+t_left,l), &
                   qi(n+t_rdown,l),qi(n+t_ldown,l))
@@ -112,8 +130,11 @@
        END DO
     END DO
+
+  CALL trace_end("compute_gradq3d")
   END SUBROUTINE compute_gradq3d
 
   ! Backward trajectories, for use with Miura approach
   SUBROUTINE compute_backward_traj(normal,tangent,ue,tau, cc)
+    USE trace
     IMPLICIT NONE
     REAL(rstd),INTENT(IN)    :: normal(3*iim*jjm,3)
@@ -125,4 +146,6 @@
     REAL(rstd) :: v_e(3), up_e, qe, ed(3)    
     INTEGER :: i,j,n,l
+
+    CALL trace_start("compute_backward_traj")
 
     ! TODO : compute normal displacement ue*tau as hfluxt / mass(upwind) then reconstruct tangential displacement
@@ -181,4 +204,7 @@
        ENDDO
     END DO
+
+    CALL trace_end("compute_backward_traj")
+
   END SUBROUTINE compute_backward_traj
 
@@ -186,4 +212,5 @@
   ! Slope-limited van Leer approach with hexagons
   SUBROUTINE compute_advect_horiz(update_mass,hfluxt,cc,gradq3d, mass,qi) 
+    USE trace
     IMPLICIT NONE
     LOGICAL, INTENT(IN)       :: update_mass
@@ -197,4 +224,6 @@
     REAL(rstd) :: qflux(3*iim*jjm,llm)
     INTEGER :: i,j,n,k,l
+
+    CALL trace_start("compute_advect_horiz")
 
     ! evaluate tracer field at point cc using piecewise linear reconstruction
@@ -262,4 +291,5 @@
     END DO
 
+    CALL trace_end("compute_advect_horiz")
   CONTAINS
 
@@ -275,8 +305,8 @@
 
   !==========================================================================
-  PURE SUBROUTINE gradq(n0,n1,n2,n3,q,dq,det)
-    IMPLICIT NONE
-    INTEGER, INTENT(IN) :: n0,n1,n2,n3
-    REAL(rstd), INTENT(IN)     :: q(iim*jjm)
+  PURE SUBROUTINE gradq(n0,l,n1,n2,n3,q,dq,det)
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: n0,l,n1,n2,n3
+    REAL(rstd), INTENT(IN)     :: q(iim*jjm,llm)
     REAL(rstd), INTENT(OUT)    :: dq(3), det
     
@@ -293,6 +323,6 @@
     A(3,1)=xyz_v(n3,1);              A(3,2)= xyz_v(n3,2);            A(3,3)=xyz_v(n3,3)
 
-    dq(1) = q(n1)-q(n0)
-    dq(2) = q(n2)-q(n0)
+    dq(1) = q(n1,l)-q(n0,l)
+    dq(2) = q(n2,l)-q(n0,l)
     dq(3) = 0.0
     !    CALL DGESV(3,1,A,3,IPIV,dq(:),3,info)
Index: /codes/icosagcm/trunk/src/advect_tracer.f90
===================================================================
--- /codes/icosagcm/trunk/src/advect_tracer.f90	(revision 147)
+++ /codes/icosagcm/trunk/src/advect_tracer.f90	(revision 148)
@@ -8,5 +8,6 @@
   TYPE(t_field),POINTER :: f_gradq3d(:)
   TYPE(t_field),POINTER :: f_cc(:)  ! starting point of backward-trajectory (Miura approach)
-
+  TYPE(t_field),POINTER :: f_one_over_sqrt_leng(:)
+ 
   REAL(rstd), PARAMETER :: pente_max=2.0 ! for vlz
 
@@ -19,4 +20,5 @@
     REAL(rstd),POINTER :: tangent(:,:)
     REAL(rstd),POINTER :: normal(:,:)
+    REAL(rstd),POINTER :: one_over_sqrt_leng(:)
     INTEGER :: ind
 
@@ -25,4 +27,5 @@
     CALL allocate_field(f_gradq3d,field_t,type_real,llm,3, name='gradq3d')
     CALL allocate_field(f_cc,field_u,type_real,llm,3, name='cc')
+    CALL allocate_field(f_one_over_sqrt_leng,field_t,type_real, name='one_over_sqrt_leng')
 
     DO ind=1,ndomain
@@ -31,5 +34,6 @@
        normal=f_normal(ind)
        tangent=f_tangent(ind)
-       CALL init_advect(normal,tangent)
+       one_over_sqrt_leng=f_one_over_sqrt_leng(ind)
+       CALL init_advect(normal,tangent,one_over_sqrt_leng)
     END DO
 
@@ -49,5 +53,5 @@
     TYPE(t_field),POINTER :: f_rhodz(:)    ! mass field at beginning of macro time step
 
-    REAL(rstd),POINTER :: q(:,:,:), normal(:,:), tangent(:,:), gradq3d(:,:,:), cc(:,:,:)
+    REAL(rstd),POINTER :: q(:,:,:), normal(:,:), tangent(:,:), one_over_sqrt_leng(:), gradq3d(:,:,:), cc(:,:,:)
     REAL(rstd),POINTER :: hfluxt(:,:), wfluxt(:,:)
     REAL(rstd),POINTER :: rhodz(:,:), u(:,:) 
@@ -106,12 +110,14 @@
        rhodz   = f_rhodz(ind)
        wfluxt  = f_wfluxt(ind) 
+
        DO k = 1, nqtot
-          CALL vlz(k==nqtot,0.5, wfluxt,rhodz,q(:,:,k))
-       END DO
+          CALL vlz(k==nqtot,0.5, wfluxt,rhodz,q(:,:,k),1)
+       END DO
+
        CALL compute_backward_traj(tangent,normal,u,0.5*dt*itau_adv, cc) 
     END DO
 
-    CALL transfert_request(f_q,req_i1)      ! necessary ?
-    CALL transfert_request(f_rhodz,req_i1)  ! necessary ?
+!    CALL transfert_request(f_q,req_i1)      ! necessary ?
+!    CALL transfert_request(f_rhodz,req_i1)  ! necessary ?
 
     ! horizontal transport - split in two to place transfer of gradq3d
@@ -123,8 +129,11 @@
           q       = f_q(ind)
           gradq3d = f_gradq3d(ind)
-          CALL compute_gradq3d(q(:,:,k),gradq3d)
+          one_over_sqrt_leng=f_one_over_sqrt_leng(ind)
+          CALL compute_gradq3d(q(:,:,k),one_over_sqrt_leng,gradq3d)
        END DO
 
        CALL transfert_request(f_gradq3d,req_i1)
+
+
 
        DO ind=1,ndomain
@@ -140,6 +149,6 @@
     END DO 
     
-    CALL transfert_request(f_q,req_i1)      ! necessary ?
-    CALL transfert_request(f_rhodz,req_i1)  ! necessary ?
+!    CALL transfert_request(f_q,req_i1)      ! necessary ?
+!    CALL transfert_request(f_rhodz,req_i1)  ! necessary ?
     
     ! 1/2 vertical transport
@@ -151,5 +160,5 @@
        wfluxt  = f_wfluxt(ind) 
        DO k = 1,nqtot
-          CALL vlz(k==nqtot, 0.5,wfluxt,rhodz, q(:,:,k))
+          CALL vlz(k==nqtot, 0.5,wfluxt,rhodz, q(:,:,k),0)
        END DO
     END DO
@@ -159,5 +168,5 @@
   END SUBROUTINE advect_tracer
 
-  SUBROUTINE vlz(update_mass, fac,wfluxt,mass, q)
+  SUBROUTINE vlz(update_mass, fac,wfluxt,mass, q, halo)
     !
     !     Auteurs:   P.Le Van, F.Hourdin, F.Forget, T. Dubos
@@ -168,4 +177,5 @@
     !     wfluxt >0 for upward transport
     !    ********************************************************************
+    USE trace
     IMPLICIT NONE
     LOGICAL, INTENT(IN)       :: update_mass
@@ -173,4 +183,5 @@
     REAL(rstd), INTENT(INOUT) :: mass(iim*jjm,llm)
     REAL(rstd), INTENT(INOUT) :: q(iim*jjm,llm)
+    INTEGER, INTENT(IN) :: halo
 
     REAL(rstd) :: dq(iim*jjm,llm), & ! increase of q
@@ -182,8 +193,10 @@
     INTEGER :: i,ij,l,j
 
+    CALL trace_start("vlz")
+
     ! finite difference of q
     DO l=2,llm
-       DO j=jj_begin-1,jj_end+1
-          DO i=ii_begin-1,ii_end+1
+       DO j=jj_begin-halo,jj_end+halo
+          DO i=ii_begin-halo,ii_end+halo
              ij=(j-1)*iim+i
              dzqw(ij,l)=q(ij,l)-q(ij,l-1)
@@ -196,6 +209,6 @@
     ! dzq = slope*dz, i.e. the reconstructed q varies by dzq inside level l
     DO l=2,llm-1
-       DO j=jj_begin-1,jj_end+1
-          DO i=ii_begin-1,ii_end+1
+       DO j=jj_begin-halo,jj_end+halo
+          DO i=ii_begin-halo,ii_end+halo
              ij=(j-1)*iim+i
              IF(dzqw(ij,l)*dzqw(ij,l+1).gt.0.) THEN
@@ -211,6 +224,6 @@
 
     ! 0 slope in top and bottom layers
-    DO j=jj_begin-1,jj_end+1
-       DO i=ii_begin-1,ii_end+1
+    DO j=jj_begin-halo,jj_end+halo
+       DO i=ii_begin-halo,ii_end+halo
           ij=(j-1)*iim+i
           dzq(ij,1)=0.
@@ -222,6 +235,6 @@
     ! then amount of q leaving level l/l+1 = wq = w * qq
     DO l = 1,llm-1
-       DO j=jj_begin-1,jj_end+1
-          DO i=ii_begin-1,ii_end+1
+       DO j=jj_begin-halo,jj_end+halo
+          DO i=ii_begin-halo,ii_end+halo
              ij=(j-1)*iim+i
              w = fac*wfluxt(ij,l+1)
@@ -238,6 +251,6 @@
     END DO
     ! wq = 0 at top and bottom
-    DO j=jj_begin-1,jj_end+1
-       DO i=ii_begin-1,ii_end+1
+    DO j=jj_begin-halo,jj_end+halo
+       DO i=ii_begin-halo,ii_end+halo
           ij=(j-1)*iim+i
           wq(ij,llm+1)=0.
@@ -248,6 +261,6 @@
     ! update q, mass is updated only after all q's have been updated
     DO l=1,llm
-       DO j=jj_begin-1,jj_end+1
-          DO i=ii_begin-1,ii_end+1
+       DO j=jj_begin-halo,jj_end+halo
+          DO i=ii_begin-halo,ii_end+halo
              ij=(j-1)*iim+i
              newmass = mass(ij,l) + fac*(wfluxt(ij,l)-wfluxt(ij,l+1))
@@ -258,4 +271,6 @@
     END DO
 
+    CALL trace_end("vlz")
+
   END SUBROUTINE vlz
 
Index: /codes/icosagcm/trunk/src/caldyn_gcm_opt.f90
===================================================================
--- /codes/icosagcm/trunk/src/caldyn_gcm_opt.f90	(revision 147)
+++ /codes/icosagcm/trunk/src/caldyn_gcm_opt.f90	(revision 148)
@@ -111,5 +111,4 @@
     
     CALL trace_start("caldyn")
-    CALL transfert_request(f_phis,req_i1) 
     CALL transfert_request(f_ps,req_i1) 
     CALL transfert_request(f_theta_rhodz,req_i1) 
Index: /codes/icosagcm/trunk/src/dissip_gcm.f90
===================================================================
--- /codes/icosagcm/trunk/src/dissip_gcm.f90	(revision 147)
+++ /codes/icosagcm/trunk/src/dissip_gcm.f90	(revision 148)
@@ -27,5 +27,5 @@
   REAL, save    :: rayleigh_tau
   
-  INTEGER,SAVE :: idissip
+!  INTEGER,SAVE :: itau_dissip
   REAL,SAVE    :: dtdissip
   
@@ -57,4 +57,5 @@
   USE mpi_mod
   USE mpipara
+  USE time_mod
   
   IMPLICIT NONE
@@ -75,4 +76,5 @@
   INTEGER               :: l
   CHARACTER(len=255)    :: rayleigh_friction_key
+  REAL(rstd)            :: mintau
   
             
@@ -415,9 +417,16 @@
        tau_divgrad(l) = tau_divgrad(l)/zvert
     ENDDO
+
+    mintau=tau_graddiv(1)
+    DO l=1,llm
+      mintau=MIN(mintau,tau_graddiv(l))
+      mintau=MIN(mintau,tau_gradrot(l))
+      mintau=MIN(mintau,tau_divgrad(l))
+    ENDDO
        
-!    idissip=INT(MIN(tetagdiv,tetagrot)/(2.*dt))
-!    idissip=MAX(1,idissip)
-!    dtdissip=idissip*dt
-!    PRINT *,"idissip",idissip," dtdissip ",dtdissip
+    itau_dissip=INT(mintau/dt)
+    itau_dissip=MAX(1,itau_dissip)
+    dtdissip=itau_dissip*dt
+    IF (is_mpi_root) PRINT *,"mintau ",mintau,"itau_dissip",itau_dissip," dtdissip ",dtdissip
 
   END SUBROUTINE init_dissip 
@@ -431,4 +440,5 @@
   USE geopotential_mod
   USE trace
+  USE time_mod
   IMPLICIT NONE
     TYPE(t_field),POINTER :: f_ue(:)
@@ -475,9 +485,9 @@
             n=(j-1)*iim+i
 
-            due(n+u_right,l) = -0.5*( due_diss1(n+u_right,l)/tau_graddiv(l) + due_diss2(n+u_right,l)/tau_gradrot(l) )
-            due(n+u_lup,l)   = -0.5*( due_diss1(n+u_lup,l)  /tau_graddiv(l) + due_diss2(n+u_lup,l)  /tau_gradrot(l) )
-            due(n+u_ldown,l) = -0.5*( due_diss1(n+u_ldown,l)/tau_graddiv(l) + due_diss2(n+u_ldown,l)/tau_gradrot(l) )
-
-            dtheta_rhodz(n,l) = -0.5*dtheta_rhodz_diss(n,l)/tau_divgrad(l)
+            due(n+u_right,l) = -0.5*( due_diss1(n+u_right,l)/tau_graddiv(l) + due_diss2(n+u_right,l)/tau_gradrot(l))*itau_dissip 
+            due(n+u_lup,l)   = -0.5*( due_diss1(n+u_lup,l)  /tau_graddiv(l) + due_diss2(n+u_lup,l)  /tau_gradrot(l))*itau_dissip
+            due(n+u_ldown,l) = -0.5*( due_diss1(n+u_ldown,l)/tau_graddiv(l) + due_diss2(n+u_ldown,l)/tau_gradrot(l))*itau_dissip
+
+            dtheta_rhodz(n,l) = -0.5*dtheta_rhodz_diss(n,l)/tau_divgrad(l)*itau_dissip
           ENDDO
         ENDDO
@@ -736,16 +746,9 @@
     REAL(rstd),INTENT(IN)  :: ue(iim*3*jjm,ll)
     REAL(rstd),INTENT(OUT) :: gradivu_e(iim*3*jjm,ll)
-    REAL(rstd),SAVE,ALLOCATABLE :: divu_i(:,:)
+    REAL(rstd) :: divu_i(iim*jjm,ll)
     
     INTEGER :: i,j,n,l
 
-!$OMP BARRIER
-!$OMP MASTER
-      ALLOCATE(divu_i(iim*jjm,ll))
-!$OMP END MASTER
-!$OMP BARRIER
-
     DO l=1,ll
-!$OMP DO
       DO j=jj_begin,jj_end
         DO i=ii_begin,ii_end
@@ -762,5 +765,4 @@
     
     DO l=1,ll
-!$OMP DO
       DO j=jj_begin,jj_end
         DO i=ii_begin,ii_end
@@ -779,5 +781,4 @@
 
     DO l=1,ll
-!$OMP DO
       DO j=jj_begin,jj_end
         DO i=ii_begin,ii_end
@@ -790,11 +791,5 @@
     ENDDO
 
-!$OMP BARRIER
-!$OMP MASTER
-      DEALLOCATE(divu_i)
-!$OMP END MASTER
-!$OMP BARRIER
-
-    
+   
   END SUBROUTINE compute_gradiv
   
@@ -805,16 +800,10 @@
     REAL(rstd),INTENT(IN)  :: theta(iim*jjm,ll)
     REAL(rstd),INTENT(OUT) :: divgrad_i(iim*jjm,ll)
-    REAL(rstd),SAVE,ALLOCATABLE :: grad_e(:,:)
+    REAL(rstd)  :: grad_e(3*iim*jjm,ll)
 
     INTEGER :: i,j,n,l
 
-!$OMP BARRIER
-!$OMP MASTER
-      ALLOCATE(grad_e(3*iim*jjm,ll))
-!$OMP END MASTER
-!$OMP BARRIER
-        
+       
     DO l=1,ll
-!$OMP DO
       DO j=jj_begin-1,jj_end+1
         DO i=ii_begin-1,ii_end+1
@@ -834,5 +823,4 @@
     
     DO l=1,ll
-!$OMP DO
       DO j=jj_begin,jj_end
         DO i=ii_begin,ii_end
@@ -849,5 +837,4 @@
    
     DO l=1,ll
-!$OMP DO
       DO j=jj_begin,jj_end
         DO i=ii_begin,ii_end
@@ -857,10 +844,4 @@
       ENDDO
     ENDDO
-
-!$OMP BARRIER
-!$OMP MASTER
-      DEALLOCATE(grad_e)
-!$OMP END MASTER
-!$OMP BARRIER
 
   END SUBROUTINE compute_divgrad
@@ -873,16 +854,9 @@
     REAL(rstd),INTENT(IN)  :: ue(iim*3*jjm,ll)
     REAL(rstd),INTENT(OUT) :: gradrot_e(iim*3*jjm,ll)
-    REAL(rstd),SAVE,ALLOCATABLE  :: rot_v(:,:)
+    REAL(rstd) :: rot_v(2*iim*jjm,ll)
 
     INTEGER :: i,j,n,l
-
-!$OMP BARRIER
-!$OMP MASTER
-      ALLOCATE(rot_v(2*iim*jjm,ll))
-!$OMP END MASTER
-!$OMP BARRIER
      
     DO l=1,ll
-!$OMP DO
       DO j=jj_begin-1,jj_end+1
         DO i=ii_begin-1,ii_end+1
@@ -902,5 +876,4 @@
   
     DO l=1,ll
-!$OMP DO
       DO j=jj_begin,jj_end
         DO i=ii_begin,ii_end
@@ -918,5 +891,4 @@
 
     DO l=1,ll
-!$OMP DO
       DO j=jj_begin,jj_end
         DO i=ii_begin,ii_end
@@ -930,10 +902,4 @@
       ENDDO
     ENDDO  
-    
-!$OMP BARRIER
-!$OMP MASTER
-      DEALLOCATE(rot_v)
-!$OMP END MASTER
-!$OMP BARRIER 
    
   END SUBROUTINE compute_gradrot
Index: /codes/icosagcm/trunk/src/timeloop_gcm.f90
===================================================================
--- /codes/icosagcm/trunk/src/timeloop_gcm.f90	(revision 147)
+++ /codes/icosagcm/trunk/src/timeloop_gcm.f90	(revision 148)
@@ -6,4 +6,5 @@
 
   INTEGER, PARAMETER :: euler=1, rk4=2, mlf=3
+  INTEGER  :: itau_sync=10
 
 CONTAINS
@@ -19,4 +20,5 @@
   USE mpipara
   USE trace
+  USE transfert_mod
   IMPLICIT NONE
   TYPE(t_field),POINTER :: f_phis(:)
@@ -47,4 +49,5 @@
   CHARACTER(len=255) :: scheme_name
   LOGICAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating fluxes in time
+  LOGICAL, PARAMETER :: check=.FALSE.
 !  INTEGER :: itaumax
 !  REAL(rstd) ::write_period
@@ -132,5 +135,6 @@
   CALL init_advect_tracer
   CALL init_physics
-  
+
+   
   CALL etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
   CALL writefield("phis",f_phis,once=.TRUE.)
@@ -155,6 +159,15 @@
   END DO
   
+  CALL transfert_request(f_phis,req_i0) 
+  CALL transfert_request(f_phis,req_i1) 
+
   DO it=0,itaumax
-
+    IF (MOD(it,itau_sync)==0) THEN
+      CALL transfert_request(f_ps,req_i0)
+      CALL transfert_request(f_theta_rhodz,req_i0) 
+      CALL transfert_request(f_u,req_e0_vect)
+      CALL transfert_request(f_q,req_i0) 
+    ENDIF
+    
     IF (is_mpi_root) PRINT *,"It No :",It,"   t :",dt*It
     IF (mod(it,itau_out)==0 ) THEN
@@ -188,9 +201,11 @@
     END DO
 
-    CALL dissip(f_u,f_du,f_ps,f_phis, f_theta_rhodz,f_dtheta_rhodz)
-    CALL euler_scheme(.FALSE.)
+    IF (MOD(it+1,itau_dissip)==0) THEN
+      CALL dissip(f_u,f_du,f_ps,f_phis, f_theta_rhodz,f_dtheta_rhodz)
+      CALL euler_scheme(.FALSE.)
+    ENDIF
 
     IF(MOD(it+1,itau_adv)==0) THEN
-       CALL transfert_request(f_wfluxt,req_i1) ! FIXME
+!       CALL transfert_request(f_wfluxt,req_i1) ! FIXME
 !       CALL transfert_request(f_hfluxt,req_e1) ! FIXME
 
@@ -199,15 +214,17 @@
 
        ! FIXME : check that rhodz is consistent with ps
-       CALL transfert_request(f_rhodz,req_i1)
-       CALL transfert_request(f_ps,req_i1)
-       CALL transfert_request(f_dps,req_i1) ! FIXME
-       CALL transfert_request(f_wflux,req_i1) ! FIXME
-       DO ind=1,ndomain
-          CALL swap_dimensions(ind)
-          CALL swap_geometry(ind)
-          rhodz=f_rhodz(ind); ps=f_ps(ind); dps=f_dps(ind); 
-          wflux=f_wflux(ind); wfluxt=f_wfluxt(ind)
-          CALL compute_rhodz(.FALSE., ps, rhodz)   
-       END DO
+       IF (check) THEN
+         CALL transfert_request(f_rhodz,req_i1)
+         CALL transfert_request(f_ps,req_i1)
+         CALL transfert_request(f_dps,req_i1) ! FIXME
+         CALL transfert_request(f_wflux,req_i1) ! FIXME
+         DO ind=1,ndomain
+            CALL swap_dimensions(ind)
+            CALL swap_geometry(ind)
+            rhodz=f_rhodz(ind); ps=f_ps(ind); dps=f_dps(ind); 
+            wflux=f_wflux(ind); wfluxt=f_wfluxt(ind)
+            CALL compute_rhodz(.FALSE., ps, rhodz)   
+         END DO
+       ENDIF
 
     END IF
@@ -222,5 +239,5 @@
     LOGICAL :: with_dps
     INTEGER :: ind
-
+    INTEGER :: i,j,ij,l
     CALL trace_start("Euler_scheme")  
 
@@ -229,14 +246,31 @@
        CALL swap_geometry(ind)
        IF(with_dps) THEN
-          ps=f_ps(ind) ; dps=f_dps(ind) ; 
-          ps(:)=ps(:)+dt*dps(:)
-          hflux=f_hflux(ind);     hfluxt=f_hfluxt(ind)
-          wflux=f_wflux(ind);     wfluxt=f_wfluxt(ind)
-          CALL accumulate_fluxes(hflux,wflux,hfluxt,wfluxt,dt,fluxt_zero(ind))
+         ps=f_ps(ind) ; dps=f_dps(ind) ; 
+
+         DO j=jj_begin,jj_end
+           DO i=ii_begin,ii_end
+             ij=(j-1)*iim+i
+             ps(ij)=ps(ij)+dt*dps(ij)
+           ENDDO
+         ENDDO
+         hflux=f_hflux(ind);     hfluxt=f_hfluxt(ind)
+         wflux=f_wflux(ind);     wfluxt=f_wfluxt(ind)
+         CALL accumulate_fluxes(hflux,wflux,hfluxt,wfluxt,dt,fluxt_zero(ind))
        END IF
+       
        u=f_u(ind) ; theta_rhodz=f_theta_rhodz(ind)
        du=f_du(ind) ; dtheta_rhodz=f_dtheta_rhodz(ind)
-       u(:,:)=u(:,:)+dt*du(:,:)
-       theta_rhodz(:,:)=theta_rhodz(:,:)+dt*dtheta_rhodz(:,:)
+
+       DO l=1,llm
+         DO j=jj_begin,jj_end
+           DO i=ii_begin,ii_end
+             ij=(j-1)*iim+i
+             u(ij+u_right,l)=u(ij+u_right,l)+dt*du(ij+u_right,l)
+             u(ij+u_lup,l)=u(ij+u_lup,l)+dt*du(ij+u_lup,l)
+             u(ij+u_ldown,l)=u(ij+u_ldown,l)+dt*du(ij+u_ldown,l)
+             theta_rhodz(ij,l)=theta_rhodz(ij,l)+dt*dtheta_rhodz(ij,l)
+           ENDDO
+         ENDDO
+       ENDDO
     ENDDO
 
@@ -250,4 +284,5 @@
       REAL(rstd), DIMENSION(4), PARAMETER :: coef = (/ .25, 1./3., .5, 1. /)
       REAL(rstd) :: tau
+      INTEGER :: i,j,ij,l
   
       CALL trace_start("RK_scheme")  
@@ -263,10 +298,45 @@
          
          IF (stage==1) THEN ! first stage : save model state in XXm1
-            psm1(:)=ps(:) ; um1(:,:)=u(:,:) ; theta_rhodzm1(:,:)=theta_rhodz(:,:)
+
+           DO j=jj_begin,jj_end
+             DO i=ii_begin,ii_end
+               ij=(j-1)*iim+i
+               psm1(ij)=ps(ij)
+             ENDDO
+           ENDDO
+              
+           DO l=1,llm
+             DO j=jj_begin,jj_end
+               DO i=ii_begin,ii_end
+                 ij=(j-1)*iim+i
+                 um1(ij+u_right,l)=u(ij+u_right,l)
+                 um1(ij+u_lup,l)=u(ij+u_lup,l)
+                 um1(ij+u_ldown,l)=u(ij+u_ldown,l)
+                 theta_rhodzm1(ij,l)=theta_rhodz(ij,l)
+               ENDDO
+             ENDDO
+           ENDDO
+
          END IF
          ! updates are of the form x1 := x0 + tau*f(x1)
-         ps(:)=psm1(:)+tau*dps(:)
-         u(:,:)=um1(:,:)+tau*du(:,:)
-         theta_rhodz(:,:)=theta_rhodzm1(:,:)+tau*dtheta_rhodz(:,:)
+         DO j=jj_begin,jj_end
+           DO i=ii_begin,ii_end
+             ij=(j-1)*iim+i
+             ps(ij)=psm1(ij)+tau*dps(ij)
+           ENDDO
+         ENDDO
+         
+         DO l=1,llm
+           DO j=jj_begin,jj_end
+             DO i=ii_begin,ii_end
+               ij=(j-1)*iim+i
+               u(ij+u_right,l)=um1(ij+u_right,l)+tau*du(ij+u_right,l)
+               u(ij+u_lup,l)=um1(ij+u_lup,l)+tau*du(ij+u_lup,l)
+               u(ij+u_ldown,l)=um1(ij+u_ldown,l)+tau*du(ij+u_ldown,l)
+               theta_rhodz(ij,l)=theta_rhodzm1(ij,l)+tau*dtheta_rhodz(ij,l)
+             ENDDO
+           ENDDO
+         ENDDO
+
          IF(stage==nb_stage) THEN ! accumulate mass fluxes at last stage
             hflux=f_hflux(ind);     hfluxt=f_hfluxt(ind)
@@ -450,13 +520,50 @@
     REAL(rstd), INTENT(IN) :: tau
     LOGICAL, INTENT(INOUT) :: fluxt_zero
+    INTEGER :: l,i,j,ij
+
     IF(fluxt_zero) THEN
 !       PRINT *, 'Accumulating fluxes (first)'
        fluxt_zero=.FALSE.
-       hfluxt = tau*hflux
-       wfluxt = tau*wflux
+       DO l=1,llm
+         DO j=jj_begin-1,jj_end+1
+           DO i=ii_begin-1,ii_end+1
+             ij=(j-1)*iim+i
+             hfluxt(ij+u_right,l) = tau*hflux(ij+u_right,l)
+             hfluxt(ij+u_lup,l) = tau*hflux(ij+u_lup,l)
+             hfluxt(ij+u_ldown,l) = tau*hflux(ij+u_ldown,l)
+           ENDDO
+         ENDDO
+       ENDDO
+
+       DO l=1,llm+1
+         DO j=jj_begin,jj_end
+           DO i=ii_begin,ii_end
+             ij=(j-1)*iim+i
+             wfluxt(ij,l) = tau*wflux(ij,l)
+           ENDDO
+         ENDDO
+       ENDDO
     ELSE
 !       PRINT *, 'Accumulating fluxes (next)'
-       hfluxt = hfluxt + tau*hflux
-       wfluxt = wfluxt + tau*wflux
+       DO l=1,llm
+         DO j=jj_begin-1,jj_end+1
+           DO i=ii_begin-1,ii_end+1
+             ij=(j-1)*iim+i
+             hfluxt(ij+u_right,l) = hfluxt(ij+u_right,l)+tau*hflux(ij+u_right,l)
+             hfluxt(ij+u_lup,l) = hfluxt(ij+u_lup,l)+tau*hflux(ij+u_lup,l)
+             hfluxt(ij+u_ldown,l) = hfluxt(ij+u_ldown,l)+tau*hflux(ij+u_ldown,l)
+           ENDDO
+         ENDDO
+       ENDDO
+
+       DO l=1,llm+1
+         DO j=jj_begin,jj_end
+           DO i=ii_begin,ii_end
+             ij=(j-1)*iim+i
+             wfluxt(ij,l) = wfluxt(ij,l)+tau*wflux(ij,l)
+           ENDDO
+         ENDDO
+       ENDDO
+
     END IF
   END SUBROUTINE accumulate_fluxes
Index: /codes/icosagcm/trunk/src/transfert.F90
===================================================================
--- /codes/icosagcm/trunk/src/transfert.F90	(revision 147)
+++ /codes/icosagcm/trunk/src/transfert.F90	(revision 148)
@@ -3,5 +3,5 @@
 #ifdef CPP_USING_MPI
   USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_mpi, req_i1,req_e1_vect, &
-                                req_e1_scal,request_add_point, create_request, gather_field
+                                req_e1_scal, req_i0, req_e0_vect, req_e0_scal, request_add_point, create_request, gather_field
 #else 
   USE transfert_mpi_mod, ONLY : init_transfert, transfert_request, req_i1,req_e1_vect, &
Index: /codes/icosagcm/trunk/src/transfert_mpi.f90
===================================================================
--- /codes/icosagcm/trunk/src/transfert_mpi.f90	(revision 147)
+++ /codes/icosagcm/trunk/src/transfert_mpi.f90	(revision 148)
@@ -37,4 +37,8 @@
   TYPE(t_request),POINTER :: req_e1_vect(:)
   
+  TYPE(t_request),POINTER :: req_i0(:)
+  TYPE(t_request),POINTER :: req_e0_scal(:)
+  TYPE(t_request),POINTER :: req_e0_vect(:)
+  
   
 CONTAINS
@@ -69,17 +73,17 @@
     
       DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_begin,req_i1)
+!        CALL request_add_point(ind,i,jj_begin,req_i1)
       ENDDO
 
       DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end,j,req_i1)
+!        CALL request_add_point(ind,ii_end,j,req_i1)
       ENDDO    
     
       DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_end,req_i1)
+!        CALL request_add_point(ind,i,jj_end,req_i1)
       ENDDO    
 
       DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin,j,req_i1)
+!        CALL request_add_point(ind,ii_begin,j,req_i1)
       ENDDO    
     
@@ -87,5 +91,32 @@
   
     CALL finalize_request(req_i1)
-  
+
+
+    CALL create_request(field_t,req_i0)
+
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+    
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_begin,req_i0)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end,j,req_i0)
+      ENDDO    
+    
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_end,req_i0)
+      ENDDO    
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin,j,req_i0)
+      ENDDO    
+    
+    ENDDO
+ 
+    CALL finalize_request(req_i0)  
+
+
     CALL create_request(field_u,req_e1_scal)
     DO ind=1,ndomain
@@ -112,21 +143,48 @@
 
       DO i=ii_begin+1,ii_end-1
-        CALL request_add_point(ind,i,jj_begin,req_e1_scal,right)
-        CALL request_add_point(ind,i,jj_end,req_e1_scal,right)
+!        CALL request_add_point(ind,i,jj_begin,req_e1_scal,right)
+!        CALL request_add_point(ind,i,jj_end,req_e1_scal,right)
       ENDDO
     
       DO j=jj_begin+1,jj_end-1
-        CALL request_add_point(ind,ii_begin,j,req_e1_scal,rup)
-        CALL request_add_point(ind,ii_end,j,req_e1_scal,rup)
+!        CALL request_add_point(ind,ii_begin,j,req_e1_scal,rup)
+!        CALL request_add_point(ind,ii_end,j,req_e1_scal,rup)
       ENDDO   
 
-      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e1_scal,left)
-      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e1_scal,ldown)
-      CALL request_add_point(ind,ii_begin+1,jj_end,req_e1_scal,left)
-      CALL request_add_point(ind,ii_end,jj_begin+1,req_e1_scal,ldown)
+!      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e1_scal,left)
+!      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e1_scal,ldown)
+!      CALL request_add_point(ind,ii_begin+1,jj_end,req_e1_scal,left)
+!      CALL request_add_point(ind,ii_end,jj_begin+1,req_e1_scal,ldown)
 
     ENDDO
 
     CALL finalize_request(req_e1_scal)
+
+
+    CALL create_request(field_u,req_e0_scal)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+
+
+      DO i=ii_begin+1,ii_end-1
+        CALL request_add_point(ind,i,jj_begin,req_e0_scal,right)
+        CALL request_add_point(ind,i,jj_end,req_e0_scal,right)
+      ENDDO
+    
+      DO j=jj_begin+1,jj_end-1
+        CALL request_add_point(ind,ii_begin,j,req_e0_scal,rup)
+        CALL request_add_point(ind,ii_end,j,req_e0_scal,rup)
+      ENDDO   
+
+      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_scal,left)
+      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_scal,ldown)
+      CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_scal,left)
+      CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_scal,ldown)
+
+    ENDDO
+
+    CALL finalize_request(req_e0_scal)
+
+
     
     CALL create_request(field_u,req_e1_vect,.TRUE.)
@@ -154,22 +212,46 @@
 
       DO i=ii_begin+1,ii_end-1
-        CALL request_add_point(ind,i,jj_begin,req_e1_vect,right)
-        CALL request_add_point(ind,i,jj_end,req_e1_vect,right)
+!        CALL request_add_point(ind,i,jj_begin,req_e1_vect,right)
+!        CALL request_add_point(ind,i,jj_end,req_e1_vect,right)
       ENDDO
     
       DO j=jj_begin+1,jj_end-1
-        CALL request_add_point(ind,ii_begin,j,req_e1_vect,rup)
-        CALL request_add_point(ind,ii_end,j,req_e1_vect,rup)
+!        CALL request_add_point(ind,ii_begin,j,req_e1_vect,rup)
+!        CALL request_add_point(ind,ii_end,j,req_e1_vect,rup)
       ENDDO   
 
-      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e1_vect,left)
-      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e1_vect,ldown)
-      CALL request_add_point(ind,ii_begin+1,jj_end,req_e1_vect,left)
-      CALL request_add_point(ind,ii_end,jj_begin+1,req_e1_vect,ldown)
-
+!      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e1_vect,left)
+!      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e1_vect,ldown)
+!      CALL request_add_point(ind,ii_begin+1,jj_end,req_e1_vect,left)
+!      CALL request_add_point(ind,ii_end,jj_begin+1,req_e1_vect,ldown)
   
     ENDDO  
 
     CALL finalize_request(req_e1_vect)
+    
+    
+    CALL create_request(field_u,req_e0_vect,.TRUE.)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+ 
+      DO i=ii_begin+1,ii_end-1
+        CALL request_add_point(ind,i,jj_begin,req_e0_vect,right)
+        CALL request_add_point(ind,i,jj_end,req_e0_vect,right)
+      ENDDO
+    
+      DO j=jj_begin+1,jj_end-1
+        CALL request_add_point(ind,ii_begin,j,req_e0_vect,rup)
+        CALL request_add_point(ind,ii_end,j,req_e0_vect,rup)
+      ENDDO   
+
+      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_vect,left)
+      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_vect,ldown)
+      CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_vect,left)
+      CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_vect,ldown)
+  
+    ENDDO  
+
+    CALL finalize_request(req_e0_vect)
+
 
   END SUBROUTINE init_transfert
@@ -533,4 +615,5 @@
   USE mpi_mod
   USE mpipara
+  USE trace
   IMPLICIT NONE
     TYPE(t_field),POINTER :: field(:)
@@ -553,4 +636,6 @@
     INTEGER :: dim3,dim4
 
+    CALL trace_start("transfert_mpi")
+    
     IF (field(1)%data_type==type_real) THEN
       IF (field(1)%ndim==2) THEN
@@ -747,4 +832,6 @@
       
     ENDIF
+
+    CALL trace_end("transfert_mpi")
     
   END SUBROUTINE transfert_request_mpi
