Index: codes/icosagcm/trunk/src/advect.f90
===================================================================
--- codes/icosagcm/trunk/src/advect.f90	(revision 185)
+++ codes/icosagcm/trunk/src/advect.f90	(revision 186)
@@ -49,11 +49,13 @@
   !=======================================================================================
 
-  SUBROUTINE compute_gradq3d(qi,one_over_sqrt_leng,gradq3d)
+  SUBROUTINE compute_gradq3d(qi_in,one_over_sqrt_leng_in,gradq3d_out,xyz_i,xyz_v)
     USE trace
     USE omp_para
     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),INTENT(IN)  :: qi_in(iim*jjm,llm)
+    REAL(rstd),INTENT(IN)  :: one_over_sqrt_leng_in(iim*jjm)
+    REAL(rstd),INTENT(IN)  :: xyz_i(iim*jjm,3)
+    REAL(rstd),INTENT(IN)  :: xyz_v(2*iim*jjm,3)
+    REAL(rstd),INTENT(OUT) :: gradq3d_out(iim*jjm,llm,3) 
     REAL(rstd) :: maxq,minq,minq_c,maxq_c 
     REAL(rstd) :: alphamx,alphami,alpha	,maggrd
@@ -63,6 +65,16 @@
     REAL(rstd) :: gradtri(2*iim*jjm,llm,3) 
     INTEGER :: ij,k,ind,l
-
-    CALL trace_start("compute_gradq3d")
+    REAL(rstd)  :: qi(iim*jjm,llm)
+    REAL(rstd)  :: one_over_sqrt_leng(iim*jjm)
+    REAL(rstd) :: gradq3d(iim*jjm,llm,3) 
+    REAL(rstd) :: detx,dety,detz,det
+    REAL(rstd) :: A(3,3), a11,a12,a13,a21,a22,a23,a31,a32,a33
+    REAL(rstd) :: x1,x2,x3
+    REAL(rstd) :: dq(3)
+
+    qi=qi_in
+    one_over_sqrt_leng=one_over_sqrt_leng_in
+    
+    CALL trace_start("compute_gradq3d1")
 
     ! TODO : precompute ar, drop arr as output argument of gradq ?
@@ -71,16 +83,152 @@
     ! Compute gradient at triangles solving a linear system
     ! arr = area of triangle joining centroids of hexagons
+!     DO l = ll_begin,ll_end 
+!!$SIMD
+!      DO ij=ij_begin_ext,ij_end_ext
+!!             CALL gradq(ij,l,ij+t_rup,ij+t_lup,ij+z_up,qi,gradtri(ij+z_up,l,:),arr(ij+z_up))
+!!             CALL gradq(ij,l,ij+t_ldown,ij+t_rdown,ij+z_down,qi,gradtri(ij+z_down,l,:),arr(ij+z_down))
+!             CALL gradq(ij,l,ij+t_rup,ij+t_lup,ij+z_up,qi,gradtri(ij+z_up,l,1),gradtri(ij+z_up,l,2),gradtri(ij+z_up,l,3),arr(ij+z_up))
+!             CALL gradq(ij,l,ij+t_ldown,ij+t_rdown,ij+z_down,qi,gradtri(ij+z_down,l,1),gradtri(ij+z_down,l,2),gradtri(ij+z_down,l,3),arr(ij+z_down))
+!       END DO
+!    END DO
+
      DO l = ll_begin,ll_end 
 !$SIMD
       DO ij=ij_begin_ext,ij_end_ext
-             CALL gradq(ij,l,ij+t_rup,ij+t_lup,ij+z_up,qi,gradtri(ij+z_up,l,:),arr(ij+z_up))
-             CALL gradq(ij,l,ij+t_ldown,ij+t_rdown,ij+z_down,qi,gradtri(ij+z_down,l,:),arr(ij+z_down))
-       END DO
+!       CALL gradq(ij,l,ij+t_rup,ij+t_lup,ij+z_up,qi,gradtri(ij+z_up,l,1),gradtri(ij+z_up,l,2),gradtri(ij+z_up,l,3),arr(ij+z_up))
+
+        
+        A(1,1)=xyz_i(ij+t_rup,1)-xyz_i(ij,1);  A(1,2)=xyz_i(ij+t_rup,2)-xyz_i(ij,2); A(1,3)=xyz_i(ij+t_rup,3)-xyz_i(ij,3) 
+        A(2,1)=xyz_i(ij+t_lup,1)-xyz_i(ij,1);  A(2,2)=xyz_i(ij+t_lup,2)-xyz_i(ij,2); A(2,3)=xyz_i(ij+t_lup,3)-xyz_i(ij,3) 
+        A(3,1)=xyz_v(ij+z_up,1);               A(3,2)= xyz_v(ij+z_up,2);             A(3,3)=xyz_v(ij+z_up,3)
+    
+        dq(1) = qi(ij+t_rup,l)-qi(ij,l)
+        dq(2) = qi(ij+t_lup,l)-qi(ij,l)
+        dq(3) = 0.0
+
+
+!        CALL determinant(A(1,1),A(2,1),A(3,1),A(1,2),A(2,2),A(3,2),A(1,3),A(2,3),A(3,3),det)
+
+         a11=A(1,1) ; a12=A(2,1) ; a13=A(3,1)
+         a21=A(1,2) ; a22=A(2,2) ; a23=A(3,2)
+         a31=A(1,3) ; a32=A(2,3) ; a33=A(3,3)
+
+         x1 =  a11 * (a22 * a33 - a23 * a32)
+         x2 =  a12 * (a21 * a33 - a23 * a31)
+         x3 =  a13 * (a21 * a32 - a22 * a31)
+         det =  x1 - x2 + x3
+                 
+!        CALL determinant(dq(1),dq(2),dq(3),A(1,2),A(2,2),A(3,2),A(1,3),A(2,3),A(3,3),detx)
+
+         a11=dq(1)  ; a12=dq(2)  ; a13=dq(3)
+         a21=A(1,2) ; a22=A(2,2) ; a23=A(3,2)
+         a31=A(1,3) ; a32=A(2,3) ; a33=A(3,3)
+
+         x1 =  a11 * (a22 * a33 - a23 * a32)
+         x2 =  a12 * (a21 * a33 - a23 * a31)
+         x3 =  a13 * (a21 * a32 - a22 * a31)
+         detx =  x1 - x2 + x3
+        
+!        CALL determinant(A(1,1),A(2,1),A(3,1),dq(1),dq(2),dq(3),A(1,3),A(2,3),A(3,3),dety)
+
+         a11=A(1,1) ; a12=A(2,1) ; a13=A(3,1)
+         a21=dq(1)  ; a22=dq(2)  ; a23=dq(3)
+         a31=A(1,3) ; a32=A(2,3) ; a33=A(3,3)
+
+         x1 =  a11 * (a22 * a33 - a23 * a32)
+         x2 =  a12 * (a21 * a33 - a23 * a31)
+         x3 =  a13 * (a21 * a32 - a22 * a31)
+         dety =  x1 - x2 + x3
+
+!        CALL determinant(A(1,1),A(2,1),A(3,1),A(1,2),A(2,2),A(3,2),dq(1),dq(2),dq(3),detz)
+
+         a11=A(1,1) ; a12=A(2,1) ; a13=A(3,1)
+         a21=A(1,2) ; a22=A(2,2) ; a23=A(3,2)
+         a31=dq(1)  ; a32=dq(2)  ; a33=dq(3)
+
+         x1 =  a11 * (a22 * a33 - a23 * a32)
+         x2 =  a12 * (a21 * a33 - a23 * a31)
+         x3 =  a13 * (a21 * a32 - a22 * a31)
+         detz =  x1 - x2 + x3
+
+        gradtri(ij+z_up,l,1) = detx
+        gradtri(ij+z_up,l,2) = dety
+        gradtri(ij+z_up,l,3) = detz
+        arr(ij+z_up) = det
+        
+      ENDDO
+      
+      DO ij=ij_begin_ext,ij_end_ext
+
+
+!        CALL gradq(ij,l,ij+t_ldown,ij+t_rdown,ij+z_down,qi,gradtri(ij+z_down,l,1),gradtri(ij+z_down,l,2),gradtri(ij+z_down,l,3),arr(ij+z_down))
+
+        A(1,1)=xyz_i(ij+t_ldown,1)-xyz_i(ij,1);  A(1,2)=xyz_i(ij+t_ldown,2)-xyz_i(ij,2); A(1,3)=xyz_i(ij+t_ldown,3)-xyz_i(ij,3) 
+        A(2,1)=xyz_i(ij+t_rdown,1)-xyz_i(ij,1);  A(2,2)=xyz_i(ij+t_rdown,2)-xyz_i(ij,2); A(2,3)=xyz_i(ij+t_rdown,3)-xyz_i(ij,3) 
+        A(3,1)=xyz_v(ij+z_down,1);               A(3,2)= xyz_v(ij+z_down,2);             A(3,3)=xyz_v(ij+z_down,3)
+ 
+        dq(1) = qi(ij+t_ldown,l)-qi(ij,l)
+        dq(2) = qi(ij+t_rdown,l)-qi(ij,l)
+        dq(3) = 0.0
+
+
+!        CALL determinant(A(1,1),A(2,1),A(3,1),A(1,2),A(2,2),A(3,2),A(1,3),A(2,3),A(3,3),det)
+
+         a11=A(1,1) ; a12=A(2,1) ; a13=A(3,1)
+         a21=A(1,2) ; a22=A(2,2) ; a23=A(3,2)
+         a31=A(1,3) ; a32=A(2,3) ; a33=A(3,3)
+
+         x1 =  a11 * (a22 * a33 - a23 * a32)
+         x2 =  a12 * (a21 * a33 - a23 * a31)
+         x3 =  a13 * (a21 * a32 - a22 * a31)
+         det =  x1 - x2 + x3
+                 
+!        CALL determinant(dq(1),dq(2),dq(3),A(1,2),A(2,2),A(3,2),A(1,3),A(2,3),A(3,3),detx)
+
+         a11=dq(1)  ; a12=dq(2)  ; a13=dq(3)
+         a21=A(1,2) ; a22=A(2,2) ; a23=A(3,2)
+         a31=A(1,3) ; a32=A(2,3) ; a33=A(3,3)
+
+         x1 =  a11 * (a22 * a33 - a23 * a32)
+         x2 =  a12 * (a21 * a33 - a23 * a31)
+         x3 =  a13 * (a21 * a32 - a22 * a31)
+         detx =  x1 - x2 + x3
+        
+!        CALL determinant(A(1,1),A(2,1),A(3,1),dq(1),dq(2),dq(3),A(1,3),A(2,3),A(3,3),dety)
+
+         a11=A(1,1) ; a12=A(2,1) ; a13=A(3,1)
+         a21=dq(1)  ; a22=dq(2)  ; a23=dq(3)
+         a31=A(1,3) ; a32=A(2,3) ; a33=A(3,3)
+
+         x1 =  a11 * (a22 * a33 - a23 * a32)
+         x2 =  a12 * (a21 * a33 - a23 * a31)
+         x3 =  a13 * (a21 * a32 - a22 * a31)
+         dety =  x1 - x2 + x3
+
+!        CALL determinant(A(1,1),A(2,1),A(3,1),A(1,2),A(2,2),A(3,2),dq(1),dq(2),dq(3),detz)
+
+         a11=A(1,1) ; a12=A(2,1) ; a13=A(3,1)
+         a21=A(1,2) ; a22=A(2,2) ; a23=A(3,2)
+         a31=dq(1)  ; a32=dq(2)  ; a33=dq(3)
+
+         x1 =  a11 * (a22 * a33 - a23 * a32)
+         x2 =  a12 * (a21 * a33 - a23 * a31)
+         x3 =  a13 * (a21 * a32 - a22 * a31)
+         detz =  x1 - x2 + x3
+
+         gradtri(ij+z_down,l,1) = detx
+         gradtri(ij+z_down,l,2) = dety
+         gradtri(ij+z_down,l,3) = detz
+         arr(ij+z_down) = det
+
+      END DO
     END DO
 
 !$SIMD
-      DO ij=ij_begin,ij_end
-         ar(ij) = arr(ij+z_up)+arr(ij+z_lup)+arr(ij+z_ldown)+arr(ij+z_down)+arr(ij+z_rdown)+arr(ij+z_rup)+1.e-50
+    DO ij=ij_begin,ij_end
+       ar(ij) = arr(ij+z_up)+arr(ij+z_lup)+arr(ij+z_ldown)+arr(ij+z_down)+arr(ij+z_rdown)+arr(ij+z_rup)+1.e-50
     ENDDO
+    CALL trace_end("compute_gradq3d1")
+    CALL trace_start2("compute_gradq3d2")
       
     DO k=1,3
@@ -94,4 +242,6 @@
       END DO
     ENDDO
+    CALL trace_end2("compute_gradq3d2")
+    CALL trace_start("compute_gradq3d3")
 
     !============================================================================================= LIMITING 
@@ -99,5 +249,6 @@
 !$SIMD
       DO ij=ij_begin,ij_end
-             maggrd =  dot_product(gradq3d(ij,l,:),gradq3d(ij,l,:))
+!             maggrd =  dot_product(gradq3d(ij,l,:),gradq3d(ij,l,:))
+             maggrd = gradq3d(ij,l,1)*gradq3d(ij,l,1) + gradq3d(ij,l,2)*gradq3d(ij,l,2) + gradq3d(ij,l,3)*gradq3d(ij,l,3) 
              maggrd = sqrt(maggrd) 
              maxq_c = qi(ij,l) + maggrd*one_over_sqrt_leng(ij)
@@ -112,9 +263,81 @@
              alphami = max(alphami,0.0) 
              alpha   = min(alphamx,alphami,1.0)
-             gradq3d(ij,l,:) = alpha*gradq3d(ij,l,:)
+!             gradq3d(ij,l,:) = alpha*gradq3d(ij,l,:)
+             gradq3d(ij,l,1) = alpha*gradq3d(ij,l,1)
+             gradq3d(ij,l,2) = alpha*gradq3d(ij,l,2)
+             gradq3d(ij,l,3) = alpha*gradq3d(ij,l,3)
        END DO
     END DO
 
-  CALL trace_end("compute_gradq3d")
+  CALL trace_end("compute_gradq3d3")
+  
+  gradq3d_out=gradq3d
+  
+  CONTAINS
+
+    SUBROUTINE gradq(n0,l,n1,n2,n3,q,dq1,dq2,dq3,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
+    REAL(rstd), INTENT(OUT)    :: dq1,dq2,dq3,det
+    REAL(rstd)    :: dq(3)
+    
+    REAL(rstd)  ::detx,dety,detz
+    INTEGER    :: info
+    INTEGER    :: IPIV(3)
+
+    REAL(rstd) :: A(3,3)
+    REAL(rstd) :: B(3)
+    
+    ! TODO : replace A by A1,A2,A3
+    A(1,1)=xyz_i(n1,1)-xyz_i(n0,1);  A(1,2)=xyz_i(n1,2)-xyz_i(n0,2); A(1,3)=xyz_i(n1,3)-xyz_i(n0,3) 
+    A(2,1)=xyz_i(n2,1)-xyz_i(n0,1);  A(2,2)=xyz_i(n2,2)-xyz_i(n0,2); A(2,3)=xyz_i(n2,3)-xyz_i(n0,3) 
+    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,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)
+!    CALL determinant(A(:,1),A(:,2),A(:,3),det)
+!    CALL determinant(dq,A(:,2),A(:,3),detx)
+!    CALL determinant(A(:,1),dq,A(:,3),dety)
+!    CALL determinant(A(:,1),A(:,2),dq,detz)
+!    dq(1) = detx
+!    dq(2) = dety
+!    dq(3) = detz 
+
+    CALL determinant(A(1,1),A(2,1),A(3,1),A(1,2),A(2,2),A(3,2),A(1,3),A(2,3),A(3,3),det)
+    CALL determinant(dq(1),dq(2),dq(3),A(1,2),A(2,2),A(3,2),A(1,3),A(2,3),A(3,3),dq1)
+    CALL determinant(A(1,1),A(2,1),A(3,1),dq(1),dq(2),dq(3),A(1,3),A(2,3),A(3,3),dq2)
+    CALL determinant(A(1,1),A(2,1),A(3,1),A(1,2),A(2,2),A(3,2),dq(1),dq(2),dq(3),dq3)
+
+  END SUBROUTINE gradq
+
+  !==========================================================================
+!  PURE SUBROUTINE determinant(a1,a2,a3,det)
+!    IMPLICIT NONE
+!    REAL(rstd), DIMENSION(3), INTENT(IN) :: a1,a2,a3
+!    REAL(rstd), INTENT(OUT) :: det
+!    REAL(rstd) ::  x1,x2,x3
+!    x1 =  a1(1) * (a2(2) * a3(3) - a2(3) * a3(2))
+!    x2 =  a1(2) * (a2(1) * a3(3) - a2(3) * a3(1))
+!    x3 =  a1(3) * (a2(1) * a3(2) - a2(2) * a3(1))
+!    det =  x1 - x2 + x3
+!  END SUBROUTINE determinant
+
+   SUBROUTINE determinant(a11,a12,a13,a21,a22,a23,a31,a32,a33,det)
+    IMPLICIT NONE
+    REAL(rstd), INTENT(IN) :: a11,a12,a13,a21,a22,a23,a31,a32,a33
+    REAL(rstd), INTENT(OUT) :: det
+    REAL(rstd) ::  x1,x2,x3
+    x1 =  a11 * (a22 * a33 - a23 * a32)
+    x2 =  a12 * (a21 * a33 - a23 * a31)
+    x3 =  a13 * (a21 * a32 - a22 * a31)
+    det =  x1 - x2 + x3
+  END SUBROUTINE determinant
+
+
   END SUBROUTINE compute_gradq3d
 
@@ -222,8 +445,10 @@
              IF (ne(ij,right)*hfluxt(ij+u_right,l)>0) THEN 
                 ed = cc(ij+u_right,l,:) - xyz_i(ij,:)
-                qe = qi(ij,l)+sum2(gradq3d(ij,l,:),ed) 
+!                qe = qi(ij,l)+sum2(gradq3d(ij,l,:),ed) 
+                 qe = qi(ij,l)+gradq3d(ij,l,1)*ed(1)+gradq3d(ij,l,2)*ed(2)+gradq3d(ij,l,3)*ed(3) 
              ELSE
                 ed = cc(ij+u_right,l,:) - xyz_i(ij+t_right,:)
-                qe = qi(ij+t_right,l)+sum2(gradq3d(ij+t_right,l,:),ed) 
+!                qe = qi(ij+t_right,l)+sum2(gradq3d(ij+t_right,l,:),ed) 
+                qe = qi(ij+t_right,l) + gradq3d(ij+t_right,l,1)*ed(1)+gradq3d(ij+t_right,l,2)*ed(2)+gradq3d(ij+t_right,l,3)*ed(3) 
              ENDIF
              qflux(ij+u_right,l) = hfluxt(ij+u_right,l)*qe
@@ -231,8 +456,10 @@
              IF (ne(ij,lup)*hfluxt(ij+u_lup,l)>0) THEN 
                 ed = cc(ij+u_lup,l,:) - xyz_i(ij,:)
-                qe = qi(ij,l)+sum2(gradq3d(ij,l,:),ed)
+!                qe = qi(ij,l)+sum2(gradq3d(ij,l,:),ed)
+                qe = qi(ij,l)  + gradq3d(ij,l,1)*ed(1)+gradq3d(ij,l,2)*ed(2)+gradq3d(ij,l,3)*ed(3) 
              ELSE
                 ed = cc(ij+u_lup,l,:) - xyz_i(ij+t_lup,:)
-                qe = qi(ij+t_lup,l)+sum2(gradq3d(ij+t_lup,l,:),ed) 
+!                qe = qi(ij+t_lup,l)+sum2(gradq3d(ij+t_lup,l,:),ed) 
+                qe = qi(ij+t_lup,l) + gradq3d(ij+t_lup,l,1)*ed(1)+gradq3d(ij+t_lup,l,2)*ed(2)+gradq3d(ij+t_lup,l,3)*ed(3) 
              ENDIF
              qflux(ij+u_lup,l) = hfluxt(ij+u_lup,l)*qe 
@@ -240,8 +467,10 @@
              IF (ne(ij,ldown)*hfluxt(ij+u_ldown,l)>0) THEN 
                 ed = cc(ij+u_ldown,l,:) - xyz_i(ij,:)
-                qe = qi(ij,l)+sum2(gradq3d(ij,l,:),ed) 
+!                qe = qi(ij,l)+sum2(gradq3d(ij,l,:),ed) 
+                qe = qi(ij,l) + gradq3d(ij,l,1)*ed(1)+gradq3d(ij,l,2)*ed(2)+gradq3d(ij,l,3)*ed(3) 
              ELSE
                 ed = cc(ij+u_ldown,l,:) - xyz_i(ij+t_ldown,:)
-                qe = qi(ij+t_ldown,l)+sum2(gradq3d(ij+t_ldown,l,:),ed) 
+!                qe = qi(ij+t_ldown,l)+sum2(gradq3d(ij+t_ldown,l,:),ed) 
+                qe = qi(ij+t_ldown,l)+gradq3d(ij+t_ldown,l,1)*ed(1)+gradq3d(ij+t_ldown,l,2)*ed(2)+gradq3d(ij+t_ldown,l,3)*ed(3) 
              ENDIF
              qflux(ij+u_ldown,l) = hfluxt(ij+u_ldown,l)*qe
@@ -289,47 +518,4 @@
   END SUBROUTINE compute_advect_horiz
 
-  !==========================================================================
-  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
-    
-    REAL(rstd)  ::detx,dety,detz
-    INTEGER    :: info
-    INTEGER    :: IPIV(3)
-
-    REAL(rstd) :: A(3,3)
-    REAL(rstd) :: B(3)
-
-    ! TODO : replace A by A1,A2,A3
-    A(1,1)=xyz_i(n1,1)-xyz_i(n0,1);  A(1,2)=xyz_i(n1,2)-xyz_i(n0,2); A(1,3)=xyz_i(n1,3)-xyz_i(n0,3) 
-    A(2,1)=xyz_i(n2,1)-xyz_i(n0,1);  A(2,2)=xyz_i(n2,2)-xyz_i(n0,2); A(2,3)=xyz_i(n2,3)-xyz_i(n0,3) 
-    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,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)
-    CALL determinant(A(:,1),A(:,2),A(:,3),det)
-    CALL determinant(dq,A(:,2),A(:,3),detx)
-    CALL determinant(A(:,1),dq,A(:,3),dety)
-    CALL determinant(A(:,1),A(:,2),dq,detz)
-    dq(1) = detx
-    dq(2) = dety
-    dq(3) = detz 
-  END SUBROUTINE gradq
-
-  !==========================================================================
-  PURE SUBROUTINE determinant(a1,a2,a3,det)
-    IMPLICIT NONE
-    REAL(rstd), DIMENSION(3), INTENT(IN) :: a1,a2,a3
-    REAL(rstd), INTENT(OUT) :: det
-    REAL(rstd) ::  x1,x2,x3
-    x1 =  a1(1) * (a2(2) * a3(3) - a2(3) * a3(2))
-    x2 =  a1(2) * (a2(1) * a3(3) - a2(3) * a3(1))
-    x3 =  a1(3) * (a2(1) * a3(2) - a2(2) * a3(1))
-    det =  x1 - x2 + x3
-  END SUBROUTINE determinant
 
 END MODULE advect_mod
Index: codes/icosagcm/trunk/src/advect_tracer.f90
===================================================================
--- codes/icosagcm/trunk/src/advect_tracer.f90	(revision 185)
+++ codes/icosagcm/trunk/src/advect_tracer.f90	(revision 186)
@@ -4,19 +4,19 @@
   PRIVATE
 
-  TYPE(t_field),POINTER :: f_normal(:)
-  TYPE(t_field),POINTER :: f_tangent(:)
-  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(:)
-
-  TYPE(t_message) :: req_u, req_cc, req_wfluxt, req_q, req_rhodz, req_gradq3d
+  TYPE(t_field),SAVE,POINTER :: f_normal(:)
+  TYPE(t_field),SAVE,POINTER :: f_tangent(:)
+  TYPE(t_field),SAVE,POINTER :: f_gradq3d(:)
+  TYPE(t_field),SAVE,POINTER :: f_cc(:)  ! starting point of backward-trajectory (Miura approach)
+  TYPE(t_field),SAVE,POINTER :: f_one_over_sqrt_leng(:)
+
+  TYPE(t_message),SAVE :: req_u, req_cc, req_wfluxt, req_q, req_rhodz, req_gradq3d
 
   REAL(rstd), PARAMETER :: pente_max=2.0 ! for vlz
 
 ! temporary shared variable for vlz
-  TYPE(t_field),POINTER :: f_dzqw(:)   ! vertical finite difference of q 
-  TYPE(t_field),POINTER :: f_adzqw(:)  ! abs(dzqw)
-  TYPE(t_field),POINTER :: f_dzq(:)    ! limited slope of q
-  TYPE(t_field),POINTER :: f_wq(:)     ! time-integrated flux of q
+  TYPE(t_field),SAVE,POINTER :: f_dzqw(:)   ! vertical finite difference of q 
+  TYPE(t_field),SAVE,POINTER :: f_adzqw(:)  ! abs(dzqw)
+  TYPE(t_field),SAVE,POINTER :: f_dzq(:)    ! limited slope of q
+  TYPE(t_field),SAVE,POINTER :: f_wq(:)     ! time-integrated flux of q
 
   PUBLIC init_advect_tracer, advect_tracer
@@ -42,4 +42,5 @@
     
     DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
@@ -88,19 +89,25 @@
     ENDIF
     
-!$OMP BARRIER
+!!$OMP BARRIER
 
     CALL trace_start("advect_tracer") 
 
     CALL send_message(f_u,req_u)
+    CALL wait_message(req_u)
     CALL send_message(f_wfluxt,req_wfluxt)
+    CALL wait_message(req_wfluxt)
     CALL send_message(f_q,req_q)
+    CALL wait_message(req_q)
     CALL send_message(f_rhodz,req_rhodz)
-    CALL wait_message(req_u)
-    CALL wait_message(req_wfluxt)
-    CALL wait_message(req_q)
     CALL wait_message(req_rhodz)
+
+!    CALL wait_message(req_u)
+!    CALL wait_message(req_wfluxt)
+!    CALL wait_message(req_q)
+!    CALL wait_message(req_rhodz)
     
     ! 1/2 vertical transport + back-trajectories
     DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
@@ -126,10 +133,12 @@
 
     CALL send_message(f_cc,req_cc)
+    CALL wait_message(req_cc)
 
 
     ! horizontal transport - split in two to place transfer of gradq3d
-!$OMP BARRIER
+!!$OMP BARRIER
     DO k = 1, nqtot
        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
           CALL swap_dimensions(ind)
           CALL swap_geometry(ind)
@@ -137,13 +146,14 @@
           gradq3d = f_gradq3d(ind)
           one_over_sqrt_leng=f_one_over_sqrt_leng(ind)
-          CALL compute_gradq3d(q(:,:,k),one_over_sqrt_leng,gradq3d)
+          CALL compute_gradq3d(q(:,:,k),one_over_sqrt_leng,gradq3d,xyz_i,xyz_v)
        END DO
 
        CALL send_message(f_gradq3d,req_gradq3d)
-       CALL wait_message(req_cc)
+!       CALL wait_message(req_cc)
        CALL wait_message(req_gradq3d)
 
 
        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
           CALL swap_dimensions(ind)
           CALL swap_geometry(ind)
@@ -158,7 +168,8 @@
     
     ! 1/2 vertical transport
-!$OMP BARRIER
+!!$OMP BARRIER
 
     DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
@@ -179,5 +190,5 @@
     CALL trace_end("advect_tracer")
 
-!$OMP BARRIER
+!!$OMP BARRIER
 
   END SUBROUTINE advect_tracer
@@ -227,5 +238,5 @@
 
 !--> flush dzqw, adzqw
-!$OMP BARRIER
+!!$OMP BARRIER
 
     ! minmod-limited slope of q
@@ -260,5 +271,5 @@
 
 !---> flush dzq
-!$OMP BARRIER  
+!!$OMP BARRIER  
 
     ! sigw = fraction of mass that leaves level l/l+1
@@ -292,5 +303,5 @@
 
 ! --> flush wq
-!$OMP BARRIER
+!!$OMP BARRIER
 
 
Index: codes/icosagcm/trunk/src/caldyn.f90
===================================================================
--- codes/icosagcm/trunk/src/caldyn.f90	(revision 185)
+++ codes/icosagcm/trunk/src/caldyn.f90	(revision 186)
@@ -4,4 +4,5 @@
   PRIVATE
   CHARACTER(LEN=255),SAVE :: caldyn_type
+!$OMP THREADPRIVATE(caldyn_type)
   
   PUBLIC init_caldyn, caldyn, caldyn_BC
Index: codes/icosagcm/trunk/src/caldyn_adv.f90
===================================================================
--- codes/icosagcm/trunk/src/caldyn_adv.f90	(revision 185)
+++ codes/icosagcm/trunk/src/caldyn_adv.f90	(revision 186)
@@ -27,4 +27,5 @@
 
     DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
@@ -78,4 +79,5 @@
 
     DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
@@ -88,7 +90,7 @@
        du=f_du(ind)
 
-       !$OMP PARALLEL DEFAULT(SHARED)
+!       !$OMP PARALLEL DEFAULT(SHARED)
        CALL compute_caldyn(ps,u,hflux, wflux, dps, dtheta_rhodz, du)
-       !$OMP END PARALLEL
+!       !$OMP END PARALLEL
     ENDDO
 
Index: codes/icosagcm/trunk/src/caldyn_gcm.f90
===================================================================
--- codes/icosagcm/trunk/src/caldyn_gcm.f90	(revision 185)
+++ codes/icosagcm/trunk/src/caldyn_gcm.f90	(revision 186)
@@ -6,5 +6,6 @@
   INTEGER, PARAMETER :: energy=1, enstrophy=2
   TYPE(t_field),POINTER :: f_out_u(:), f_qu(:), f_qv(:)
-  REAL(rstd),POINTER :: out_u(:,:), p(:,:), qu(:,:)
+  REAL(rstd),SAVE,POINTER :: out_u(:,:), p(:,:), qu(:,:)
+  !$OMP THREADPRIVATE(out_u, p, qu)
 
   TYPE(t_field),POINTER :: f_buf_i(:), f_buf_ulon(:), f_buf_ulat(:), f_buf_u3d(:)
@@ -19,5 +20,6 @@
    
   INTEGER :: caldyn_conserv
-  
+ !$OMP THREADPRIVATE(caldyn_conserv) 
+ 
   TYPE(t_message) :: req_ps, req_mass, req_theta_rhodz, req_u, req_qu
 
@@ -101,4 +103,5 @@
     IF (omp_first) THEN
        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
           CALL swap_dimensions(ind)
           CALL swap_geometry(ind)
@@ -124,5 +127,5 @@
     ENDIF
 
-    !$OMP BARRIER
+!    !$OMP BARRIER
   END SUBROUTINE caldyn_BC
    
@@ -175,5 +178,5 @@
       IF(caldyn_eta==eta_mass) THEN
          CALL init_message(f_ps,req_i1,req_ps)
-      ELSE
+!      ELSE
          CALL init_message(f_mass,req_i1,req_mass)
       END IF
@@ -181,19 +184,35 @@
       CALL init_message(f_u,req_e1_vect,req_u)
       CALL init_message(f_qu,req_e1_scal,req_qu)
+!      IF(caldyn_eta==eta_mass) THEN
+!         CALL send_message(f_ps,req_ps) 
+!         CALL wait_message(req_ps)  
+!      ELSE
+!         CALL send_message(f_mass,req_mass) 
+!         CALL wait_message(req_mass)  
+!      END IF
+    ENDIF
+    
+    CALL trace_start("caldyn")
+
       IF(caldyn_eta==eta_mass) THEN
          CALL send_message(f_ps,req_ps) 
+         CALL wait_message(req_ps)  
       ELSE
          CALL send_message(f_mass,req_mass) 
+         CALL wait_message(req_mass)  
       END IF
-    ENDIF
-    
-    CALL trace_start("caldyn")
 
     CALL send_message(f_u,req_u)
+    CALL wait_message(req_u)
     CALL send_message(f_theta_rhodz,req_theta_rhodz) 
+    CALL wait_message(req_theta_rhodz) 
+    
+!    CALL wait_message(req_u)
+!    CALL wait_message(req_theta_rhodz) 
 
     SELECT CASE(caldyn_conserv)
     CASE(energy) ! energy-conserving
        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
           CALL swap_dimensions(ind)
           CALL swap_geometry(ind)
@@ -209,6 +228,8 @@
 
        CALL send_message(f_qu,req_qu)
+       CALL wait_message(req_qu)
 
        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
           CALL swap_dimensions(ind)
           CALL swap_geometry(ind)
@@ -237,4 +258,5 @@
     CASE(enstrophy) ! enstrophy-conserving
        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
           CALL swap_dimensions(ind)
           CALL swap_geometry(ind)
@@ -267,5 +289,5 @@
     END SELECT
 
-!$OMP BARRIER
+!!$OMP BARRIER
     IF (write_out) THEN
 
@@ -289,5 +311,5 @@
     !    CALL check_mass_conservation(f_ps,f_dps)
     CALL trace_end("caldyn")
-!$OMP BARRIER
+!!$OMP BARRIER
     
 END SUBROUTINE caldyn
@@ -338,13 +360,13 @@
 
   IF(caldyn_eta==eta_mass) THEN
-     CALL wait_message(req_ps)  
+!     CALL wait_message(req_ps)  
   ELSE
-     CALL wait_message(req_mass)
+!     CALL wait_message(req_mass)
   END IF
-  CALL wait_message(req_theta_rhodz) 
+!  CALL wait_message(req_theta_rhodz) 
 
   IF(caldyn_eta==eta_mass) THEN ! Compute mass & theta
      DO l = ll_begin,ll_end
-        CALL test_message(req_u) 
+!        CALL test_message(req_u) 
 !DIR$ SIMD
         DO ij=ij_begin_ext,ij_end_ext
@@ -356,5 +378,5 @@
   ELSE ! Compute only theta
      DO l = ll_begin,ll_end
-        CALL test_message(req_u) 
+!        CALL test_message(req_u) 
 !DIR$ SIMD
        DO ij=ij_begin_ext,ij_end_ext
@@ -364,5 +386,5 @@
   END IF
 
-  CALL wait_message(req_u)   
+!  CALL wait_message(req_u)   
   
 !!! Compute shallow-water potential vorticity
@@ -427,5 +449,5 @@
 !!! Compute exner function and geopotential
        DO l = 1,llm
-          !$OMP DO SCHEDULE(STATIC) 
+!         !$OMP DO SCHEDULE(STATIC) 
           !DIR$ SIMD
           DO ij=ij_begin_ext,ij_end_ext         
@@ -448,5 +470,5 @@
           ! specific volume 1 = dphi/g/rhodz
           DO l = 1,llm
-             !$OMP DO SCHEDULE(STATIC) 
+!             !$OMP DO SCHEDULE(STATIC) 
              !DIR$ SIMD
              DO ij=ij_begin_ext,ij_end_ext         
@@ -462,5 +484,6 @@
           ! other layers
           DO l = llm-1, 1, -1
-             !$OMP DO SCHEDULE(STATIC) 
+
+!          !$OMP DO SCHEDULE(STATIC) 
              !DIR$ SIMD
              DO ij=ij_begin_ext,ij_end_ext         
@@ -475,5 +498,6 @@
           ! specific volume v = kappa*theta*pi/p = dphi/g/rhodz
           DO l = 1,llm
-             !$OMP DO SCHEDULE(STATIC) 
+
+!             !$OMP DO SCHEDULE(STATIC) 
              !DIR$ SIMD
              DO ij=ij_begin_ext,ij_end_ext         
@@ -521,9 +545,9 @@
     CALL trace_start("compute_caldyn_horiz")
 
-    CALL wait_message(req_theta_rhodz) 
+!    CALL wait_message(req_theta_rhodz) 
 
   DO l = ll_begin, ll_end
 !!!  Compute mass and theta fluxes
-    IF (caldyn_conserv==energy) CALL test_message(req_qu) 
+!    IF (caldyn_conserv==energy) CALL test_message(req_qu) 
 !DIR$ SIMD
     DO ij=ij_begin_ext,ij_end_ext         
@@ -565,5 +589,5 @@
     CASE(energy) ! energy-conserving TRiSK
 
-       CALL wait_message(req_qu)
+!       CALL wait_message(req_qu)
 
         DO l=ll_begin,ll_end
@@ -671,5 +695,5 @@
        ! other layers
        DO l = llm-1, 1, -1
-          !$OMP DO SCHEDULE(STATIC) 
+!          !$OMP DO SCHEDULE(STATIC) 
           !DIR$ SIMD
           DO ij=ij_begin_ext,ij_end_ext         
@@ -686,6 +710,7 @@
 !DIR$ SIMD
           DO ij=ij_begin,ij_end         
-                berni(ij,l) = pk(ij,l) &
-                     + 1/(4*Ai(ij))*(le(ij+u_right)*de(ij+u_right)*u(ij+u_right,l)**2 +    &
+                
+                berni(ij,l) = pk(ij,l) + &
+                       1/(4*Ai(ij))*(le(ij+u_right)*de(ij+u_right)*u(ij+u_right,l)**2 +    &
                                      le(ij+u_rup)*de(ij+u_rup)*u(ij+u_rup,l)**2 +          &
                                      le(ij+u_lup)*de(ij+u_lup)*u(ij+u_lup,l)**2 +          &
@@ -756,6 +781,6 @@
     REAL(rstd),INTENT(INOUT)  :: convm(iim*jjm,llm)  ! mass flux convergence
 
-    REAL(rstd),INTENT(OUT) :: wflux(iim*jjm,llm+1) ! vertical mass flux (kg/m2/s)
-    REAL(rstd),INTENT(OUT) :: wwuu(iim*3*jjm,llm+1)
+    REAL(rstd),INTENT(INOUT) :: wflux(iim*jjm,llm+1) ! vertical mass flux (kg/m2/s)
+    REAL(rstd),INTENT(INOUT) :: wwuu(iim*3*jjm,llm+1)
     REAL(rstd),INTENT(OUT) :: du(iim*3*jjm,llm)
     REAL(rstd),INTENT(OUT) :: dtheta_rhodz(iim*jjm,llm)
@@ -766,12 +791,16 @@
     REAL(rstd) :: p_ik, exner_ik
 
-
+!    REAL(rstd) :: wwuu(iim*3*jjm,llm+1) ! tmp var, don't know why but gain 30% on the whole code in opemp
+                                        ! need to be understood
+
+!    wwuu=wwuu_out
   CALL trace_start("compute_caldyn_vert")
 
-!$OMP BARRIER   
+!!$OMP BARRIER   
 !!! cumulate mass flux convergence from top to bottom
   DO  l = llm-1, 1, -1
-    IF (caldyn_conserv==energy) CALL test_message(req_qu) 
-!$OMP DO SCHEDULE(STATIC) 
+!    IF (caldyn_conserv==energy) CALL test_message(req_qu) 
+
+!!$OMP DO SCHEDULE(STATIC) 
 !DIR$ SIMD
     DO ij=ij_begin,ij_end         
@@ -794,5 +823,5 @@
 !!! Compute vertical mass flux (l=1,llm+1 done by caldyn_BC)
   DO l=ll_beginp1,ll_end
-    IF (caldyn_conserv==energy) CALL test_message(req_qu) 
+!    IF (caldyn_conserv==energy) CALL test_message(req_qu) 
 !DIR$ SIMD
       DO ij=ij_begin,ij_end         
@@ -828,5 +857,5 @@
 
  !--> flush wwuu  
- !$OMP BARRIER
+ ! !$OMP BARRIER
 
 ! Add vertical transport to du
@@ -839,4 +868,13 @@
     ENDDO
   ENDDO      
+
+!  DO l=ll_beginp1,ll_end
+!!DIR$ SIMD
+!      DO ij=ij_begin,ij_end         
+!        wwuu_out(ij+u_right,l) = wwuu(ij+u_right,l)
+!        wwuu_out(ij+u_lup,l)   = wwuu(ij+u_lup,l)
+!        wwuu_out(ij+u_ldown,l) = wwuu(ij+u_ldown,l)
+!     ENDDO
+!   ENDDO
   
   CALL trace_end("compute_caldyn_vert")
@@ -973,4 +1011,5 @@
 
     DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
@@ -1002,4 +1041,5 @@
     
     DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/check_conserve.f90
===================================================================
--- codes/icosagcm/trunk/src/check_conserve.f90	(revision 185)
+++ codes/icosagcm/trunk/src/check_conserve.f90	(revision 186)
@@ -10,7 +10,9 @@
   PUBLIC init_check_conserve, check_conserve 
     REAL(rstd),SAVE:: mtot0,ztot0,etot0,ang0,stot0,rmsv0
+!$OMP THREADPRIVATE(mtot0,ztot0,etot0,ang0,stot0,rmsv0)
     REAL(rstd),SAVE:: etot,ang,stot,rmsv
+!$OMP THREADPRIVATE(etot,ang,stot,rmsv)
     REAL(rstd),SAVE:: ztot
-	
+!$OMP THREADPRIVATE(ztot)	
      
 CONTAINS 
@@ -53,4 +55,5 @@
 
     DO ind=1,ndomain 
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -67,5 +70,5 @@
 
     IF (is_mpi_root) THEN 
-       
+!$OMP MASTER       
        IF ( it == 0  ) Then 
           ztot0 = ztot
@@ -87,8 +90,9 @@
        WRITE(*,4000)mtot,rmsdpdt,etot,ztot,stot,rmsv,ang
        
-4000   FORMAT(10x,'masse',4x,'rmsdpdt',7x,'energie',2x,'enstrophie'  &
-            ,2x,'entropie',3x,'rmsv',4x,'mt.ang',/,'GLOB  '                &
+4000   FORMAT(10x,'masse',5x,'rmsdpdt',5x,'energie',5x,'enstrophie'  &
+            ,5x,'entropie',5x,'rmsv',5x,'mt.ang',/,'GLOB  '                &
             ,e10.3,e13.6,5e10.3/)     
-       close(134) 
+       close(134)
+!$OMP END MASTER 
     END IF
   END SUBROUTINE check_conserve
@@ -99,4 +103,5 @@
   USE mpi_mod
   USE mpipara
+  USE transfert_omp_mod
   USE icosa
   IMPLICIT NONE
@@ -108,7 +113,9 @@
     INTEGER :: ind,i,j,ij  
     REAL :: mloc, rmsloc
+    REAL :: mloc_mpi, rmsloc_mpi
 
     mloc=0.0; rmsloc=0.0
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -127,6 +134,12 @@
 
     IF (using_mpi) THEN
-      CALL MPI_REDUCE(mloc, mtot, 1, MPI_REAL8, MPI_SUM, 0, comm_icosa, ierr)
-      CALL MPI_REDUCE(rmsloc, rmsdpdt, 1, MPI_REAL8, MPI_SUM, 0, comm_icosa, ierr)
+        CALL reduce_sum_omp(mloc, mloc_mpi)
+        CALL reduce_sum_omp(rmsloc, rmsloc_mpi)
+!$OMP MASTER    
+      CALL MPI_REDUCE(mloc_mpi, mtot, 1, MPI_REAL8, MPI_SUM, 0, comm_icosa, ierr)
+      CALL MPI_REDUCE(rmsloc_mpi, rmsdpdt, 1, MPI_REAL8, MPI_SUM, 0, comm_icosa, ierr)
+!$OMP END MASTER
+    ELSE
+      
     ENDIF
     
@@ -153,4 +166,5 @@
 
     DO ind=1,ndomain 
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -260,4 +274,5 @@
 
      DO ind=1,ndomain 
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/dcmip_initial_conditions_test_1_2_3_v5.f90
===================================================================
--- codes/icosagcm/trunk/src/dcmip_initial_conditions_test_1_2_3_v5.f90	(revision 185)
+++ codes/icosagcm/trunk/src/dcmip_initial_conditions_test_1_2_3_v5.f90	(revision 186)
@@ -260,6 +260,6 @@
 	r  = ACOS (sin_tmp + cos_tmp*cos(lon-lambda0)) 
 	r2  = ACOS (sin_tmp2 + cos_tmp2*cos(lon-lambda1)) 
-	d1 = min( 1.d0, (r/RR)**2 + ((height-z0)/ZZ)**2 )
-	d2 = min( 1.d0, (r2/RR)**2 + ((height-z0)/ZZ)**2 )
+	d1 = min( 1., (r/RR)**2 + ((height-z0)/ZZ)**2 )
+	d2 = min( 1., (r2/RR)**2 + ((height-z0)/ZZ)**2 )
 	
 	q1 = 0.5d0 * (1.d0 + cos(pi*d1)) + 0.5d0 * (1.d0 + cos(pi*d2))
Index: codes/icosagcm/trunk/src/dimensions.f90
===================================================================
--- codes/icosagcm/trunk/src/dimensions.f90	(revision 185)
+++ codes/icosagcm/trunk/src/dimensions.f90	(revision 186)
@@ -1,41 +1,74 @@
 MODULE dimensions
 
-    INTEGER :: iim
-    INTEGER :: jjm
-    INTEGER :: ii_begin
-    INTEGER :: jj_begin
-    INTEGER :: ii_end
-    INTEGER :: jj_end
-    INTEGER :: ii_nb
-    INTEGER :: jj_nb
-    INTEGER :: ij_begin
-    INTEGER :: ij_end
-    INTEGER :: ij_begin_ext
-    INTEGER :: ij_end_ext
+    INTEGER,SAVE :: iim
+!$OMP THREADPRIVATE(iim)
+    INTEGER,SAVE :: jjm
+!$OMP THREADPRIVATE(jjm)
+    INTEGER,SAVE :: ii_begin
+!$OMP THREADPRIVATE(ii_begin)
+    INTEGER,SAVE :: jj_begin
+!$OMP THREADPRIVATE(jj_begin)
+    INTEGER,SAVE :: ii_end
+!$OMP THREADPRIVATE(ii_end)
+    INTEGER,SAVE :: jj_end
+!$OMP THREADPRIVATE(jj_end)
+    INTEGER,SAVE :: ii_nb
+!$OMP THREADPRIVATE(ii_nb)
+    INTEGER,SAVE :: jj_nb
+!$OMP THREADPRIVATE(jj_nb)
+    INTEGER,SAVE :: ij_begin
+!$OMP THREADPRIVATE(ij_begin)
+    INTEGER,SAVE :: ij_end
+!$OMP THREADPRIVATE(ij_end)
+    INTEGER,SAVE :: ij_begin_ext
+!$OMP THREADPRIVATE(ij_begin_ext)
+    INTEGER,SAVE :: ij_end_ext
+!$OMP THREADPRIVATE(ij_end_ext)
         
-    INTEGER :: t_right
-    INTEGER :: t_rup
-    INTEGER :: t_lup
-    INTEGER :: t_left
-    INTEGER :: t_ldown
-    INTEGER :: t_rdown
+    INTEGER,SAVE :: t_right
+!$OMP THREADPRIVATE(t_right)
+    INTEGER,SAVE :: t_rup
+!$OMP THREADPRIVATE(t_rup)
+    INTEGER,SAVE :: t_lup
+!$OMP THREADPRIVATE(t_lup)
+    INTEGER,SAVE :: t_left
+!$OMP THREADPRIVATE(t_left)
+    INTEGER,SAVE :: t_ldown
+!$OMP THREADPRIVATE(t_ldown)
+    INTEGER,SAVE :: t_rdown
+!$OMP THREADPRIVATE(t_rdown)
 
-    INTEGER :: u_right
-    INTEGER :: u_rup
-    INTEGER :: u_lup
-    INTEGER :: u_left
-    INTEGER :: u_ldown
-    INTEGER :: u_rdown
+    INTEGER,SAVE :: u_right
+!$OMP THREADPRIVATE(u_right)
+    INTEGER,SAVE :: u_rup
+!$OMP THREADPRIVATE(u_rup)
+    INTEGER,SAVE :: u_lup
+!$OMP THREADPRIVATE(u_lup)
+    INTEGER,SAVE :: u_left
+!$OMP THREADPRIVATE(u_left)
+    INTEGER,SAVE :: u_ldown
+!$OMP THREADPRIVATE(u_ldown)
+    INTEGER,SAVE :: u_rdown
+!$OMP THREADPRIVATE(u_rdown)
 
-    INTEGER :: z_rup
-    INTEGER :: z_up
-    INTEGER :: z_lup
-    INTEGER :: z_ldown
-    INTEGER :: z_down
-    INTEGER :: z_rdown
+    INTEGER,SAVE :: z_rup
+!$OMP THREADPRIVATE(z_rup)
+    INTEGER,SAVE :: z_up
+!$OMP THREADPRIVATE(z_up)
+    INTEGER,SAVE :: z_lup
+!$OMP THREADPRIVATE(z_lup)
+    INTEGER,SAVE :: z_ldown
+!$OMP THREADPRIVATE(z_ldown)
+    INTEGER,SAVE :: z_down
+!$OMP THREADPRIVATE(z_down)
+    INTEGER,SAVE :: z_rdown
+!$OMP THREADPRIVATE(z_rdown)
 
-    INTEGER :: t_pos(6)
-    INTEGER :: u_pos(6)
-    INTEGER :: z_pos(6)
+    INTEGER,SAVE :: t_pos(6)
+!$OMP THREADPRIVATE(t_pos)
+    INTEGER,SAVE :: u_pos(6)
+!$OMP THREADPRIVATE(u_pos)
+    INTEGER,SAVE :: z_pos(6)
+!$OMP THREADPRIVATE(z_pos)
         
 CONTAINS
@@ -48,6 +81,4 @@
     TYPE(t_domain),POINTER :: d
     
-    
-!$OMP MASTER
     d=>domain(ind)
      
@@ -91,6 +122,4 @@
      z_pos(:)=d%z_pos(:)
 
-!$OMP END MASTER     
-!$OMP BARRIER
    END SUBROUTINE swap_dimensions
    
Index: codes/icosagcm/trunk/src/dissip_gcm.f90
===================================================================
--- codes/icosagcm/trunk/src/dissip_gcm.f90	(revision 185)
+++ codes/icosagcm/trunk/src/dissip_gcm.f90	(revision 186)
@@ -10,22 +10,34 @@
   TYPE(t_field),POINTER,SAVE :: f_dtheta_diss(:)
   TYPE(t_field),POINTER,SAVE :: f_dtheta_rhodz_diss(:)
-  TYPE(t_message) :: req_due, req_dtheta 
+  TYPE(t_message),SAVE :: req_due, req_dtheta 
  
   INTEGER,SAVE :: nitergdiv=1
+!$OMP THREADPRIVATE(nitergdiv)
   INTEGER,SAVE :: nitergrot=1
+!$OMP THREADPRIVATE(nitergrot)
   INTEGER,SAVE :: niterdivgrad=1
+!$OMP THREADPRIVATE(niterdivgrad)
 
   REAL,ALLOCATABLE,SAVE :: tau_graddiv(:)
+!$OMP THREADPRIVATE(tau_graddiv)
   REAL,ALLOCATABLE,SAVE :: tau_gradrot(:)
+!$OMP THREADPRIVATE(tau_gradrot)
   REAL,ALLOCATABLE,SAVE :: tau_divgrad(:)
+!$OMP THREADPRIVATE(tau_divgrad)
   
   REAL,SAVE :: cgraddiv
+!$OMP THREADPRIVATE(cgraddiv)
   REAL,SAVE :: cgradrot
+!$OMP THREADPRIVATE(cgradrot)
   REAL,SAVE :: cdivgrad
+!$OMP THREADPRIVATE(cdivgrad)
 
   INTEGER, SAVE :: rayleigh_friction_type, rayleigh_shear
-  REAL, save    :: rayleigh_tau
+!$OMP THREADPRIVATE(rayleigh_friction_type)
+  REAL, SAVE    :: rayleigh_tau
+!$OMP THREADPRIVATE(rayleigh_shear)
   
   REAL,SAVE    :: dtdissip
+!$OMP THREADPRIVATE(dtdissip)
  
   PUBLIC init_dissip, dissip
@@ -58,13 +70,13 @@
   USE transfert_mod
   USE time_mod
-  
+  USE transfert_omp_mod
   IMPLICIT NONE
   
-  TYPE(t_field),POINTER :: f_u(:)
-  TYPE(t_field),POINTER :: f_du(:)
-  REAL(rstd),POINTER    :: u(:)
-  REAL(rstd),POINTER    :: du(:)
-  TYPE(t_field),POINTER :: f_theta(:)
-  TYPE(t_field),POINTER :: f_dtheta(:)
+  TYPE(t_field),POINTER,SAVE  :: f_u(:)
+  TYPE(t_field),POINTER,SAVE  :: f_du(:)
+  REAL(rstd),POINTER     :: u(:)
+  REAL(rstd),POINTER     :: du(:)
+  TYPE(t_field),POINTER,SAVE  :: f_theta(:)
+  TYPE(t_field),POINTER ,SAVE :: f_dtheta(:)
   REAL(rstd),POINTER    :: theta(:)
   REAL(rstd),POINTER    :: dtheta(:)
@@ -128,5 +140,5 @@
     
     tau_gradrot(:)=5000
-    CALL getin("tau_gradrot",tau_gradrot)
+    CALL getin("tau_gradrot",tau)
     tau_gradrot(:)=tau/scale_factor
 
@@ -146,4 +158,5 @@
     
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -171,4 +184,5 @@
         CALL transfert_request(f_u,req_e1_vect)
         DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
           CALL swap_dimensions(ind)
           CALL swap_geometry(ind)
@@ -183,4 +197,5 @@
       
       DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
@@ -199,9 +214,16 @@
 
       IF (using_mpi) THEN 
-        CALL MPI_ALLREDUCE(dumax,dumax1,1,MPI_REAL8,MPI_MAX,comm_icosa,ierr)
+        CALL reduce_sum_omp(dumax,dumax1)
+!$OMP MASTER        
+        CALL MPI_ALLREDUCE(dumax1,dumax,1,MPI_REAL8,MPI_MAX,comm_icosa,ierr)
+!$OMP END MASTER     
+        CALL bcast_omp(dumax)  
+      ELSE
+        CALL allreduce_sum_omp(dumax,dumax1)
         dumax=dumax1
-      ENDIF
+      ENDIF  
 			
       DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
@@ -223,4 +245,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -247,4 +270,5 @@
         CALL transfert_request(f_u,req_e1_vect)
         DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
           CALL swap_dimensions(ind)
           CALL swap_geometry(ind)
@@ -259,4 +283,5 @@
       
       DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
@@ -274,10 +299,18 @@
       ENDDO
 
-      IF (using_mpi) THEN
-        CALL MPI_ALLREDUCE(dumax,dumax1,1,MPI_REAL8,MPI_MAX,comm_icosa,ierr)
+      IF (using_mpi) THEN 
+        CALL reduce_sum_omp(dumax,dumax1)
+!$OMP MASTER        
+        CALL MPI_ALLREDUCE(dumax1,dumax,1,MPI_REAL8,MPI_MAX,comm_icosa,ierr)
+!$OMP END MASTER     
+        CALL bcast_omp(dumax)  
+      ELSE
+        CALL allreduce_sum_omp(dumax,dumax1)
         dumax=dumax1
-      ENDIF
+      ENDIF  
+
       
       DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
@@ -298,4 +331,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -317,4 +351,5 @@
         CALL transfert_request(f_theta,req_i1)
         DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
           CALL swap_dimensions(ind)
           CALL swap_geometry(ind)
@@ -329,4 +364,5 @@
       
       DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
@@ -341,13 +377,20 @@
         ENDDO
       ENDDO
-      
-      IF (using_mpi) THEN
-        CALL MPI_ALLREDUCE(dthetamax,dthetamax1,1,MPI_REAL8,MPI_MAX,comm_icosa,ierr)
-	dthetamax=dthetamax1
-      ENDIF
+
+      IF (using_mpi) THEN 
+        CALL reduce_sum_omp(dthetamax ,dthetamax1)
+!$OMP MASTER        
+        CALL MPI_ALLREDUCE(dthetamax1,dthetamax,1,MPI_REAL8,MPI_MAX,comm_icosa,ierr)
+!$OMP END MASTER     
+        CALL bcast_omp(dthetamax)  
+      ELSE
+        CALL allreduce_sum_omp(dthetamax,dthetamax1)
+        dumax=dumax1
+      ENDIF  
       
       IF (is_mpi_root) PRINT *,"divgrad : it :",it ,": dthetamax",dthetamax
 
       DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
@@ -434,4 +477,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -524,4 +568,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -544,4 +589,5 @@
         
       DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
@@ -571,4 +617,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -591,4 +638,5 @@
         
       DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
@@ -618,4 +666,5 @@
        
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -630,4 +679,5 @@
         
       DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
@@ -661,4 +711,5 @@
        
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -679,4 +730,5 @@
       CALL wait_message(req_dtheta)
       DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
@@ -688,4 +740,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/disvert.f90
===================================================================
--- codes/icosagcm/trunk/src/disvert.f90	(revision 185)
+++ codes/icosagcm/trunk/src/disvert.f90	(revision 186)
@@ -2,13 +2,20 @@
   USE icosa
   REAL(rstd), SAVE, POINTER :: ap(:)
+!$OMP THREADPRIVATE(ap) 
   REAL(rstd), SAVE, POINTER :: bp(:)
+!$OMP THREADPRIVATE(bp) 
   REAL(rstd), SAVE, POINTER :: presnivs(:)
+!$OMP THREADPRIVATE(presnivs) 
   REAL(rstd), SAVE, POINTER :: mass_al(:), mass_bl(:), mass_ak(:), mass_bk(:), mass_dak(:), mass_dbk(:)
+!$OMP THREADPRIVATE(mass_al, mass_bl, mass_ak, mass_bk, mass_dak, mass_dbk) 
 
   REAL(rstd) :: ptop ! pressure at top of atmosphere l=llm+1
+!$OMP THREADPRIVATE(ptop) 
   ! vertical coordinate : Lagrangian or mass-based
   INTEGER, SAVE :: caldyn_eta
+!$OMP THREADPRIVATE(caldyn_eta) 
   INTEGER, PARAMETER :: eta_mass=1, eta_lag=2
   LOGICAL,SAVE :: ap_bp_present
+!$OMP THREADPRIVATE(ap_bp_present) 
 
 CONTAINS
@@ -42,4 +49,5 @@
     ap_bp_present=.TRUE.
     CALL getin("disvert",def)
+    PRINT*,"def --> ",def
     SELECT CASE (TRIM(def))
       CASE('none')
@@ -83,5 +91,6 @@
         bp=>bp_ncarl30
         presnivs=>presnivs_ncarl30
-        
+        PRINT*,"ap --> ",ap
+        PRINT*,"ap_ncarl30 --> ",ap_ncarl30
       CASE default
         IF (is_mpi_root) PRINT*,'Bad selector for variable disvert : <', TRIM(def),"> options are <std>, <ncar>, <ncarl30>" 
@@ -169,6 +178,8 @@
     INTEGER :: ncid,levid,ilevid,hyaiid,hybiid,hyamid,hybmid,P0id
     INTEGER :: l
-    
-   
+
+!$OMP BARRIER
+!$OMP MASTER    
+  IF(ap_bp_present) THEN
     status = NF90_CREATE('apbp.nc', NF90_CLOBBER, ncid)
     status = NF90_DEF_DIM(ncid,'lev',llm,lev)
@@ -204,6 +215,5 @@
 
     status = NF90_ENDDEF(ncid)   
-
-  IF(ap_bp_present) THEN
+    
     status=NF90_PUT_VAR(ncid,ilevid, ap(:)+bp(:)*Preff)
     
@@ -228,9 +238,9 @@
  
     status=NF90_PUT_VAR(ncid,P0id, Preff)
-
-  END IF
    
     status=NF90_CLOSE(ncid)
-
+  END IF
+!$OMP END MASTER
+!$OMP BARRIER
   END SUBROUTINE write_apbp
 
Index: codes/icosagcm/trunk/src/disvert_dcmip200.f90
===================================================================
--- codes/icosagcm/trunk/src/disvert_dcmip200.f90	(revision 185)
+++ codes/icosagcm/trunk/src/disvert_dcmip200.f90	(revision 186)
@@ -3,6 +3,9 @@
  
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: ap(:)
+!$OMP THREADPRIVATE(ap)
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: bp(:)
+!$OMP THREADPRIVATE(bp)
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: presnivs(:)
+!$OMP THREADPRIVATE(presnivs)
 
 CONTAINS
Index: codes/icosagcm/trunk/src/disvert_dcmip3.f90
===================================================================
--- codes/icosagcm/trunk/src/disvert_dcmip3.f90	(revision 185)
+++ codes/icosagcm/trunk/src/disvert_dcmip3.f90	(revision 186)
@@ -3,6 +3,9 @@
  
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: ap(:)
+!$OMP THREADPRIVATE(ap)
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: bp(:)
+!$OMP THREADPRIVATE(bp)
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: presnivs(:)
+!$OMP THREADPRIVATE(presnivs)
 
 CONTAINS
Index: codes/icosagcm/trunk/src/disvert_ncar.f90
===================================================================
--- codes/icosagcm/trunk/src/disvert_ncar.f90	(revision 185)
+++ codes/icosagcm/trunk/src/disvert_ncar.f90	(revision 186)
@@ -3,6 +3,9 @@
  
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: ap(:)
+!$OMP THREADPRIVATE(ap)
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: bp(:)
+!$OMP THREADPRIVATE(bp)
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: presnivs(:)
+!$OMP THREADPRIVATE(presnivs)
 
 CONTAINS
Index: codes/icosagcm/trunk/src/disvert_ncarl30.f90
===================================================================
--- codes/icosagcm/trunk/src/disvert_ncarl30.f90	(revision 185)
+++ codes/icosagcm/trunk/src/disvert_ncarl30.f90	(revision 186)
@@ -1,7 +1,11 @@
 MODULE disvert_ncarl30_mod
   USE icosa
+
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: ap(:)
+!$OMP THREADPRIVATE(ap)
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: bp(:)
+!$OMP THREADPRIVATE(bp)
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: presnivs(:)
+!$OMP THREADPRIVATE(presnivs)
 
 CONTAINS
Index: codes/icosagcm/trunk/src/disvert_std.f90
===================================================================
--- codes/icosagcm/trunk/src/disvert_std.f90	(revision 185)
+++ codes/icosagcm/trunk/src/disvert_std.f90	(revision 186)
@@ -2,6 +2,9 @@
   USE icosa
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: ap(:)
+!$OMP THREADPRIVATE(ap)
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: bp(:)
+!$OMP THREADPRIVATE(bp)
   REAL(rstd), SAVE, ALLOCATABLE,TARGET :: presnivs(:)
+!$OMP THREADPRIVATE(presnivs)
 
 CONTAINS
Index: codes/icosagcm/trunk/src/domain.f90
===================================================================
--- codes/icosagcm/trunk/src/domain.f90	(revision 185)
+++ codes/icosagcm/trunk/src/domain.f90	(revision 186)
@@ -58,13 +58,17 @@
   END TYPE t_domain
 
+  INTEGER,SAVE :: ndomain
+  INTEGER,SAVE :: ndomain_glo
+
   TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain(:)
-  INTEGER :: ndomain
   TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain_glo(:)
-  INTEGER :: ndomain_glo
-
-  INTEGER,ALLOCATABLE,SAVE :: domglo_rank(:)
-  INTEGER,ALLOCATABLE,SAVE :: domglo_loc_ind(:)
-  INTEGER,ALLOCATABLE,SAVE :: domloc_glo_ind(:)
-  
+
+  INTEGER,ALLOCATABLE,SAVE :: domglo_rank(:)  ! size : ndomain_glo : mpi rank assigned to a domain 
+  INTEGER,ALLOCATABLE,SAVE :: domglo_loc_ind(:) ! size : ndomain_glo : corresponding local indice for a global domain indice
+  INTEGER,ALLOCATABLE,SAVE :: domloc_glo_ind(:) ! size : ndomain : corresponding global indice for a local domain indice
+
+  LOGICAL, ALLOCATABLE, SAVE :: assigned_domain(:) ! size : ndomain : is an omp task is assigned to this domain
+!$OMP THREADPRIVATE(assigned_domain)
+    
 CONTAINS
 
@@ -423,7 +427,41 @@
       ENDIF
     ENDDO
+
+!$OMP PARALLEL
+    CALL assign_domain_omp
+!$OMP END PARALLEL
+        
     
   END SUBROUTINE  assign_domain      
-    
+   
+  SUBROUTINE assign_domain_omp
+  USE omp_para
+  USE mpipara
+  IMPLICIT NONE
+    INTEGER :: nb_domain
+    INTEGER :: rank, ind, i
+
+    ALLOCATE(assigned_domain(ndomain))
+    
+    ind=0
+    DO rank=0,omp_size-1
+      nb_domain=ndomain/omp_size
+      IF ( rank < MOD(ndomain,omp_size) ) nb_domain=nb_domain+1
+    
+      DO i=1,nb_domain
+       ind=ind+1
+       IF (rank==omp_rank) THEN 
+         assigned_domain(ind)=.TRUE.
+         PRINT *,"Rank ",mpi_rank," task ",rank," local domain : ",ind," global domain ",domloc_glo_ind(ind)
+       ELSE
+         assigned_domain(ind)=.FALSE.
+       ENDIF  
+      ENDDO
+    
+    ENDDO
+    
+  END SUBROUTINE assign_domain_omp
+    
+
           
   SUBROUTINE compute_domain
Index: codes/icosagcm/trunk/src/earth_const.f90
===================================================================
--- codes/icosagcm/trunk/src/earth_const.f90	(revision 185)
+++ codes/icosagcm/trunk/src/earth_const.f90	(revision 186)
@@ -18,5 +18,5 @@
   
   SUBROUTINE init_earth_const
-  USE ioipsl
+  USE getin_mod
   IMPLICIT NONE
   REAL(rstd) :: X=1
Index: codes/icosagcm/trunk/src/etat0.f90
===================================================================
--- codes/icosagcm/trunk/src/etat0.f90	(revision 185)
+++ codes/icosagcm/trunk/src/etat0.f90	(revision 186)
@@ -1,4 +1,5 @@
 MODULE etat0_mod
     CHARACTER(len=255),SAVE :: etat0_type
+!$OMP THREADPRIVATE(etat0_type)
 
 CONTAINS
@@ -26,4 +27,5 @@
     TYPE(t_field),POINTER :: f_u(:)
     TYPE(t_field),POINTER :: f_q(:)
+    
     REAL(rstd),POINTER :: ps(:), mass(:,:)
     LOGICAL :: init_mass
@@ -75,6 +77,7 @@
 
     IF(init_mass) THEN ! initialize mass distribution using ps
-       !$OMP BARRIER
+!       !$OMP BARRIER
        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
           CALL swap_dimensions(ind)
           CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/etat0_academic.f90
===================================================================
--- codes/icosagcm/trunk/src/etat0_academic.f90	(revision 185)
+++ codes/icosagcm/trunk/src/etat0_academic.f90	(revision 186)
@@ -10,11 +10,11 @@
   USE kinetic_mod
   IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_ps(:)
-    TYPE(t_field),POINTER :: f_phis(:)
-    TYPE(t_field),POINTER :: f_theta_rhodz(:)
-    TYPE(t_field),POINTER :: f_u(:)
-    TYPE(t_field),POINTER :: f_q(:)
-    TYPE(t_field),POINTER :: f_Ki(:)
-    TYPE(t_field),POINTER :: f_temp(:)
+    TYPE(t_field),POINTER,SAVE :: f_ps(:)
+    TYPE(t_field),POINTER,SAVE :: f_phis(:)
+    TYPE(t_field),POINTER,SAVE :: f_theta_rhodz(:)
+    TYPE(t_field),POINTER,SAVE :: f_u(:)
+    TYPE(t_field),POINTER,SAVE :: f_q(:)
+    TYPE(t_field),POINTER,SAVE :: f_Ki(:)
+    TYPE(t_field),POINTER,SAVE :: f_temp(:)
   
     REAL(rstd),POINTER :: Ki(:,:)
@@ -58,4 +58,5 @@
     
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/etat0_dcmip1.f90
===================================================================
--- codes/icosagcm/trunk/src/etat0_dcmip1.f90	(revision 185)
+++ codes/icosagcm/trunk/src/etat0_dcmip1.f90	(revision 186)
@@ -4,19 +4,35 @@
 
   REAL(rstd), SAVE  :: h0=1.
+!$OMP THREADPRIVATE(h0)
   REAL(rstd), SAVE  :: lon0=3*pi/2
+!$OMP THREADPRIVATE(lon0)
   REAL(rstd), SAVE  :: lat0=0.0
+!$OMP THREADPRIVATE(lat0)
   REAL(rstd), SAVE  :: alpha=0.0
+!$OMP THREADPRIVATE(alpha)
   REAL(rstd), SAVE  :: R0 
+!$OMP THREADPRIVATE(R0)
   REAL(rstd), SAVE  :: lat1=0.
+!$OMP THREADPRIVATE(lat1)
   REAL(rstd), SAVE  :: lat2=0.
+!$OMP THREADPRIVATE(lat2)
   REAL(rstd), SAVE  :: lon1=pi/6
+!$OMP THREADPRIVATE(lon1)
   REAL(rstd), SAVE  :: lon2=-pi/6
+!$OMP THREADPRIVATE(lon2)
   REAL(rstd), SAVE  :: latc1=0.
+!$OMP THREADPRIVATE(latc1)
   REAL(rstd), SAVE  :: latc2=0.
+!$OMP THREADPRIVATE(latc2)
   REAL(rstd), SAVE  :: lonc1=5*pi/6
+!$OMP THREADPRIVATE(lonc1)
   REAL(rstd), SAVE  :: lonc2=7*pi/6
+!$OMP THREADPRIVATE(lonc2)
   REAL(rstd), SAVE  :: zt=1000.0
+!$OMP THREADPRIVATE(zt)
   REAL(rstd), SAVE  :: rt
+!$OMP THREADPRIVATE(rt)
   REAL(rstd), SAVE  :: zc=5000.0
+!$OMP THREADPRIVATE(zc)
 
   PUBLIC etat0
@@ -47,4 +63,5 @@
     
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/etat0_dcmip2.f90
===================================================================
--- codes/icosagcm/trunk/src/etat0_dcmip2.f90	(revision 185)
+++ codes/icosagcm/trunk/src/etat0_dcmip2.f90	(revision 186)
@@ -46,4 +46,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/etat0_dcmip3.f90
===================================================================
--- codes/icosagcm/trunk/src/etat0_dcmip3.f90	(revision 185)
+++ codes/icosagcm/trunk/src/etat0_dcmip3.f90	(revision 186)
@@ -34,4 +34,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/etat0_dcmip4.f90
===================================================================
--- codes/icosagcm/trunk/src/etat0_dcmip4.f90	(revision 185)
+++ codes/icosagcm/trunk/src/etat0_dcmip4.f90	(revision 186)
@@ -12,8 +12,17 @@
   REAL(rstd),PARAMETER :: up0=1
   REAL(rstd) :: latw=2*Pi/9
+!$OMP THREADPRIVATE(latw)
   REAL(rstd) :: pw=34000
+!$OMP THREADPRIVATE(pw)
   REAL(rstd) :: q0=0.021
+!$OMP THREADPRIVATE(q0)
   REAL(rstd) :: lonc
+!$OMP THREADPRIVATE(lonc)
   REAL(rstd) :: latc
+!$OMP THREADPRIVATE(latc)
+
+  INTEGER,SAVE :: testcase
+!$OMP THREADPRIVATE(testcase)  
+
   PUBLIC  etat0
 CONTAINS
@@ -36,6 +45,10 @@
     REAL(rstd),POINTER :: q(:,:,:)
     INTEGER :: ind
+
+    testcase=1
+    CALL getin("dcmip4_testcase",testcase)
     
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -81,12 +94,7 @@
   REAL(rstd) :: lonx,latx
   REAL(rstd) :: dthetaodeta_ave, dthetaodeta, dthetaodlat, duodeta, K, r
-  INTEGER :: testcase
   
     lonc=Pi/9
     latc=2*Pi/9 
-  
-    testcase=1
-    CALL getin("dcmip4_testcase",testcase)
-  
   
     DO l=1,llm
Index: codes/icosagcm/trunk/src/etat0_dcmip5.f90
===================================================================
--- codes/icosagcm/trunk/src/etat0_dcmip5.f90	(revision 185)
+++ codes/icosagcm/trunk/src/etat0_dcmip5.f90	(revision 186)
@@ -16,8 +16,11 @@
   REAL(rstd),PARAMETER :: epsilon=1e-25
   REAL(rstd),PARAMETER :: Rd=287
-  REAL(rstd) :: lonc
-  REAL(rstd) :: latc
+  REAL(rstd),SAVE :: lonc
+!$OMP THREADPRIVATE(lonc)  
+  REAL(rstd),SAVE :: latc
+!$OMP THREADPRIVATE(latc)  
   TYPE(t_field),POINTER :: f_out_i(:)
-  REAL(rstd),POINTER :: out_i(:,:)
+  REAL(rstd),POINTER,SAVE :: out_i(:,:)
+!$OMP THREADPRIVATE(out_i)  
 
   PUBLIC  etat0
@@ -45,4 +48,5 @@
  
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/etat0_heldsz.f90
===================================================================
--- codes/icosagcm/trunk/src/etat0_heldsz.f90	(revision 185)
+++ codes/icosagcm/trunk/src/etat0_heldsz.f90	(revision 186)
@@ -8,10 +8,14 @@
   TYPE(t_field),POINTER :: f_clat(:) ! FIXME, duplication
 
-  REAL(rstd),ALLOCATABLE :: knewt_t(:),kfrict(:)
-
+  REAL(rstd),ALLOCATABLE,SAVE :: knewt_t(:),kfrict(:)
+!$OMP THREADPRIVATE(knewt_t,kfrict)
   LOGICAL, SAVE :: done=.FALSE.
-
-  REAL(rstd) :: teta0,ttp,delt_y,delt_z,eps
-  REAL(rstd) :: knewt_g, k_f,k_c_a,k_c_s
+!$OMP THREADPRIVATE(done)
+
+  REAL(rstd),SAVE :: teta0,ttp,delt_y,delt_z,eps
+!$OMP THREADPRIVATE(teta0,ttp,delt_y,delt_z,eps)
+
+  REAL(rstd),SAVE :: knewt_g, k_f,k_c_a,k_c_s
+!$OMP THREADPRIVATE(knewt_g, k_f,k_c_a,k_c_s)
 
   PUBLIC :: etat0, held_suarez
@@ -69,4 +73,5 @@
     CALL Init_Teq
     DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
@@ -139,4 +144,5 @@
 
        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
           CALL swap_dimensions(ind)
           CALL swap_geometry(ind)
@@ -230,4 +236,5 @@
 
     DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/etat0_jablonowsky06.f90
===================================================================
--- codes/icosagcm/trunk/src/etat0_jablonowsky06.f90	(revision 185)
+++ codes/icosagcm/trunk/src/etat0_jablonowsky06.f90	(revision 186)
@@ -23,16 +23,16 @@
   USE vorticity_mod
   IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_ps(:)
-    TYPE(t_field),POINTER :: f_phis(:)
-    TYPE(t_field),POINTER :: f_theta_rhodz(:)
-    TYPE(t_field),POINTER :: f_u(:)
-    TYPE(t_field),POINTER :: f_Ki(:)
-    TYPE(t_field),POINTER :: f_temp(:)
-    TYPE(t_field),POINTER :: f_p(:)
-    TYPE(t_field),POINTER :: f_pks(:)
-    TYPE(t_field),POINTER :: f_pk(:)
-    TYPE(t_field),POINTER :: f_phi(:)
-    TYPE(t_field),POINTER :: f_vort(:)
-    TYPE(t_field),POINTER :: f_q(:)
+    TYPE(t_field),POINTER,SAVE :: f_ps(:)
+    TYPE(t_field),POINTER,SAVE :: f_phis(:)
+    TYPE(t_field),POINTER,SAVE :: f_theta_rhodz(:)
+    TYPE(t_field),POINTER,SAVE :: f_u(:)
+    TYPE(t_field),POINTER,SAVE :: f_Ki(:)
+    TYPE(t_field),POINTER,SAVE :: f_temp(:)
+    TYPE(t_field),POINTER,SAVE :: f_p(:)
+    TYPE(t_field),POINTER,SAVE :: f_pks(:)
+    TYPE(t_field),POINTER,SAVE :: f_pk(:)
+    TYPE(t_field),POINTER,SAVE :: f_phi(:)
+    TYPE(t_field),POINTER,SAVE :: f_vort(:)
+    TYPE(t_field),POINTER,SAVE :: f_q(:)
   
     REAL(rstd),POINTER :: Ki(:,:)
@@ -90,4 +90,5 @@
     
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/etat0_williamson.f90
===================================================================
--- codes/icosagcm/trunk/src/etat0_williamson.f90	(revision 185)
+++ codes/icosagcm/trunk/src/etat0_williamson.f90	(revision 186)
@@ -23,4 +23,5 @@
     
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -61,4 +62,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/exner.f90
===================================================================
--- codes/icosagcm/trunk/src/exner.f90	(revision 185)
+++ codes/icosagcm/trunk/src/exner.f90	(revision 186)
@@ -1,5 +1,7 @@
 MODULE exner_mod
 
-  INTEGER :: caldyn_exner
+  INTEGER,SAVE :: caldyn_exner
+!$OMP THREADPRIVATE(caldyn_exner)
+
   INTEGER, PARAMETER :: lmdz=3, direct=4
 
@@ -21,4 +23,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/field.f90
===================================================================
--- codes/icosagcm/trunk/src/field.f90	(revision 185)
+++ codes/icosagcm/trunk/src/field.f90	(revision 186)
@@ -57,7 +57,13 @@
     INTEGER :: ii_size,jj_size
 
+!$OMP BARRIER
+!$OMP MASTER
     ALLOCATE(field(ndomain))
+!$OMP END MASTER
+!$OMP BARRIER
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+
       IF(PRESENT(name)) THEN
          field(ind)%name = name
@@ -106,4 +112,5 @@
       
    ENDDO
+!$OMP BARRIER
    
   END SUBROUTINE allocate_field
Index: codes/icosagcm/trunk/src/geometry.f90
===================================================================
--- codes/icosagcm/trunk/src/geometry.f90	(revision 185)
+++ codes/icosagcm/trunk/src/geometry.f90	(revision 186)
@@ -25,26 +25,47 @@
   END TYPE t_geometry    
 
-  TYPE(t_geometry),TARGET :: geom
+  TYPE(t_geometry),SAVE,TARGET :: geom
+
   
   REAL(rstd),POINTER :: Ai(:)          ! area of a cell
+!$OMP THREADPRIVATE(Ai)
   REAL(rstd),POINTER :: xyz_i(:,:)     ! coordinate of the center of the cell (voronoi)
+!$OMP THREADPRIVATE(xyz_i)
   REAL(rstd),POINTER :: centroid(:,:)  ! coordinate of the centroid of the cell
+!$OMP THREADPRIVATE(centroid)
   REAL(rstd),POINTER :: xyz_e(:,:)     ! coordinate of a wind point on the cell on a edge
+!$OMP THREADPRIVATE(xyz_e)
   REAL(rstd),POINTER :: ep_e(:,:)      ! perpendicular unit vector of a edge (outsider)
+!$OMP THREADPRIVATE(ep_e)
   REAL(rstd),POINTER :: et_e(:,:)      ! tangeantial unit vector of a edge
+!$OMP THREADPRIVATE(et_e)
   REAL(rstd),POINTER :: elon_i(:,:)    ! unit longitude vector on the center 
+!$OMP THREADPRIVATE(elon_i)
   REAL(rstd),POINTER :: elat_i(:,:)    ! unit latitude vector on the center 
+!$OMP THREADPRIVATE(elat_i)
   REAL(rstd),POINTER :: elon_e(:,:)    ! unit longitude vector on a wind point 
+!$OMP THREADPRIVATE(elon_e)
   REAL(rstd),POINTER :: elat_e(:,:)    ! unit latitude vector on a wind point
+!$OMP THREADPRIVATE(elat_e)
   REAL(rstd),POINTER :: xyz_v(:,:)     ! coordinate of a vertex (center of the dual mesh)
+!$OMP THREADPRIVATE(xyz_v)
   REAL(rstd),POINTER :: Av(:)          ! area of dual mesk cell
+!$OMP THREADPRIVATE(Av)
   REAL(rstd),POINTER :: de(:)          ! distance from a neighbour == lenght of an edge of the dual mesh
+!$OMP THREADPRIVATE(de)
   REAL(rstd),POINTER :: le(:)          ! lenght of a edge
+!$OMP THREADPRIVATE(le)
   REAL(rstd),POINTER :: Riv(:,:)       ! weight
+!$OMP THREADPRIVATE(Riv)
   REAL(rstd),POINTER :: Riv2(:,:)      ! weight
+!$OMP THREADPRIVATE(Riv2)
   INTEGER,POINTER    :: ne(:,:)        ! convention for the way on the normal wind on an edge 
+!$OMP THREADPRIVATE(ne)
   REAL(rstd),POINTER :: Wee(:,:,:)     ! weight
+!$OMP THREADPRIVATE(Wee)
   REAL(rstd),POINTER :: bi(:)          ! orographie
+!$OMP THREADPRIVATE(bi)
   REAL(rstd),POINTER :: fv(:)          ! coriolis (evaluted on a vertex)
+!$OMP THREADPRIVATE(fv)
      
 
@@ -91,5 +112,5 @@
   IMPLICIT NONE
     INTEGER,INTENT(IN) :: ind
-!$OMP MASTER
+!!$OMP MASTER
     Ai=geom%Ai(ind)
     xyz_i=geom%xyz_i(ind)
@@ -112,6 +133,6 @@
     bi=geom%bi(ind)
     fv=geom%fv(ind)
-!$OMP END MASTER
-!$OMP BARRIER    
+!!$OMP END MASTER
+!!$OMP BARRIER    
   END SUBROUTINE swap_geometry
 
@@ -127,10 +148,21 @@
     REAL(rstd) :: vect(3,6)
     REAL(rstd) :: centr(3)
-
     INTEGER :: ind,i,j,n,k
-
-    CALL transfert_request(geom%xyz_i,req_i1)
+    TYPE(t_message),SAVE :: message
+    LOGICAL, SAVE :: first=.TRUE.
+!$OMP THREADPRIVATE(first)    
+    
+    IF (first) THEN
+      CALL init_message(geom%xyz_i, req_i1 ,message)
+      first=.FALSE.
+    ENDIF
+    
+    CALL transfert_message(geom%xyz_i,message)
+        
+    
+!    CALL transfert_request(geom%xyz_i,req_i1)
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -157,5 +189,5 @@
   USE transfert_mod
   USE vector
-  USE ioipsl
+  USE getin_mod
   IMPLICIT NONE
     INTEGER :: nb_it=0
@@ -172,4 +204,5 @@
     
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       d=>domain(ind)
       CALL swap_dimensions(ind)
@@ -186,4 +219,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       d=>domain(ind)
       CALL swap_dimensions(ind)
@@ -215,4 +249,5 @@
       sum=0
       DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
@@ -253,5 +288,5 @@
   USE dimensions
   USE transfert_mod
-  USE ioipsl
+  USE getin_mod
   IMPLICIT NONE
 
@@ -273,4 +308,5 @@
  
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       d=>domain(ind)
       CALL swap_dimensions(ind)
@@ -489,6 +525,8 @@
                  
     ENDDO
+
     CALL transfert_request(geom%Ai,req_i1)
     CALL transfert_request(geom%centroid,req_i1)
+
     CALL surf_triangle(d%xyz(:,ii_begin,jj_begin),d%xyz(:,ii_begin,jj_end),d%xyz(:,ii_end,jj_begin),S)
  
Index: codes/icosagcm/trunk/src/geopotential_mod.f90
===================================================================
--- codes/icosagcm/trunk/src/geopotential_mod.f90	(revision 185)
+++ codes/icosagcm/trunk/src/geopotential_mod.f90	(revision 186)
@@ -20,4 +20,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/getin.f90
===================================================================
--- codes/icosagcm/trunk/src/getin.f90	(revision 186)
+++ codes/icosagcm/trunk/src/getin.f90	(revision 186)
@@ -0,0 +1,70 @@
+MODULE getin_mod
+
+PRIVATE
+
+  INTERFACE getin
+    MODULE PROCEDURE getin_c , getin_l, getin_i, getin_r
+  END INTERFACE getin
+ 
+PUBLIC getin
+  
+CONTAINS
+
+  SUBROUTINE getin_c(name,value)
+  USE ioipsl, ONLY : getin_=>getin
+  USE transfert_omp_mod
+  USE omp_para
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: name
+    CHARACTER(LEN=*) :: value
+
+!$OMP MASTER    
+    CALL getin_(name,value)
+!$OMP END MASTER
+    IF (omp_in_parallel()) CALL bcast_omp(value)
+  END SUBROUTINE getin_c
+
+  SUBROUTINE getin_l(name,value)
+  USE ioipsl, ONLY : getin_=>getin
+  USE transfert_omp_mod
+  USE omp_para
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: name
+    LOGICAL          :: value
+
+!$OMP MASTER    
+    CALL getin_(name,value)
+!$OMP END MASTER
+    IF (omp_in_parallel()) CALL bcast_omp(value)
+  END SUBROUTINE getin_l
+
+  SUBROUTINE getin_i(name,value)
+  USE ioipsl, ONLY : getin_=>getin
+  USE transfert_omp_mod
+  USE omp_para
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: name
+    INTEGER          :: value
+
+!$OMP MASTER    
+    CALL getin_(name,value)
+!$OMP END MASTER
+    IF (omp_in_parallel()) CALL bcast_omp(value)
+  END SUBROUTINE getin_i
+  
+  
+  SUBROUTINE getin_r(name,value)
+  USE ioipsl, ONLY : getin_=>getin
+  USE omp_para
+  USE transfert_omp_mod
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: name
+    REAL             :: value
+
+!$OMP MASTER    
+    CALL getin_(name,value)
+!$OMP END MASTER
+    IF (omp_in_parallel()) CALL bcast_omp(value)
+  END SUBROUTINE getin_r
+ 
+END MODULE getin_mod
Index: codes/icosagcm/trunk/src/guided_mod.f90
===================================================================
--- codes/icosagcm/trunk/src/guided_mod.f90	(revision 185)
+++ codes/icosagcm/trunk/src/guided_mod.f90	(revision 186)
@@ -2,4 +2,5 @@
 
   CHARACTER(LEN=255),SAVE :: guided_type
+!$OMP THREADPRIVATE(guided_type)
 
 CONTAINS
Index: codes/icosagcm/trunk/src/guided_ncar_mod.f90
===================================================================
--- codes/icosagcm/trunk/src/guided_ncar_mod.f90	(revision 185)
+++ codes/icosagcm/trunk/src/guided_ncar_mod.f90	(revision 186)
@@ -4,4 +4,5 @@
   
   INTEGER,SAVE :: case_wind
+!$OMP THREADPRIVATE(case_wind)
   
   REAL(rstd), PARAMETER :: alpha=0.0 ! tilt of solid-body rotation
@@ -46,4 +47,5 @@
     
     DO ind = 1 , ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind) 
Index: codes/icosagcm/trunk/src/icosa_gcm.f90
===================================================================
--- codes/icosagcm/trunk/src/icosa_gcm.f90	(revision 185)
+++ codes/icosagcm/trunk/src/icosa_gcm.f90	(revision 186)
@@ -12,8 +12,9 @@
   USE xios_mod
   USE write_field
+  USE getin_mod
   IMPLICIT NONE
   
-  TYPE(t_field),POINTER :: sum_ne(:)
-  TYPE(t_field),POINTER :: sum_ne_glo(:)
+  TYPE(t_field),POINTER,SAVE :: sum_ne(:)
+  TYPE(t_field),POINTER,SAVE :: sum_ne_glo(:)
   REAL(rstd),POINTER :: pt_sum_ne(:)
   
@@ -24,4 +25,5 @@
  
   CALL init_mpipara
+  CALL trace_off
   CALL xios_init
   CALL init_earth_const 
@@ -34,6 +36,7 @@
   CALL init_trace
 
+!$OMP PARALLEL  
+  CALL compute_geometry
   
-  CALL compute_geometry
   CALL init_disvert 
   CALL init_vertical_interp
@@ -41,5 +44,6 @@
   CALL allocate_field(sum_ne,field_T,type_real)
   
-
+!$OMP BARRIER
+!$OMP MASTER
   DO ind=1,ndomain
      
@@ -60,12 +64,11 @@
     ENDDO
   ENDDO
-
-
   
   IF (is_mpi_root) PRINT *," Diff surf",1-tot_sum/(4*Pi*radius*radius)
+!$OMP END MASTER
 
+ 
+  CALL WriteField("Ai",geom%Ai)
   
-  CALL WriteField("Ai",geom%Ai)
-
   IF (is_mpi_root) CALL write_apbp
   CALL init_time
@@ -74,6 +77,7 @@
   CALL init_timeloop
 
-!$OMP PARALLEL
+
   CALL timeloop
+
 !$OMP END PARALLEL
 
Index: codes/icosagcm/trunk/src/icosa_mod.f90
===================================================================
--- codes/icosagcm/trunk/src/icosa_mod.f90	(revision 185)
+++ codes/icosagcm/trunk/src/icosa_mod.f90	(revision 186)
@@ -2,5 +2,6 @@
 
   USE genmod
-  USE ioipsl, ONLY : getin
+!  USE ioipsl, ONLY : getin
+  USE getin_mod, ONLY : getin
   USE grid_param
   USE metric
Index: codes/icosagcm/trunk/src/kinetic.f90
===================================================================
--- codes/icosagcm/trunk/src/kinetic.f90	(revision 185)
+++ codes/icosagcm/trunk/src/kinetic.f90	(revision 186)
@@ -18,4 +18,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/mpi_mod.F90
===================================================================
--- codes/icosagcm/trunk/src/mpi_mod.F90	(revision 185)
+++ codes/icosagcm/trunk/src/mpi_mod.F90	(revision 186)
@@ -12,4 +12,7 @@
   INTEGER :: MPI_STATUS_SIZE 
   INTEGER :: MPI_SUM
+  INTEGER :: MPI_THREAD_SINGLE, MPI_THREAD_FUNNELED, 
+  INTEGER :: MPI_THREAD_SERIALIZED, MPI_THREAD_MULTIPLE
+  
   INTEGER,PARAMETER :: MPI_ADDRESS_KIND=KIND(INTEGER)
 #endif
@@ -21,4 +24,8 @@
 
  SUBROUTINE  MPI_INIT
+   PRINT *, 'Compiled without MPI'
+ END
+
+ SUBROUTINE  MPI_INIT_THREAD
    PRINT *, 'Compiled without MPI'
  END
@@ -69,3 +76,6 @@
  END
 
+ SUBROUTINE MPI_FREE_MEM
+ END
+
 #endif
Index: codes/icosagcm/trunk/src/mpipara.F90
===================================================================
--- codes/icosagcm/trunk/src/mpipara.F90	(revision 185)
+++ codes/icosagcm/trunk/src/mpipara.F90	(revision 186)
@@ -3,4 +3,5 @@
   INTEGER,SAVE :: mpi_rank
   INTEGER,SAVE :: mpi_size
+  INTEGER,SAVE :: mpi_threading_mode
   
   INTEGER,SAVE :: comm_icosa
@@ -13,12 +14,19 @@
   END INTERFACE allocate_mpi_buffer
 
+  INTERFACE free_mpi_buffer
+    MODULE PROCEDURE free_mpi_buffer_r2, free_mpi_buffer_r3, free_mpi_buffer_r4
+  END INTERFACE free_mpi_buffer
+
 CONTAINS
 
   SUBROUTINE init_mpipara
   USE mpi_mod
+  USE getin_mod
 #ifdef CPP_USING_XIOS
   USE xios
 #endif
   IMPLICIT NONE
+    CHARACTER(LEN=256) :: required_mode_str
+    INTEGER :: required_mode
 
     using_mpi=.FALSE.
@@ -28,6 +36,44 @@
     
     IF (using_mpi) THEN
-      CALL MPI_INIT(ierr)
-
+    
+      required_mode_str='multiple'
+      CALL getin('mpi_threading_mode',required_mode_str)
+      
+      SELECT CASE(TRIM(required_mode_str))
+        CASE ('single')
+          required_mode=MPI_THREAD_SINGLE
+        CASE ('funneled')
+          required_mode=MPI_THREAD_FUNNELED
+        CASE ('serialized')
+          required_mode=MPI_THREAD_SERIALIZED
+        CASE ('multiple')
+          required_mode=MPI_THREAD_MULTIPLE
+        CASE DEFAULT
+          PRINT*,'Bad selector for variable mpi_threading_mode  : <', TRIM(required_mode_str),  &
+                 '>  => options are <single>, <funneled>, <serialized>, <multiple>'
+          STOP
+      END SELECT
+      
+
+      IF (required_mode==MPI_THREAD_SINGLE)     PRINT*,'MPI_INIT_THREAD : MPI_SINGLE_THREAD required'
+      IF (required_mode==MPI_THREAD_FUNNELED)   PRINT*,'MPI_INIT_THREAD : MPI_THREAD_FUNNELED required'
+      IF (required_mode==MPI_THREAD_SERIALIZED) PRINT*,'MPI_INIT_THREAD : MPI_THREAD_SERIALIZED required'
+      IF (required_mode==MPI_THREAD_MULTIPLE)   PRINT*,'MPI_INIT_THREAD : MPI_THREAD_MULTIPLE required'
+
+      
+      CALL MPI_INIT_THREAD(MPI_THREAD_MULTIPLE,mpi_threading_mode,ierr)
+      
+      IF (mpi_threading_mode==MPI_THREAD_SINGLE)     PRINT*,'MPI_INIT_THREAD : MPI_SINGLE_THREAD provided'
+      IF (mpi_threading_mode==MPI_THREAD_FUNNELED)   PRINT*,'MPI_INIT_THREAD : MPI_THREAD_FUNNELED provided'
+      IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) PRINT*,'MPI_INIT_THREAD : MPI_THREAD_SERIALIZED provided'
+      IF (mpi_threading_mode==MPI_THREAD_MULTIPLE)   PRINT*,'MPI_INIT_THREAD : MPI_THREAD_MULTIPLE provided'
+
+      IF (mpi_threading_mode > required_mode) mpi_threading_mode=required_mode
+
+      IF (mpi_threading_mode==MPI_THREAD_SINGLE)     PRINT*,'MPI_INIT_THREAD : MPI_SINGLE_THREAD used'
+      IF (mpi_threading_mode==MPI_THREAD_FUNNELED)   PRINT*,'MPI_INIT_THREAD : MPI_THREAD_FUNNELED used'
+      IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) PRINT*,'MPI_INIT_THREAD : MPI_THREAD_SERIALIZED used'
+      IF (mpi_threading_mode==MPI_THREAD_MULTIPLE)   PRINT*,'MPI_INIT_THREAD : MPI_THREAD_MULTIPLE used'
+          
 #ifdef CPP_USING_XIOS
       CALL xios_initialize("icosagcm",return_comm=comm_icosa)
@@ -79,5 +125,16 @@
     CALL C_F_POINTER(base_ptr, buffer, (/ length /))
 
-   END SUBROUTINE allocate_mpi_buffer_r2
+  END SUBROUTINE allocate_mpi_buffer_r2
+
+  SUBROUTINE free_mpi_buffer_r2(buffer)
+  USE ISO_C_BINDING
+  USE mpi_mod
+  USE prec
+  IMPLICIT NONE
+    REAL(rstd), POINTER :: buffer(:)
+
+    CALL MPI_FREE_MEM(buffer,ierr)
+
+   END SUBROUTINE free_mpi_buffer_r2
 
   SUBROUTINE allocate_mpi_buffer_r3(buffer,length,dim3)
@@ -100,5 +157,16 @@
     CALL C_F_POINTER(base_ptr, buffer, (/ length,dim3 /))
     
-   END SUBROUTINE allocate_mpi_buffer_r3
+  END SUBROUTINE allocate_mpi_buffer_r3
+
+  SUBROUTINE free_mpi_buffer_r3(buffer)
+  USE ISO_C_BINDING
+  USE mpi_mod
+  USE prec
+  IMPLICIT NONE
+    REAL(rstd), POINTER :: buffer(:,:)
+
+    CALL MPI_FREE_MEM(buffer,ierr)
+
+  END SUBROUTINE free_mpi_buffer_r3
 
   SUBROUTINE allocate_mpi_buffer_r4(buffer,length,dim3,dim4)
@@ -123,4 +191,15 @@
     
    END SUBROUTINE allocate_mpi_buffer_r4
+
+  SUBROUTINE free_mpi_buffer_r4(buffer)
+  USE ISO_C_BINDING
+  USE mpi_mod
+  USE prec
+  IMPLICIT NONE
+    REAL(rstd), POINTER :: buffer(:,:,:)
+
+    CALL MPI_FREE_MEM(buffer,ierr)
+
+  END SUBROUTINE free_mpi_buffer_r4
    
 END MODULE mpipara
Index: codes/icosagcm/trunk/src/omega.f90
===================================================================
--- codes/icosagcm/trunk/src/omega.f90	(revision 185)
+++ codes/icosagcm/trunk/src/omega.f90	(revision 186)
@@ -13,4 +13,5 @@
     REAL(rstd),POINTER :: ps(:), u(:,:), om(:,:)
     DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/omp_para.F90
===================================================================
--- codes/icosagcm/trunk/src/omp_para.F90	(revision 185)
+++ codes/icosagcm/trunk/src/omp_para.F90	(revision 186)
@@ -18,4 +18,6 @@
   LOGICAL,SAVE :: using_openmp
 
+  LOGICAL,PARAMETER :: omp_by_domain=.TRUE. 
+
 CONTAINS
 
@@ -23,5 +25,5 @@
   SUBROUTINE init_omp_para
   USE grid_param
-#ifdef CPP_USING_OPENMP
+#ifdef CPP_USING_OMP
   USE omp_lib
 #endif
@@ -29,5 +31,5 @@
   INTEGER :: ll_nb,i
 
-#ifdef CPP_USING_OPENMP
+#ifdef CPP_USING_OMP
   using_openmp=.TRUE.
 #else
@@ -39,39 +41,58 @@
   
 !$OMP MASTER
-#ifdef CPP_USING_OPENMP
+#ifdef CPP_USING_OMP
     omp_size=OMP_GET_NUM_THREADS()
 #endif
 !$OMP END MASTER
 !$OMP BARRIER
-#ifdef CPP_USING_OPENMP
+#ifdef CPP_USING_OMP
     omp_rank=OMP_GET_THREAD_NUM()
 #endif
-    omp_first=.FALSE.
-    omp_last=.FALSE.
-    omp_master=.FALSE.
+
+    IF (omp_by_domain) THEN
+      omp_first=.TRUE.
+      omp_last=.TRUE.
+      IF (omp_rank==0) THEN
+        omp_master=.TRUE.
+      ELSE
+        omp_master=.FALSE.
+      ENDIF
+     
+      ll_begin=1
+      ll_beginp1=2
+      ll_end=llm
+      ll_endm1=llm-1
+      ll_endp1=llm+1
+     
+    ELSE    
     
-    IF (omp_rank==0) THEN
-      omp_first=.TRUE.
-      omp_master=.TRUE.
+      omp_first=.FALSE.
+      omp_last=.FALSE.
+      omp_master=.FALSE.
+    
+      IF (omp_rank==0) THEN
+        omp_first=.TRUE.
+        omp_master=.TRUE.
+      ENDIF
+    
+      IF (omp_rank==omp_size-1) omp_last=.TRUE.
+    
+      ll_end=0
+      DO i=0,omp_rank
+        ll_begin=ll_end+1
+        ll_nb=llm/omp_size
+        IF (MOD(llm,omp_size)>i) ll_nb=ll_nb+1
+        ll_end=ll_begin+ll_nb-1
+      ENDDO
+    
+      ll_beginp1=ll_begin
+      ll_endp1=ll_end
+      ll_endm1=ll_end
+
+      IF (omp_first) ll_beginp1=ll_begin+1
+      IF (omp_last) ll_endp1=ll_endp1+1
+      IF (omp_last) ll_endm1=ll_endm1-1
+    
     ENDIF
-    
-    IF (omp_rank==omp_size-1) omp_last=.TRUE.
-    
-    ll_end=0
-    DO i=0,omp_rank
-      ll_begin=ll_end+1
-      ll_nb=llm/omp_size
-      IF (MOD(llm,omp_size)>i) ll_nb=ll_nb+1
-      ll_end=ll_begin+ll_nb-1
-    ENDDO
-    
-    ll_beginp1=ll_begin
-    ll_endp1=ll_end
-    ll_endm1=ll_end
-
-    IF (omp_first) ll_beginp1=ll_begin+1
-    IF (omp_last) ll_endp1=ll_endp1+1
-    IF (omp_last) ll_endm1=ll_endm1-1
-
 !$OMP END PARALLEL
 
@@ -91,5 +112,19 @@
   END SUBROUTINE init_omp_para
 
-  
+  FUNCTION omp_in_parallel()
+#ifdef CPP_USING_OMP
+  USE omp_lib, ONLY : omp_in_parallel_=>omp_in_parallel
+#endif
+  IMPLICIT NONE
+    LOGICAL :: omp_in_parallel
+    
+#ifdef CPP_USING_OMP
+    omp_in_parallel=omp_in_parallel_()
+#else
+    omp_in_parallel=.FALSE.
+#endif
+
+  END FUNCTION  omp_in_parallel  
+      
 END MODULE omp_para
     
Index: codes/icosagcm/trunk/src/output_field.f90
===================================================================
--- codes/icosagcm/trunk/src/output_field.f90	(revision 185)
+++ codes/icosagcm/trunk/src/output_field.f90	(revision 186)
@@ -2,15 +2,21 @@
 USE genmod
   PRIVATE
-  LOGICAL,SAVE :: xios_output    
+  LOGICAL,SAVE :: xios_output 
+!$OMP THREADPRIVATE(xios_output)     
+  LOGICAL,SAVE :: enable_io    
+!$OMP THREADPRIVATE(enable_io)     
 
-  PUBLIC xios_output,output_field_init,output_field,output_field_finalize
+  PUBLIC enable_io,xios_output,output_field_init,output_field,output_field_finalize
 
 CONTAINS 
   
   SUBROUTINE output_field_init
-  USE IOIPSL
+  USE getin_mod
   USE xios_mod
   USE write_field
   IMPLICIT NONE
+
+    enable_io=.TRUE.
+    CALL getin('enable_io',enable_io)
 
     IF (using_xios) THEN
Index: codes/icosagcm/trunk/src/phyparam.F
===================================================================
--- codes/icosagcm/trunk/src/phyparam.F	(revision 185)
+++ codes/icosagcm/trunk/src/phyparam.F	(revision 186)
@@ -1,601 +1,0 @@
-	MODULE PHY
-         USE dimphys_mod
-         LOGICAL:: firstcall,lastcall
-	contains      
-
-	SUBROUTINE phyparam_lmd(it,ngrid,nlayer,nq,
-     s            ptimestep,lati,long,rjourvrai,gmtime,
-     s            pplev,pplay,pphi,pphis,
-     s            pu,pv,pt,pq,
-     s            pdu,pdv,pdt,pdq,pdpsrf)
-
-	USE ICOSA
-	USE dimphys_mod
-	USE RADIATION
-	USE SURFACE_PROCESS
-c
-      IMPLICIT NONE
-c=======================================================================
-c
-c   subject:
-c   --------
-c
-c   Organisation of the physical parametrisations of the LMD 
-c   20 parameters GCM for planetary atmospheres.
-c   It includes:
-c   raditive transfer (long and shortwave) for CO2 and dust.
-c   vertical turbulent mixing
-c   convective adjsutment
-c
-c   author: Frederic Hourdin 15 / 10 /93
-c   -------
-c
-c   arguments:
-c   ----------
-c
-c   input:
-c   ------
-c
-c    ngrid                 Size of the horizontal grid.
-c                          All internal loops are performed on that grid.
-c    nlayer                Number of vertical layers.
-c    nq                    Number of advected fields
-c    firstcall             True at the first call
-c    lastcall              True at the last call
-c    rjourvrai                  Number of days counted from the North. Spring
-c                          equinoxe.
-c    gmtime                 hour (s)
-c    ptimestep             timestep (s)
-c    pplay(ngrid,nlayer+1) Pressure at the middle of the layers (Pa)
-c    pplev(ngrid,nlayer+1) intermediate pressure levels (pa)
-c    pphi(ngrid,nlayer)    Geopotential at the middle of the layers (m2s-2)
-c    pu(ngrid,nlayer)      u component of the wind (ms-1)
-c    pv(ngrid,nlayer)      v component of the wind (ms-1)
-c    pt(ngrid,nlayer)      Temperature (K)
-c    pq(ngrid,nlayer,nq)   Advected fields
-c    pudyn(ngrid,nlayer)    \ 
-c    pvdyn(ngrid,nlayer)     \ Dynamical temporal derivative for the
-c    ptdyn(ngrid,nlayer)     / corresponding variables
-c    pqdyn(ngrid,nlayer,nq) /
-c    pw(ngrid,?)           vertical velocity
-c
-c   output:
-c   -------
-c
-c    pdu(ngrid,nlayer)        \
-c    pdv(ngrid,nlayer)         \  Temporal derivative of the corresponding
-c    pdt(ngrid,nlayer)         /  variables due to physical processes.
-c    pdq(ngrid,nlayer)      /
-c    pdpsrf(ngrid)        /
-c
-c=======================================================================
-c
-!c-----------------------------------------------------------------------
-!c
-!c    0.  Declarations :
-!c    ------------------
-!c    Arguments :
-!c    -----------
-
-!c    inputs:
-!c    -------
-	INTEGER ngrid,nlayer,nq,it,ij,i
-      REAL ptimestep
-      real zdtime
-      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
-      REAL pphi(ngrid,nlayer)
-      REAL pphis(ngrid)
-      REAL pu(ngrid,nlayer),pv(ngrid,nlayer)
-      REAL pt(ngrid,nlayer),pq(ngrid,nlayer,nq)
-      REAL pdu(ngrid,nlayer),pdv(ngrid,nlayer)
-
-!c   dynamial tendencies
-      REAL pdtdyn(ngrid,nlayer),pdqdyn(ngrid,nlayer,nq)
-      REAL pdudyn(ngrid,nlayer),pdvdyn(ngrid,nlayer)
-      REAL pw(ngrid,nlayer)
-
-!c   Time
-      real rjourvrai
-      REAL gmtime
-
-!c     outputs:
-!c     --------
-
-!c   physical tendencies
-      REAL pdt(ngrid,nlayer),pdq(ngrid,nlayer,nq)
-      REAL pdpsrf(ngrid)
-
-
-!c    Local variables :
-!c    -----------------
-
-      INTEGER j,l,ig,ierr,aslun,nlevel,igout,it1,it2,unit,isoil
-      REAL zps_av
-      REAL zday
-      REAL zh(ngrid,nlayer),z1,z2
-      REAL zzlev(ngrid,nlayer+1),zzlay(ngrid,nlayer)
-      REAL zdvfr(ngrid,nlayer),zdufr(ngrid,nlayer)
-      REAL zdhfr(ngrid,nlayer),zdtsrf(ngrid),zdtsrfr(ngrid)
-      REAL zflubid(ngrid),zpmer(ngrid)
-      REAL zplanck(ngrid),zpopsk(ngrid,nlayer)
-      REAL zdum1(ngrid,nlayer)
-      REAL zdum2(ngrid,nlayer)
-      REAL zdum3(ngrid,nlayer)
-      REAL ztim1,ztim2,ztim3
-      REAL zls,zinsol
-      REAL zdtlw(ngrid,nlayer),zdtsw(ngrid,nlayer)
-      REAL zfluxsw(ngrid),zfluxlw(ngrid)
-      character*2 str2
-
-!c   Local saved variables:
-!c   ----------------------
-	REAL(rstd)::long(ngrid),lati(ngrid) 
-	REAL(rstd)::mu0(ngrid),fract(ngrid),coslat(ngrid)
-        REAL(rstd)::sinlon(ngrid),coslon(ngrid),sinlat(ngrid)
-	REAL(rstd)::dist_sol,declin
-        REAL::totarea !sarvesh  
-!!!!!!!!sarvesh !!!!!!! CHECK SAVE ATTRIBUTE 
-      INTEGER:: icount
-      real:: zday_last
-      REAL:: solarcst
-
-      SAVE icount,zday_last
-      SAVE solarcst
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      REAL stephan
-      SAVE stephan
-      DATA stephan/5.67e-08/
-      DATA solarcst/1370./
-      REAL presnivs(nlayer)
-	INTEGER:: nn1,nn2
-c-----------------------------------------------------------------------
-c    1. Initialisations :
-c    --------------------
-c     call initial0(ngrid*nlayer*nqmx,pdq)
-
-!	nn1=(jj_begin -1)*iim+ii_begin
-!	nn2=(jj_end -1)*iim+ii_end
-
-      nlevel=nlayer+1
-      igout=ngrid/2+1
-
-	 DO j=jj_begin-offset,jj_end+offset
-         DO i=ii_begin-offset,ii_end+offset
-           ig=(j-1)*iim+i
-	   sinlat(ig) = sin(lati(ig))
-	   coslat(ig) = cos(lati(ig))
-	   sinlon(ig) = sin(long(ig))
-	   coslon(ig) = cos(long(ig))
-	  END DO
-	 ENDDO 
-        zday=rjourvrai+gmtime
-	IF ( it == 0 ) then 
-	 firstcall=.TRUE.
-	ELSE
-	 firstcall=.FALSE. 
-	ENDIF 
-	IF ( it == ndays*day_step ) Then
-	 lastcall = .True.
-        END IF 
-	 
-        IF(firstcall) THEN
-        PRINT*,'FIRSTCALL  ',ngridmx,nlayermx,nsoilmx
-         zday_last=rjourvrai
-         inertie=2000
-         albedo=0.2
-         emissiv=1.
-         z0=0.1
-         rnatur=1.
-         q2=1.e-10
-         q2l=1.e-10
-         tsurf(:)=300.
-         tsoil(:,:)=300.
-!         print*,tsoil(ngrid/2+1,nsoilmx/2+2)
-!         print*,'TS ',tsurf(igout),tsoil(igout,5)
- 
-          IF (.not.callrad) then
-	    DO j=jj_begin-offset,jj_end+offset
-             DO i=ii_begin-offset,ii_end+offset
-              ig=(j-1)*iim+i
-              fluxrad(ig)=0.
-             enddo
-            enddo
-           ENDIF
-
-         IF(callsoil) THEN
-             CALL soil(ngrid,nsoilmx,firstcall,inertie,
-     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
-          ELSE
-            PRINT*,'WARNING!!! Thermal conduction in the soil
-     s      turned off'
-	    DO j=jj_begin-offset,jj_end+offset
-             DO i=ii_begin-offset,ii_end+offset
-               ig=(j-1)*iim+i
-               capcal(ig)=1.e5
-               fluxgrd(ig)=0.
-             ENDDO
-           ENDDO
-          ENDIF
-            icount=0
-         ENDIF
-
-        IF (ngrid.NE.ngrid) THEN
-         PRINT*,'STOP in inifis'
-         PRINT*,'Probleme de dimenesions :'
-         PRINT*,'ngrid     = ',ngrid
-         PRINT*,'ngrid   = ',ngrid
-         STOP
-        ENDIF
-
-       DO l=1,nlayer
-         DO j=jj_begin-offset,jj_end+offset
-         DO i=ii_begin-offset,ii_end+offset
-            ig=(j-1)*iim+i
-            pdv(ig,l)=0.
-            pdu(ig,l)=0.
-            pdt(ig,l)=0.
-          ENDDO
-         ENDDO
-        ENDDO
-
-         DO j=jj_begin-offset,jj_end+offset
-         DO i=ii_begin-offset,ii_end+offset
-          ig=(j-1)*iim+i
-          pdpsrf(ig)=0.
-          zflubid(ig)=0.
-          zdtsrf(ig)=0.
-         ENDDO
-	ENDDO
-
-        zps_av=0.0
-         DO j=jj_begin-offset,jj_end+offset
-         DO i=ii_begin-offset,ii_end+offset
-           ig=(j-1)*iim+i
-           zps_av=zps_av+pplev(ig,1)*Ai(ig)
-           totarea=totarea+Ai(ig)
-          END DO
-         END DO
-	zps_av=zps_av/totarea
-
-
-	!print*,"maxplev",maxval(pplev(:,1)),minval(pplev(:,1))
-c-----------------------------------------------------------------------
-c   calcul du geopotentiel aux niveaux intercouches
-c   ponderation des altitudes au niveau des couches en dp/p
-
-       DO l=1,nlayer
-         DO j=jj_begin-offset,jj_end+offset
-         DO i=ii_begin-offset,ii_end+offset
-          ig=(j-1)*iim+i
-          zzlay(ig,l)=pphi(ig,l)/g
-         ENDDO
-        ENDDO
-       ENDDO
-
-	!print*,"zzlay",maxval(zzlay(:,1)),minval(zzlay(:,1))
-
-
-        DO j=jj_begin-offset,jj_end+offset
-         DO i=ii_begin-offset,ii_end+offset
-          ig=(j-1)*iim+i
-          zzlev(ig,1)=0.
-         ENDDO
-        ENDDO
-
-      DO l=2,nlayer
-         DO j=jj_begin-offset,jj_end+offset
-         DO i=ii_begin-offset,ii_end+offset
-          ig=(j-1)*iim+i
-          z1=(pplay(ig,l-1)+pplev(ig,l))/(pplay(ig,l-1)-pplev(ig,l))
-          z2=(pplev(ig,l)+pplay(ig,l))/(pplev(ig,l)-pplay(ig,l))
-          zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
-         ENDDO
-        ENDDO
-       ENDDO
-       !print*,"zzlev",maxval(zzlev(:,1)),minval(zzlev(:,1))
-c-----------------------------------------------------------------------
-c   Transformation de la temperature en temperature potentielle
-        DO l=1,nlayer
-          DO j=jj_begin-offset,jj_end+offset
-          DO i=ii_begin-offset,ii_end+offset
-           ig=(j-1)*iim  +i
-           zpopsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**kappa
-          ENDDO
-         ENDDO
-        ENDDO
-
-        DO l=1,nlayer
-          DO j=jj_begin-offset,jj_end+offset
-          DO i=ii_begin-offset,ii_end+offset
-           ig=(j-1)*iim+i
-           zh(ig,l)=pt(ig,l)/zpopsk(ig,l)
-          ENDDO
-         ENDDO
-	ENDDO
-	!print*,"ph pot",maxval(zh(:,1)),minval(zh(:,1))
-!	go to 101
-c-----------------------------------------------------------------------
-c    2. Calcul of the radiative tendencies :
-c    ---------------------------------------
-!      print*,'callrad0'
-      IF(callrad) THEN
-!         print*,'callrad'
-!   WARNING !!! on calcule le ray a chaque appel
-!        IF( MOD(icount,iradia).EQ.0) THEN
-
-           CALL solarlong(zday,zls)
-           CALL orbite(zls,dist_sol,declin)
-!   
-!      print*,'ATTENTIOn : pdeclin = 0','  L_s=',zls
-!      print*,'diurnal=',diurnal
-       IF(diurnal) THEN
-         if ( 1.eq.1 ) then
-               ztim1=SIN(declin)
-               ztim2=COS(declin)*COS(2.*pi*(zday-.5))
-               ztim3=-COS(declin)*SIN(2.*pi*(zday-.5))
-
-               CALL solang(ngrid,sinlon,coslon,sinlat,coslat,
-     s         ztim1,ztim2,ztim3,
-     s         mu0,fract)
-          else
-               zdtime=ptimestep*float(iradia)
-!               CALL zenang(zls,gmtime,zdtime,lati,long,mu0,fract) ! FIXME
-              !print*,'ZENANG '
-         endif
-
-          IF(lverbose) THEN
-                  PRINT*,'day, declin, sinlon,coslon,sinlat,coslat'
-                  PRINT*,zday, declin,
-     s            sinlon(igout),coslon(igout),
-     s            sinlat(igout),coslat(igout)
-           ENDIF
-        ELSE
-             !print*,'declin,ngrid,radius',declin,ngrid,radius
-            CALL mucorr(ngrid,declin,lati,mu0,fract,10000.,radius)
-!	      open(100,file="mu0.txt")
-!	      write(100,*)(mu0(ij),ij=1,ngrid) 
-        ENDIF
-!	print*,"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii"
-!c    2.2 Calcul of the radiative tendencies and fluxes:
-!c    --------------------------------------------------
-!c  2.1.2 levels
-
-            zinsol=solarcst/(dist_sol*dist_sol)
-!            print*,'iim,jjm,llm,ngrid,nlayer,ngrid,nlayer'
-!            print*,iim,jjm,llm,ngrid,nlayer,ngrid,nlayer
-!		print*,"zinsol sol_dist",zinsol,dist_sol
-!	STOP 
-
-            CALL sw(ngrid,nlayer,diurnal,coefvis,albedo,
-     $              pplev,zps_av,
-     $              mu0,fract,zinsol,
-     $              zfluxsw,zdtsw,
-     $              lverbose)
-
-	!print*,"sw",maxval(zfluxsw),minval(zfluxsw),
-!	$            maxval(zdtsw),minval(zdtsw), "   it",it
-
-!	print*,"lllllllllllllllllllllllllllllllllllllllll"
-!	print*,"pplev",maxval(pplev),minval(pplev)
-!	print*,"zps,tsurf",zps_av,maxval(tsurf),minval(tsurf)
-!	print*,"pt",maxval(pt),minval(pt) 
-
-
-            CALL lw(ngrid,nlayer,coefir,emissiv,
-     $             pplev,zps_av,tsurf,pt,
-     $             zfluxlw,zdtlw,
-     $             lverbose)
-
-	!print*,"lw",maxval(zfluxlw),minval(zfluxlw),
-!	$            maxval(zdtlw),minval(zdtlw)
-
-!	print*,"lw",maxval(
-
-!	print*,"after lw"
-c    2.4 total flux and tendencies:
-c    ------------------------------
-
-c    2.4.1 fluxes
-
-          DO j=jj_begin-offset,jj_end+offset
-           DO i=ii_begin-offset,ii_end+offset
-               ig=(j-1)*iim+i
-               fluxrad(ig)=emissiv(ig)*zfluxlw(ig)
-     $         +zfluxsw(ig)*(1.-albedo(ig))
-
-               zplanck(ig)=tsurf(ig)*tsurf(ig)
-
-               zplanck(ig)=emissiv(ig)*
-     $         stephan*zplanck(ig)*zplanck(ig)
-
-               fluxrad(ig)=fluxrad(ig)-zplanck(ig)
-            ENDDO
-          ENDDO
-c    2.4.2 temperature tendencies
-
-            DO l=1,nlayer
-	       DO j=jj_begin-offset,jj_end+offset
-                DO i=ii_begin-offset,ii_end+offset
-                  ig=(j-1)*iim+i
-                  dtrad(ig,l)=zdtsw(ig,l)+zdtlw(ig,l)
-                 ENDDO
-               ENDDO
-             ENDDO
-
-
-c    2.5 Transformation of the radiative tendencies:
-c    -----------------------------------------------
-
-         DO l=1,nlayer
-	    DO j=jj_begin-offset,jj_end+offset
-            DO i=ii_begin-offset,ii_end+offset
-              ig=(j-1)*iim+i
-              pdt(ig,l)=pdt(ig,l)+dtrad(ig,l)
-            ENDDO
-           ENDDO
-          ENDDO
-
-         IF(lverbose) THEN
-            PRINT*,'Diagnotique for the radaition'
-            PRINT*,'albedo, emissiv, mu0,fract,Frad,Planck'
-            PRINT*,albedo(igout),emissiv(igout),mu0(igout),
-     s           fract(igout),
-     s           fluxrad(igout),zplanck(igout)
-            PRINT*,'Tlay Play Plev dT/dt SW dT/dt LW (K/day)'
-!            PRINT*,'unjours',unjours
-            DO l=1,nlayer
-               WRITE(*,'(3f15.5,2e15.2)') pt(igout,l),
-     s         pplay(igout,l),pplev(igout,l),
-     s         zdtsw(igout,l),zdtlw(igout,l)
-            ENDDO
-          ENDIF
-        ENDIF   !( CALL RADIATION ) 
-!	print*,"eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee"
-
-c-----------------------------------------------------------------------
-c    3. Vertical diffusion (turbulent mixing):
-c    -----------------------------------------
-c
-       IF(calldifv) THEN
-
-         DO ig=1,ngrid
-            zflubid(ig)=fluxrad(ig)+fluxgrd(ig)
-         ENDDO
-
-         CALL zerophys(ngrid*nlayer,zdum1)
-         CALL zerophys(ngrid*nlayer,zdum2)
-c        CALL zerophys(ngrid*nlayer,zdum3)
-         do l=1,nlayer
-            do ig=1,ngrid
-               zdum3(ig,l)=pdt(ig,l)/zpopsk(ig,l)
-            enddo
-         enddo
-
-         CALL vdif(ngrid,nlayer,zday,
-     $        ptimestep,capcal,z0,
-     $        pplay,pplev,zzlay,zzlev,
-     $        pu,pv,zh,tsurf,emissiv,
-     $        zdum1,zdum2,zdum3,zflubid,
-     $        zdufr,zdvfr,zdhfr,zdtsrfr,q2,q2l,
-     $        lverbose)
-c        igout=ngrid/2+1
-c        PRINT*,'zdufr zdvfr zdhfr'
-c        DO l=1,nlayer
-c           PRINT*,zdufr(igout,1),zdvfr(igout,l),zdhfr(igout,l)
-c        ENDDO
-c        CALL difv  (ngrid,nlayer,
-c    $                  area,lati,capcal,
-c    $                  pplev,pphi,
-c    $                  pu,pv,zh,tsurf,emissiv,
-c    $                  zdum1,zdum2,zdum3,zflubid,
-c    $                  zdufr,zdvfr,zdhfr,zdtsrf,
-c    $                  .true.)
-c        PRINT*,'zdufr zdvfr zdhfr'
-c        DO l=1,nlayer
-c           PRINT*,zdufr(igout,1),zdvfr(igout,l),zdhfr(igout,l)
-c        ENDDO
-c        STOP
-
-         DO l=1,nlayer
-            DO ig=1,ngrid
-               pdv(ig,l)=pdv(ig,l)+zdvfr(ig,l)
-               pdu(ig,l)=pdu(ig,l)+zdufr(ig,l)
-               pdt(ig,l)=pdt(ig,l)+zdhfr(ig,l)*zpopsk(ig,l)
-            ENDDO
-         ENDDO
-
-         DO ig=1,ngrid
-            zdtsrf(ig)=zdtsrf(ig)+zdtsrfr(ig)
-         ENDDO
-
-       ELSE
-
-         DO j=jj_begin-offset,jj_end+offset
-          DO i=ii_begin-offset,ii_end+offset
-            ig=(j-1)*iim+i
-            zdtsrf(ig)=zdtsrf(ig)+
-     s      (fluxrad(ig)+fluxgrd(ig))/capcal(ig)
-          ENDDO
-         ENDDO
-
-!       write(66,*)"tsrf",maxval(zdtsrf(:)),minval(zdtsrf(:))
-!       write(66,*)"frd",maxval(fluxrad(:)),minval(fluxrad(:))
-!       write(66,*)"fgd",maxval(fluxgrd(:)),minval(fluxgrd(:))
-        ENDIF
-c-----------------------------------------------------------------------
-c   4. Dry convective adjustment:
-c   -----------------------------
-
-      IF(calladj) THEN
-
-         DO l=1,nlayer
-            DO ig=1,ngrid
-               zdum1(ig,l)=pdt(ig,l)/zpopsk(ig,l)
-            ENDDO
-         ENDDO
-         CALL zerophys(ngrid*nlayer,zdufr)
-         CALL zerophys(ngrid*nlayer,zdvfr)
-         CALL zerophys(ngrid*nlayer,zdhfr)
-         CALL convadj(ngrid,nlayer,ptimestep,
-     $                pplay,pplev,zpopsk,
-     $                pu,pv,zh,
-     $                pdu,pdv,zdum1,
-     $                zdufr,zdvfr,zdhfr)
-
-         DO l=1,nlayer
-            DO ig=1,ngrid
-               pdu(ig,l)=pdu(ig,l)+zdufr(ig,l)
-               pdv(ig,l)=pdv(ig,l)+zdvfr(ig,l)
-               pdt(ig,l)=pdt(ig,l)+zdhfr(ig,l)*zpopsk(ig,l)
-            ENDDO
-         ENDDO
-
-        ENDIF
-
-!101		continue
-c-----------------------------------------------------------------------
-c   On incremente les tendances physiques de la temperature du sol:
-c   ---------------------------------------------------------------
-!       WRITE(55,*)"tsurf",maxval(tsurf(:)),minval(tsurf(:)),it
-
-	  DO j=jj_begin-offset,jj_end+offset
-           DO i=ii_begin-offset,ii_end+offset
-             ig=(j-1)*iim+i
-             tsurf(ig)=tsurf(ig)+ptimestep*zdtsrf(ig) 
-           ENDDO
-         ENDDO
-c-----------------------------------------------------------------------
-c   soil temperatures:
-c   --------------------
-
-       IF (callsoil) THEN
-         CALL soil(ngrid,nsoilmx,.false.,inertie,
-     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
-         IF(lverbose) THEN
-            PRINT*,'Surface Heat capacity,conduction Flux, Ts,
-     s          dTs, dt'
-            PRINT*,capcal(igout),fluxgrd(igout),tsurf(igout),
-     s          zdtsrf(igout),ptimestep
-         ENDIF
-       ENDIF
-
-c-----------------------------------------------------------------------
-c   sorties:
-c   --------
-      if(zday.GT.zday_last+period_sort) then
-       zday_last=zday
-c  Ecriture/extension de la coordonnee temps
-
-         do ig=1,ngrid
-            zpmer(ig)=pplev(ig,1)*exp(pphi(ig,1)/(kappa*cpp*285.))
-         enddo
-       endif
-c-----------------------------------------------------------------------
-      IF(lastcall) THEN
-       PRINT*,'Ecriture du fichier de reinitialiastion de la physique'
-      ENDIF
-
-      icount=icount+1
-!      RETURN
-      END SUBROUTINE phyparam_lmd
-	END MODULE PHY
Index: codes/icosagcm/trunk/src/physics.f90
===================================================================
--- codes/icosagcm/trunk/src/physics.f90	(revision 185)
+++ codes/icosagcm/trunk/src/physics.f90	(revision 186)
@@ -2,5 +2,5 @@
 
   CHARACTER(LEN=255) :: physics_type="automatic"
-
+!$OMP THREADPRIVATE(physics_type)
 
 CONTAINS
@@ -11,5 +11,5 @@
     USE icosa
     USE physics_dcmip_mod,init_physics_dcmip=>init_physics
-    USE physics_dry_mod
+!    USE physics_dry_mod
     IMPLICIT NONE
 
@@ -32,5 +32,5 @@
 
     CASE ('dry')
-       CALL init_physics_dry
+!       CALL init_physics_dry
 
     CASE DEFAULT
@@ -44,5 +44,5 @@
   SUBROUTINE physics(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q)
     USE icosa
-    USE physics_dry_mod
+!    USE physics_dry_mod
     USE physics_dcmip_mod, physics_dcmip=>physics
     USE etat0_mod
@@ -67,4 +67,6 @@
           !	CALL transfert_request(f_ue,req_e1_vect)
           CALL held_suarez(f_ps,f_theta_rhodz,f_ue) 
+       CASE DEFAULT
+!          PRINT*,"NO PHYSICAL PACAKAGE USED" ! FIXME MPI
        END SELECT
 
@@ -73,5 +75,5 @@
 
     CASE ('dry')
-       CALL physics_dry(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q)
+!       CALL physics_dry(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q)
 
     CASE DEFAULT
Index: codes/icosagcm/trunk/src/physics_dcmip.f90
===================================================================
--- codes/icosagcm/trunk/src/physics_dcmip.f90	(revision 185)
+++ codes/icosagcm/trunk/src/physics_dcmip.f90	(revision 186)
@@ -1,7 +1,9 @@
-	MODULE physics_dcmip_mod
+MODULE physics_dcmip_mod
   USE ICOSA
   PRIVATE
   
   INTEGER,SAVE :: testcase
+!$OMP THREADPRIVATE(testcase)
+
   PUBLIC init_physics, physics
   TYPE(t_field),POINTER :: f_out_i(:)
@@ -42,4 +44,5 @@
     CALL transfert_request(f_ue,req_e1_vect)
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/physics_dry.f90
===================================================================
--- codes/icosagcm/trunk/src/physics_dry.f90	(revision 185)
+++ codes/icosagcm/trunk/src/physics_dry.f90	(revision 186)
@@ -1,307 +1,0 @@
-	MODULE physics_dry_mod
-  USE ICOSA
-  PUBLIC init_physics_dry, physics_dry
-
-CONTAINS
-
-   SUBROUTINE init_physics_dry
-      USE ICOSA !sarvesh
-      USE time_mod !sarvesh 
-      USE dimphys_mod
-      USE RADIATION
-
-      IMPLICIT NONE
-      INTEGER::i,j,ij
-!-------------------------------------- ORBITAL PARAMETER----
-    periheli=150.
-    CALL getin('periheli', periheli)
-    aphelie=150.
-    CALL getin('aphelie',aphelie) 
-    coefir=0.08
-    CALL getin('coefir',coefir)
-    coefvis=0.99
-    CALL getin('coefvis',coefvis)
-    obliquit=0.0
-    CALL getin('obliquit',obliquit) 
-    peri_day=0.
-    CALL getin('peri_day',peri_day)
-    year_day=360.
-    CALL getin('year_day',year_day) 
-    callrad=.true.
-    CALL getin('callrad', callrad)
-    calldifv=.true.
-    CALL getin('calldifv', calldifv)
-    calladj=.true.
-    CALL getin('calladj', calladj)
-    callcond=.true.
-    callsoil=.true.
-    CALL getin('callsoil',callsoil)
-    season=.true.
-    CALL getin('season',season)
-    diurnal=.true.
-    CALL getin('diurnal',diurnal)
-    lverbose=.false.
-    CALL getin('lverbose',lverbose)
-    period_sort=1.
-   CALL getin('period_sort',period_sort)
-!    ptimestep=dt
-!   CALL getin('ptimestep',ptimestep) 
-
-      print*,'Activation de la physique:'
-      print*,' Rayonnement ',callrad
-      print*,' Diffusion verticale turbulente ', calldifv
-      print*,' Ajustement convectif ',calladj
-      print*,' Sol ',callsoil
-      print*,' Cycle diurne ',diurnal
-!      choice of the frequency of the computation of radiations
-      IF(diurnal) THEN
-         iradia=NINT(daysec/(20.*dt))
-      ELSE
-         iradia=NINT(daysec/(4.*dt))
-      ENDIF
-      iradia=1
-
-      ngridmx=iim*jjm ; nlayermx=llm
-	offset=halo
-
-      ALLOCATE(albedo(ngridmx));ALLOCATE(emissiv(ngridmx))
-      ALLOCATE(inertie(ngridmx));ALLOCATE(z0(ngridmx))
-      ALLOCATE(rnatur(ngridmx));ALLOCATE(tsurf(ngridmx))
-      ALLOCATE(tsoil(ngridmx,nlayermx));ALLOCATE(fluxgrd(ngridmx))
-      ALLOCATE(fluxrad(ngridmx));ALLOCATE(dtrad(ngridmx,llm+1))
-      ALLOCATE(q2(ngridmx,llm+1));ALLOCATE(q2l(ngridmx,llm+1))
-      ALLOCATE(capcal(ngridmx))
-
-      CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit)
-
-      PRINT*,'unjours',daysec
-      PRINT*,'The radiative transfer is computed each ', iradia,' physical time-step or each ', &
-              iradia*dt,' seconds'
-  END SUBROUTINE init_physics_dry
-
-
-  SUBROUTINE physics_dry( it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q)
-  USE icosa
-  IMPLICIT NONE
-    INTEGER,INTENT(IN)    :: it
-    REAL(rstd),INTENT(IN) :: jD_cur,jH_cur
-    TYPE(t_field),POINTER :: f_phis(:)
-    TYPE(t_field),POINTER :: f_ps(:)
-    TYPE(t_field),POINTER :: f_theta_rhodz(:)
-    TYPE(t_field),POINTER :: f_ue(:)
-    TYPE(t_field),POINTER :: f_q(:)
-  
-    REAL(rstd),POINTER :: phis(:)
-    REAL(rstd),POINTER :: ps(:)
-    REAL(rstd),POINTER :: theta_rhodz(:,:)
-    REAL(rstd),POINTER :: ue(:,:)
-    REAL(rstd),POINTER :: q(:,:,:)
-!    REAL(rstd),POINTER :: precl(:)
-    INTEGER :: ind
-!    LOGICAL:: firstcall,lastcall
-
-    CALL transfert_request(f_ue,req_e1_vect)
-    CALL transfert_request(f_theta_rhodz,req_i1)
-
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      phis=f_phis(ind)
-      ps=f_ps(ind)
-      theta_rhodz=f_theta_rhodz(ind)
-      ue=f_ue(ind)
-      q=f_q(ind)
-!      out_i=f_out_i(ind)
-!      precl=f_precl(ind) 
-!     print*,"====================================ind",ind,"----------it",it
-      CALL compute_physics_dry(it,jD_cur,jH_cur,phis, ps, theta_rhodz, ue, q(:,:,1))
-     ENDDO	
-
-!    CALL writefield("out_i",f_out_i)
-    
-!    IF (mod(it,itau_out)==0 ) THEN
-!      CALL writefield("precl",f_precl)
-!    ENDIF
-
-  END SUBROUTINE physics_dry
-  
-  SUBROUTINE compute_physics_dry(it,jD_cur,jH_cur,phis, ps, theta_rhodz, ue, q)
-  USE icosa
-  USE pression_mod
-  USE exner_mod
-  USE theta2theta_rhodz_mod
-  USE geopotential_mod
-  USE wind_mod
-  USE PHY
-  
-  IMPLICIT NONE
-    INTEGER::it
-    REAL(rstd) :: jD_cur
-    REAL(rstd) :: jH_cur
-    REAL(rstd) :: phis(iim*jjm)
-    REAL(rstd) :: ps(iim*jjm)
-    REAL(rstd) :: theta_rhodz(iim*jjm,llm)
-    REAL(rstd) :: ue(3*iim*jjm,llm)
-    REAL(rstd) :: q(iim*jjm,llm)
-!    REAL(rstd) :: precl(iim*jjm)
-
-    REAL(rstd) :: p(iim*jjm,llm+1)
-    REAL(rstd) :: pks(iim*jjm)
-    REAL(rstd) :: pk(iim*jjm,llm)
-    REAL(rstd) :: phi(iim*jjm,llm)
-    REAL(rstd) :: T(iim*jjm,llm)
-    REAL(rstd) :: Tfi(iim*jjm,llm)
-    REAL(rstd) :: theta(iim*jjm,llm)
-
-   REAL(rstd) :: uc(iim*jjm,3,llm)
-   REAL(rstd) :: u(iim*jjm,llm)
-   REAL(rstd) :: v(iim*jjm,llm)
-    REAL(rstd) :: ufi(iim*jjm,llm)
-    REAL(rstd) :: vfi(iim*jjm,llm)
-    REAL(rstd) :: qfi(iim*jjm,llm)
-    REAL(rstd) :: utemp(iim*jjm,llm)
-    REAL(rstd) :: vtemp(iim*jjm,llm)
-    REAL(rstd) :: lat(iim*jjm)
-    REAL(rstd) :: lon(iim*jjm)
-    REAL(rstd) :: pmid(iim*jjm,llm)
-    REAL(rstd) :: pint(iim*jjm,llm+1)
-    REAL(rstd) :: pdel(iim*jjm,llm)
-    REAL(rstd) :: plev(iim*jjm,llm+1),play(iim*jjm,llm) 
-    REAL(rstd) :: pkbycp
-    INTEGER :: i,j,l,ij,ig
-	
-!-------------------
-!    LOGICAL:: firstcall,lastcall
-    REAL(rstd) :: dufi(iim*jjm,llm)
-    REAL(rstd) :: dvfi(iim*jjm,llm)
-    REAL(rstd) :: dTfi(iim*jjm,llm)
-    REAL(rstd) :: dpsfi(iim*jjm)
-    REAL(rstd) :: dqfi(iim*jjm,llm)
-!    PRINT *,'Entering in LMD SIMPLE physics'    
-
-
-	offset=halo 
-    CALL compute_pression(ps,p,halo)
-    CALL compute_exner(ps,p,pks,pk,halo)
-    CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,halo)
-    CALL compute_geopotential(phis,pks,pk,theta,phi,halo)
-    CALL compute_theta_rhodz2temperature(ps,theta_rhodz,T,halo)
-    CALL compute_wind_centered(ue,uc)
-    CALL compute_wind_centered_lonlat_compound(uc, u, v)
-
-     DO j=jj_begin-offset,jj_end+offset
-      DO i=ii_begin-offset,ii_end+offset
-        ij=(j-1)*iim+i
-        CALL xyz2lonlat(xyz_i(ij,:),lon(ij),lat(ij)) 
-      ENDDO
-     ENDDO	
-   
-    DO l=1,llm
-      DO j=jj_begin-offset,jj_end+offset
-        DO i=ii_begin-offset,ii_end+offset
-          ij=(j-1)*iim+i
-!          Tfi(ij,l)=T(ij,l)
-!          ufi(ij,l)=u(ij,l)
-!          vfi(ij,l)=v(ij,l)
-!          qfi(ij,l)=q(ij,l)
-          dTfi(ij,l)=0.0
-          dufi(ij,l)=0.0
-          dvfi(ij,l)=0.0
-          dqfi(ij,l)=0.0
-        ENDDO
-      ENDDO
-    ENDDO    
-	plev(:,:) = p(:,:)  
-	dpsfi=0.0  
-
-   DO l=1,llm
-     DO j=jj_begin-offset,jj_end+offset
-       DO i=ii_begin-offset,ii_end+offset
-          ij=(j-1)*iim+i
-          pkbycp=pk(ij,l)/cpp
-          play(ij,l)=preff*pkbycp**(1./kappa) 
-        ENDDO
-      ENDDO
-     ENDDO 
-
-
-      CALL phyparam_lmd(it,iim*jjm,llm,1,dt,lat,lon,jD_cur,jH_cur, &
-      plev,play,phi,phis,u,v,T,q,dufi,dvfi,dTfi,dqfi,dpsfi) 
-
-      CALL ADDFI(u,v,T,q,ps,dufi,dvfi,dTfi,dqfi,dpsfi)
-
-!	CALL SARCHECKF(llm)
-!	print*,"plev",(maxval(plev(:,l)),l=1,llm+1) 
-
-!      CALL phyparam_lmd(it,iim*jjm,llm,1,dt,lat,lon,jD_cur,jH_cur, &
-!      plev,play,phi,phis,ufi,vfi,Tfi,qfi,dufi,dvfi,dTfi,dqfi,dpsfi) 
-
-!		Print*,"going ADD FI",it
-!      CALL ADDFI(ufi,vfi,Tfi,qfi,ps,dufi,dvfi,dTfi,dqfi,dpsfi)
-
-!       WRITE(11,*)"ducovfi",maxval(dufi),minval(dufi),it
-!       WRITE(11,*)"ucovfi",maxval(ufi),minval(ufi)
-!       WRITE(11,*)"dtetafi",maxval(dTfi),minval(dTfi)
-
-!=============================================
-!	go to 1234
-    DO l=1,llm
-      DO j=jj_begin-offset,jj_end+offset
-        DO i=ii_begin-offset,ii_end+offset
-          ij=(j-1)*iim+i
-          uc(ij,:,l)=(dufi(ij,l)*elon_i(ij,:)+dvfi(ij,l)*elat_i(ij,:))*dt
-        ENDDO
-      ENDDO
-    ENDDO
-
-    
-    DO l=1,llm
-      DO j=jj_begin-offset,jj_end+offset
-        DO i=ii_begin-offset,ii_end+offset
-          ij=(j-1)*iim+i
-          ue(ij+u_right,l)=ue(ij+u_right,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:) )
-          ue(ij+u_lup,l)=ue(ij+u_lup,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:) )
-          ue(ij+u_ldown,l)=ue(ij+u_ldown,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) )
-        ENDDO
-      ENDDO
-    ENDDO
-!1234	 continue
-   
-!   CALL compute_temperature2theta_rhodz(ps,Tfi,theta_rhodz,halo)
-   CALL compute_temperature2theta_rhodz(ps,T,theta_rhodz,halo)
-
-!       WRITE(13,*)"tetafi",maxval(theta_rhodz),minval(theta_rhodz)
-    RETURN   
-  END SUBROUTINE compute_physics_dry
-
-    SUBROUTINE addfi(ufi,vfi,Tfi,qfi,ps,dufi,dvfi,dTfi,dqfi,dpsfi)
-	USE ICOSA
-	IMPLICIT NONE
-	  REAL(rstd) :: dufi(iim*jjm,llm)
-	  REAL(rstd) :: dvfi(iim*jjm,llm)
-        REAL(rstd) :: dTfi(iim*jjm,llm)
-        REAL(rstd) :: dpsfi(iim*jjm)
-        REAL(rstd) :: dqfi(iim*jjm,llm)
-        REAL(rstd) :: ufi(iim*jjm,llm)
-        REAL(rstd) :: vfi(iim*jjm,llm)
-        REAL(rstd) :: qfi(iim*jjm,llm)
-	  REAL(rstd) :: ps(iim*jjm)
-	  REAL(rstd) :: Tfi(iim*jjm,llm)
-	  INTEGER::i,j,l,ij,offset
-		offset=halo
-	
-     DO l=1,llm
-      DO j=jj_begin-offset,jj_end+offset
-        DO i=ii_begin-offset,ii_end+offset
-          ij=(j-1)*iim+i
-          Tfi(ij,l)=Tfi(ij,l)+dTfi(ij,l)*dt
-          ufi(ij,l)=ufi(ij,l)+dufi(ij,l)*dt 
-          vfi(ij,l)=vfi(ij,l)+dvfi(ij,l)*dt 
-          qfi(ij,l)=qfi(ij,l)+dqfi(ij,l)*dt  
-        END DO
-      END DO
-     END DO  
-	 ps(:)=ps(:) + dpsfi(:)*dt
-	END SUBROUTINE addfi 
-   
-END MODULE physics_dry_mod
Index: codes/icosagcm/trunk/src/pression.f90
===================================================================
--- codes/icosagcm/trunk/src/pression.f90	(revision 185)
+++ codes/icosagcm/trunk/src/pression.f90	(revision 186)
@@ -14,4 +14,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/radiation_mod.F
===================================================================
--- codes/icosagcm/trunk/src/radiation_mod.F	(revision 185)
+++ codes/icosagcm/trunk/src/radiation_mod.F	(revision 186)
@@ -1,1033 +1,0 @@
-	MODULE RADIATION
-	 USE ICOSA
-	 USE dimphys_mod
-!	 USE PHY
-	contains
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-	 SUBROUTINE zerophys(n,x)
-      IMPLICIT NONE
-      INTEGER n
-      REAL x(n)
-      INTEGER i
-
-      DO i=1,n
-         x(i)=0.
-      ENDDO
-      RETURN
-      END subroutine zerophys
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-	 SUBROUTINE solarlong(pday,psollong)
-      IMPLICIT NONE
-c=======================================================================
-c
-c   Objet:
-c   ------
-c
-c      Calcul de la distance soleil-planete et de la declinaison
-c   en fonction du jour de l'annee.
-c
-c
-c   Methode:
-c   --------
-c
-c      Calcul complet de l'elipse
-c
-c   Interface:
-c   ----------
-c
-c      Uncommon comprenant les parametres orbitaux.
-c
-c   Arguments:
-c   ----------
-c
-c   Input:
-c   ------
-c   pday          jour de l'annee (le jour 0 correspondant a l'equinoxe)
-c   lwrite        clef logique pour sorties de controle
-c
-c   Output:
-c   -------
-c   pdist_sol     distance entre le soleil et la planete
-c                 ( en unite astronomique pour utiliser la constante 
-c                  solaire terrestre 1370 Wm-2 )
-c   pdecli        declinaison ( en radians )
-c
-c=======================================================================
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-
-c arguments:
-c ----------
-
-      REAL pday,pdist_sol,pdecli,psollong
-      LOGICAL lwrite
-
-c Local:
-c ------
-
-      REAL zanom,xref,zx0,zdx,zteta,zz
-      INTEGER iter
-
-
-c-----------------------------------------------------------------------
-c calcul de l'angle polaire et de la distance au soleil :
-c -------------------------------------------------------
-
-c  calcul de l'zanomalie moyenne
-
-      zz=(pday-peri_day)/year_day
-      zanom=2.*pi*(zz-nint(zz))
-      xref=abs(zanom)
-
-c  resolution de lequation horaire  zx0 - e * sin (zx0) = xref
-c  methode de Newton
-
-      zx0=xref+e_elips*sin(xref)
-      DO 110 iter=1,10
-         zdx=-(zx0-e_elips*sin(zx0)-xref)/(1.-e_elips*cos(zx0))
-         if(abs(zdx).le.(1.e-7)) goto 120
-         zx0=zx0+zdx
-110   continue
-120   continue
-      zx0=zx0+zdx
-      if(zanom.lt.0.) zx0=-zx0
-
-c zteta est la longitude solaire
-
-      zteta=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
-
-      psollong=zteta-timeperi
-
-      IF(psollong.LT.0.) psollong=psollong+2.*pi
-      IF(psollong.GT.2.*pi) psollong=psollong-2.*pi
-
-      RETURN
-      END SUBROUTINE solarlong
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-        SUBROUTINE orbite(pls,pdist_sol,pdecli)
-      IMPLICIT NONE
-c====================================================================
-c
-c   Objet:
-c   ------
-c
-c   Distance from sun and declimation as a function of the solar
-c   longitude Ls
-c
-c   Interface:
-c   ----------
-c   Arguments:
-c   ----------
-c
-c   Input:
-c   ------
-c   pls          Ls
-c
-c   Output:
-c   -------
-c   pdist_sol     Distance Sun-Planet in UA
-c   pdecli        declinaison ( en radians )
-c
-c====================================================================
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-c arguments:
-c ----------
-
-      REAL pday,pdist_sol,pdecli,pls
-
-c-----------------------------------------------------------------------
-
-c Distance Sun-Planet
-
-      pdist_sol=p_elips/(1.+e_elips*cos(pls+timeperi))
-
-c Solar declination
-
-      pdecli= asin (sin(pls)*sin(obliquit*pi/180.))
-
-c-----------------------------------------------------------------------
-c   sorties eventuelles:
-c   ---------------------
-
-      END SUBROUTINE orbite
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-        SUBROUTINE iniorbit
-     $     (paphelie,pperiheli,pyear_day,pperi_day,pobliq)
-      IMPLICIT NONE
-c=====================================================================
-c
-c   Auteur:
-c   -------
-c     Frederic Hourdin      22 Fevrier 1991
-c
-c   Objet:
-c   ------
-c    Initialisation du sous programme orbite qui calcule
-c    a une date donnee de l'annee de duree year_day commencant
-c    a l'equinoxe de printemps et dont le perihelie se situe
-c    a la date peri_day, la distance au soleil et la declinaison.
-c
-c   Interface:
-c   ----------
-c   - Doit etre appele avant d'utiliser orbite.
-c   - initialise le common comorbit
-c
-c   Arguments:
-c   ----------
-c
-c   Input:
-c   ------
-c   aphelie       \   aphelie et perihelie de l'orbite
-c   periheli      /   en millions de kilometres.
-c
-c=====================================================================
-c   Declarations:
-c   -------------
-c   Arguments:
-c   ----------
-
-      REAL paphelie,pperiheli,pyear_day,pperi_day,pobliq
-
-c   Local:
-c   ------
-
-      REAL zxref,zanom,zz,zx0,zdx
-      INTEGER iter
-
-c'-----------------------------------------------------------------------
-
-      aphelie =paphelie
-      periheli=pperiheli
-      year_day=pyear_day
-      obliquit=pobliq
-      peri_day=pperi_day
-
-      PRINT*,'Perihelie en Mkm  ',periheli
-      PRINT*,'Aphelise  en Mkm  ',aphelie 
-      PRINT*,'obliquite en degres  :',obliquit
-      unitastr=149.597927
-      e_elips=(aphelie-periheli)/(periheli+aphelie)
-      p_elips=0.5*(periheli+aphelie)*(1-e_elips*e_elips)/unitastr
-
-      print*,'e_elips',e_elips
-      print*,'p_elips',p_elips
-
-c-----------------------------------------------------------------------
-c calcul de l'angle polaire et de la distance au soleil :
-c -------------------------------------------------------
-
-c  calcul de l'zanomalie moyenne
-
-      zz=(year_day-pperi_day)/year_day
-      zanom=2.*pi*(zz-nint(zz))
-      zxref=abs(zanom)
-      PRINT*,'zanom  ',zanom
-
-c  resolution de lequation horaire  zx0 - e * sin (zx0) = zxref
-c  methode de Newton
-
-      zx0=zxref+e_elips*sin(zxref)
-      DO 110 iter=1,100
-         zdx=-(zx0-e_elips*sin(zx0)-zxref)/(1.-e_elips*cos(zx0))
-         if(abs(zdx).le.(1.e-12)) goto 120
-         zx0=zx0+zdx
-110   continue
-120   continue
-      zx0=zx0+zdx
-      if(zanom.lt.0.) zx0=-zx0
-      PRINT*,'zx0   ',zx0
-
-c zteta est la longitude solaire
-
-      timeperi=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
-      PRINT*,'longitude solaire du perihelie timeperi = ',timeperi
-
-      RETURN
-      END SUBROUTINE iniorbit
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-      SUBROUTINE mucorr(npts,pdeclin, plat, pmu, pfract,phaut,prad)
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Calcul of equivalent solar angle and and fraction of day whithout 
-c   diurnal cycle.
-c
-c   parmeters :
-c   -----------
-c
-c      Input :
-c      -------
-c         npts             number of points
-c         pdeclin          solar declinaison
-c         plat(npts)        latitude
-c         phaut            hauteur typique de l'atmosphere
-c         prad             rayon planetaire '
-c
-c      Output :
-c      --------
-c         pmu(npts)          equivalent cosinus of the solar angle
-c         pfract(npts)       fractionnal day
-c
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c
-c    0. Declarations :
-c    -----------------
-
-c     Arguments :
-c     -----------
-      INTEGER npts
-      REAL plat(npts),pmu(npts), pfract(npts)
-      REAL phaut,prad,pdeclin
-c
-c     Local variables :
-c     -----------------
-      INTEGER j,i,ij,ig
-      REAL pi
-      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
-      REAL ap,a,t,b
-      REAL alph
-
-c-----------------------------------------------------------------------
-
-      !print*,'npts,pdeclin'
-      !print*,npts,pdeclin
-      pi = 4. * atan(1.0)
-      !print*,'PI=',pi
-      pi=2.*asin(1.)
-      z = pdeclin
-      cz = cos (z)
-      sz = sin (z)
-      !print*,'cz,sz',cz,sz
-
-!	DO j=jj_begin-offset,jj_end+offset
-!         DO i=ii_begin-offset,ii_end+offset
-!             ig=(j-1)*iim+i
-
-	  DO ig=1,npts
-             phi = plat(ig)
-             cphi = cos(phi)
-           if (cphi.le.1.e-9) cphi=1.e-9
-            sphi = sin(phi)
-            tphi = sphi / cphi
-               b = cphi * cz
-               t = -tphi * sz / cz
-               a = 1.0 - t*t
-              ap = a
-             IF(t.eq.0.) then
-               t=0.5*pi
-             ELSE
-                IF (a.lt.0.) a = 0.
-                  t = sqrt(a) / t
-                IF (t.lt.0.) then
-                  t = -atan (-t) + pi
-                 ELSE
-                  t = atan(t)
-                ENDIF
-             ENDIF
-   
-            pmu(ig) = (sphi*sz*t) / pi + b*sin(t)/pi
-            pfract(ig) = t / pi
-            IF (ap .lt.0.) then
-             pmu(ig) = sphi * sz
-             pfract(ig) = 1.0
-            ENDIF
-            IF (pmu(ig).le.0.0) pmu(ig) = 0.0
-             pmu(ig) = pmu(ig) / pfract(ig)
-            IF (pmu(ig).eq.0.) pfract(ig) = 0.
-	  ENDDO
-!	ENDDO
-c-----------------------------------------------------------------------
-c   correction de rotondite:
-c   ------------------------
-
-	      alph=phaut/prad
-!	DO j=jj_begin-offset,jj_end+offset
-!         DO i=ii_begin-offset,ii_end+offset
-!		           ig=(j-1)*iim+i
-	   DO ig = 1,npts
-            pmu(ig)=sqrt(1224.*pmu(ig)*pmu(ig)+1.)/35.
-
-c    $    (sqrt(alph*alph*pmu(ig)*pmu(ig)+2.*alph+1.)-alph*pmu(ig))
-	 ENDDO
-!	ENDDO
-
-      RETURN
-      END SUBROUTINE mucorr
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-	
-	      SUBROUTINE sw(ngrid,nlayer,ldiurn,
-     $              coefvis,albedo,
-     $              plevel,ps_rad,pmu,pfract,psolarf0,
-     $              fsrfvis,dtsw,
-     $              lwrite)
-      IMPLICIT NONE
-c=======================================================================
-c
-c   Rayonnement solaire en atmosphere non diffusante avec un 
-c   coefficient d'absoprption gris.
-c'
-c=======================================================================
-c
-c   declarations:
-c   -------------
-c   arguments:
-c   ----------
-c
-      INTEGER ngrid,nlayer,i,j,ij
-      REAL albedo(ngrid),coefvis
-      REAL pmu(ngrid),pfract(ngrid)
-      REAL plevel(ngrid,nlayer+1),ps_rad
-      REAL psolarf0
-      REAL fsrfvis(ngrid),dtsw(ngrid,nlayer)
-      LOGICAL lwrite,ldiurn
-c
-c   variables locales:
-c   ------------------
-c
-
-      REAL zalb(ngrid),zmu(ngrid),zfract(ngrid)
-      REAL zplev(ngrid,nlayer+1)
-      REAL zflux(ngrid),zdtsw(ngrid,nlayer)
-
-      INTEGER ig,l,nlevel,ncount,igout
-	INTEGER,DIMENSION(ngrid)::index
-      REAL ztrdir(ngrid,nlayer+1),ztrref(ngrid,nlayer+1)
-      REAL zfsrfref(ngrid)
-      REAL z1(ngrid)
-      REAL zu(ngrid,nlayer+1)
-      REAL tau0
-
-      EXTERNAL SSUM
-      EXTERNAL ismax
-      REAL ismax
-
-      LOGICAL firstcall
-      SAVE firstcall
-      DATA firstcall/.true./
-
-c-----------------------------------------------------------------------
-c   1. initialisations:
-c   -------------------
-
-
- 
-      IF (firstcall) THEN
- 
-      IF (ngrid.NE.ngrid) THEN
-         PRINT*,'STOP in inifis'
-         PRINT*,'Probleme de dimenesions :'
-         PRINT*,'ngrid     = ',ngrid
-         PRINT*,'ngrid   = ',ngrid
-         STOP
-      ENDIF
- 
- 
-      IF (nlayer.NE.llm) THEN
-         PRINT*,'STOP in inifis'
-         PRINT*,'Probleme de dimenesions :'
-         PRINT*,'nlayer     = ',nlayer
-         PRINT*,'llm   = ',llm
-         STOP
-      ENDIF
- 
-      ENDIF
-
-      nlevel=nlayer+1
-c-----------------------------------------------------------------------
-c   Definitions des tableaux locaux pour les points ensoleilles:
-c   ------------------------------------------------------------
-
-      IF (ldiurn) THEN
-         ncount=0
-        DO j=jj_begin-offset,jj_end+offset
-           DO i=ii_begin-offset,ii_end+offset
-            ig=(j-1)*iim+i
-            index(ig)=0
-           ENDDO
-	 ENDDO
-         DO j=jj_begin-offset,jj_end+offset
-          DO i=ii_begin-offset,ii_end+offset
-             ig=(j-1)*iim+i
-           IF(pfract(ig).GT.1.e-6) THEN
-             ncount=ncount+1
-             index(ncount)=ig
-           ENDIF
-          ENDDO
-         ENDDO
-!	SARVESH CHANGED NCOUNT TO NGRID TO BE CONSISTENT ???
-
-         CALL monGATHER(ncount,zfract,pfract,index)
-         CALL monGATHER(ncount,zmu,pmu,index)
-         CALL monGATHER(ncount,zalb,albedo,index)
-         DO l=1,nlevel
-            CALL monGATHER(ncount,zplev(1,l),plevel(1,l),index)
-         ENDDO
-      ELSE
-         ncount=ngrid
-         zfract(:)=pfract(:)
-         zmu(:)=pmu(:)
-         zalb(:)=albedo(:)
-         zplev(:,:)=plevel(:,:)
-      ENDIF
-
-c-----------------------------------------------------------------------
-c   calcul des profondeurs optiques integres depuis p=0:
-c   ----------------------------------------------------
-
-      tau0=-.5*log(coefvis)
-
-c calcul de la partie homogene de l'opacite
-c'
-      tau0=tau0/ps_rad
-
-
-      DO l=1,nlayer+1
-        DO j=jj_begin-offset,jj_end+offset
-          DO i=ii_begin-offset,ii_end+offset
-            ig=(j-1)*iim+i
-            zu(ig,l)=tau0*zplev(ig,l)
-           ENDDO
-         ENDDO
-        ENDDO
-
-c-----------------------------------------------------------------------
-c   2. calcul de la transmission depuis le sommet de l'atmosphere:
-c'   -----------------------------------------------------------
-
-       DO l=1,nlevel
-         DO j=jj_begin-offset,jj_end+offset
-           DO i=ii_begin-offset,ii_end+offset
-            ig=(j-1)*iim+i
-            ztrdir(ig,l)=exp(-zu(ig,l)/zmu(ig))
-           ENDDO
-          ENDDO
-        ENDDO
-
-      IF (lwrite) THEN
-         igout=ncount/2+1
-         PRINT*
-         PRINT*,'Diagnostique des transmission dans le spectre solaire'
-         PRINT*,'zfract, zmu, zalb'
-         PRINT*,zfract(igout), zmu(igout), zalb(igout)
-         PRINT*,'Pression, quantite d abs, transmission'
-         DO l=1,nlayer+1
-            PRINT*,zplev(igout,l),zu(igout,l),ztrdir(igout,l)
-         ENDDO
-      ENDIF
-
-c-----------------------------------------------------------------------
-c   3. taux de chauffage, ray. solaire direct:
-c   ------------------------------------------
-
-      DO l=1,nlayer
-        DO j=jj_begin-offset,jj_end+offset
-          DO i=ii_begin-offset,ii_end+offset
-            ig=(j-1)*iim+i
-            zdtsw(ig,l)=g*psolarf0*zfract(ig)*zmu(ig)*
-     $                     (ztrdir(ig,l+1)-ztrdir(ig,l))/
-     $                     (cpp*(zplev(ig,l)-zplev(ig,l+1)))
-           ENDDO
-          ENDDO
-       ENDDO
-      IF (lwrite) THEN
-         PRINT*
-         PRINT*,'Diagnostique des taux de chauffage solaires:'
-         PRINT*,' 1 taux de chauffage lie au ray. solaire  direct'
-         DO l=1,nlayer
-            PRINT*,zdtsw(igout,l)
-         ENDDO
-      ENDIF
-
-
-c-----------------------------------------------------------------------
-c   4. calcul du flux solaire arrivant sur le sol:
-c   ----------------------------------------------
-
-       DO j=jj_begin-offset,jj_end+offset
-        DO i=ii_begin-offset,ii_end+offset
-          ig=(j-1)*iim+i
-          z1(ig)=zfract(ig)*zmu(ig)*psolarf0*ztrdir(ig,1)
-          zflux(ig)=(1.-zalb(ig))*z1(ig)
-          zfsrfref(ig)=    zalb(ig)*z1(ig)
-        ENDDO
-       ENDDO
-      IF (lwrite) THEN
-         PRINT*
-         PRINT*,'Diagnostique des taux de chauffage solaires:'
-         PRINT*,' 2 flux solaire net incident sur le sol'
-         PRINT*,zflux(igout)
-      ENDIF
-
-
-c-----------------------------------------------------------------------
-c   5.calcul des traansmissions depuis le sol, cas diffus:
-c   ------------------------------------------------------
-
-      DO l=1,nlevel
-       DO j=jj_begin-offset,jj_end+offset
-        DO i=ii_begin-offset,ii_end+offset
-          ig=(j-1)*iim+i
-            ztrref(ig,l)=exp(-(zu(ig,1)-zu(ig,l))*1.66)
-         ENDDO
-        ENDDO
-       ENDDO
-
-      IF (lwrite) THEN
-         PRINT*
-         PRINT*,'Diagnostique des taux de chauffage solaires'
-         PRINT*,' 3 transmission avec les sol'
-         PRINT*,'niveau     transmission'
-         DO l=1,nlevel
-            PRINT*,l,ztrref(igout,l)
-         ENDDO
-      ENDIF
-
-c-----------------------------------------------------------------------
-c   6.ajout a l'echauffement de la contribution du ray. sol. reflechit: 
-c' -------------------------------------------------------------------
-
-      DO l=1,nlayer
-       DO j=jj_begin-offset,jj_end+offset
-        DO i=ii_begin-offset,ii_end+offset
-          ig=(j-1)*iim+i
-            zdtsw(ig,l)=zdtsw(ig,l)+
-     $      g*zfsrfref(ig)*(ztrref(ig,l+1)-ztrref(ig,l))/
-     $      (cpp*(zplev(ig,l+1)-zplev(ig,l)))
-         ENDDO
-        ENDDO
-       ENDDO
-
-c-----------------------------------------------------------------------
-c   10. sorites eventuelles:
-c   ------------------------
-
-      IF (lwrite) THEN
-         PRINT*
-         PRINT*,'Diagnostique des taux de chauffage solaires:'
-         PRINT*,' 3 taux de chauffage total'
-         DO l=1,nlayer
-            PRINT*,zdtsw(igout,l)
-         ENDDO
-      ENDIF
-
-      IF (ldiurn) THEN
-         CALL zerophys(ngrid,fsrfvis)
-         CALL monscatter(ncount,fsrfvis,index,zflux)
-         CALL zerophys(ngrid*nlayer,dtsw)
-         DO l=1,nlayer
-            CALL monscatter(ncount,dtsw(1,l),index,zdtsw(1,l))
-         ENDDO
-      ELSE
-         !print*,'NOT DIURNE'
-         fsrfvis(:)=zflux(:)
-         dtsw(:,:)=zdtsw(:,:)
-      ENDIF
-
-      RETURN
-      END  SUBROUTINE sw
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-      SUBROUTINE lw(ngrid,nlayer,coefir,emissiv,
-     $             pp,ps_rad,ptsurf,pt,
-     $             pfluxir,pdtlw,
-     $             lwrite)
-
-      IMPLICIT NONE
-c=======================================================================
-c
-c   calcul de l'evolution de la temperature sous l'effet du rayonnement
-c   infra-rouge.
-c   Pour simplifier, les transmissions sont precalculees et ne
-c   dependent que de l'altitude.
-c
-c   arguments:
-c   ----------
-c'
-c   entree:
-c   -------
-c      ngrid             nombres de points de la grille horizontale
-c      nlayer              nombre de couches
-c      ptsurf(ngrid)     temperature de la surface
-c      pt(ngrid,nlayer)    temperature des couches
-c      pp(ngrid,nlayer+1)  pression entre les couches
-c      lwrite            variable logique pour sorties
-c
-c   sortie:
-c   -------
-c      pdtlw(ngrid,nlayer) taux de refroidissement
-c      pfluxir(ngrid)    flux infrarouge sur le sol
-c
-c=======================================================================
-
-!c   declarations:
-!c   -------------
-!c   arguments:
-!c'   ----------
-
-      INTEGER ngrid,nlayer
-      REAL coefir,emissiv(ngrid),ps_rad
-      REAL ptsurf(ngrid),pt(ngrid,nlayer),pp(ngrid,nlayer+1)
-      REAL pdtlw(ngrid,nlayer),pfluxir(ngrid)
-      LOGICAL lwrite
-
-c   variables locales:
-c   ------------------
-
-      INTEGER nlevel,ilev,ig,i,il
-      REAL zplanck(ngridmx,nlayermx+1),zcoef
-      REAL zfluxup(ngridmx,nlayermx+1),zfluxdn(ngridmx,nlayermx+1)
-      REAL zflux(ngridmx,nlayermx+1)
-      REAL zlwtr1(ngridmx),zlwtr2(ngridmx)
-      REAL zup(ngridmx,nlayermx+1),zdup(ngridmx)
-      REAL stephan
-
-      LOGICAL lstrong
-      SAVE lstrong,stephan
-      DATA lstrong/.true./
-c-----------------------------------------------------------------------
-c   initialisations:
-c   ----------------
-
-      nlevel=nlayer+1
-      stephan=5.67e-08
-
-
-	pfluxir=0.0
-	pdtlw=0.0
-	!print*,"ngr,nlay,coefi",ngrid,nlayer,coefir
-c-----------------------------------------------------------------------
-c   2. calcul des quantites d'absorbants:
-c'   -------------------------------------
-
-c   absorption forte
-      IF(lstrong) THEN
-         DO ilev=1,nlevel
-            DO ig=1,ngrid
-               zup(ig,ilev)=pp(ig,ilev)*pp(ig,ilev)/(2.*g)
-            ENDDO
-         ENDDO
-         IF(lwrite) THEN
-            DO ilev=1,nlayer
-             PRINT*,' up(',ilev,')  =  ',zup(ngrid/2+1,ilev)
-            ENDDO
-         ENDIF
-         zcoef=-log(coefir)/sqrt(ps_rad*ps_rad/(2.*g))
-
-c   absorption faible
-      ELSE
-         DO ilev=1,nlevel
-            DO ig=1,ngrid
-               zup(ig,ilev)=pp(ig,ilev)
-            ENDDO
-         ENDDO
-         zcoef=-log(coefir)/ps_rad
-      ENDIF
-
-
-c-----------------------------------------------------------------------
-c   2. calcul de la fonction de corps noir:
-c   ---------------------------------------
-
-      DO ilev=1,nlayer
-         DO ig=1,ngrid
-            zplanck(ig,ilev)=pt(ig,ilev)*pt(ig,ilev)
-            zplanck(ig,ilev)=stephan*
-     $      zplanck(ig,ilev)*zplanck(ig,ilev)
-	 ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   4. flux descendants:
-c   --------------------
-
-      DO ilev=1,nlayer
-         DO ig=1,ngrid
-            zfluxdn(ig,ilev)=0.
-		 ENDDO
-         DO ig=1,ngrid
-            zdup(ig)=zup(ig,ilev)-zup(ig,nlevel)
-         ENDDO
-         CALL lwtr(ngrid,zcoef,lstrong,zdup,zlwtr1)
-
-         DO il=nlayer,ilev,-1
-            zlwtr2(:)=zlwtr1(:)
-            DO ig=1,ngrid
-               zdup(ig)=zup(ig,ilev)-zup(ig,il)
-            ENDDO
-            CALL lwtr(ngrid,zcoef,lstrong,zdup,zlwtr1)
-            DO ig=1,ngrid
-               zfluxdn(ig,ilev)=zfluxdn(ig,ilev)+
-     $         zplanck(ig,il)*(zlwtr1(ig)-zlwtr2(ig))
-			ENDDO
-		 ENDDO
-      ENDDO
-
-      DO ig=1,ngrid
-         zfluxdn(ig,nlevel)=0.
-         pfluxir(ig)=emissiv(ig)*zfluxdn(ig,1)
-      ENDDO
-
-      DO ig=1,ngrid
-         zfluxup(ig,1)=ptsurf(ig)*ptsurf(ig)
-         zfluxup(ig,1)=emissiv(ig)*stephan*zfluxup(ig,1)*zfluxup(ig,1)
-     $   +(1.-emissiv(ig))*zfluxdn(ig,1)
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   3. flux montants:
-c   ------------------
-
-      DO ilev=1,nlayer
-         DO ig=1,ngrid
-            zdup(ig)=zup(ig,1)-zup(ig,ilev+1)
-         ENDDO
-         CALL lwtr(ngrid,zcoef,lstrong,zdup,zlwtr1)
-         DO ig=1,ngrid
-            zfluxup(ig,ilev+1)=zfluxup(ig,1)*zlwtr1(ig)
-		 ENDDO
-         DO il=1,ilev
-            zlwtr2(:)=zlwtr1(:)
-            DO ig=1,ngrid
-               zdup(ig)=zup(ig,il+1)-zup(ig,ilev+1)
-            ENDDO
-            CALL lwtr(ngrid,zcoef,lstrong,zdup,zlwtr1)
-            DO ig=1,ngrid
-               zfluxup(ig,ilev+1)=zfluxup(ig,ilev+1)+
-     $         zplanck(ig,il)*(zlwtr1(ig)-zlwtr2(ig))
-			ENDDO
-         ENDDO
-
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   5. calcul des flux nets:
-c   ------------------------
-
-      DO ilev=1,nlevel
-         DO ig=1,ngrid
-            zflux(ig,ilev)=zfluxup(ig,ilev)-zfluxdn(ig,ilev)
-		 ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   6. Calcul des taux de refroidissement:
-c   --------------------------------------
-   
-      DO ilev=1,nlayer
-         DO ig=1,ngrid
-            pdtlw(ig,ilev)=(zflux(ig,ilev+1)-zflux(ig,ilev))*
-     $           g/(cpp*(pp(ig,ilev+1)-pp(ig,ilev)))
-		 ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   10. sorties eventuelles:
-c   ------------------------
-
-      IF (lwrite) THEN
-
-         PRINT*
-         PRINT*,'Diagnostique rayonnement thermique'
-         PRINT*
-         PRINT*,'temperature     ',
-     $   'flux montant    flux desc.     taux de refroid.'
-         i=ngrid/2+1
-         WRITE(6,9000) ptsurf(i)
-         DO ilev=1,nlayer
-            WRITE(6,'(i4,4e18.4)') ilev,pt(i,ilev),
-     $      zfluxup(i,ilev),zfluxdn(i,ilev),pdtlw(i,ilev)
-		 ENDDO
-         WRITE(6,9000) zfluxup(i,nlevel),zfluxdn(i,nlevel)
-
-      ENDIF
-
-c-----------------------------------------------------------------------
-
-      RETURN
-9000  FORMAT(4e18.4)
-      END SUBROUTINE lw 
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-	      subroutine solang ( kgrid,psilon,pcolon,psilat,pcolat,
-     &                    ptim1,ptim2,ptim3,pmu0,pfract )
-      IMPLICIT NONE
-
-C
-C**** *LW*   - ORGANIZES THE LONGWAVE CALCULATIONS
-C
-C     PURPOSE.
-C     --------
-C          CALCULATES THE SOLAR ANGLE FOR ALL THE POINTS OF THE GRID
-C     ==== INPUTS  ===
-C
-C PSILON(KGRID)   : SINUS OF THE LONGITUDE
-C PCOLON(KGRID)   : COSINUS OF THE LONGITUDE
-C PSILAT(KGRID)   : SINUS OF THE LATITUDE
-C PCOLAT(KGRID)   : COSINUS OF THE LATITUDE
-C PTIM1           : SIN(DECLI)
-C PTIM2           : COS(DECLI)*COS(TIME)
-C PTIM3           : SIN(DECLI)*SIN(TIME)
-C
-C     ==== OUTPUTS ===
-C
-C PMU0 (KGRID)    : SOLAR ANGLE
-C PFRACT(KGRID)   : DAY FRACTION OF THE TIME INTERVAL
-C
-C        IMPLICIT ARGUMENTS :   NONE
-C        --------------------
-C
-C     METHOD.
-C     -------
-C
-C     EXTERNALS.
-C     ----------
-C
-C         NONE
-C
-C     REFERENCE.
-C     ----------
-C
-C         RADIATIVE PROCESSES IN METEOROLOGIE AND CLIMATOLOGIE
-C         PALTRIDGE AND PLATT
-C
-C     AUTHOR.
-C     -------
-C        FREDERIC HOURDIN
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL :90-01-14
-C                  92-02-14 CALCULATIONS DONE THE ENTIER GRID (J.Polcher)
-C-----------------------------------------------------------------------
-C
-C     ------------------------------------------------------------------
-
-C-----------------------------------------------------------------------
-C
-C*      0.1   ARGUMENTS
-C             ---------
-C
-      INTEGER kgrid
-      REAL ptim1,ptim2,ptim3
-      REAL psilon(kgrid),pcolon(kgrid),pmu0(kgrid),pfract(kgrid)
-      REAL psilat(kgrid), pcolat(kgrid)
-C
-      INTEGER jl,i,j
-      REAL ztim1,ztim2,ztim3
-C------------------------------------------------------------------------
-C------------------------------------------------------------------------
-C---------------------------------------------------------------------
-C
-C--------------------------------------------------------------------
-C
-C*     1.     INITIALISATION
-C             --------------
-C
-!!!!!! 100  CONTINUE
-C
-      DO j=jj_begin-offset,jj_end+offset
-       DO i=ii_begin-offset,ii_end+offset
-         jl=(j-1)*iim+i
-        pmu0(jl)=0.
-        pfract(jl)=0.
-       ENDDO
-      ENDDO
-!C
-!C*     1.1     COMPUTATION OF THE SOLAR ANGLE
-!C              ------------------------------
-!C
-       DO j=jj_begin-offset,jj_end+offset
-         DO i=ii_begin-offset,ii_end+offset
-          jl=(j-1)*iim+i
-         ztim1=psilat(jl)*ptim1
-         ztim2=pcolat(jl)*ptim2
-         ztim3=pcolat(jl)*ptim3
-         pmu0(jl)=ztim1+ztim2*pcolon(jl)+ztim3*psilon(jl)
-        ENDDO
-      ENDDO
-!C
-!C*     1.2      DISTINCTION BETWEEN DAY AND NIGHT
-!C               ---------------------------------
-!C
-       DO j=jj_begin-offset,jj_end+offset
-        DO i=ii_begin-offset,ii_end+offset
-          jl=(j-1)*iim+i      
-          IF (pmu0(jl).gt.0.) THEN
-            pfract(jl)=1.
-	   ELSE
-            pmu0(jl)=0.
-	    pfract(jl)=0.
-          ENDIF
-         ENDDO
-        ENDDO
-      RETURN
-      END SUBROUTINE solang
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-	      SUBROUTINE monGATHER(n,a,b,index)
-c
-      IMPLICIT NONE
-C
-      INTEGER n,ng,index(n),i,j,ij
-      REAL a(n),b(n)
-c
-      DO 100 i=1,n
-        a(i)=b(index(i))
-100   CONTINUE
-
-!       DO j=jj_begin-offset,jj_end+offset
-!         DO i=ii_begin-offset,ii_end+offset
-!          ij=(j-1)*iim+i
-!          a(ij)=b(index(ij))
-!c
-      RETURN
-      END  SUBROUTINE monGATHER
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-       subroutine monscatter(n,a,index,b)
-C
-       implicit none
-       integer N,INDEX(n),I
-       real A(n),B(n)
-c
-c
-       DO 100 I=1,N
-          A(INDEX(I))=B(I)
-100    CONTINUE
-c
-       return
-       end SUBROUTINE monscatter
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-	      SUBROUTINE lwtr(ngrid,coef,lstrong,dup,transm)
-      IMPLICIT NONE
-      INTEGER ngrid
-      REAL coef
-      LOGICAL lstrong
-      REAL dup(ngrid),transm(ngrid)
-      INTEGER ig
-
-      IF(lstrong) THEN
-         DO ig=1,ngrid
-            transm(ig)=exp(-coef*sqrt(dup(ig)))
-         ENDDO
-      ELSE
-         DO ig=1,ngrid
-            transm(ig)=exp(-coef*dup(ig))
-         ENDDO
-      ENDIF
-      RETURN
-      END subroutine lwtr 
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-       END MODULE RADIATION 
Index: codes/icosagcm/trunk/src/surface_mod.F
===================================================================
--- codes/icosagcm/trunk/src/surface_mod.F	(revision 185)
+++ codes/icosagcm/trunk/src/surface_mod.F	(revision 186)
@@ -1,935 +1,0 @@
-	MODULE SURFACE_PROCESS
-	
-	USE ICOSA
-	USE dimphys_mod
-	USE RADIATION
-	DATA lmixmin,emin_turb,karman/100.,1.e-8,.4/
-
-	contains
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-	      subroutiNE vdif(ngrid,nlay,ptime,
-     $                ptimestep,pcapcal,pz0,
-     $                pplay,pplev,pzlay,pzlev,
-     $                pu,pv,ph,ptsrf,pemis,
-     $                pdufi,pdvfi,pdhfi,pfluxsrf,
-     $                pdudif,pdvdif,pdhdif,pdtsrf,pq2,pq2l,
-     $                lwrite)
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Diffusion verticale
-c   Shema implicite
-c   On commence par rajouter au variables x la tendance physique
-c   et on resoult en fait:
-c      x(t+1) =  x(t) + dt * (dx/dt)phys(t)  +  dt * (dx/dt)difv(t+1)
-c
-c   !!! attention :
-c   pour utilisation sur une machine sans allocation dynamique de 
-c   memoires (sur SUN par exemple) il faut que ngrid soit egal
-c   a ngrid.
-c
-c   arguments:
-c   ----------
-c
-c   entree:
-c   -------
-c
-c
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-c
-c   arguments:
-c   ----------
-
-      INTEGER ngrid,nlay
-      REAL ptime,ptimestep
-      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
-      REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
-      REAL pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay)
-      REAL ptsrf(ngrid),pemis(ngrid)
-      REAL pdufi(ngrid,nlay),pdvfi(ngrid,nlay),pdhfi(ngrid,nlay)
-      REAL pfluxsrf(ngrid)
-      REAL pdudif(ngrid,nlay),pdvdif(ngrid,nlay),pdhdif(ngrid,nlay)
-      REAL pdtsrf(ngrid),pcapcal(ngrid),pz0(ngrid)
-      REAL pq2(ngrid,nlay+1),pq2l(ngrid,nlay+1)
-      LOGICAL lwrite
-c
-c   local:
-c   ------
-
-      INTEGER ilev,ig,ilay,nlev
-      INTEGER unit,ierr,it1,it2,icount
-      SAVE icount
-      INTEGER cluvdb,putdat,putvdim,setname,setvdim
-      REAL z4st,zdplanck(ngrid),zu2
-      REAL zkv(ngrid,nlayermx+1),zkh(ngrid,nlayermx+1)
-      REAL zcdv(ngrid),zcdh(ngrid)
-      REAL zu(ngrid,nlayermx),zv(ngrid,nlayermx)
-      REAL zh(ngrid,nlayermx)
-      REAL ztsrf2(ngrid)
-      REAL z1(ngrid),z2(ngrid)
-      REAL za(ngrid,nlayermx),zb(ngrid,nlayermx)
-      REAL zb0(ngrid,nlayermx)
-      REAL zc(ngrid,nlayermx),zd(ngrid,nlayermx)
-      REAL zout_dyn(iim+1,jjm+1,nlayermx+1),zout_fi(ngrid,nlayermx+1)
-      REAL zcst1
-      REAL karman
-
-      EXTERNAL coefdifv
-      EXTERNAL SSUM
-      REAL SSUM
-      SAVE karman
-
-      DATA karman/0.4/
-      DATA icount/0/
-c
-c-----------------------------------------------------------------------
-c   initialisations:
-c   ----------------
-
-      nlev=nlay+1
-
-      IF(ngrid.NE.ngrid) THEN
-         PRINT*,'STOP dans coefdifv'
-         PRINT*,'probleme de dimensions :'
-         PRINT*,'ngrid  =',ngrid
-         PRINT*,'ngrid  =',ngrid
-         STOP
-      ENDIF
-
-c   computation of rho*dz and dt*rho/dz=dt*rho**2 g/dp:
-c   with rho=p/RT=p/ (R Theta) (p/ps)**kappa
-c   ---------------------------------
-
-      DO ilay=1,nlay
-         DO ig=1,ngrid
-            za(ig,ilay)=
-     s       (pplev(ig,ilay)-pplev(ig,ilay+1))/g
-         ENDDO
-      ENDDO
-
-      zcst1=4.*g*ptimestep/(kappa*cpp)**2 
-      DO ilev=2,nlev-1
-         DO ig=1,ngrid
-            zb0(ig,ilev)=pplev(ig,ilev)*
-     s      (pplev(ig,1)/pplev(ig,ilev))**kappa /
-     s      (ph(ig,ilev-1)+ph(ig,ilev))
-            zb0(ig,ilev)=zcst1*zb0(ig,ilev)*zb0(ig,ilev)/
-     s      (pplay(ig,ilev-1)-pplay(ig,ilev))
-         ENDDO
-      ENDDO
-      DO ig=1,ngrid
-         zb0(ig,1)=ptimestep*pplev(ig,1)/(kappa*cpp*ptsrf(ig))
-      ENDDO
-      IF(lwrite) THEN
-         ig=ngrid/2+1
-         PRINT*,'Pression (mbar) ,altitude (km),u,v,theta, rho dz'
-         DO ilay=1,nlay
-            WRITE(*,*) .01*pplay(ig,ilay),.001*pzlay(ig,ilay),
-     s      pu(ig,ilay),pv(ig,ilay),ph(ig,ilay),za(ig,ilay)
-         ENDDO
-         PRINT*,'Pression (mbar) ,altitude (km),zb'
-         DO ilev=1,nlay
-            WRITE(*,*) .01*pplev(ig,ilev),.001*pzlev(ig,ilev),
-     s      zb0(ig,ilev)
-         ENDDO
-      ENDIF
-
-c-----------------------------------------------------------------------
-c   2. ajout des tendances physiques:
-c   ------------------------------
-
-      DO ilev=1,nlay
-         DO ig=1,ngrid
-            zu(ig,ilev)=pu(ig,ilev)+pdufi(ig,ilev)*ptimestep
-            zv(ig,ilev)=pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep
-            zh(ig,ilev)=ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep
-         ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   3. calcul de  cd :
-c   ----------------
-c
-      CALL vdif_cd( ngrid,pz0,g,pzlay,pu,pv,ptsrf,ph,zcdv,zcdh)
-
-c     CALL my_25(ptimestep,g,pzlev,pzlay,pu,pv,ph,zcdv,
-c    a          pq2,pq2l,zkv,zkh)
-
-        CALL vdif_k(ngrid,nlay,
-     s   ptimestep,g,pzlev,pzlay,pz0,pu,pv,ph,zcdv,zkv,zkh,pq2,pq2l)
-
-      DO ig=1,ngrid
-         zu2=pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)
-         zcdv(ig)=zcdv(ig)*sqrt(zu2)
-         zcdh(ig)=zcdh(ig)*sqrt(zu2)
-      ENDDO
-
-      IF(lwrite) THEN
-         PRINT*
-         PRINT*,'Diagnostique diffusion verticale'
-         PRINT*,'coefficients Cd pour v et h'
-         PRINT*,zcdv(ngrid/2+1),zcdh(ngrid/2+1)
-         PRINT*,'coefficients K pour v et h'
-         DO ilev=1,nlay
-            PRINT*,zkv(ngrid/2+1,ilev),zkh(ngrid/2+1,ilev)
-         ENDDO
-      ENDIF
-
-c-----------------------------------------------------------------------
-c   integration verticale pour u:
-c   -----------------------------
-c
-      CALL multipl((nlay-1)*ngrid,zkv(1,2),zb0(1,2),zb(1,2))
-      CALL multipl(ngrid,zcdv,zb0,zb)
-      DO ig=1,ngrid
-         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
-         zc(ig,nlay)=za(ig,nlay)*zu(ig,nlay)*z1(ig)
-         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
-      ENDDO
-
-      DO ilay=nlay-1,1,-1
-         DO ig=1,ngrid
-            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
-     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
-            zc(ig,ilay)=(za(ig,ilay)*zu(ig,ilay)+
-     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
-            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
-         ENDDO
-      ENDDO
-
-      DO ig=1,ngrid
-         zu(ig,1)=zc(ig,1)
-      ENDDO
-      DO ilay=2,nlay
-         DO ig=1,ngrid
-            zu(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zu(ig,ilay-1)
-         ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   integration verticale pour v:
-c   -----------------------------
-c
-      DO ig=1,ngrid
-         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
-         zc(ig,nlay)=za(ig,nlay)*zv(ig,nlay)*z1(ig)
-         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
-      ENDDO
-
-      DO ilay=nlay-1,1,-1
-         DO ig=1,ngrid
-            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
-     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
-            zc(ig,ilay)=(za(ig,ilay)*zv(ig,ilay)+
-     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
-            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
-         ENDDO
-      ENDDO
-
-      DO ig=1,ngrid
-         zv(ig,1)=zc(ig,1)
-      ENDDO
-      DO ilay=2,nlay
-         DO ig=1,ngrid
-            zv(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zv(ig,ilay-1)
-         ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   integration verticale pour h:
-c   -----------------------------
-c
-      CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
-      CALL multipl(ngrid,zcdh,zb0,zb)
-      DO ig=1,ngrid
-         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
-         zc(ig,nlay)=za(ig,nlay)*zh(ig,nlay)*z1(ig)
-         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
-      ENDDO
-
-      DO ilay=nlay-1,1,-1
-         DO ig=1,ngrid
-            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
-     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
-            zc(ig,ilay)=(za(ig,ilay)*zh(ig,ilay)+
-     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
-            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
-         ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   rajout eventuel de planck dans le shema implicite:
-c   --------------------------------------------------
-
-      z4st=4.*5.67e-8*ptimestep
-c     z4st=0.
-      DO ig=1,ngrid
-         zdplanck(ig)=z4st*pemis(ig)*ptsrf(ig)*ptsrf(ig)*ptsrf(ig)
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   calcul le l'evolution de la temperature du sol':
-c   -----------------------------------------------
-
-      DO ig=1,ngrid
-         z1(ig)=pcapcal(ig)*ptsrf(ig)+cpp*zb(ig,1)*zc(ig,1)
-     s     +zdplanck(ig)*ptsrf(ig)+ pfluxsrf(ig)*ptimestep
-         z2(ig)= pcapcal(ig)+cpp*zb(ig,1)*(1.-zd(ig,1))+zdplanck(ig)
-         ztsrf2(ig)=z1(ig)/z2(ig)
-         zh(ig,1)=zc(ig,1)+zd(ig,1)*ztsrf2(ig)
-         pdtsrf(ig)=(ztsrf2(ig)-ptsrf(ig))/ptimestep
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   integration verticale finale:
-c   -----------------------------
-
-      DO ilay=2,nlay
-         DO ig=1,ngrid
-            zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zh(ig,ilay-1)
-         ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   calcul final des tendances de la diffusion verticale:
-c   -----------------------------------------------------
-
-      DO ilev = 1, nlay
-         DO ig=1,ngrid
-            pdudif(ig,ilev)=(    zu(ig,ilev)-
-     $      (pu(ig,ilev)+pdufi(ig,ilev)*ptimestep)    )/ptimestep
-            pdvdif(ig,ilev)=(    zv(ig,ilev)-
-     $      (pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep)    )/ptimestep
-            pdhdif(ig,ilev)=(    zh(ig,ilev)-
-     $      (ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep)    )/ptimestep
-         ENDDO
-      ENDDO
-
-      IF(lwrite) THEN
-         PRINT*
-         PRINT*,'Diagnostique de la diffusion verticale'
-         PRINT*,'h avant et apres diffusion verticale'
-         PRINT*,ptsrf(ngrid/2+1),ztsrf2(ngrid/2+1)
-         DO 3110 ilev=1,nlay
-            PRINT*,ph(ngrid/2+1,ilev),zh(ngrid/2+1,ilev)
-3110     CONTINUE
-      ENDIF
-c---------------------------------------------------------------------
-      RETURN
-      END SUBROUTINE vdif
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-	      SUBROUTINE convadj(ngrid,nlay,ptimestep,
-     S                   pplay,pplev,ppopsk,
-     $                   pu,pv,ph,
-     $                   pdufi,pdvfi,pdhfi,
-     $                   pduadj,pdvadj,pdhadj)
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   ajustement convectif sec
-c   on peut ajouter les tendances pdhfi au profil pdh avant l'ajustement
-c'
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-c   arguments:
-c   ----------
-
-      INTEGER ngrid,nlay
-      REAL ptimestep
-      REAL ph(ngrid,nlay),pdhfi(ngrid,nlay),pdhadj(ngrid,nlay)
-      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1),ppopsk(ngrid,nlay)
-      REAL pu(ngrid,nlay),pdufi(ngrid,nlay),pduadj(ngrid,nlay)
-      REAL pv(ngrid,nlay),pdvfi(ngrid,nlay),pdvadj(ngrid,nlay)
-
-c   local:
-c   ------
-
-      INTEGER ig,i,l,l1,l2,jj
-      INTEGER jcnt, jadrs(ngrid)
-
-      REAL*8 sig(nlayermx+1),sdsig(nlayermx),dsig(nlayermx)
-      REAL*8 zu(ngrid,nlayermx),zv(ngrid,nlayermx)
-      REAL*8 zh(ngrid,nlayermx)
-      REAL*8 zu2(ngrid,nlayermx),zv2(ngrid,nlayermx)
-      REAL*8 zh2(ngrid,nlayermx)
-      REAL*8 zhm,zsm,zum,zvm,zalpha
-
-      LOGICAL vtest(ngrid),down
-
-c
-c-----------------------------------------------------------------------
-c   initialisation:
-c   ---------------
-c
-      IF(ngrid.NE.ngrid) THEN
-         PRINT*
-         PRINT*,'STOP dans convadj'
-         PRINT*,'ngrid    =',ngrid
-         PRINT*,'ngrid  =',ngrid
-      ENDIF
-c
-c-----------------------------------------------------------------------
-c   detection des profils a modifier:
-c   ---------------------------------
-c   si le profil est a modifier
-c   (i.e. ph(niv_sup) < ph(niv_inf) )
-c   alors le tableau "vtest" est mis a .TRUE. ;
-c   sinon, il reste a sa valeur initiale (.FALSE.)
-c   cette operation est vectorisable
-c   On en profite pour copier la valeur initiale de "ph"
-c   dans le champ de travail "zh"
-
-
-      DO 1010 l=1,nlay
-         DO 1015 ig=1,ngrid
-            zh(ig,l)=ph(ig,l)+pdhfi(ig,l)*ptimestep
-            zu(ig,l)=pu(ig,l)+pdufi(ig,l)*ptimestep
-            zv(ig,l)=pv(ig,l)+pdvfi(ig,l)*ptimestep
-1015     CONTINUE
-1010  CONTINUE
-
-      zu2(:,:)=zu(:,:)
-      zv2(:,:)=zv(:,:)
-      zh2(:,:)=zh(:,:)
-
-      DO 1020 ig=1,ngrid
-        vtest(ig)=.FALSE.
- 1020 CONTINUE
-c
-      DO 1040 l=2,nlay
-        DO 1060 ig=1,ngrid
-CRAY      vtest(ig)=CVMGM(.TRUE. , vtest(ig),
-CRAY .                      zh2(ig,l)-zh2(ig,l-1))
-          IF(zh2(ig,l).LT.zh2(ig,l-1)) vtest(ig)=.TRUE.
- 1060   CONTINUE
- 1040 CONTINUE
-c
-CRAY  CALL WHENNE(ngrid, vtest, 1, 0, jadrs, jcnt)
-      jcnt=0
-      DO 1070 ig=1,ngrid
-         IF(vtest(ig)) THEN
-            jcnt=jcnt+1
-            jadrs(jcnt)=ig
-         ENDIF
-1070  CONTINUE
-
-
-c-----------------------------------------------------------------------
-c  Ajustement des "jcnt" profils instables indices par "jadrs":
-c  ------------------------------------------------------------
-c
-      DO 1080 jj = 1, jcnt
-c
-          i = jadrs(jj)
-c
-c   Calcul des niveaux sigma sur cette colonne
-          DO l=1,nlay+1
-            sig(l)=pplev(i,l)/pplev(i,1)
-         ENDDO
-         DO l=1,nlay
-            dsig(l)=sig(l)-sig(l+1)
-            sdsig(l)=ppopsk(i,l)*dsig(l)
-         ENDDO
-          l2 = 1
-c
-c      -- boucle de sondage vers le haut
-c
-cins$     Loop
- 8000     CONTINUE
-c
-            l2 = l2 + 1
-c
-cins$       Exit
-            IF (l2 .GT. nlay) Goto 8001
-c
-            IF (zh2(i, l2) .LT. zh2(i, l2-1)) THEN
-c
-c          -- l2 est le niveau le plus haut de la colonne instable
-c
-              l1 = l2 - 1
-              l  = l1
-              zsm = sdsig(l2)
-              zhm = zh2(i, l2)
-c
-c          -- boucle de sondage vers le bas
-c
-cins$         Loop
- 8020         CONTINUE
-c
-                zsm = zsm + sdsig(l)
-                zhm = zhm + sdsig(l) * (zh2(i, l) - zhm) / zsm
-c
-c            -- doit on etendre la colonne vers le bas ?
-c
-c_EC (M1875) 20/6/87 : AND -> AND THEN
-c
-                down = .FALSE.
-                IF (l1 .NE. 1) THEN    !--  and then
-                  IF (zhm .LT. zh2(i, l1-1)) THEN
-                    down = .TRUE.
-                  END IF
-                END IF
-c
-                IF (down) THEN
-c
-                  l1 = l1 - 1
-                  l  = l1
-c
-                ELSE
-c
-c              -- peut on etendre la colonne vers le haut ?
-c
-cins$             Exit
-                  IF (l2 .EQ. nlay) Goto 8021
-c
-cins$             Exit
-                  IF (zh2(i, l2+1) .GE. zhm) Goto 8021
-c
-                  l2 = l2 + 1
-                  l  = l2
-c
-                END IF
-c
-cins$         End Loop
-              GO TO 8020
- 8021         CONTINUE
-c
-c          -- nouveau profil : constant (valeur moyenne)
-c
-              zalpha=0.
-              zum=0.
-              zvm=0.
-              DO 1100 l = l1, l2
-                zalpha=zalpha+ABS(zh2(i,l)-zhm)*dsig(l)
-                zh2(i, l) = zhm
-                zum=zum+dsig(l)*zu(i,l)
-                zvm=zvm+dsig(l)*zv(i,l)
- 1100         CONTINUE
-              zalpha=zalpha/(zhm*(sig(l1)-sig(l2+1)))
-              zum=zum/(sig(l1)-sig(l2+1))
-              zvm=zvm/(sig(l1)-sig(l2+1))
-              IF(zalpha.GT.1.) THEN
-                 PRINT*,'WARNING dans convadj zalpha=',zalpha
-                 if(ig.eq.1) then
-                    print*,'Au pole nord'
-                 elseif (ig.eq.ngrid) then
-                    print*,'Au pole sud'
-                 else
-                    print*,'Point i=',
-     .              ig-((ig-1)/iim)*iim,'j=',(ig-1)/iim+1
-                 endif
-!                 STOP !problem with icosa pole 
-                 zalpha=1.
-              ELSE
-c                IF(zalpha.LT.0.) STOP'zalpha=0'
-                 IF(zalpha.LT.1.e-5) zalpha=1.e-5
-              ENDIF
-              DO l=l1,l2
-                 zu2(i,l)=zu2(i,l)+zalpha*(zum-zu2(i,l))
-                 zv2(i,l)=zv2(i,l)+zalpha*(zvm-zv2(i,l))
-              ENDDO
- 
-              l2 = l2 + 1
-c
-            END IF
-c
-cins$     End Loop
-          GO TO 8000
- 8001     CONTINUE
-c
- 1080 CONTINUE
-c
-      DO 4000 l=1,nlay
-        DO 4020 ig=1,ngrid
-          pdhadj(ig,l)=(zh2(ig,l)-zh(ig,l))/ptimestep
-          pduadj(ig,l)=(zu2(ig,l)-zu(ig,l))/ptimestep
-          pdvadj(ig,l)=(zv2(ig,l)-zv(ig,l))/ptimestep
- 4020   CONTINUE
- 4000 CONTINUE
-c
-      RETURN
-      END SUBROUTINE convadj 
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-	      SUBROUTINE soil(ngrid,nsoil,firstcall,ptherm_i,
-     s          ptimestep,ptsrf,ptsoil,
-     s          pcapcal,pfluxgrd)
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur:  Frederic Hourdin     30/01/92
-c   -------
-c
-c   objet:  computation of : the soil temperature evolution
-c   ------                   the surfacic heat capacity "Capcal"
-c                            the surface conduction flux pcapcal
-c
-c
-c   Method: implicit time integration
-c   -------
-c   Consecutive ground temperatures are related by:
-c           T(k+1) = C(k) + D(k)*T(k)  (1)
-c   the coefficients C and D are computed at the t-dt time-step.
-c   Routine structure:
-c   1)new temperatures are computed  using (1)
-c   2)C and D coefficients are computed from the new temperature
-c     profile for the t+dt time-step
-c   3)the coefficients A and B are computed where the diffusive
-c     fluxes at the t+dt time-step is given by
-c            Fdiff = A + B Ts(t+dt)
-c     or     Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt
-c            with F0 = A + B (Ts(t))
-c                 Capcal = B*dt
-c           
-c   Interface:
-c   ----------
-c
-c   Arguments:
-c   ----------
-c   ngird               number of grid-points
-c   ptimestep              physical timestep (s)
-c   pto(ngrid,nsoil)     temperature at time-step t (K)
-c   ptn(ngrid,nsoil)     temperature at time step t+dt (K)
-c   pcapcal(ngrid)      specific heat (W*m-2*s*K-1)
-c   pfluxgrd(ngrid)      surface diffusive flux from ground (Wm-2)
-c   
-c=======================================================================
-c   declarations:
-c   -------------
-c-----------------------------------------------------------------------
-c  arguments
-c  ---------
-
-      INTEGER ngrid,nsoil
-      REAL ptimestep
-      REAL ptsrf(ngrid),ptsoil(ngrid,nsoilmx),ptherm_i(ngrid)
-      REAL pcapcal(ngrid),pfluxgrd(ngrid)
-      LOGICAL firstcall
-
-c-----------------------------------------------------------------------
-c  local arrays
-c  ------------
-
-      INTEGER ig,jk
-      REAL za(ngrid),zb(ngrid)
-      REAL zdz2(nsoilmx),z1(ngrid)
-      REAL min_period,dalph_soil
-
-c   local saved variables:
-c   ----------------------
-      REAL dz1(nsoilmx),dz2(nsoilmx)
-      REAL zc(ngrid,nsoilmx),zd(ngrid,nsoilmx)
-      REAL lambda
-
-!!!!!!!! SARVESH !!!!!!! SAVE ATTRIBUTE 
-!!      SAVE dz1,dz2,zc,zd,lambda
-
-c-----------------------------------------------------------------------
-c   Depthts:
-c   --------
-
-      REAL fz,rk,fz1,rk1,rk2
-      fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
-
-      IF (firstcall) THEN
-
-c-----------------------------------------------------------------------
-c   ground levels 
-c   grnd=z/l where l is the skin depth of the diurnal cycle:
-c   --------------------------------------------------------
-
-         min_period=20000.
-         dalph_soil=2.
-
-         OPEN(99,file='soil.def',status='old',form='formatted',err=9999)
-         READ(99,*) min_period
-         READ(99,*) dalph_soil
-         PRINT*,'Discretization for the soil model'
-         PRINT*,'First level e-folding depth',min_period,
-     s   '   dalph',dalph_soil
-         CLOSE(99)
-9999     CONTINUE
-
-c   la premiere couche represente un dixieme de cycle diurne
-         fz1=sqrt(min_period/3.14)
-
-         DO jk=1,nsoil
-            rk1=jk
-            rk2=jk-1
-            dz2(jk)=fz(rk1)-fz(rk2)
-         ENDDO
-         DO jk=1,nsoil-1
-            rk1=jk+.5
-            rk2=jk-.5
-            dz1(jk)=1./(fz(rk1)-fz(rk2))
-         ENDDO
-         lambda=fz(.5)*dz1(1)
-         PRINT*,'full layers, intermediate layers (secoonds)'
-         DO jk=1,nsoil
-            rk=jk
-            rk1=jk+.5
-            rk2=jk-.5
-            PRINT*,fz(rk1)*fz(rk2)*3.14,
-     s      fz(rk)*fz(rk)*3.14
-         ENDDO
-
-c   Initialisations:
-c   ----------------
-
-      ELSE
-c-----------------------------------------------------------------------
-c   Computation of the soil temperatures using the Cgrd and Dgrd
-c  coefficient computed at the previous time-step:
-c  -----------------------------------------------
-
-c    surface temperature
-         DO ig=1,ngrid
-            ptsoil(ig,1)=(lambda*zc(ig,1)+ptsrf(ig))/
-     s      (lambda*(1.-zd(ig,1))+1.)
-         ENDDO
-
-c   other temperatures
-         DO jk=1,nsoil-1
-            DO ig=1,ngrid
-               ptsoil(ig,jk+1)=zc(ig,jk)+zd(ig,jk)*ptsoil(ig,jk)
-            ENDDO
-         ENDDO
-
-      ENDIF
-c-----------------------------------------------------------------------
-c   Computation of the Cgrd and Dgrd coefficient for the next step:
-c   ---------------------------------------------------------------
-
-      DO jk=1,nsoil
-         zdz2(jk)=dz2(jk)/ptimestep
-      ENDDO
-
-      DO ig=1,ngrid
-         z1(ig)=zdz2(nsoil)+dz1(nsoil-1)
-         zc(ig,nsoil-1)=zdz2(nsoil)*ptsoil(ig,nsoil)/z1(ig)
-         zd(ig,nsoil-1)=dz1(nsoil-1)/z1(ig)
-      ENDDO
-
-      DO jk=nsoil-1,2,-1
-         DO ig=1,ngrid
-            z1(ig)=1./(zdz2(jk)+dz1(jk-1)+dz1(jk)*(1.-zd(ig,jk)))
-            zc(ig,jk-1)=
-     s      (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*zc(ig,jk))*z1(ig)
-            zd(ig,jk-1)=dz1(jk-1)*z1(ig)
-         ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   computation of the surface diffusive flux from ground and
-c   calorific capacity of the ground:
-c   ---------------------------------
-
-      DO ig=1,ngrid
-         pfluxgrd(ig)=ptherm_i(ig)*dz1(1)*
-     s   (zc(ig,1)+(zd(ig,1)-1.)*ptsoil(ig,1))
-         pcapcal(ig)=ptherm_i(ig)*
-     s   (dz2(1)+ptimestep*(1.-zd(ig,1))*dz1(1))
-         z1(ig)=lambda*(1.-zd(ig,1))+1.
-         pcapcal(ig)=pcapcal(ig)/z1(ig)
-         pfluxgrd(ig)=pfluxgrd(ig)
-     s   +pcapcal(ig)*(ptsoil(ig,1)*z1(ig)-lambda*zc(ig,1)-ptsrf(ig))
-     s   /ptimestep
-      ENDDO
-
-      RETURN
-      END SUBROUTINE SOIL
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-	      SUBROUTINE vdif_cd( ngrid,pz0,pg,pz,pu,pv,pts,ph,pcdv,pcdh)
-      IMPLICIT NONE
-c=======================================================================
-c
-c   Subject: computation of the surface drag coefficient using the
-c   -------  approch developed by Loui for ECMWF.
-c
-c   Author: Frederic Hourdin  15 /10 /93
-c   -------
-c
-c   Arguments:
-c   ----------
-c
-c   inputs:
-c   ------
-c     ngrid            size of the horizontal grid
-c     pg               gravity (m s -2)
-c     pz(ngrid)        height of the first atmospheric layer
-c     pu(ngrid)        u component of the wind in that layer
-c     pv(ngrid)        v component of the wind in that layer
-c     pts(ngrid)       surfacte temperature
-c     ph(ngrid)        potential temperature T*(p/ps)^kappa
-c
-c   outputs:
-c   --------
-c     pcdv(ngrid)      Cd for the wind
-c     pcdh(ngrid)      Cd for potential temperature
-c
-c=======================================================================
-c
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-
-c   Arguments:
-c   ----------
-
-      INTEGER ngrid,nlay
-      REAL pz0(ngrid)
-      REAL pg,pz(ngrid)
-      REAL pu(ngrid),pv(ngrid)
-      REAL pts(ngrid),ph(ngrid)
-      REAL pcdv(ngrid),pcdh(ngrid)
-
-c   Local:
-c   ------
-
-      INTEGER ig
-
-      REAL zu2,z1,zri,zcd0,zz
-
-      REAL karman,b,c,d,c2b,c3bc,c3b,z0,umin2
-      LOGICAL firstcal
-      DATA karman,b,c,d,umin2/.4,5.,5.,5.,1.e-12/
-      DATA firstcal/.true./
-      SAVE b,c,d,karman,c2b,c3bc,c3b,firstcal,umin2
-
-c-----------------------------------------------------------------------
-c   couche de surface:
-c   ------------------
-
-c     DO ig=1,ngrid
-c        zu2=pu(ig)*pu(ig)+pv(ig)*pv(ig)+umin2
-c        pcdv(ig)=pz0(ig)*(1.+sqrt(zu2))
-c        pcdh(ig)=pcdv(ig)
-c     ENDDO
-c     RETURN
-
-      IF (firstcal) THEN
-         c2b=2.*b
-         c3bc=3.*b*c
-         c3b=3.*b
-         firstcal=.false.
-      ENDIF
-
-c!!!! WARNING, verifier la formule originale de Louis!
-      DO ig=1,ngrid
-         zu2=pu(ig)*pu(ig)+pv(ig)*pv(ig)+umin2
-         zri=pg*pz(ig)*(ph(ig)-pts(ig))/(ph(ig)*zu2)
-         z1=1.+pz(ig)/pz0(ig)
-         zcd0=karman/log(z1)
-         zcd0=zcd0*zcd0*sqrt(zu2)
-         IF(zri.LT.0.) THEN
-            z1=b*zri/(1.+c3bc*zcd0*sqrt(-z1*zri))
-            pcdv(ig)=zcd0*(1.-2.*z1)
-            pcdh(ig)=zcd0*(1.-3.*z1)
-         ELSE
-            zz=sqrt(1.+d*zri)
-            pcdv(ig)=zcd0/(1.+c2b*zri/zz)
-            pcdh(ig)=zcd0/(1.+c3b*zri*zz)
-         ENDIF
-      ENDDO
-
-c-----------------------------------------------------------------------
-
-      RETURN
-      END SUBROUTINE vdif_cd
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-        SUBROUTINE vdif_k(ngrid,nlay,
-     s   ptimestep,pg,pzlev,pzlay,pz0,pu,pv,ph,pcdv,pkv,pkh,pq2,pq2l)
-
-      IMPLICIT NONE
-
-      INTEGER ngrid,nlay
-
-      REAL ptimestep
-      REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
-      REAL pz0(ngrid)
-      REAL pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay)
-      REAL pg,pcdv(ngrid)
-      REAL pkv(ngrid,nlay+1),pkh(ngrid,nlay+1)
-	REAL pq2(ngrid,nlay+1),pq2l(ngrid,nlay+1) !!!! SARVESH ADDED to 
-
-      INTEGER ig,il
-      REAL zdu,zdv,zri,zdvodz2,zdz,z1,lmix
-
-      REAL karman
-      SAVE karman
-!      DATA lmixmin,emin_turb,karman/100.,1.e-8,.4/
-!!!!! SARVESH !!!!!!
-!Error: Host associated variable 'lmixmin' may not be in the DATA statement 
-
-!      print*,'LMIXMIN',lmixmin
-      DO ig=1,ngrid
-         pkv(ig,1)=0.
-         pkh(ig,1)=0.
-         pkv(ig,nlay+1)=0.
-         pkh(ig,nlay+1)=0.
-      ENDDO
-c    s     ' zdu,zdv,zdz,zdovdz2,ph(ig,il)+ph(ig,il-1)'
-      DO il=2,nlay
-         DO ig=1,ngrid
-            z1=pzlev(ig,il)+pz0(ig)
-            lmix=karman*z1/(1.+karman*z1/lmixmin)
-c           lmix=lmixmin
-c WARNING test lmix=lmixmin
-            zdu=pu(ig,il)-pu(ig,il-1)
-            zdv=pv(ig,il)-pv(ig,il-1)
-            zdz=pzlay(ig,il)-pzlay(ig,il-1)
-            zdvodz2=(zdu*zdu+zdv*zdv)/(zdz*zdz)
-            IF(zdvodz2.LT.1.e-5) THEN
-                pkv(ig,il)=lmix*sqrt(emin_turb)
-            ELSE
-               zri=2.*pg*(ph(ig,il)-ph(ig,il-1))
-     s         / (zdz* (ph(ig,il)+ph(ig,il-1)) *zdvodz2  )
-               pkv(ig,il)=
-     s         lmix*sqrt(MAX(lmix*lmix*zdvodz2*(1-zri/.4),emin_turb))
-            ENDIF
-            pkh(ig,il)=pkv(ig,il)
-c           IF(ig.EQ.ngrid/2+1) PRINT*,il,lmix,pkv(ig,il),
-c    s      zdu,zdv,zdz,zdvodz2,ph(ig,il)+ph(ig,il-1),
-c    s      lmix*lmix*zdvodz2*(1-zri/.4),emin_turb,zri,ph(ig,il)-ph(ig,il-1),
-c    s      ph(ig,il),ph(ig,il-1)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END SUBROUTINE vdif_k
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-	      SUBROUTINE multipl(n,x1,x2,y)
-      IMPLICIT NONE
-c====================================================================
-c
-c   multiplication de deux vecteurs
-c
-c=======================================================================
-c
-      INTEGER n,i
-      REAL x1(n),x2(n),y(n)
-c
-      DO 10 i=1,n
-	 y(i)=x1(i)*x2(i)
-10    CONTINUE
-c
-      RETURN
-      END SUBROUTINE multipl
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-        END MODULE SURFACE_PROCESS
Index: codes/icosagcm/trunk/src/theta_rhodz.f90
===================================================================
--- codes/icosagcm/trunk/src/theta_rhodz.f90	(revision 185)
+++ codes/icosagcm/trunk/src/theta_rhodz.f90	(revision 186)
@@ -16,4 +16,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -39,4 +40,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -62,4 +64,5 @@
 
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
@@ -82,4 +85,5 @@
     INTEGER :: i,j,ij,l
     REAL(rstd),ALLOCATABLE,SAVE :: p(:,:)
+!$OMP THREADPRIVATE(p)
 
     ALLOCATE( p(iim*jjm,llm+1))
@@ -109,4 +113,5 @@
     INTEGER :: i,j,ij,l
     REAL(rstd),SAVE,ALLOCATABLE :: p(:,:)
+!$OMP THREADPRIVATE(p)
 
     ALLOCATE( p(iim*jjm,llm+1))
Index: codes/icosagcm/trunk/src/time.f90
===================================================================
--- codes/icosagcm/trunk/src/time.f90	(revision 185)
+++ codes/icosagcm/trunk/src/time.f90	(revision 186)
@@ -4,19 +4,33 @@
 
   INTEGER,SAVE :: ncid
+!$OMP THREADPRIVATE(ncid)  
   INTEGER,SAVE :: time_counter_id
+!$OMP THREADPRIVATE(time_counter_id)  
   INTEGER,SAVE :: it
+!$OMP THREADPRIVATE(it)  
 
   REAL(rstd),SAVE :: dt
+!$OMP THREADPRIVATE(dt)  
   REAL(rstd),SAVE :: write_period
+!$OMP THREADPRIVATE(write_period)  
   INTEGER,SAVE    :: itau_out, itau_adv, itau_dissip, itau_physics, itaumax
+!$OMP THREADPRIVATE(itau_out, itau_adv, itau_dissip, itau_physics, itaumax)  
   
   INTEGER,SAVE :: day_step,ndays
+!$OMP THREADPRIVATE(day_step,ndays)  
   REAL(rstd),SAVE :: jD_ref,jH_ref
+!$OMP THREADPRIVATE(jD_ref,jH_ref)  
   INTEGER,SAVE :: day_ini,day_end,annee_ref,day_ref
+!$OMP THREADPRIVATE(day_ini,day_end,annee_ref,day_ref)  
   REAL(rstd),SAVE::start_time
+!$OMP THREADPRIVATE(start_time)  
   CHARACTER(LEN=255) :: time_style
+!$OMP THREADPRIVATE(time_style)  
   INTEGER,SAVE:: an, mois, jour
+!$OMP THREADPRIVATE(an, mois, jour)  
   REAL(rstd),SAVE:: heure
+!$OMP THREADPRIVATE(heure)  
   CHARACTER (LEN=10):: calend
+!$OMP THREADPRIVATE(calend)  
 
   PUBLIC create_time_counter_header, update_time_counter, close_time_counter, init_time,  &
@@ -32,5 +46,5 @@
   SUBROUTINE init_time
   USE earth_const
-  USE ioipsl
+  USE getin_mod
   USE mpipara
   IMPLICIT NONE
@@ -38,5 +52,5 @@
 
 
-     time_style='dcmip'
+   time_style='dcmip'
    CALL getin('time_style',time_style)
 
@@ -81,5 +95,5 @@
   USE netcdf_mod
   USE prec
-  USE ioipsl
+  USE getin_mod
   USE mpipara
   IMPLICIT NONE
@@ -88,5 +102,9 @@
   REAL(rstd) :: dt
   CHARACTER(LEN=255) :: time_frequency
-  
+
+  CALL getin("dt",dt)
+
+!$OMP BARRIER
+!$OMP MASTER  
     IF (is_mpi_root) THEN 
       status = NF90_CREATE('time_counter.nc', NF90_CLOBBER, ncid)
@@ -104,8 +122,9 @@
       status = NF90_ENDDEF(ncid) 
 
-      CALL getin("dt",dt)
       status=NF90_PUT_VAR(ncid,dtid, dt)
     ENDIF
     it=0
+!$OMP END MASTER
+!$OMP BARRIER
 
   END SUBROUTINE create_time_counter_header
@@ -120,4 +139,5 @@
   REAL(rstd) ::time_array(1)
 
+!$OMP BARRIER
 !$OMP MASTER
     time_array(1)=time
@@ -129,4 +149,5 @@
     ENDIF
 !$OMP END MASTER
+!$OMP BARRIER
 
   END SUBROUTINE update_time_counter    
@@ -138,5 +159,9 @@
     INTEGER :: status
     
+!$OMP BARRIER
+!$OMP MASTER
      IF (is_mpi_root) status=NF90_CLOSE(ncid)
+!$OMP END MASTER
+!$OMP BARRIER
     
   END SUBROUTINE  close_time_counter 
Index: codes/icosagcm/trunk/src/timeloop_gcm.f90
===================================================================
--- codes/icosagcm/trunk/src/timeloop_gcm.f90	(revision 185)
+++ codes/icosagcm/trunk/src/timeloop_gcm.f90	(revision 186)
@@ -7,20 +7,22 @@
 
   INTEGER, PARAMETER :: euler=1, rk4=2, mlf=3
-  INTEGER  :: itau_sync=10
-
-  TYPE(t_message) :: req_ps0, req_mass0, req_theta_rhodz0, req_u0, req_q0
-
-  TYPE(t_field),POINTER :: f_q(:)
-  TYPE(t_field),POINTER :: f_rhodz(:), f_mass(:), f_massm1(:), f_massm2(:), f_dmass(:)
-  TYPE(t_field),POINTER :: f_phis(:), f_ps(:),f_psm1(:), f_psm2(:), f_dps(:)
-  TYPE(t_field),POINTER :: f_u(:),f_um1(:),f_um2(:), f_du(:)
-  TYPE(t_field),POINTER :: f_theta_rhodz(:),f_theta_rhodzm1(:),f_theta_rhodzm2(:), f_dtheta_rhodz(:)
-  TYPE(t_field),POINTER :: f_hflux(:), f_wflux(:), f_hfluxt(:), f_wfluxt(:)  
-
-  INTEGER :: nb_stage, matsuno_period, scheme    
+  INTEGER, PARAMETER :: itau_sync=10
+
+  TYPE(t_message),SAVE :: req_ps0, req_mass0, req_theta_rhodz0, req_u0, req_q0
+
+  TYPE(t_field),POINTER,SAVE :: f_q(:)
+  TYPE(t_field),POINTER,SAVE :: f_rhodz(:), f_mass(:), f_massm1(:), f_massm2(:), f_dmass(:)
+  TYPE(t_field),POINTER,SAVE :: f_phis(:), f_ps(:),f_psm1(:), f_psm2(:), f_dps(:)
+  TYPE(t_field),POINTER,SAVE :: f_u(:),f_um1(:),f_um2(:), f_du(:)
+  TYPE(t_field),POINTER,SAVE :: f_theta_rhodz(:),f_theta_rhodzm1(:),f_theta_rhodzm2(:), f_dtheta_rhodz(:)
+  TYPE(t_field),POINTER,SAVE :: f_hflux(:), f_wflux(:), f_hfluxt(:), f_wfluxt(:)  
+
+  INTEGER,SAVE :: nb_stage, matsuno_period, scheme    
+!$OMP THREADPRIVATE(nb_stage, matsuno_period, scheme)
 
   REAL(rstd),SAVE :: jD_cur, jH_cur
+!$OMP THREADPRIVATE(jD_cur, jH_cur)  
   REAL(rstd),SAVE :: start_time
-
+!$OMP THREADPRIVATE(start_time)
 CONTAINS
   
@@ -39,5 +41,4 @@
   USE transfert_mod
   USE check_conserve_mod
-  USE ioipsl
   USE output_field_mod
   USE write_field
@@ -47,57 +48,58 @@
 
 !----------------------------------------------------
-  IF (TRIM(time_style)=='lmd')  Then
-
-   day_step=180
-   CALL getin('day_step',day_step)
-
-   ndays=1
-   CALL getin('ndays',ndays)
-
-   dt = daysec/REAL(day_step)
-   itaumax = ndays*day_step
-
-   calend = 'earth_360d'
-   CALL getin('calend', calend)
-
-   day_ini = 0
-   CALL getin('day_ini',day_ini)
-
-   day_end = 0
-   CALL getin('day_end',day_end)
-
-   annee_ref = 1998
-   CALL getin('annee_ref',annee_ref)
-
-   start_time = 0
-   CALL getin('start_time',start_time) 
-
-   
-   write_period=0
-   CALL getin('write_period',write_period)
-      
-   write_period=write_period/scale_factor
-   itau_out=FLOOR(write_period/dt)
-   
-   PRINT *, 'Output frequency (scaled) set to ',write_period, ' : itau_out = ',itau_out 
-
-  mois = 1 ; heure = 0.
-  call ymds2ju(annee_ref, mois, day_ref, heure, jD_ref)
-  jH_ref = jD_ref - int(jD_ref) 
-  jD_ref = int(jD_ref) 
-  
-  CALL ioconf_startdate(INT(jD_ref),jH_ref) 
-  write(*,*)'annee_ref, mois, day_ref, heure, jD_ref'
-  write(*,*)annee_ref, mois, day_ref, heure, jD_ref
-  write(*,*)"ndays,day_step,itaumax,dt======>"
-  write(*,*)ndays,day_step,itaumax,dt
-  call ju2ymds(jD_ref+jH_ref,an, mois, jour, heure)
-  write(*,*)'jD_ref+jH_ref,an, mois, jour, heure'
-  write(*,*)jD_ref+jH_ref,an, mois, jour, heure
-  day_end = day_ini + ndays 
- END IF 
+!  IF (TRIM(time_style)=='lmd')  Then
+
+!   day_step=180
+!   CALL getin('day_step',day_step)
+
+!   ndays=1
+!   CALL getin('ndays',ndays)
+
+!   dt = daysec/REAL(day_step)
+!   itaumax = ndays*day_step
+
+!   calend = 'earth_360d'
+!   CALL getin('calend', calend)
+
+!   day_ini = 0
+!   CALL getin('day_ini',day_ini)
+
+!   day_end = 0
+!   CALL getin('day_end',day_end)
+
+!   annee_ref = 1998
+!   CALL getin('annee_ref',annee_ref)
+
+!   start_time = 0
+!   CALL getin('start_time',start_time) 
+
+!   
+!   write_period=0
+!   CALL getin('write_period',write_period)
+!      
+!   write_period=write_period/scale_factor
+!   itau_out=FLOOR(write_period/dt)
+!   
+!   PRINT *, 'Output frequency (scaled) set to ',write_period, ' : itau_out = ',itau_out 
+
+!  mois = 1 ; heure = 0.
+!  call ymds2ju(annee_ref, mois, day_ref, heure, jD_ref)
+!  jH_ref = jD_ref - int(jD_ref) 
+!  jD_ref = int(jD_ref) 
+!  
+!  CALL ioconf_startdate(INT(jD_ref),jH_ref) 
+!  write(*,*)'annee_ref, mois, day_ref, heure, jD_ref'
+!  write(*,*)annee_ref, mois, day_ref, heure, jD_ref
+!  write(*,*)"ndays,day_step,itaumax,dt======>"
+!  write(*,*)ndays,day_step,itaumax,dt
+!  call ju2ymds(jD_ref+jH_ref,an, mois, jour, heure)
+!  write(*,*)'jD_ref+jH_ref,an, mois, jour, heure'
+!  write(*,*)jD_ref+jH_ref,an, mois, jour, heure
+!  day_end = day_ini + ndays 
+! END IF 
 !----------------------------------------------------
 
    IF (xios_output) itau_out=1
+   IF (.NOT. enable_io) itau_out=HUGE(itau_out)
 
 ! Time-independant orography
@@ -178,4 +180,5 @@
     CALL init_check_conserve
     CALL init_physics
+
     CALL etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_q)
 
@@ -221,8 +224,11 @@
     LOGICAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating fluxes in time
     LOGICAL, PARAMETER :: check=.FALSE.
-
+    INTEGER :: start_clock
+    INTEGER :: stop_clock
+    INTEGER :: rate_clock
+    
     CALL caldyn_BC(f_phis, f_wflux) ! set constant values in first/last interfaces
 
-!$OMP BARRIER
+!!$OMP BARRIER
   DO ind=1,ndomain
      CALL swap_dimensions(ind)
@@ -237,4 +243,10 @@
   fluxt_zero=.TRUE.
 
+!$OMP MASTER
+  CALL SYSTEM_CLOCK(start_clock)
+!$OMP END MASTER   
+
+  CALL trace_on
+  
   DO it=0,itaumax
     
@@ -242,16 +254,24 @@
     IF (MOD(it,itau_sync)==0) THEN
       CALL send_message(f_ps,req_ps0)
+      CALL wait_message(req_ps0)
       CALL send_message(f_mass,req_mass0)
+      CALL wait_message(req_mass0)
       CALL send_message(f_theta_rhodz,req_theta_rhodz0) 
+      CALL wait_message(req_theta_rhodz0) 
       CALL send_message(f_u,req_u0)
+      CALL wait_message(req_u0)
       CALL send_message(f_q,req_q0) 
-      CALL wait_message(req_ps0)
-      CALL wait_message(req_mass0)
-      CALL wait_message(req_theta_rhodz0) 
-      CALL wait_message(req_u0)
       CALL wait_message(req_q0) 
+
+!      CALL wait_message(req_ps0)
+!      CALL wait_message(req_mass0)
+!      CALL wait_message(req_theta_rhodz0) 
+!      CALL wait_message(req_u0)
+!      CALL wait_message(req_q0) 
     ENDIF
-    
-!    IF (is_mpi_root) PRINT *,"It No :",It,"   t :",dt*It
+
+!$OMP MASTER    
+    IF (is_mpi_root) PRINT *,"It No :",It,"   t :",dt*It
+!$OMP END MASTER    
     IF (mod(it,itau_out)==0 ) THEN
       CALL update_time_counter(dt*it)
@@ -279,6 +299,10 @@
 
     IF (MOD(it+1,itau_dissip)==0) THEN
+!         CALL send_message(f_ps,req_ps)
+!         CALL wait_message(req_ps)  
+       
        IF(caldyn_eta==eta_mass) THEN
           DO ind=1,ndomain
+             IF (.NOT. assigned_domain(ind)) CYCLE
              CALL swap_dimensions(ind)
              CALL swap_geometry(ind)
@@ -287,5 +311,9 @@
           END DO
        ENDIF
+!       CALL send_message(f_mass,req_mass)
+!       CALL wait_message(req_mass)  
        CALL dissip(f_u,f_du,f_mass,f_phis, f_theta_rhodz,f_dtheta_rhodz)
+!       CALL send_message(f_mass,req_mass)
+!       CALL wait_message(req_mass)  
        CALL euler_scheme(.FALSE.)  ! update only u, theta
     END IF
@@ -299,4 +327,5 @@
        IF (check) THEN
          DO ind=1,ndomain
+            IF (.NOT. assigned_domain(ind)) CYCLE
             CALL swap_dimensions(ind)
             CALL swap_geometry(ind)
@@ -316,6 +345,17 @@
 !    jH_cur = jH_cur - int(jH_cur)
     CALL physics(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_u, f_q)
+
     ENDDO
 
+    CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)  
+
+!$OMP MASTER
+    CALL SYSTEM_CLOCK(stop_clock)
+    CALL SYSTEM_CLOCK(count_rate=rate_clock)
+    
+    IF (mpi_rank==0) THEN 
+      PRINT *,"Time elapsed : ",(stop_clock-start_clock)*1./rate_clock
+    ENDIF  
+!$OMP END MASTER 
  
   CONTAINS
@@ -329,4 +369,5 @@
 
     DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
@@ -390,4 +431,5 @@
 
             DO ind=1,ndomain
+               IF (.NOT. assigned_domain(ind)) CYCLE
                CALL swap_dimensions(ind)
                CALL swap_geometry(ind)
@@ -408,8 +450,11 @@
             ENDDO
          ENDIF
-         CALL send_message(f_ps,req_ps)
+!         CALL send_message(f_ps,req_ps)
+!ym no overlap for now         
+!         CALL wait_message(req_ps)  
       
       ELSE ! Lagrangian coordinate, deal with mass
          DO ind=1,ndomain
+            IF (.NOT. assigned_domain(ind)) CYCLE
             CALL swap_dimensions(ind)
             CALL swap_geometry(ind)
@@ -433,5 +478,7 @@
             ENDDO
          END DO
-         CALL send_message(f_mass,req_mass)
+!         CALL send_message(f_mass,req_mass)
+!ym no overlap for now         
+!         CALL wait_message(req_mass)  
 
       END IF
@@ -439,4 +486,5 @@
       ! now deal with other prognostic variables
       DO ind=1,ndomain
+         IF (.NOT. assigned_domain(ind)) CYCLE
          CALL swap_dimensions(ind)
          CALL swap_geometry(ind)
@@ -488,4 +536,5 @@
       tau = dt/nb_stage
       DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/trace.F90
===================================================================
--- codes/icosagcm/trunk/src/trace.F90	(revision 185)
+++ codes/icosagcm/trunk/src/trace.F90	(revision 186)
@@ -17,5 +17,31 @@
   END SUBROUTINE init_trace
   
+  SUBROUTINE trace_on
+  IMPLICIT NONE
+#ifdef VTRACE
+#include <vt_user.inc>
+#endif 
+!$OMP MASTER
+#ifdef VTRACE
+     VT_ON()
+#endif
+!$OMP END MASTER
+     
+  END SUBROUTINE trace_on
   
+  SUBROUTINE trace_off
+  IMPLICIT NONE
+#ifdef VTRACE
+#include <vt_user.inc>
+#endif 
+
+!$OMP MASTER
+#ifdef VTRACE
+   VT_OFF()
+#endif
+!$OMP END MASTER
+     
+  END SUBROUTINE trace_off
+    
   SUBROUTINE trace_start(name)
   IMPLICIT NONE
@@ -49,4 +75,37 @@
   END SUBROUTINE trace_end    
 
+  SUBROUTINE trace_start2(name)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name 
+#ifdef VTRACE
+#include <vt_user.inc>
+#endif 
+
+!$OMP MASTER
+#ifdef VTRACE
+     VT_USER_START(name)
+#endif
+!$OMP END MASTER
+
+  END SUBROUTINE trace_start2    
+
+  SUBROUTINE trace_end2(name)
+  IMPLICIT NONE
+#ifdef VTRACE
+#include <vt_user.inc>
+#endif 
+
+    CHARACTER(LEN=*),INTENT(IN) :: name
+
+!$OMP MASTER
+#ifdef VTRACE
+     VT_USER_END(name)
+#endif
+!$OMP END MASTER
+
+  END SUBROUTINE trace_end2    
+
+
+
   SUBROUTINE Marker(name)
   IMPLICIT NONE
Index: codes/icosagcm/trunk/src/transfert_mpi.f90
===================================================================
--- codes/icosagcm/trunk/src/transfert_mpi.f90	(revision 185)
+++ codes/icosagcm/trunk/src/transfert_mpi.f90	(revision 186)
@@ -8,16 +8,17 @@
     INTEGER         :: domain
     INTEGER         :: rank
+    INTEGER         :: tag
     INTEGER         :: size
+    INTEGER         :: offset
+    INTEGER         :: ireq
     INTEGER,POINTER :: buffer(:)
-    REAL,POINTER    :: buffer_r2(:)
-    REAL,POINTER    :: buffer_r3(:,:)
-    REAL,POINTER    :: buffer_r4(:,:,:)
+    REAL,POINTER    :: buffer_r(:)
     INTEGER,POINTER :: src_value(:)
   END TYPE array
   
   TYPE t_buffer
-    REAL,POINTER    :: r2(:)
-    REAL,POINTER    :: r3(:,:)
-    REAL,POINTER    :: r4(:,:,:)
+    REAL,POINTER    :: r(:)
+    INTEGER         :: size
+    INTEGER         :: rank
   END TYPE t_buffer    
     
@@ -39,18 +40,30 @@
     INTEGER :: nsend
     INTEGER :: nreq_mpi
+    INTEGER :: nreq_send
+    INTEGER :: nreq_recv
     TYPE(ARRAY),POINTER :: send(:)
   END TYPE t_request
   
-  TYPE(t_request),POINTER :: req_i1(:)
-  TYPE(t_request),POINTER :: req_e1_scal(:)
-  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(:)
+  TYPE(t_request),SAVE,POINTER :: req_i1(:)
+  TYPE(t_request),SAVE,POINTER :: req_e1_scal(:)
+  TYPE(t_request),SAVE,POINTER :: req_e1_vect(:)
+  
+  TYPE(t_request),SAVE,POINTER :: req_i0(:)
+  TYPE(t_request),SAVE,POINTER :: req_e0_scal(:)
+  TYPE(t_request),SAVE,POINTER :: req_e0_vect(:)
+
+  TYPE t_reorder
+    INTEGER :: ind
+    INTEGER :: rank
+    INTEGER :: tag
+    INTEGER :: isend
+  END TYPE t_reorder  
   
   TYPE t_message
     TYPE(t_request), POINTER :: request(:)
     INTEGER :: nreq
+    INTEGER :: nreq_send
+    INTEGER :: nreq_recv
+    TYPE(t_reorder), POINTER :: reorder(:)
     INTEGER, POINTER :: mpi_req(:)
     INTEGER, POINTER :: status(:,:)
@@ -62,8 +75,7 @@
   END TYPE t_message
   
-  INTEGER,SAVE :: message_number=0 ;
-  
 CONTAINS
-  
+       
+      
   SUBROUTINE init_transfert
   USE domain_mod
@@ -72,6 +84,8 @@
   USE metric
   USE mpipara
+  USE mpi_mod
   IMPLICIT NONE
   INTEGER :: ind,i,j
+  LOGICAL ::ok
  
     CALL create_request(field_t,req_i1)
@@ -410,4 +424,5 @@
     INTEGER :: nb_domain_recv(0:mpi_size-1)
     INTEGER :: nb_domain_send(0:mpi_size-1)
+    INTEGER :: tag_rank(0:mpi_size-1)
     INTEGER :: nb_data_domain_recv(ndomain_glo)
     INTEGER :: list_domain_recv(ndomain_glo)
@@ -415,10 +430,14 @@
     INTEGER             :: list_domain(ndomain)
 
-    INTEGER :: rank,i,j
+    INTEGER :: rank,i,j,pos
     INTEGER :: size_,ind_glo,ind_loc, ind_src
-    INTEGER :: isend, irecv, ireq, nreq
+    INTEGER :: isend, irecv, ireq, nreq, nsend, nrecv
     INTEGER, ALLOCATABLE :: mpi_req(:)
     INTEGER, ALLOCATABLE :: status(:,:)
-    
+    INTEGER, ALLOCATABLE :: rank_list(:)
+    INTEGER, ALLOCATABLE :: offset(:)
+    LOGICAL,PARAMETER :: debug = .FALSE.
+
+ 
     IF (.NOT. using_mpi) RETURN
     
@@ -428,4 +447,5 @@
       nb_data_domain_recv(:) = 0
       nb_domain_recv(:) = 0
+      tag_rank(:)=0
       
       DO i=1,req%size
@@ -486,4 +506,5 @@
     ALLOCATE(status(MPI_STATUS_SIZE,nreq))
     
+
     ireq=0
     DO ind_loc=1,ndomain
@@ -492,7 +513,9 @@
         ireq=ireq+1
         CALL MPI_ISEND(req%recv(irecv)%domain,1,MPI_INTEGER,req%recv(irecv)%rank,0,comm_icosa, mpi_req(ireq),ierr)
+        IF (debug) PRINT *,"Isend ",req%recv(irecv)%domain, "from ", mpi_rank, "to ",req%recv(irecv)%rank, "tag ",0
       ENDDO
     ENDDO
-    
+
+    IF (debug) PRINT *,"------------"    
     j=0
     DO rank=0,mpi_size-1
@@ -501,6 +524,8 @@
         ireq=ireq+1
         CALL MPI_IRECV(list_domain_send(j),1,MPI_INTEGER,rank,0,comm_icosa, mpi_req(ireq),ierr)
+        IF (debug) PRINT *,"IRecv ",list_domain_send(j), "from ", rank, "to ",mpi_rank, "tag ",0
       ENDDO
     ENDDO
+    IF (debug) PRINT *,"------------"    
     
     CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
@@ -517,4 +542,6 @@
       ALLOCATE(req%send(req%nsend))
     ENDDO
+
+    IF (debug) PRINT *,"------------"    
    
    ireq=0 
@@ -525,14 +552,21 @@
        ireq=ireq+1
        CALL MPI_ISEND(mpi_rank,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"Isend ",mpi_rank, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
      ENDDO
+    IF (debug) PRINT *,"------------"    
      
      DO isend=1,req%nsend
        ireq=ireq+1
        CALL MPI_IRECV(req%send(isend)%rank,1,MPI_INTEGER,MPI_ANY_SOURCE,ind_loc,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"IRecv ",req%send(isend)%rank, "from ", "xxx", "to ",mpi_rank, "tag ",ind_loc
      ENDDO
    ENDDO
 
+   IF (debug) PRINT *,"------------"    
+
    CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
    CALL MPI_BARRIER(comm_icosa,ierr)
+
+   IF (debug) PRINT *,"------------"    
 
    ireq=0 
@@ -543,14 +577,47 @@
        ireq=ireq+1
        CALL MPI_ISEND(ind_loc,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"Isend ",ind_loc, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
      ENDDO
+
+     IF (debug) PRINT *,"------------"    
      
      DO isend=1,req%nsend
        ireq=ireq+1
        CALL MPI_IRECV(req%send(isend)%domain,1,MPI_INTEGER,req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"IRecv ",req%send(isend)%domain, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
      ENDDO
    ENDDO
+   IF (debug) PRINT *,"------------"    
    
    CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
    CALL MPI_BARRIER(comm_icosa,ierr)
+   IF (debug) PRINT *,"------------"    
+
+   ireq=0
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+     
+     DO irecv=1,req%nrecv
+       ireq=ireq+1
+       req%recv(irecv)%tag=tag_rank(req%recv(irecv)%rank)
+       tag_rank(req%recv(irecv)%rank)=tag_rank(req%recv(irecv)%rank)+1
+       CALL MPI_ISEND(req%recv(irecv)%tag,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"Isend ",req%recv(irecv)%tag, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
+     ENDDO
+   IF (debug) PRINT *,"------------"    
+     
+     DO isend=1,req%nsend
+       ireq=ireq+1
+       CALL MPI_IRECV(req%send(isend)%tag,1,MPI_INTEGER,req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"IRecv ",req%send(isend)%tag, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
+     ENDDO
+   ENDDO
+   IF (debug) PRINT *,"------------"    
+   
+   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+   CALL MPI_BARRIER(comm_icosa,ierr)
+
+
+   IF (debug) PRINT *,"------------"    
 
    ireq=0 
@@ -560,10 +627,13 @@
      DO irecv=1,req%nrecv
        ireq=ireq+1
-       CALL MPI_ISEND(req%recv(irecv)%size,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
+       CALL MPI_ISEND(req%recv(irecv)%size,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"Isend ",req%recv(irecv)%size, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
      ENDDO
+     IF (debug) PRINT *,"------------"    
      
      DO isend=1,req%nsend
        ireq=ireq+1
-       CALL MPI_IRECV(req%send(isend)%size,1,MPI_INTEGER,req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr)
+       CALL MPI_IRECV(req%send(isend)%size,1,MPI_INTEGER,req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"IRecv ",req%send(isend)%size, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
      ENDDO
    ENDDO
@@ -578,5 +648,5 @@
        ireq=ireq+1
        CALL MPI_ISEND(req%recv(irecv)%value,req%recv(irecv)%size,MPI_INTEGER,&
-            req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
+            req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
      ENDDO
      
@@ -585,5 +655,5 @@
        ALLOCATE(req%send(isend)%value(req%send(isend)%size))
        CALL MPI_IRECV(req%send(isend)%value,req%send(isend)%size,MPI_INTEGER,&
-            req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr)
+            req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
      ENDDO
    ENDDO
@@ -600,6 +670,7 @@
      ENDDO
    ENDDO  
-
-! domain is on the same mpi process
+   
+
+! domain is on the same mpi process => copie memory to memory
    
    DO ind_loc=1,ndomain
@@ -611,7 +682,8 @@
            req_src=>request(req%recv(irecv)%domain)
            DO isend=1,req_src%nsend
-             IF (req_src%send(isend)%rank==mpi_rank .AND. req_src%send(isend)%domain==ind_loc) THEN
+             IF (req_src%send(isend)%rank==mpi_rank .AND. req_src%send(isend)%tag==req%recv(irecv)%tag) THEN
                req%recv(irecv)%src_value => req_src%send(isend)%value
                IF ( size(req%recv(irecv)%value) /= size(req_src%send(isend)%value)) THEN
+                 PRINT *,ind_loc, irecv, isend, size(req%recv(irecv)%value), size(req_src%send(isend)%value)
                  STOP "size(req%recv(irecv)%value) /= size(req_src%send(isend)%value"
                ENDIF
@@ -624,17 +696,102 @@
    
 ! true number of mpi request
+
+   request(:)%nreq_mpi=0
+   request(:)%nreq_send=0
+   request(:)%nreq_recv=0
+   ALLOCATE(rank_list(sum(request(:)%nsend)))
+   ALLOCATE(offset(sum(request(:)%nsend)))
+   offset(:)=0
+   
+   nsend=0
    DO ind_loc=1,ndomain
      req=>request(ind_loc)
-     req%nreq_mpi=0
 
      DO isend=1,req%nsend
-      IF (req%send(isend)%rank/=mpi_rank .OR. .TRUE.) req%nreq_mpi=req%nreq_mpi+1  
+       IF (req%send(isend)%rank/=mpi_rank) THEN
+         pos=0
+         DO i=1,nsend
+           IF (req%send(isend)%rank==rank_list(i)) EXIT
+           pos=pos+1
+         ENDDO
+        
+         IF (pos==nsend) THEN
+           nsend=nsend+1
+           req%nreq_mpi=req%nreq_mpi+1
+           req%nreq_send=req%nreq_send+1
+           IF (mpi_threading_mode==MPI_THREAD_FUNNELED) THEN
+             rank_list(nsend)=req%send(isend)%rank
+           ELSE
+             rank_list(nsend)=-1
+           ENDIF
+         ENDIF
+         
+         pos=pos+1
+         req%send(isend)%ireq=pos
+         req%send(isend)%offset=offset(pos)
+         offset(pos)=offset(pos)+req%send(isend)%size
+       ENDIF
      ENDDO
-     
+   ENDDO
+
+   DEALLOCATE(rank_list)
+   DEALLOCATE(offset)
+     
+   ALLOCATE(rank_list(sum(request(:)%nrecv)))
+   ALLOCATE(offset(sum(request(:)%nrecv)))
+   offset(:)=0
+   
+   nrecv=0
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+
      DO irecv=1,req%nrecv
-      IF (req%recv(irecv)%rank/=mpi_rank .OR. .TRUE.) req%nreq_mpi=req%nreq_mpi+1  
+       IF (req%recv(irecv)%rank/=mpi_rank) THEN
+         pos=0
+         DO i=1,nrecv
+           IF (req%recv(irecv)%rank==rank_list(i)) EXIT
+           pos=pos+1
+         ENDDO
+        
+         IF (pos==nrecv) THEN
+           nrecv=nrecv+1
+           req%nreq_mpi=req%nreq_mpi+1
+           req%nreq_recv=req%nreq_recv+1
+           IF (mpi_threading_mode==MPI_THREAD_FUNNELED) THEN
+             rank_list(nrecv)=req%recv(irecv)%rank
+           ELSE
+             rank_list(nrecv)=-1
+           ENDIF
+         ENDIF
+        
+         pos=pos+1
+         req%recv(irecv)%ireq=nsend+pos
+         req%recv(irecv)%offset=offset(pos)
+         offset(pos)=offset(pos)+req%recv(irecv)%size
+       ENDIF
      ENDDO
-  
    ENDDO 
+
+! get the offsets   
+
+   ireq=0 
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+     
+     DO irecv=1,req%nrecv
+       ireq=ireq+1
+       CALL MPI_ISEND(req%recv(irecv)%offset,1,MPI_INTEGER,&
+            req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
+     ENDDO
+     
+     DO isend=1,req%nsend
+       ireq=ireq+1
+       CALL MPI_IRECV(req%send(isend)%offset,1,MPI_INTEGER,&
+            req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
+     ENDDO
+   ENDDO
+
+   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+      
        
   END SUBROUTINE Finalize_request 
@@ -701,4 +858,6 @@
   END SUBROUTINE transfert_message_seq    
     
+
+
     
   SUBROUTINE init_message_mpi(field,request, message)
@@ -717,97 +876,165 @@
     TYPE(t_request),POINTER :: req
     INTEGER :: irecv,isend
-    INTEGER :: ireq,nreq
+    INTEGER :: ireq,nreq, nreq_send
     INTEGER :: ind
     INTEGER :: dim3,dim4
-
+    INTEGER :: i,j
+    INTEGER :: message_number
+!    TYPE(t_reorder),POINTER :: reorder(:)
+!    TYPE(t_reorder) :: reorder_swap
+
+!$OMP BARRIER
 !$OMP MASTER
     message%number=message_number
     message_number=message_number+1
     IF (message_number==100) message_number=0
-    
+
+  
     message%request=>request
-    nreq=sum(request(:)%nsend)+sum(request(:)%nrecv)
-!    message%nreq=nreq
     message%nreq=sum(message%request(:)%nreq_mpi)
+    message%nreq_send=sum(message%request(:)%nreq_send)
+    message%nreq_recv=sum(message%request(:)%nreq_recv)
+    nreq=message%nreq
+
     ALLOCATE(message%mpi_req(nreq))
     ALLOCATE(message%buffers(nreq))
     ALLOCATE(message%status(MPI_STATUS_SIZE,nreq))
-    
+    message%buffers(:)%size=0
     message%pending=.FALSE.
     message%completed=.FALSE.
-    
+  
+    DO ind=1,ndomain
+      req=>request(ind)
+      DO isend=1,req%nsend
+        IF (req%send(isend)%rank/=mpi_rank) THEN
+          ireq=req%send(isend)%ireq 
+          message%buffers(ireq)%size=message%buffers(ireq)%size+req%send(isend)%size
+          message%buffers(ireq)%rank=req%send(isend)%rank
+        ENDIF
+      ENDDO
+      DO irecv=1,req%nrecv
+        IF (req%recv(irecv)%rank/=mpi_rank) THEN
+          ireq=req%recv(irecv)%ireq 
+          message%buffers(ireq)%size=message%buffers(ireq)%size+req%recv(irecv)%size
+          message%buffers(ireq)%rank=req%recv(irecv)%rank
+        ENDIF
+      ENDDO
+    ENDDO
+
+
     IF (field(1)%data_type==type_real) THEN
 
       IF (field(1)%ndim==2) THEN
-      
-        ireq=0
-        DO ind=1,ndomain
-          req=>request(ind)
-      
-          DO isend=1,req%nsend
-            ireq=ireq+1
-            send=>req%send(isend)
-            CALL allocate_mpi_buffer(message%buffers(ireq)%r2,send%size)
-          ENDDO
-        
-          DO irecv=1,req%nrecv
-            ireq=ireq+1
-            recv=>req%recv(irecv)
-            CALL allocate_mpi_buffer(message%buffers(ireq)%r2,recv%size)
-          ENDDO
-        
-        ENDDO
-      
+     
+        DO ireq=1,message%nreq
+          CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
+        ENDDO
       
       ELSE  IF (field(1)%ndim==3) THEN
-    
-        ireq=0
-        DO ind=1,ndomain
-          dim3=size(field(ind)%rval3d,2)
-          req=>request(ind)
- 
-          DO isend=1,req%nsend
-            ireq=ireq+1
-            send=>req%send(isend)
-            CALL allocate_mpi_buffer(message%buffers(ireq)%r3,send%size,dim3)
-          ENDDO
-        
-          DO irecv=1,req%nrecv
-            ireq=ireq+1
-            recv=>req%recv(irecv)
-            CALL allocate_mpi_buffer(message%buffers(ireq)%r3,recv%size,dim3)
-
-          ENDDO
-        
-        ENDDO
-
-
+      
+        dim3=size(field(1)%rval3d,2)
+        DO ireq=1,message%nreq
+          message%buffers(ireq)%size=message%buffers(ireq)%size*dim3
+          CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
+        ENDDO
+      
       ELSE  IF (field(1)%ndim==4) THEN
-   
-        ireq=0
-        DO ind=1,ndomain
-          dim3=size(field(ind)%rval4d,2)
-          dim4=size(field(ind)%rval4d,3)
-          req=>request(ind)
-
-          DO isend=1,req%nsend
-            ireq=ireq+1
-            send=>req%send(isend)
-            CALL allocate_mpi_buffer(message%buffers(ireq)%r4,send%size,dim3,dim4)
-          ENDDO
-        
-          DO irecv=1,req%nrecv
-            ireq=ireq+1
-            recv=>req%recv(irecv)
-            CALL allocate_mpi_buffer(message%buffers(ireq)%r4,recv%size,dim3,dim4)
-          ENDDO
-        
-        ENDDO
-      
+        dim3=size(field(1)%rval4d,2)
+        dim4=size(field(1)%rval4d,3)
+        DO ireq=1,message%nreq
+          message%buffers(ireq)%size=message%buffers(ireq)%size*dim3*dim4
+          CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
+        ENDDO
       ENDIF      
     ENDIF
+      
+         
+    
+! ! Reorder the request, so recv request are done in the same order than send request
+
+!    nreq_send=sum(request(:)%nsend)  
+!    message%nreq_send=nreq_send
+!    ALLOCATE(message%reorder(nreq_send))
+!    reorder=>message%reorder
+!    ireq=0
+!    DO ind=1,ndomain
+!      req=>request(ind)
+!      DO isend=1,req%nsend
+!        ireq=ireq+1
+!        reorder(ireq)%ind=ind
+!        reorder(ireq)%isend=isend
+!        reorder(ireq)%tag=req%send(isend)%tag
+!      ENDDO
+!    ENDDO
+
+! ! do a very very bad sort
+!    DO i=1,nreq_send-1
+!      DO j=i+1,nreq_send
+!        IF (reorder(i)%tag > reorder(j)%tag) THEN
+!          reorder_swap=reorder(i)
+!          reorder(i)=reorder(j)
+!          reorder(j)=reorder_swap
+!        ENDIF
+!      ENDDO
+!    ENDDO
+!    PRINT *,"reorder ",reorder(:)%tag
+    
+ 
 !$OMP END MASTER
 !$OMP BARRIER    
+
   END SUBROUTINE init_message_mpi
+  
+  SUBROUTINE Finalize_message_mpi(field,message)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  USE mpi_mod
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_message) :: message
+
+    TYPE(t_request),POINTER :: req
+    INTEGER :: irecv,isend
+    INTEGER :: ireq,nreq
+    INTEGER :: ind
+
+!$OMP BARRIER
+!$OMP MASTER
+
+
+    IF (field(1)%data_type==type_real) THEN
+
+      IF (field(1)%ndim==2) THEN
+     
+        DO ireq=1,message%nreq
+          CALL free_mpi_buffer(message%buffers(ireq)%r)
+        ENDDO
+      
+      ELSE  IF (field(1)%ndim==3) THEN
+
+        DO ireq=1,message%nreq
+          CALL free_mpi_buffer(message%buffers(ireq)%r)
+        ENDDO
+      
+      ELSE  IF (field(1)%ndim==4) THEN
+
+        DO ireq=1,message%nreq
+          CALL free_mpi_buffer(message%buffers(ireq)%r)
+        ENDDO
+
+      ENDIF      
+    ENDIF
+    
+
+
+!$OMP END MASTER
+!$OMP BARRIER
+
+      
+  END SUBROUTINE Finalize_message_mpi
+
+
   
   SUBROUTINE barrier
@@ -845,257 +1072,5 @@
     REAL(rstd),POINTER :: rval3d(:,:), src_rval3d(:,:) 
     REAL(rstd),POINTER :: rval4d(:,:,:), src_rval4d(:,:,:) 
-    REAL(rstd),POINTER :: buffer_r2(:) 
-    REAL(rstd),POINTER :: buffer_r3(:,:) 
-    REAL(rstd),POINTER :: buffer_r4(:,:,:) 
-    INTEGER,POINTER :: value(:) 
-    INTEGER,POINTER :: sgn(:) 
-    TYPE(ARRAY),POINTER :: recv,send 
-    TYPE(t_request),POINTER :: req
-    INTEGER, ALLOCATABLE :: mpi_req(:)
-    INTEGER, ALLOCATABLE :: status(:,:)
-    INTEGER :: irecv,isend
-    INTEGER :: ireq,ireq_mpi,nreq
-    INTEGER :: ind,n,l,m
-    INTEGER :: dim3,dim4
-    INTEGER,POINTER :: src_value(:)
-    INTEGER,POINTER :: sign(:)
-
-!$OMP BARRIER
-
-    CALL trace_start("transfert_mpi")
-
-!    nreq=message%nreq
-    message%field=>field
-
-!$OMP MASTER
-    IF (message%nreq>0) THEN
-      message%completed=.FALSE.
-      message%pending=.TRUE.
-    ELSE
-      message%completed=.TRUE.
-      message%pending=.FALSE.
-    ENDIF
-    
-!$OMP END MASTER
-    
-    IF (field(1)%data_type==type_real) THEN
-      IF (field(1)%ndim==2) THEN
-
-        ireq=0
-        ireq_mpi=0
-        DO ind=1,ndomain
-          rval2d=>field(ind)%rval2d
-        
-          req=>message%request(ind)
-          DO isend=1,req%nsend
-            ireq=ireq+1
-            send=>req%send(isend)
-            value=>send%value
-
-            
-            IF (send%rank/=mpi_rank .OR. .TRUE.) THEN
-              ireq_mpi=ireq_mpi+1
-              buffer_r2=>message%buffers(ireq)%r2
-              CALL trace_in
-
-              !$OMP DO SCHEDULE(STATIC)
-              DO n=1,send%size
-                buffer_r2(n)=rval2d(value(n))
-              ENDDO
-            
-              CALL trace_out
-
-              !$OMP MASTER
-              CALL MPI_ISSEND(buffer_r2,send%size,MPI_REAL8,send%rank,ind+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr)
-              !$OMP END MASTER
-             
-             ENDIF
-          ENDDO
-        
-          DO irecv=1,req%nrecv
-            ireq=ireq+1
-            recv=>req%recv(irecv)
-
-            IF (recv%rank==mpi_rank .AND. .FALSE.) THEN
-              value=>recv%value
-              src_value => recv%src_value
-              src_rval2d=>field(recv%domain)%rval2d
-              sgn=>recv%sign
-              !$OMP DO SCHEDULE(STATIC)
-              DO n=1,recv%size
-                rval2d(value(n))=src_rval2d(src_value(n))*sgn(n)
-              ENDDO
-            
-            ELSE
-               ireq_mpi=ireq_mpi+1
-               buffer_r2=>message%buffers(ireq)%r2
-              !$OMP MASTER
-              CALL MPI_IRECV(buffer_r2,recv%size,MPI_REAL8,recv%rank,recv%domain+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr)
-              !$OMP END MASTER
-            ENDIF
-          ENDDO
-        
-        ENDDO
-      
-      ELSE  IF (field(1)%ndim==3) THEN
-      
-        ireq=0
-        ireq_mpi=0
-        DO ind=1,ndomain
-          dim3=size(field(ind)%rval3d,2)
-          rval3d=>field(ind)%rval3d
-          req=>message%request(ind)
- 
-          DO isend=1,req%nsend
-            ireq=ireq+1
-            send=>req%send(isend)
-            value=>send%value
-
-            IF (send%rank/=mpi_rank .OR. .TRUE.) THEN
-              ireq_mpi=ireq_mpi+1
-              buffer_r3=>message%buffers(ireq)%r3
- 
-              CALL trace_in
-            
-!$OMP DO SCHEDULE(STATIC)
-                DO n=1,send%size
-                  buffer_r3(n,:)=rval3d(value(n),:)
-                ENDDO
-
-               CALL trace_out
-
-  !$OMP MASTER
-              CALL MPI_ISSEND(buffer_r3,send%size*dim3,MPI_REAL8,send%rank,ind+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr)
-  !$OMP END MASTER
-            ENDIF
-         ENDDO
-        
-          DO irecv=1,req%nrecv
-            ireq=ireq+1
-            recv=>req%recv(irecv)
-
-            IF (recv%rank==mpi_rank .AND. .FALSE.) THEN
-              value=>recv%value
-              src_value => recv%src_value
-              src_rval3d=>field(recv%domain)%rval3d
-              sgn=>recv%sign
-              !$OMP DO SCHEDULE(STATIC)
-              DO n=1,recv%size
-                rval3d(value(n),:)=src_rval3d(src_value(n),:)*sgn(n)
-              ENDDO
-            
-            ELSE
-              ireq_mpi=ireq_mpi+1
-              buffer_r3=>message%buffers(ireq)%r3
-!$OMP MASTER           
-              CALL MPI_IRECV(buffer_r3,recv%size*dim3,MPI_REAL8,recv%rank,recv%domain+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr)
-!$OMP END MASTER
-            ENDIF
-          ENDDO
-        
-        ENDDO
-
-      ELSE  IF (field(1)%ndim==4) THEN
-    
-        ireq=0
-        ireq_mpi=0
-        DO ind=1,ndomain
-          dim3=size(field(ind)%rval4d,2)
-          dim4=size(field(ind)%rval4d,3)
-          rval4d=>field(ind)%rval4d
-          req=>message%request(ind)
-
-          DO isend=1,req%nsend
-            ireq=ireq+1
-            send=>req%send(isend)
-            value=>send%value
-
-            IF (send%rank/=mpi_rank .OR. .TRUE.) THEN
-              ireq_mpi=ireq_mpi+1
-              buffer_r4=>message%buffers(ireq)%r4
-              CALL trace_in
-
-!$OMP DO SCHEDULE(STATIC)
-              DO n=1,send%size
-                 buffer_r4(n,:,:)=rval4d(value(n),:,:)
-              ENDDO
-
-             CALL trace_out
-
-!$OMP MASTER
-              CALL MPI_ISSEND(buffer_r4,send%size*dim3*dim4,MPI_REAL8,send%rank,ind+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr)
-!$OMP END MASTER
-            ENDIF
-          ENDDO
-        
-          DO irecv=1,req%nrecv
-            ireq=ireq+1
-            recv=>req%recv(irecv)
-            IF (recv%rank==mpi_rank .AND. .FALSE.) THEN
-              value=>recv%value
-              src_value => recv%src_value
-              src_rval4d=>field(recv%domain)%rval4d
-              sgn=>recv%sign
-
-              !$OMP DO SCHEDULE(STATIC)
-              DO n=1,recv%size
-                rval4d(value(n),:,:)=src_rval4d(src_value(n),:,:)*sgn(n)
-              ENDDO
-            
-            ELSE
-              ireq_mpi=ireq_mpi+1
-              buffer_r4=>message%buffers(ireq)%r4
-!$OMP MASTER           
-              CALL MPI_IRECV(buffer_r4,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%domain+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr)
-!$OMP END MASTER
-            ENDIF
-          ENDDO
-        
-        ENDDO
-      
-      ENDIF      
-      
-    ENDIF
-    IF (ireq_mpi /= message%nreq ) THEN
-      STOP "ireq_mpi /= message%nreq"
-    ENDIF
-    
-    CALL trace_end("transfert_mpi")
-!$OMP BARRIER
-    
-  END SUBROUTINE send_message_mpi
-  
-  SUBROUTINE test_message_mpi(message)
-  IMPLICIT NONE
-    TYPE(t_message) :: message
-    
-    INTEGER :: ierr
-!$OMP MASTER
-     IF (.NOT. message%pending) RETURN
-!$OMP END MASTER
-
-!$OMP MASTER
-     IF (.NOT. message%completed) CALL MPI_TESTALL(message%nreq,message%mpi_req,message%completed,message%status,ierr)
-!$OMP END MASTER
-  END SUBROUTINE  test_message_mpi
-  
-   
-  SUBROUTINE wait_message_mpi(message)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE omp_para
-  USE trace
-  IMPLICIT NONE
-    TYPE(t_message) :: message
-
-    TYPE(t_field),POINTER :: field(:)
-    REAL(rstd),POINTER :: rval2d(:) 
-    REAL(rstd),POINTER :: rval3d(:,:) 
-    REAL(rstd),POINTER :: rval4d(:,:,:) 
-    REAL(rstd),POINTER :: buffer_r2(:) 
-    REAL(rstd),POINTER :: buffer_r3(:,:) 
-    REAL(rstd),POINTER :: buffer_r4(:,:,:) 
+    REAL(rstd),POINTER :: buffer_r(:) 
     INTEGER,POINTER :: value(:) 
     INTEGER,POINTER :: sgn(:) 
@@ -1106,157 +1081,306 @@
     INTEGER :: irecv,isend
     INTEGER :: ireq,nreq
-    INTEGER :: ind,n,l,m
-    INTEGER :: dim3,dim4
+    INTEGER :: ind,i,n,l,m
+    INTEGER :: dim3,dim4,d3,d4
+    INTEGER,POINTER :: src_value(:)
+    INTEGER,POINTER :: sign(:)
+    INTEGER :: offset,msize,rank
+
+    CALL trace_start("transfert_mpi")
 
 !$OMP BARRIER
 
-    CALL trace_start("transfert_mpi")
-
-    IF (.NOT. message%pending) RETURN
-    
-    field=>message%field
-    nreq=message%nreq
-    
+
+!$OMP MASTER
+    message%field=>field
+
+    IF (message%nreq>0) THEN
+      message%completed=.FALSE.
+      message%pending=.TRUE.
+    ELSE
+      message%completed=.TRUE.
+      message%pending=.FALSE.
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+     
     IF (field(1)%data_type==type_real) THEN
       IF (field(1)%ndim==2) THEN
 
-!$OMP MASTER
-        IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,message%status,ierr)
-!$OMP END MASTER
-!$OMP BARRIER
-
-        ireq=0        
         DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+          
           rval2d=>field(ind)%rval2d
+        
           req=>message%request(ind)
-
           DO isend=1,req%nsend
-            ireq=ireq+1
-          ENDDO
-     
-          DO irecv=1,req%nrecv
-            ireq=ireq+1
-            recv=>req%recv(irecv)
-            IF (recv%rank/=mpi_rank .OR. .TRUE.) THEN
-              buffer_r2=>message%buffers(ireq)%r2
-              value=>recv%value
-              sgn=>recv%sign
-
-              CALL trace_in
+            send=>req%send(isend)
+            value=>send%value
+
             
-!$OMP DO SCHEDULE(STATIC)
-              DO n=1,recv%size
-                rval2d(value(n))=buffer_r2(n)*sgn(n)  
-              ENDDO        
-
-              CALL trace_out
+            IF (send%rank/=mpi_rank) THEN
+              ireq=send%ireq
+
+              buffer_r=>message%buffers(ireq)%r
+              offset=send%offset
+                                            
+              DO n=1,send%size
+                buffer_r(offset+n)=rval2d(value(n))
+              ENDDO
+
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
+                !$OMP CRITICAL            
+                CALL MPI_ISEND(buffer_r,send%size,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                !$OMP END CRITICAL
+              ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
+                CALL MPI_ISEND(buffer_r,send%size,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+              ENDIF
+             
             ENDIF
           ENDDO
-        
-        ENDDO
-      
+        ENDDO
+        
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+          rval2d=>field(ind)%rval2d
+          req=>message%request(ind)        
+
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+
+            IF (recv%rank==mpi_rank) THEN
+
+              value=>recv%value
+              src_value => recv%src_value
+              src_rval2d=>field(recv%domain)%rval2d
+              sgn=>recv%sign
+
+              DO n=1,recv%size
+                rval2d(value(n))=src_rval2d(src_value(n))*sgn(n)
+              ENDDO
+                
+                    
+            ELSE
+            
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
+               !$OMP CRITICAL            
+                CALL MPI_IRECV(buffer_r,recv%size,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+               !$OMP END CRITICAL
+              ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
+                 CALL MPI_IRECV(buffer_r,recv%size,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+              ENDIF
+            
+            ENDIF
+          ENDDO
+        
+        ENDDO
+        
       
       ELSE  IF (field(1)%ndim==3) THEN
-
-!$OMP MASTER
-        IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,message%status,ierr)
-!$OMP END MASTER
-!$OMP BARRIER
-
-        ireq=0        
+      
         DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+
+          dim3=size(field(ind)%rval3d,2)
           rval3d=>field(ind)%rval3d
           req=>message%request(ind)
-
+ 
           DO isend=1,req%nsend
-            ireq=ireq+1
-          ENDDO
-        
-          DO irecv=1,req%nrecv
-            ireq=ireq+1
-            recv=>req%recv(irecv)
-            IF (recv%rank/=mpi_rank .OR. .TRUE.) THEN
-              buffer_r3=>message%buffers(ireq)%r3
-              value=>recv%value
-              sgn=>recv%sign
-
-              CALL trace_in
-            
-!$OMP DO SCHEDULE(STATIC)
-              DO n=1,recv%size
-                rval3d(value(n),:)=buffer_r3(n,:)*sgn(n)  
-              ENDDO  
-
-              CALL trace_out
+            send=>req%send(isend)
+            value=>send%value
+
+            IF (send%rank/=mpi_rank) THEN
+              ireq=send%ireq
+              buffer_r=>message%buffers(ireq)%r
+              offset=send%offset*dim3
+
+              DO d3=1,dim3
+                DO n=1,send%size
+                  buffer_r(n+offset)=rval3d(value(n),d3)
+                ENDDO
+                offset=offset+send%size
+              ENDDO
+
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
+                !$OMP CRITICAL   
+                CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                !$OMP END CRITICAL
+              ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
+                CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+              ENDIF
             ENDIF
           ENDDO
+        ENDDO
+         
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+          dim3=size(field(ind)%rval3d,2)
+          rval3d=>field(ind)%rval3d
+          req=>message%request(ind)
+
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+
+            IF (recv%rank==mpi_rank) THEN
+              value=>recv%value
+              src_value => recv%src_value
+              src_rval3d=>field(recv%domain)%rval3d
+              sgn=>recv%sign
+
+              DO n=1,recv%size
+                rval3d(value(n),:)=src_rval3d(src_value(n),:)*sgn(n)
+              ENDDO
+
+            ELSE
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+ 
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
+                !$OMP CRITICAL
+                CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                !$OMP END CRITICAL
+              ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
+                CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+              ENDIF
+            ENDIF
+          ENDDO
         
         ENDDO
 
       ELSE  IF (field(1)%ndim==4) THEN
-!$OMP MASTER
-        IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,message%status,ierr)
-!$OMP END MASTER
-!$OMP BARRIER
-
-        ireq=0        
+    
         DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+
+          dim3=size(field(ind)%rval4d,2)
+          dim4=size(field(ind)%rval4d,3)
           rval4d=>field(ind)%rval4d
           req=>message%request(ind)
 
           DO isend=1,req%nsend
-            ireq=ireq+1
-          ENDDO
-        
-          DO irecv=1,req%nrecv
-            ireq=ireq+1
-            recv=>req%recv(irecv)
-            IF (recv%rank/=mpi_rank .OR. .TRUE.) THEN
-              buffer_r4=>message%buffers(ireq)%r4
-              value=>recv%value
-              sgn=>recv%sign
-
-              CALL trace_in
-
-!$OMP DO SCHEDULE(STATIC)
-              DO n=1,recv%size
-                rval4d(value(n),:,:)=buffer_r4(n,:,:)*sgn(n) 
+            send=>req%send(isend)
+            value=>send%value
+
+            IF (send%rank/=mpi_rank) THEN
+
+              ireq=send%ireq
+              buffer_r=>message%buffers(ireq)%r
+              offset=send%offset*dim3*dim4
+
+              DO d4=1,dim4
+                DO d3=1,dim3
+                  DO n=1,send%size
+                    buffer_r(n+offset)=rval4d(value(n),d3,d4)
+                  ENDDO
+                  offset=offset+send%size
+                ENDDO
               ENDDO
 
-              CALL trace_out
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
+                !$OMP CRITICAL
+                CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                !$OMP END CRITICAL
+              ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
+                CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+              ENDIF
+
             ENDIF
           ENDDO
-        
-        ENDDO
-      
+        ENDDO
+        
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+          
+          dim3=size(field(ind)%rval4d,2)
+          dim4=size(field(ind)%rval4d,3)
+          rval4d=>field(ind)%rval4d
+          req=>message%request(ind)
+
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+            IF (recv%rank==mpi_rank) THEN
+              value=>recv%value
+              src_value => recv%src_value
+              src_rval4d=>field(recv%domain)%rval4d
+              sgn=>recv%sign
+
+              DO n=1,recv%size
+                rval4d(value(n),:,:)=src_rval4d(src_value(n),:,:)*sgn(n)
+              ENDDO
+                   
+            ELSE
+
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
+                !$OMP CRITICAL           
+                CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
+                !$OMP END CRITICAL
+              ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
+                CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
+              ENDIF
+    
+            ENDIF
+          ENDDO
+        ENDDO
+
       ENDIF      
-      
+
+      IF (mpi_threading_mode==MPI_THREAD_FUNNELED) THEN
+!$OMP BARRIER
+!$OMP MASTER        
+
+        DO ireq=1,message%nreq_send
+          buffer_r=>message%buffers(ireq)%r
+          msize=message%buffers(ireq)%size
+          rank=message%buffers(ireq)%rank
+          CALL MPI_ISEND(buffer_r,msize,MPI_REAL8,rank,1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+        ENDDO
+
+        DO ireq=message%nreq_send+1,message%nreq_send+message%nreq_recv
+          buffer_r=>message%buffers(ireq)%r
+          msize=message%buffers(ireq)%size
+          rank=message%buffers(ireq)%rank
+          CALL MPI_IRECV(buffer_r,msize,MPI_REAL8,rank,1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+        ENDDO
+
+!$OMP END MASTER
+      ENDIF              
     ENDIF
+    
+!$OMP BARRIER
+    CALL trace_end("transfert_mpi")
+    
+  END SUBROUTINE send_message_mpi
+  
+  SUBROUTINE test_message_mpi(message)
+  IMPLICIT NONE
+    TYPE(t_message) :: message
+    
+    INTEGER :: ierr
 
 !$OMP MASTER
-    message%pending=.FALSE.
+    IF (message%pending .AND. .NOT. message%completed) CALL MPI_TESTALL(message%nreq,message%mpi_req,message%completed,message%status,ierr)
 !$OMP END MASTER
-
-    CALL trace_end("transfert_mpi")
-!$OMP BARRIER
-    
-  END SUBROUTINE wait_message_mpi
-
-
-  SUBROUTINE transfert_request_mpi(field,request)
+  END SUBROUTINE  test_message_mpi
+  
+   
+  SUBROUTINE wait_message_mpi(message)
   USE field_mod
   USE domain_mod
   USE mpi_mod
   USE mpipara
+  USE omp_para
   USE trace
   IMPLICIT NONE
+    TYPE(t_message) :: message
+
     TYPE(t_field),POINTER :: field(:)
-    TYPE(t_request),POINTER :: request(:)
     REAL(rstd),POINTER :: rval2d(:) 
     REAL(rstd),POINTER :: rval3d(:,:) 
     REAL(rstd),POINTER :: rval4d(:,:,:) 
-    REAL(rstd),POINTER :: buffer_r2(:) 
-    REAL(rstd),POINTER :: buffer_r3(:,:) 
-    REAL(rstd),POINTER :: buffer_r4(:,:,:) 
+    REAL(rstd),POINTER :: buffer_r(:) 
     INTEGER,POINTER :: value(:) 
     INTEGER,POINTER :: sgn(:) 
@@ -1267,190 +1391,115 @@
     INTEGER :: irecv,isend
     INTEGER :: ireq,nreq
-    INTEGER :: ind,n
-    INTEGER :: dim3,dim4
+    INTEGER :: ind,n,l,m,i
+    INTEGER :: dim3,dim4,d3,d4
+    INTEGER :: offset
+
+    IF (.NOT. message%pending) RETURN
 
     CALL trace_start("transfert_mpi")
 
+    field=>message%field
+    nreq=message%nreq
+    
     IF (field(1)%data_type==type_real) THEN
       IF (field(1)%ndim==2) THEN
-      
-        nreq=sum(request(:)%nsend)+sum(request(:)%nrecv)
-        ALLOCATE(mpi_req(nreq))
-        ALLOCATE(status(MPI_STATUS_SIZE,nreq))
-    
-        ireq=0
+
+!$OMP MASTER
+        IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,message%status,ierr)
+!$OMP END MASTER
+!$OMP BARRIER
+        
         DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+          
           rval2d=>field(ind)%rval2d
-        
-          req=>request(ind)
-          DO isend=1,req%nsend
-            send=>req%send(isend)
-
-            ALLOCATE(send%buffer_r2(send%size))
-            buffer_r2=>send%buffer_r2
-            value=>send%value
-            DO n=1,send%size
-              buffer_r2(n)=rval2d(value(n))
-            ENDDO
-
-            ireq=ireq+1
-            CALL MPI_ISEND(buffer_r2,send%size,MPI_REAL8,send%rank,ind,comm_icosa, mpi_req(ireq),ierr)
-          ENDDO
-        
+          req=>message%request(ind)
           DO irecv=1,req%nrecv
             recv=>req%recv(irecv)
-            ALLOCATE(recv%buffer_r2(recv%size))
-           
-            ireq=ireq+1
-            CALL MPI_IRECV(recv%buffer_r2,recv%size,MPI_REAL8,recv%rank,recv%domain,comm_icosa, mpi_req(ireq),ierr)
+            IF (recv%rank/=mpi_rank) THEN
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+              value=>recv%value
+              sgn=>recv%sign
+              offset=recv%offset
+              DO n=1,recv%size
+                rval2d(value(n))=buffer_r(n+offset)*sgn(n)  
+              ENDDO
+
+            ENDIF
           ENDDO
         
         ENDDO
-        
-        CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+      
+      
+      ELSE  IF (field(1)%ndim==3) THEN
+
+!$OMP MASTER
+        IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,message%status,ierr)
+!$OMP END MASTER
+!$OMP BARRIER
+
         
         DO ind=1,ndomain
-          rval2d=>field(ind)%rval2d
-        
-          req=>request(ind)
-          DO isend=1,req%nsend
-            send=>req%send(isend)
-            DEALLOCATE(send%buffer_r2)
-          ENDDO
-        
+          IF (.NOT. assigned_domain(ind)) CYCLE
+
+          rval3d=>field(ind)%rval3d
+          req=>message%request(ind)
           DO irecv=1,req%nrecv
             recv=>req%recv(irecv)
-            buffer_r2=>recv%buffer_r2
-            value=>recv%value
-            sgn=>recv%sign
-            DO n=1,recv%size
-              rval2d(value(n))=buffer_r2(n)*sgn(n)  
-            ENDDO        
-            DEALLOCATE(recv%buffer_r2)
+            IF (recv%rank/=mpi_rank) THEN
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+              value=>recv%value
+              sgn=>recv%sign
+              
+              dim3=size(rval3d,2)
+              offset=recv%offset*dim3
+              DO d3=1,dim3
+                DO n=1,recv%size
+                  rval3d(value(n),d3)=buffer_r(n+offset)*sgn(n)  
+                ENDDO
+                offset=offset+recv%size
+              ENDDO  
+            ENDIF
           ENDDO
         
         ENDDO
-      
-      
-      ELSE  IF (field(1)%ndim==3) THEN
-      
-        nreq=sum(request(:)%nsend)+sum(request(:)%nrecv)
-        ALLOCATE(mpi_req(nreq))
-        ALLOCATE(status(MPI_STATUS_SIZE,nreq))
-    
-        ireq=0
+
+      ELSE  IF (field(1)%ndim==4) THEN
+!$OMP MASTER
+        IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,message%status,ierr)
+!$OMP END MASTER
+!$OMP BARRIER
+
+                
         DO ind=1,ndomain
-          dim3=size(field(ind)%rval3d,2)
-          rval3d=>field(ind)%rval3d
-        
-          req=>request(ind)
-          DO isend=1,req%nsend
-            send=>req%send(isend)
-
-            ALLOCATE(send%buffer_r3(send%size,dim3))
-            buffer_r3=>send%buffer_r3
-            value=>send%value
-            DO n=1,send%size
-              buffer_r3(n,:)=rval3d(value(n),:)
-            ENDDO
-
-            ireq=ireq+1
-            CALL MPI_ISEND(buffer_r3,send%size*dim3,MPI_REAL8,send%rank,ind,comm_icosa, mpi_req(ireq),ierr)
-          ENDDO
-        
+          IF (.NOT. assigned_domain(ind)) CYCLE
+
+          rval4d=>field(ind)%rval4d
+          req=>message%request(ind)
           DO irecv=1,req%nrecv
             recv=>req%recv(irecv)
-            ALLOCATE(recv%buffer_r3(recv%size,dim3))
-           
-            ireq=ireq+1
-            CALL MPI_IRECV(recv%buffer_r3,recv%size*dim3,MPI_REAL8,recv%rank,recv%domain,comm_icosa, mpi_req(ireq),ierr)
+            IF (recv%rank/=mpi_rank) THEN
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+              value=>recv%value
+              sgn=>recv%sign
+
+              dim3=size(rval4d,2)
+              dim4=size(rval4d,3)
+              offset=recv%offset*dim3*dim4
+              DO d4=1,dim4
+                DO d3=1,dim3
+                  DO n=1,recv%size
+                    rval4d(value(n),d3,d4)=buffer_r(n+offset)*sgn(n) 
+                  ENDDO
+                  offset=offset+recv%size
+                ENDDO
+              ENDDO
+            ENDIF
           ENDDO
         
         ENDDO
-        
-        CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-        
-        DO ind=1,ndomain
-          rval3d=>field(ind)%rval3d
-        
-          req=>request(ind)
-          DO isend=1,req%nsend
-            send=>req%send(isend)
-            DEALLOCATE(send%buffer_r3)
-          ENDDO
-        
-          DO irecv=1,req%nrecv
-            recv=>req%recv(irecv)
-            buffer_r3=>recv%buffer_r3
-            value=>recv%value
-            sgn=>recv%sign
-            DO n=1,recv%size
-              rval3d(value(n),:)=buffer_r3(n,:)*sgn(n)  
-            ENDDO        
-            DEALLOCATE(recv%buffer_r3)
-          ENDDO
-        
-        ENDDO
-
-      ELSE  IF (field(1)%ndim==4) THEN
-      
-        nreq=sum(request(:)%nsend)+sum(request(:)%nrecv)
-        ALLOCATE(mpi_req(nreq))
-        ALLOCATE(status(MPI_STATUS_SIZE,nreq))
-    
-        ireq=0
-        DO ind=1,ndomain
-          dim3=size(field(ind)%rval4d,2)
-          dim4=size(field(ind)%rval4d,3)
-          rval4d=>field(ind)%rval4d
-        
-          req=>request(ind)
-          DO isend=1,req%nsend
-            send=>req%send(isend)
-
-            ALLOCATE(send%buffer_r4(send%size,dim3,dim4))
-            buffer_r4=>send%buffer_r4
-            value=>send%value
-            DO n=1,send%size
-              buffer_r4(n,:,:)=rval4d(value(n),:,:)
-            ENDDO
-
-            ireq=ireq+1
-            CALL MPI_ISEND(buffer_r4,send%size*dim3*dim4,MPI_REAL8,send%rank,ind,comm_icosa, mpi_req(ireq),ierr)
-          ENDDO
-        
-          DO irecv=1,req%nrecv
-            recv=>req%recv(irecv)
-            ALLOCATE(recv%buffer_r4(recv%size,dim3,dim4))
-           
-            ireq=ireq+1
-            CALL MPI_IRECV(recv%buffer_r4,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%domain,comm_icosa, mpi_req(ireq),ierr)
-          ENDDO
-        
-        ENDDO
-        
-        CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-        
-        DO ind=1,ndomain
-          rval4d=>field(ind)%rval4d
-        
-          req=>request(ind)
-          DO isend=1,req%nsend
-            send=>req%send(isend)
-            DEALLOCATE(send%buffer_r4)
-          ENDDO
-        
-          DO irecv=1,req%nrecv
-            recv=>req%recv(irecv)
-            buffer_r4=>recv%buffer_r4
-            value=>recv%value
-            sgn=>recv%sign
-            DO n=1,recv%size
-              rval4d(value(n),:,:)=buffer_r4(n,:,:)*sgn(n) 
-            ENDDO        
-            DEALLOCATE(recv%buffer_r4)
-          ENDDO
-        
-        ENDDO
       
       ENDIF      
@@ -1458,7 +1507,29 @@
     ENDIF
 
+!$OMP MASTER
+    message%pending=.FALSE.
+!$OMP END MASTER
+
     CALL trace_end("transfert_mpi")
-    
+!$OMP BARRIER
+    
+  END SUBROUTINE wait_message_mpi
+
+  SUBROUTINE transfert_request_mpi(field,request)
+  USE field_mod
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_request),POINTER :: request(:)
+
+    TYPE(t_message),SAVE :: message
+   
+   
+    CALL init_message_mpi(field,request, message)
+    CALL transfert_message_mpi(field,message)
+    CALL finalize_message_mpi(field,message)
+   
   END SUBROUTINE transfert_request_mpi
+ 
+   
    
   SUBROUTINE transfert_request_seq(field,request)
Index: codes/icosagcm/trunk/src/transfert_omp.f90
===================================================================
--- codes/icosagcm/trunk/src/transfert_omp.f90	(revision 186)
+++ codes/icosagcm/trunk/src/transfert_omp.f90	(revision 186)
@@ -0,0 +1,742 @@
+MODULE transfert_omp_mod
+  PRIVATE
+  
+  INTEGER,PARAMETER :: grow_factor=1.5
+  INTEGER,PARAMETER :: size_min=1024
+  
+  CHARACTER(LEN=size_min),SAVE            :: buffer_c
+!  INTEGER,SAVE                            :: size_c=0
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_i
+  INTEGER,SAVE                            :: size_i=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:)      :: buffer_r
+  INTEGER,SAVE                            :: size_r=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_l
+  INTEGER,SAVE                            :: size_l=0
+
+
+  
+  
+  INTERFACE bcast_omp
+    MODULE PROCEDURE bcast_omp_c,                                                     &
+                     bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
+                     bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, &
+		     bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
+  END INTERFACE
+
+  INTERFACE reduce_sum_omp
+    MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
+                     reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
+  END INTERFACE 
+
+  INTERFACE allreduce_sum_omp
+    MODULE PROCEDURE allreduce_sum_omp_i,allreduce_sum_omp_i1,allreduce_sum_omp_i2,allreduce_sum_omp_i3,allreduce_sum_omp_i4, &
+                     allreduce_sum_omp_r,allreduce_sum_omp_r1,allreduce_sum_omp_r2,allreduce_sum_omp_r3,allreduce_sum_omp_r4
+  END INTERFACE 
+
+  PUBLIC bcast_omp, reduce_sum_omp, allreduce_sum_omp
+  
+CONTAINS
+
+  SUBROUTINE check_buffer_i(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_i) THEN
+      IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i)
+      size_i=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_i(size_i))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_i
+  
+  SUBROUTINE check_buffer_r(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_r) THEN
+      IF (ALLOCATED(buffer_r)) DEALLOCATE(buffer_r)
+      size_r=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_r(size_r))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_r
+  
+  SUBROUTINE check_buffer_l(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_l) THEN
+      IF (ALLOCATED(buffer_l)) DEALLOCATE(buffer_l)
+      size_l=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_l(size_l))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_l
+    
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_omp_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    
+    CALL bcast_omp_cgen(Var,len(Var),buffer_c)
+    
+  END SUBROUTINE bcast_omp_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_omp_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    INTEGER :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_i(1)
+    CALL bcast_omp_igen(Var_tmp,1,buffer_i)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_i
+
+
+  SUBROUTINE bcast_omp_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i1
+
+
+  SUBROUTINE bcast_omp_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i2
+
+
+  SUBROUTINE bcast_omp_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i3
+
+
+  SUBROUTINE bcast_omp_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_omp_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_r(1)
+    CALL bcast_omp_rgen(Var_tmp,1,buffer_r)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_r
+
+
+  SUBROUTINE bcast_omp_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r1
+
+
+  SUBROUTINE bcast_omp_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r2
+
+
+  SUBROUTINE bcast_omp_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r3
+
+
+  SUBROUTINE bcast_omp_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r4
+
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_omp_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_l(1)
+    CALL bcast_omp_lgen(Var_tmp,1,buffer_l)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_l
+
+
+  SUBROUTINE bcast_omp_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l1
+
+
+  SUBROUTINE bcast_omp_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l2
+
+
+  SUBROUTINE bcast_omp_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l3
+
+
+  SUBROUTINE bcast_omp_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l4
+  
+
+
+
+  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    INTEGER             :: VarIn_tmp(1)
+    INTEGER             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_i(1)   
+    CALL reduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE reduce_sum_omp_i
+
+  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+   
+  END SUBROUTINE reduce_sum_omp_i1
+  
+  
+  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i2
+
+
+  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i3
+
+
+  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i4
+
+
+  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    REAL             :: VarIn_tmp(1)
+    REAL             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_r(1)   
+    CALL reduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE reduce_sum_omp_r
+
+  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+   
+  END SUBROUTINE reduce_sum_omp_r1
+  
+  
+  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r2
+
+
+  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r3
+
+
+  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r4  
+  
+  
+  
+  
+    SUBROUTINE allreduce_sum_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    INTEGER             :: VarIn_tmp(1)
+    INTEGER             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_i(1)   
+    CALL allreduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE allreduce_sum_omp_i
+
+  SUBROUTINE allreduce_sum_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL allreduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+   
+  END SUBROUTINE allreduce_sum_omp_i1
+  
+  
+  SUBROUTINE allreduce_sum_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL allreduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE allreduce_sum_omp_i2
+
+
+  SUBROUTINE allreduce_sum_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL allreduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE allreduce_sum_omp_i3
+
+
+  SUBROUTINE allreduce_sum_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_i(size(VarIn))   
+    CALL allreduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE allreduce_sum_omp_i4
+
+
+  SUBROUTINE allreduce_sum_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    REAL             :: VarIn_tmp(1)
+    REAL             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_r(1)   
+    CALL allreduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE allreduce_sum_omp_r
+
+  SUBROUTINE allreduce_sum_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL allreduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+   
+  END SUBROUTINE allreduce_sum_omp_r1
+  
+  
+  SUBROUTINE allreduce_sum_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL allreduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE allreduce_sum_omp_r2
+
+
+  SUBROUTINE allreduce_sum_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL allreduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE allreduce_sum_omp_r3
+
+
+  SUBROUTINE allreduce_sum_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_r(size(VarIn))   
+    CALL allreduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE allreduce_sum_omp_r4  
+  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!    LES ROUTINES GENERIQUES    !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_omp_cgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=*),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+    
+    INTEGER :: i
+  
+  !$OMP MASTER
+      Buff=Var
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var=Buff
+    ENDDO
+  !$OMP BARRIER      
+  
+  END SUBROUTINE bcast_omp_cgen
+
+
+      
+  SUBROUTINE bcast_omp_igen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
+    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_igen
+
+
+  SUBROUTINE bcast_omp_rgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+    REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_rgen
+
+  SUBROUTINE bcast_omp_lgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+  
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_lgen
+  
+
+  SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_sum_omp_igen
+
+  SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_sum_omp_rgen
+
+
+
+  SUBROUTINE allreduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER
+  
+  END SUBROUTINE allreduce_sum_omp_igen
+
+  SUBROUTINE allreduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+
+  !$OMP BARRIER
+  
+  END SUBROUTINE allreduce_sum_omp_rgen
+    
+END MODULE transfert_omp_mod
Index: codes/icosagcm/trunk/src/vertical_interp.f90
===================================================================
--- codes/icosagcm/trunk/src/vertical_interp.f90	(revision 185)
+++ codes/icosagcm/trunk/src/vertical_interp.f90	(revision 186)
@@ -3,5 +3,5 @@
   PRIVATE
   
-  TYPE(t_field),POINTER :: f_p(:)
+  TYPE(t_field),SAVE, POINTER :: f_p(:)
   
 
@@ -36,4 +36,5 @@
  
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/vorticity.f90
===================================================================
--- codes/icosagcm/trunk/src/vorticity.f90	(revision 185)
+++ codes/icosagcm/trunk/src/vorticity.f90	(revision 186)
@@ -16,4 +16,5 @@
    
     DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/wind.f90
===================================================================
--- codes/icosagcm/trunk/src/wind.f90	(revision 185)
+++ codes/icosagcm/trunk/src/wind.f90	(revision 186)
@@ -13,4 +13,5 @@
 
     DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
Index: codes/icosagcm/trunk/src/write_field.f90
===================================================================
--- codes/icosagcm/trunk/src/write_field.f90	(revision 185)
+++ codes/icosagcm/trunk/src/write_field.f90	(revision 186)
@@ -1770,8 +1770,9 @@
    IMPLICIT NONE
      INTEGER :: i,k,status
-     
+!$OMP MASTER     
      DO i=1,NbField
          status=NF90_CLOSE(FieldId(i))
      ENDDO
+!$OMP END MASTER
    END SUBROUTINE  Close_files
      
Index: codes/icosagcm/trunk/src/xios_mod.F90
===================================================================
--- codes/icosagcm/trunk/src/xios_mod.F90	(revision 185)
+++ codes/icosagcm/trunk/src/xios_mod.F90	(revision 186)
@@ -7,6 +7,9 @@
   PUBLIC
   LOGICAL,SAVE :: using_xios
+
   INTEGER,SAVE :: ncell_i
+!$OMP THREADPRIVATE(ncell_i)
   INTEGER,SAVE :: ncell_v
+!$OMP THREADPRIVATE(ncell_v)
 
   PRIVATE ncell_i,ncell_v
@@ -17,5 +20,5 @@
  
  SUBROUTINE xios_init
-   USE IOIPSL
+   USE getin_mod
    IMPLICIT NONE
 
@@ -46,4 +49,6 @@
   TYPE(t_domain),POINTER :: d
 
+!$OMP BARRIER
+!$OMP MASTER
    CALL xios_context_initialize("icosagcm",comm_icosa)
    CALL xios_get_handle("icosagcm",ctx_hdl)
@@ -186,5 +191,7 @@
    CALL xios_set_timestep(dtime) 
    CALL xios_close_context_definition()
-    
+!$OMP END MASTER
+!$OMP BARRIER
+   
  END SUBROUTINE xios_init_write_field
   
@@ -197,4 +204,7 @@
    CHARACTER(LEN=10) :: str_number
    INTEGER :: iq
+
+!$OMP BARRIER
+!$OMP MASTER
    
    IF (Field(1)%field_type==field_T) THEN
@@ -225,4 +235,6 @@
       ENDIF
     ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
       
  END SUBROUTINE xios_write_field
@@ -400,5 +412,11 @@
  SUBROUTINE xios_write_field_finalize
  IMPLICIT NONE
+
+!$OMP BARRIER
+!$OMP MASTER 
    CALL xios_context_finalize
+!$OMP END MASTER
+!$OMP BARRIER
+
  END SUBROUTINE xios_write_field_finalize
    
