Index: codes/icosagcm/devel/src/advect.f90
===================================================================
--- codes/icosagcm/devel/src/advect.f90	(revision 531)
+++ 	(revision )
@@ -1,528 +1,0 @@
-MODULE advect_mod
-  USE icosa
-  IMPLICIT NONE 
-
-  PRIVATE
-  
-  PUBLIC :: init_advect, compute_backward_traj, compute_gradq3d, compute_advect_horiz
-
-CONTAINS
-
-  !==========================================================================
-
-  SUBROUTINE init_advect(normal,tangent,sqrt_leng)
-    IMPLICIT NONE
-    REAL(rstd),INTENT(OUT) :: normal(3*iim*jjm,3)
-    REAL(rstd),INTENT(OUT) :: tangent(3*iim*jjm,3)
-    REAL(rstd),INTENT(OUT) :: sqrt_leng(iim*jjm)
-
-    INTEGER :: ij
-
-!DIR$ SIMD
-      DO ij=ij_begin,ij_end
-
-          CALL cross_product2(xyz_v(ij+z_rdown,:),xyz_v(ij+z_rup,:),normal(ij+u_right,:))
-          normal(ij+u_right,:)=normal(ij+u_right,:)/sqrt(sum(normal(ij+u_right,:)**2)+1e-50)*ne(ij,right)
-
-          CALL cross_product2(xyz_v(ij+z_up,:),xyz_v(ij+z_lup,:),normal(ij+u_lup,:))
-          normal(ij+u_lup,:)=normal(ij+u_lup,:)/sqrt(sum(normal(ij+u_lup,:)**2)+1e-50)*ne(ij,lup)
-
-          CALL cross_product2(xyz_v(ij+z_ldown,:),xyz_v(ij+z_down,:),normal(ij+u_ldown,:))	 
-          normal(ij+u_ldown,:)=normal(ij+u_ldown,:)/sqrt(sum(normal(ij+u_ldown,:)**2)+1e-50)*ne(ij,ldown)
-
-          tangent(ij+u_right,:)=xyz_v(ij+z_rup,:)-xyz_v(ij+z_rdown,:) 
-          tangent(ij+u_right,:)=tangent(ij+u_right,:)/sqrt(sum(tangent(ij+u_right,:)**2)+1e-50)
-
-          tangent(ij+u_lup,:)=xyz_v(ij+z_lup,:)-xyz_v(ij+z_up,:) 
-          tangent(ij+u_lup,:)=tangent(ij+u_lup,:)/sqrt(sum(tangent(ij+u_lup,:)**2)+1e-50)
-
-          tangent(ij+u_ldown,:)=xyz_v(ij+z_down,:)-xyz_v(ij+z_ldown,:)
-          tangent(ij+u_ldown,:)=tangent(ij+u_ldown,:)/sqrt(sum(tangent(ij+u_ldown,:)**2)+1e-50)
-
-          sqrt_leng(ij) = sqrt(max(sum((xyz_v(ij+z_up,:) - xyz_i(ij,:))**2),sum((xyz_v(ij+z_down,:) - xyz_i(ij,:))**2), &
-                                   sum((xyz_v(ij+z_rup,:) - xyz_i(ij,:))**2),sum((xyz_v(ij+z_rdown,:) - xyz_i(ij,:))**2),  &
-                                   sum((xyz_v(ij+z_lup,:) - xyz_i(ij,:))**2),sum((xyz_v(ij+z_ldown,:) - xyz_i(ij,:))**2)) )
-    ENDDO
-
-  END SUBROUTINE init_advect
-
-  !=======================================================================================
-
-  SUBROUTINE compute_gradq3d(qi_in,sqrt_leng_in,gradq3d_out,xyz_i,xyz_v)
-    USE trace
-    USE omp_para
-    IMPLICIT NONE
-    REAL(rstd),INTENT(IN)  :: qi_in(iim*jjm,llm)
-    REAL(rstd),INTENT(IN)  :: 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
-    REAL(rstd) :: leng1,leng2
-    REAL(rstd) :: arr(2*iim*jjm)
-    REAL(rstd) :: ar(iim*jjm)
-    REAL(rstd) :: gradtri(2*iim*jjm,llm,3) 
-    INTEGER :: ij,k,ind,l
-    REAL(rstd)  :: qi(iim*jjm,llm)
-    REAL(rstd)  :: 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
-    sqrt_leng=sqrt_leng_in
-    
-    CALL trace_start("compute_gradq3d1")
-
-    ! TODO : precompute ar, drop arr as output argument of gradq ?
-
-    !========================================================================================== GRADIENT 
-    ! Compute gradient at triangles solving a linear system
-    ! arr = area of triangle joining centroids of hexagons
-!     DO l = ll_begin,ll_end 
-!!DIR$ 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 
-!DIR$ 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,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
-
-!DIR$ 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
-    ENDDO
-    CALL trace_end("compute_gradq3d1")
-    CALL trace_start2("compute_gradq3d2")
-      
-    DO k=1,3
-      DO l =ll_begin,ll_end
-!DIR$ SIMD
-      DO ij=ij_begin,ij_end
-              gradq3d(ij,l,k) = ( gradtri(ij+z_up,l,k) + gradtri(ij+z_down,l,k)   +   &
-                                 gradtri(ij+z_rup,l,k) +  gradtri(ij+z_ldown,l,k)   +   & 
-                                 gradtri(ij+z_lup,l,k)+    gradtri(ij+z_rdown,l,k) ) / ar(ij)  
-        END DO
-      END DO
-    ENDDO
-    CALL trace_end2("compute_gradq3d2")
-    CALL trace_start("compute_gradq3d3")
-
-    !============================================================================================= LIMITING 
-    DO l =ll_begin,ll_end
-!DIR$ SIMD
-      DO ij=ij_begin,ij_end
-!             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*sqrt_leng(ij)
-             minq_c = qi(ij,l) - maggrd*sqrt_leng(ij)
-             maxq = max(qi(ij,l),qi(ij+t_right,l),qi(ij+t_lup,l),qi(ij+t_rup,l),qi(ij+t_left,l), &
-                  qi(ij+t_rdown,l),qi(ij+t_ldown,l))
-             minq = min(qi(ij,l),qi(ij+t_right,l),qi(ij+t_lup,l),qi(ij+t_rup,l),qi(ij+t_left,l), &
-                  qi(ij+t_rdown,l),qi(ij+t_ldown,l))
-             alphamx = (maxq - qi(ij,l)) ; alphamx = alphamx/(maxq_c - qi(ij,l) )
-             alphamx = max(alphamx,0.0)
-             alphami = (minq - qi(ij,l)); alphami = alphami/(minq_c - qi(ij,l))
-             alphami = max(alphami,0.0) 
-             alpha   = min(alphamx,alphami,1.0)
-!             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_gradq3d3")
-  
-  
-  DO k=1,3
-    DO l = ll_begin,ll_end
-      DO ij=ij_begin,ij_end 
-        gradq3d_out(ij,l,k)=gradq3d(ij,l,k)
-      ENDDO
-    ENDDO
-  ENDDO
-  
-  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
-
-  ! Backward trajectories, for use with Miura approach
-  SUBROUTINE compute_backward_traj(normal,tangent,ue,tau, cc)
-    USE trace
-    USE omp_para
-    IMPLICIT NONE
-    REAL(rstd),INTENT(IN)    :: normal(3*iim*jjm,3)
-    REAL(rstd),INTENT(IN)    :: tangent(3*iim*jjm,3)
-    REAL(rstd),INTENT(IN)    :: ue(iim*3*jjm,llm)
-    REAL(rstd),INTENT(OUT)   :: cc(3*iim*jjm,llm,3) ! start of backward trajectory
-    REAL(rstd),INTENT(IN)    :: tau
-
-    REAL(rstd) :: v_e(3), up_e, qe, ed(3)    
-    INTEGER :: ij,l
-
-    CALL trace_start("compute_backward_traj")
-
-    ! TODO : compute normal displacement ue*tau as hfluxt / mass(upwind) then reconstruct tangential displacement
-    
-    ! reconstruct tangential wind then 3D wind at edge then cc = edge midpoint - u*tau
-    DO l = ll_begin,ll_end
-!DIR$ SIMD
-      DO ij=ij_begin,ij_end
-             up_e =1/de(ij+u_right)*(                                                   &
-                  wee(ij+u_right,1,1)*le(ij+u_rup)*ue(ij+u_rup,l)+                        &
-                  wee(ij+u_right,2,1)*le(ij+u_lup)*ue(ij+u_lup,l)+                        &
-                  wee(ij+u_right,3,1)*le(ij+u_left)*ue(ij+u_left,l)+                      &
-                  wee(ij+u_right,4,1)*le(ij+u_ldown)*ue(ij+u_ldown,l)+                    &
-                  wee(ij+u_right,5,1)*le(ij+u_rdown)*ue(ij+u_rdown,l)+                    & 
-                  wee(ij+u_right,1,2)*le(ij+t_right+u_ldown)*ue(ij+t_right+u_ldown,l)+    &
-                  wee(ij+u_right,2,2)*le(ij+t_right+u_rdown)*ue(ij+t_right+u_rdown,l)+    &
-                  wee(ij+u_right,3,2)*le(ij+t_right+u_right)*ue(ij+t_right+u_right,l)+    &
-                  wee(ij+u_right,4,2)*le(ij+t_right+u_rup)*ue(ij+t_right+u_rup,l)+        &
-                  wee(ij+u_right,5,2)*le(ij+t_right+u_lup)*ue(ij+t_right+u_lup,l)         &
-                  )
-             v_e = ue(ij+u_right,l)*normal(ij+u_right,:) + up_e*tangent(ij+u_right,:)
-             cc(ij+u_right,l,:) = xyz_e(ij+u_right,:) - v_e*tau
-
-             up_e=1/de(ij+u_lup)*(                                                      &
-                  wee(ij+u_lup,1,1)*le(ij+u_left)*ue(ij+u_left,l)+                        &
-                  wee(ij+u_lup,2,1)*le(ij+u_ldown)*ue(ij+u_ldown,l)+                      &
-                  wee(ij+u_lup,3,1)*le(ij+u_rdown)*ue(ij+u_rdown,l)+                      &
-                  wee(ij+u_lup,4,1)*le(ij+u_right)*ue(ij+u_right,l)+                      &
-                  wee(ij+u_lup,5,1)*le(ij+u_rup)*ue(ij+u_rup,l)+                          & 
-                  wee(ij+u_lup,1,2)*le(ij+t_lup+u_right)*ue(ij+t_lup+u_right,l)+          &
-                  wee(ij+u_lup,2,2)*le(ij+t_lup+u_rup)*ue(ij+t_lup+u_rup,l)+              &
-                  wee(ij+u_lup,3,2)*le(ij+t_lup+u_lup)*ue(ij+t_lup+u_lup,l)+              &
-                  wee(ij+u_lup,4,2)*le(ij+t_lup+u_left)*ue(ij+t_lup+u_left,l)+            &
-                  wee(ij+u_lup,5,2)*le(ij+t_lup+u_ldown)*ue(ij+t_lup+u_ldown,l)           &
-                  )
-             v_e = ue(ij+u_lup,l)*normal(ij+u_lup,:) + up_e*tangent(ij+u_lup,:)
-             cc(ij+u_lup,l,:) = xyz_e(ij+u_lup,:) - v_e*tau
-            
-
-             up_e=1/de(ij+u_ldown)*(                                                    &
-                  wee(ij+u_ldown,1,1)*le(ij+u_rdown)*ue(ij+u_rdown,l)+                    &
-                  wee(ij+u_ldown,2,1)*le(ij+u_right)*ue(ij+u_right,l)+                    &
-                  wee(ij+u_ldown,3,1)*le(ij+u_rup)*ue(ij+u_rup,l)+                        &
-                  wee(ij+u_ldown,4,1)*le(ij+u_lup)*ue(ij+u_lup,l)+                        &
-                  wee(ij+u_ldown,5,1)*le(ij+u_left)*ue(ij+u_left,l)+                      & 
-                  wee(ij+u_ldown,1,2)*le(ij+t_ldown+u_lup)*ue(ij+t_ldown+u_lup,l)+        &
-                  wee(ij+u_ldown,2,2)*le(ij+t_ldown+u_left)*ue(ij+t_ldown+u_left,l)+      &
-                  wee(ij+u_ldown,3,2)*le(ij+t_ldown+u_ldown)*ue(ij+t_ldown+u_ldown,l)+    &
-                  wee(ij+u_ldown,4,2)*le(ij+t_ldown+u_rdown)*ue(ij+t_ldown+u_rdown,l)+    &
-                  wee(ij+u_ldown,5,2)*le(ij+t_ldown+u_right)*ue(ij+t_ldown+u_right,l)     &
-                  )
-             v_e = ue(ij+u_ldown,l)*normal(ij+u_ldown,:) + up_e*tangent(ij+u_ldown,:)
-             cc(ij+u_ldown,l,:) = xyz_e(ij+u_ldown,:) - v_e*tau
-       ENDDO
-    END DO
-
-    CALL trace_end("compute_backward_traj")
-
-  END SUBROUTINE compute_backward_traj
-
-  ! Horizontal transport (S. Dubey, T. Dubos)
-  ! Slope-limited van Leer approach with hexagons
-  SUBROUTINE compute_advect_horiz(update_mass,hfluxt,cc,gradq3d, mass,qi) 
-    USE trace
-    USE omp_para
-    IMPLICIT NONE
-    LOGICAL, INTENT(IN)       :: update_mass
-    REAL(rstd), INTENT(IN)    :: gradq3d(iim*jjm,llm,3) 
-    REAL(rstd), INTENT(IN)    :: hfluxt(3*iim*jjm,llm) ! mass flux
-    REAL(rstd), INTENT(IN)    :: cc(3*iim*jjm,llm,3)   ! barycenter of quadrilateral, where q is evaluated (1-point quadrature)
-    REAL(rstd), INTENT(INOUT) :: mass(iim*jjm,llm)
-    REAL(rstd), INTENT(INOUT) :: qi(iim*jjm,llm)
-
-    REAL(rstd) :: dq,dmass,qe,ed(3), newmass
-    REAL(rstd) :: qflux(3*iim*jjm,llm)
-    INTEGER :: ij,k,l
-
-    CALL trace_start("compute_advect_horiz")
-
-    ! evaluate tracer field at point cc using piecewise linear reconstruction
-    ! q(cc)= q0 + gradq.(cc-xyz_i)  with xi centroid of hexagon
-    ! ne*hfluxt>0 iff outgoing
-    DO l = ll_begin,ll_end
-
-!DIR$ SIMD
-      DO ij=ij_begin_ext,ij_end_ext
-
-             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)+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) + 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
-             
-             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)  + 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) + 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 
-
-             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) + 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)+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
-       END DO
-    END DO
-
-    ! update q and, if update_mass, update mass
-    DO l = ll_begin,ll_end
-!DIR$ SIMD
-      DO ij=ij_begin,ij_end
-             ! sign convention as Ringler et al. (2010) eq. 21
-             dmass =   hfluxt(ij+u_right,l)*ne(ij,right)   &
-                     + hfluxt(ij+u_lup,l)  *ne(ij,lup)     &
-                     + hfluxt(ij+u_ldown,l)*ne(ij,ldown)   &
-                     + hfluxt(ij+u_rup,l)  *ne(ij,rup)     &
-                     + hfluxt(ij+u_left,l) *ne(ij,left)    &
-                     + hfluxt(ij+u_rdown,l)*ne(ij,rdown)
-
-             dq    =   qflux(ij+u_right,l) *ne(ij,right)   &
-                     + qflux(ij+u_lup,l)   *ne(ij,lup)     &
-                     + qflux(ij+u_ldown,l) *ne(ij,ldown)   &
-                     + qflux(ij+u_rup,l)   *ne(ij,rup)     &
-                     + qflux(ij+u_left,l)  *ne(ij,left)    &
-                     + qflux(ij+u_rdown,l) *ne(ij,rdown)
-
-             
-             newmass = mass(ij,l) - dmass/Ai(ij)
-             qi(ij,l) = (qi(ij,l)*mass(ij,l) - dq/Ai(ij) ) / newmass
-             IF(update_mass) mass(ij,l) = newmass
-
-       END DO
-    END DO
-
-    CALL trace_end("compute_advect_horiz")
-  CONTAINS
-
-    !====================================================================================
-    PURE REAL(rstd) FUNCTION sum2(a1,a2)
-      IMPLICIT NONE
-      REAL(rstd),INTENT(IN):: a1(3), a2(3)
-      sum2 = a1(1)*a2(1)+a1(2)*a2(2)+a1(3)*a2(3)
-      ! sum2 = 0. ! Godunov scheme
-    END FUNCTION sum2
-
-  END SUBROUTINE compute_advect_horiz
-
-
-END MODULE advect_mod
Index: codes/icosagcm/devel/src/advect_tracer.f90
===================================================================
--- codes/icosagcm/devel/src/advect_tracer.f90	(revision 531)
+++ 	(revision )
@@ -1,331 +1,0 @@
-MODULE advect_tracer_mod
-  USE icosa
-  IMPLICIT NONE
-  PRIVATE
-
-  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_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),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
-
-CONTAINS
-
-  SUBROUTINE init_advect_tracer
-    USE advect_mod
-    USE omp_para
-    REAL(rstd),POINTER :: tangent(:,:)
-    REAL(rstd),POINTER :: normal(:,:)
-    REAL(rstd),POINTER :: sqrt_leng(:)
-    INTEGER :: ind
-
-    CALL allocate_field(f_normal,field_u,type_real,3, name='normal')
-    CALL allocate_field(f_tangent,field_u,type_real,3, name='tangent')
-    CALL allocate_field(f_gradq3d,field_t,type_real,llm,3, name='gradq3d')
-    CALL allocate_field(f_cc,field_u,type_real,llm,3, name='cc')
-    CALL allocate_field(f_sqrt_leng,field_t,type_real, name='sqrt_leng')
-    CALL allocate_field(f_dzqw, field_t, type_real, llm, name='dzqw')
-    CALL allocate_field(f_adzqw, field_t, type_real, llm, name='adzqw')
-    CALL allocate_field(f_dzq, field_t, type_real, llm, name='dzq')
-    CALL allocate_field(f_wq, field_t, type_real, llm+1, name='wq')
-    
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       normal=f_normal(ind)
-       tangent=f_tangent(ind)
-       sqrt_leng=f_sqrt_leng(ind)
-       IF (is_omp_level_master) CALL init_advect(normal,tangent,sqrt_leng)
-    END DO
-
-  END SUBROUTINE init_advect_tracer
-
-  SUBROUTINE advect_tracer(f_hfluxt, f_wfluxt,f_u, f_q,f_rhodz)
-    USE advect_mod
-    USE mpipara
-    USE trace
-    USE write_field_mod
-    USE tracer_mod
-    IMPLICIT NONE
-    
-    TYPE(t_field),POINTER :: f_hfluxt(:)   ! time-integrated horizontal mass flux
-    TYPE(t_field),POINTER :: f_wfluxt(:)   ! time-integrated vertical mass flux
-    TYPE(t_field),POINTER :: f_u(:)        ! velocity (for back-trajectories)
-    TYPE(t_field),POINTER :: f_q(:)        ! tracer
-    TYPE(t_field),POINTER :: f_rhodz(:)    ! mass field at beginning of macro time step
-
-    REAL(rstd),POINTER :: q(:,:,:), normal(:,:), tangent(:,:), sqrt_leng(:), gradq3d(:,:,:), cc(:,:,:)
-    REAL(rstd),POINTER :: hfluxt(:,:), wfluxt(:,:)
-    REAL(rstd),POINTER :: rhodz(:,:), u(:,:) 
-! temporary shared variable for vlz
-    REAL(rstd),POINTER ::  dzqw(:,:)         ! vertical finite difference of q 
-    REAL(rstd),POINTER ::  adzqw(:,:)        ! abs(dzqw)
-    REAL(rstd),POINTER ::  dzq(:,:)          ! limited slope of q
-    REAL(rstd),POINTER ::  wq(:,:)           ! time-integrated flux of q
-    
-     INTEGER :: ind,k, nq_last
-    LOGICAL,SAVE :: first=.TRUE.
-!$OMP THREADPRIVATE(first)
-
-    IF (first) THEN
-      first=.FALSE.
-      CALL init_message(f_u,req_e1_vect,req_u, 'req_u')
-      CALL init_message(f_cc,req_e1_scal,req_cc, 'req_cc')
-      CALL init_message(f_wfluxt,req_i1,req_wfluxt, 'req_wfluxt')
-      CALL init_message(f_q,req_i1,req_q, 'req_q')
-      CALL init_message(f_rhodz,req_i1,req_rhodz, 'req_rhodz')
-      CALL init_message(f_gradq3d,req_i1,req_gradq3d, 'req_gradq3d')
-    ENDIF
-    
-!!$OMP BARRIER
-
-    IF(nqtot<1) RETURN
-    nq_last=-1
-    
-    DO k = 1, nqtot
-      IF (advection_scheme(k)==advect_vanleer) nq_last=k
-    ENDDO
-     
-    IF(nq_last<0) RETURN
-      
-    CALL trace_start("advect_tracer") 
-
-    CALL send_message(f_u,req_u)
-    CALL send_message(f_wfluxt,req_wfluxt)
-    CALL send_message(f_q,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)
-    
-    ! 1/2 vertical transport + back-trajectories
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       normal  = f_normal(ind)
-       tangent = f_tangent(ind)
-       cc      = f_cc(ind)
-       u       = f_u(ind)
-       q       = f_q(ind)
-       rhodz   = f_rhodz(ind)
-       wfluxt  = f_wfluxt(ind) 
-       dzqw    = f_dzqw(ind)
-       adzqw   = f_adzqw(ind)
-       dzq     = f_dzq(ind)
-       wq      = f_wq(ind) 
-
-       DO k = 1, nqtot
-          IF (advection_scheme(k)==advect_vanleer) CALL vlz(k==nq_last,0.5, wfluxt,rhodz,q(:,:,k),1,dzqw, adzqw, dzq, wq)
-       END DO
-
-       CALL compute_backward_traj(tangent,normal,u,0.5*dt*itau_adv, cc) 
-
-    END DO
-
-    CALL send_message(f_cc,req_cc)
-
-
-    ! horizontal transport - split in two to place transfer of gradq3d
-    DO k = 1, nqtot
-      IF (advection_scheme(k)==advect_vanleer) THEN
-       
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind)) CYCLE
-          CALL swap_dimensions(ind)
-          CALL swap_geometry(ind)
-          q       = f_q(ind)
-          gradq3d = f_gradq3d(ind)
-          sqrt_leng=f_sqrt_leng(ind)
-          CALL compute_gradq3d(q(:,:,k),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_gradq3d)
-
-
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind)) CYCLE
-          CALL swap_dimensions(ind)
-          CALL swap_geometry(ind)
-          cc      = f_cc(ind)
-          q       = f_q(ind)
-          rhodz   = f_rhodz(ind)
-          hfluxt  = f_hfluxt(ind) 
-          gradq3d = f_gradq3d(ind)
-          CALL compute_advect_horiz(k==nq_last,hfluxt,cc,gradq3d, rhodz,q(:,:,k))
-        END DO
-      ENDIF
-    END DO 
-    
-    ! 1/2 vertical transport
-!!$OMP BARRIER
-
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       q       = f_q(ind)
-       rhodz   = f_rhodz(ind)
-       wfluxt  = f_wfluxt(ind) 
-       dzqw    = f_dzqw(ind)
-       adzqw   = f_adzqw(ind)
-       dzq     = f_dzq(ind)
-       wq      = f_wq(ind) 
-
-       DO k = 1,nqtot
-         IF (advection_scheme(k)==advect_vanleer) CALL vlz(k==nq_last, 0.5,wfluxt,rhodz, q(:,:,k),0, dzqw, adzqw, dzq, wq)
-       END DO
-
-    END DO
-
-    CALL trace_end("advect_tracer")
-
-!!$OMP BARRIER
-
-  END SUBROUTINE advect_tracer
-
-  SUBROUTINE vlz(update_mass, fac,wfluxt,mass, q, halo, dzqw, adzqw, dzq, wq)
-    !
-    !     Auteurs:   P.Le Van, F.Hourdin, F.Forget, T. Dubos
-    !
-    !    ********************************************************************
-    !     Update tracers using vertical mass flux only
-    !     Van Leer scheme with minmod limiter
-    !     wfluxt >0 for upward transport
-    !    ********************************************************************
-    USE trace
-    USE omp_para
-    IMPLICIT NONE
-    LOGICAL, INTENT(IN)       :: update_mass
-    REAL(rstd), INTENT(IN)    :: fac, wfluxt(iim*jjm,llm+1) ! vertical mass flux
-    REAL(rstd), INTENT(INOUT) :: mass(iim*jjm,llm)
-    REAL(rstd), INTENT(INOUT) :: q(iim*jjm,llm)
-    INTEGER, INTENT(IN) :: halo
-
-! temporary shared variable
-    REAL(rstd),INTENT(INOUT) :: dzqw(iim*jjm,llm),        & ! vertical finite difference of q 
-                                adzqw(iim*jjm,llm),       & ! abs(dzqw)
-                                dzq(iim*jjm,llm),         & ! limited slope of q
-                                wq(iim*jjm,llm+1)           ! time-integrated flux of q
-
-
-    REAL(rstd) :: dzqmax, newmass, sigw, qq, w
-    INTEGER :: i,ij,l,j,ijb,ije
-
-    CALL trace_start("vlz")
-     
-     ijb=((jj_begin-halo)-1)*iim+ii_begin-halo
-     ije = ((jj_end+halo)-1)*iim+ii_end+halo
-
-    ! finite difference of q
-
-     DO l=ll_beginp1,ll_end
-!DIR$ SIMD
-       DO ij=ijb,ije
-         dzqw(ij,l)=q(ij,l)-q(ij,l-1)
-         adzqw(ij,l)=abs(dzqw(ij,l))
-       ENDDO
-    ENDDO
-
-!--> flush dzqw, adzqw
-!$OMP BARRIER
-
-    ! minmod-limited slope of q
-    ! dzq = slope*dz, i.e. the reconstructed q varies by dzq inside level l
-
-     DO l=ll_beginp1,ll_endm1
-!DIR$ SIMD
-       DO ij=ijb,ije 
-         IF(dzqw(ij,l)*dzqw(ij,l+1).gt.0.) THEN
-             dzq(ij,l) = 0.5*( dzqw(ij,l)+dzqw(ij,l+1) )
-             dzqmax    = pente_max * min( adzqw(ij,l),adzqw(ij,l+1) )
-             dzq(ij,l) = sign( min(abs(dzq(ij,l)),dzqmax) , dzq(ij,l) )  ! NB : sign(a,b)=a*sign(b)
-          ELSE
-             dzq(ij,l)=0.
-          ENDIF
-       ENDDO
-    ENDDO
-
-
-    ! 0 slope in top and bottom layers
-    IF (is_omp_first_level) THEN
-      DO ij=ijb,ije
-           dzq(ij,1)=0.
-      ENDDO
-    ENDIF
-      
-    IF (is_omp_last_level) THEN
-      DO ij=ijb,ije
-          dzq(ij,llm)=0.
-      ENDDO
-    ENDIF
-
-!---> flush dzq
-!$OMP BARRIER  
-
-    ! sigw = fraction of mass that leaves level l/l+1
-    ! then amount of q leaving level l/l+1 = wq = w * qq
-     DO l=ll_beginp1,ll_end
-!DIR$ SIMD
-       DO ij=ijb,ije
-             w = fac*wfluxt(ij,l)
-             IF(w>0.) THEN  ! upward transport, upwind side is at level l 
-                sigw       = w/mass(ij,l-1)
-                qq         = q(ij,l-1)+0.5*(1.-sigw)*dzq(ij,l-1) ! qq = q if sigw=1 , qq = q+dzq/2 if sigw=0
-             ELSE           ! downward transport, upwind side is at level l+1
-                sigw       = w/mass(ij,l)
-                qq         = q(ij,l)-0.5*(1.+sigw)*dzq(ij,l) ! qq = q if sigw=-1 , qq = q-dzq/2 if sigw=0                
-             ENDIF
-             wq(ij,l) = w*qq
-       ENDDO
-    END DO
-    ! wq = 0 at top and bottom
-    IF (is_omp_first_level) THEN
-       DO ij=ijb,ije
-            wq(ij,1)=0.
-      END DO
-    ENDIF
-    
-    IF (is_omp_last_level) THEN
-      DO ij=ijb,ije
-            wq(ij,llm+1)=0.
-      END DO
-    ENDIF
-
-! --> flush wq
-!$OMP BARRIER
-
-
-    ! update q, mass is updated only after all q's have been updated
-    DO l=ll_begin,ll_end
-!DIR$ SIMD
-       DO ij=ijb,ije
-             newmass = mass(ij,l) + fac*(wfluxt(ij,l)-wfluxt(ij,l+1))
-             q(ij,l) = ( q(ij,l)*mass(ij,l) + wq(ij,l)-wq(ij,l+1) ) / newmass
-             IF(update_mass) mass(ij,l)=newmass
-       ENDDO
-    END DO
-
-    CALL trace_end("vlz")
-
-  END SUBROUTINE vlz
-
-END MODULE advect_tracer_mod
Index: codes/icosagcm/devel/src/base/dimensions.f90
===================================================================
--- codes/icosagcm/devel/src/base/dimensions.f90	(revision 533)
+++ codes/icosagcm/devel/src/base/dimensions.f90	(revision 533)
@@ -0,0 +1,127 @@
+MODULE dimensions
+
+    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,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,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,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,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
+
+  SUBROUTINE swap_dimensions(ind)
+  USE domain_mod
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: ind
+    
+    TYPE(t_domain),POINTER :: d
+    
+    d=>domain(ind)
+     
+     iim=d%iim
+     jjm=d%jjm
+     ii_begin=d%ii_begin
+     jj_begin=d%jj_begin
+     ii_end=d%ii_end
+     jj_end=d%jj_end
+     ii_nb=d%ii_nb
+     jj_nb=d%jj_nb
+    
+     ij_begin=(jj_begin-1)*iim+ii_begin
+     ij_end=(jj_end-1)*iim+ii_end 
+     ij_begin_ext=((jj_begin-1)-1)*iim+ii_begin-1
+     ij_end_ext = ((jj_end+1)-1)*iim+ii_end+1
+        
+     t_right=d%t_right
+     t_rup=d%t_rup
+     t_lup=d%t_lup
+     t_left=d%t_left
+     t_ldown=d%t_ldown
+     t_rdown=d%t_rdown
+
+     u_right=d%u_right
+     u_rup=d%u_rup
+     u_lup=d%u_lup
+     u_left=d%u_left
+     u_ldown=d%u_ldown
+     u_rdown=d%u_rdown
+
+     z_rup=d%z_rup
+     z_up=d%z_up
+     z_lup=d%z_lup
+     z_ldown=d%z_ldown
+     z_down=d%z_down
+     z_rdown=d%z_rdown
+     
+     t_pos(:)=d%t_pos(:)
+     u_pos(:)=d%u_pos(:)
+     z_pos(:)=d%z_pos(:)
+
+   END SUBROUTINE swap_dimensions
+   
+END MODULE dimensions   
+    
Index: codes/icosagcm/devel/src/base/earth_const.f90
===================================================================
--- codes/icosagcm/devel/src/base/earth_const.f90	(revision 533)
+++ codes/icosagcm/devel/src/base/earth_const.f90	(revision 533)
@@ -0,0 +1,64 @@
+MODULE earth_const
+  USE prec
+  USE math_const
+  
+  REAL(rstd),SAVE :: radius=6.37122E6
+  REAL(rstd),SAVE :: g=9.80616
+  REAL(rstd),PARAMETER :: daysec=86400
+  REAL(rstd),SAVE :: omega=7.292E-5
+  REAL(rstd),SAVE :: kappa=0.2857143
+  REAL(rstd),SAVE :: cpp=1004.70885
+  REAL(rstd),SAVE :: cppv=1860.
+  REAL(rstd),SAVE :: Rv=461.5
+  REAL(rstd),SAVE :: Treff=273.
+  REAL(rstd),SAVE :: preff=101325.
+  REAL(rstd),SAVE :: pa=50000.
+  REAL(rstd),SAVE :: scale_height=8000. ! atmospheric scale height (m)
+  REAL(rstd),SAVE :: scale_factor=1.
+  REAL(rstd),SAVE :: gas_constant = 8.3144621 
+  REAL(rstd),SAVE :: mu                 ! molar mass of the atmosphere
+
+  INTEGER, PARAMETER,PUBLIC :: thermo_theta=1, thermo_entropy=2, &
+       thermo_moist=3, thermo_moist_debug=10, thermo_dry=4, thermo_fake_moist=5 
+  INTEGER, PUBLIC :: caldyn_thermo, physics_thermo
+  !$OMP THREADPRIVATE(caldyn_thermo) 
+  !$OMP THREADPRIVATE(physics_thermo) 
+
+  LOGICAL, SAVE :: boussinesq, hydrostatic
+
+CONTAINS
+  
+  SUBROUTINE init_earth_const
+  USE getin_mod
+  IMPLICIT NONE
+  REAL(rstd) :: X=1
+  
+    CALL getin("radius",radius)
+    CALL getin("g",g)
+    CALL getin("scale_factor",scale_factor)
+    CALL getin("omega",omega)  
+    CALL getin("kappa",kappa)  
+    CALL getin("cpp",cpp)  
+    CALL getin("cppv",cppv)
+    CALL getin("Rv",Rv)
+    CALL getin("preff",preff)  
+    CALL getin("Treff",Treff)  
+    CALL getin("scale_height",scale_height)
+    
+    boussinesq=.FALSE.
+    CALL getin("boussinesq",boussinesq)  
+    hydrostatic=.TRUE.
+    CALL getin("hydrostatic",hydrostatic)  
+    IF(boussinesq .AND. .NOT. hydrostatic) THEN
+       PRINT *, 'boussinesq=.TRUE. and hydrostatic=.FALSE. : Non-hydrostatic boussinesq equations are not supported'
+       STOP
+    END IF
+    
+    mu=kappa/cpp
+    radius=radius/scale_factor
+    omega=omega*scale_factor
+    
+  END SUBROUTINE init_earth_const
+  
+  
+END MODULE earth_const
Index: codes/icosagcm/devel/src/base/field.f90
===================================================================
--- codes/icosagcm/devel/src/base/field.f90	(revision 533)
+++ codes/icosagcm/devel/src/base/field.f90	(revision 533)
@@ -0,0 +1,462 @@
+MODULE field_mod
+  USE genmod
+  IMPLICIT NONE
+  
+  INTEGER,PARAMETER :: field_T=1
+  INTEGER,PARAMETER :: field_U=2
+  INTEGER,PARAMETER :: field_Z=3
+
+  INTEGER,PARAMETER :: type_integer=1
+  INTEGER,PARAMETER :: type_real=2
+  INTEGER,PARAMETER :: type_logical=3
+    
+  TYPE t_field
+    CHARACTER(30)      :: name
+    REAL(rstd),POINTER :: rval2d(:)
+    REAL(rstd),POINTER :: rval3d(:,:)
+    REAL(rstd),POINTER :: rval4d(:,:,:)
+
+    INTEGER,POINTER :: ival2d(:)
+    INTEGER,POINTER :: ival3d(:,:)
+    INTEGER,POINTER :: ival4d(:,:,:)
+    
+    LOGICAL,POINTER :: lval2d(:)
+    LOGICAL,POINTER :: lval3d(:,:)
+    LOGICAL,POINTER :: lval4d(:,:,:)
+
+    INTEGER :: ndim
+    INTEGER :: field_type
+    INTEGER :: data_type 
+    INTEGER :: dim3
+    INTEGER :: dim4
+  END TYPE t_field   
+
+  INTERFACE get_val
+    MODULE PROCEDURE getval_r2d,getval_r3d,getval_r4d, &
+                     getval_i2d,getval_i3d,getval_i4d, &
+                     getval_l2d,getval_l3d,getval_l4d
+  END INTERFACE
+                   
+  INTERFACE ASSIGNMENT(=)
+    MODULE PROCEDURE getval_r2d,getval_r3d,getval_r4d, &
+                     getval_i2d,getval_i3d,getval_i4d, &
+                     getval_l2d,getval_l3d,getval_l4d 
+  END INTERFACE
+
+  PRIVATE :: allocate_field_
+
+CONTAINS
+
+  SUBROUTINE allocate_field(field,field_type,data_type,dim1,dim2,name)
+  USE domain_mod
+  USE omp_para
+    TYPE(t_field),POINTER :: field(:)
+    INTEGER,INTENT(IN) :: field_type
+    INTEGER,INTENT(IN) :: data_type
+    INTEGER,OPTIONAL :: dim1,dim2
+    CHARACTER(*), OPTIONAL :: name
+!$OMP BARRIER
+!$OMP MASTER
+    ALLOCATE(field(ndomain))
+!$OMP END MASTER
+!$OMP BARRIER
+    CALL allocate_field_(field,field_type,data_type,dim1,dim2,name)
+  END SUBROUTINE allocate_field
+
+  SUBROUTINE allocate_fields(nfield,field,field_type,data_type,dim1,dim2,name)
+  USE domain_mod
+  USE omp_para
+    INTEGER,INTENT(IN) :: nfield
+    TYPE(t_field),POINTER :: field(:,:)
+    INTEGER,INTENT(IN) :: field_type
+    INTEGER,INTENT(IN) :: data_type
+    INTEGER,OPTIONAL :: dim1,dim2
+    CHARACTER(*), OPTIONAL :: name
+    INTEGER :: i
+!$OMP BARRIER
+!$OMP MASTER
+    ALLOCATE(field(ndomain,nfield))
+!$OMP END MASTER
+!$OMP BARRIER
+    DO i=1,nfield
+       CALL allocate_field_(field(:,i),field_type,data_type,dim1,dim2,name)
+    END DO
+  END SUBROUTINE allocate_fields
+
+  SUBROUTINE allocate_field_(field,field_type,data_type,dim1,dim2,name)
+  USE domain_mod
+  USE omp_para
+  IMPLICIT NONE
+    TYPE(t_field) :: field(:)
+    INTEGER,INTENT(IN) :: field_type
+    INTEGER,INTENT(IN) :: data_type
+    INTEGER,OPTIONAL :: dim1,dim2
+    CHARACTER(*), OPTIONAL :: name
+    INTEGER :: ind
+    INTEGER :: ii_size,jj_size
+
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
+
+      IF(PRESENT(name)) THEN
+         field(ind)%name = name
+      ELSE
+         field(ind)%name = '(undefined)'
+      END IF
+
+      IF (PRESENT(dim2)) THEN
+        field(ind)%ndim=4 
+        field(ind)%dim4=dim2 
+        field(ind)%dim3=dim1
+      ELSE IF (PRESENT(dim1)) THEN
+        field(ind)%ndim=3
+        field(ind)%dim3=dim1
+      ELSE
+        field(ind)%ndim=2
+      ENDIF
+    
+    
+      field(ind)%data_type=data_type
+      field(ind)%field_type=field_type
+    
+      IF (field_type==field_T) THEN 
+        jj_size=domain(ind)%jjm
+      ELSE IF (field_type==field_U) THEN 
+        jj_size=3*domain(ind)%jjm
+      ELSE IF (field_type==field_Z) THEN 
+        jj_size=2*domain(ind)%jjm
+      ENDIF
+      
+      ii_size=domain(ind)%iim
+        
+      IF (field(ind)%ndim==4) THEN
+        IF (data_type==type_integer) ALLOCATE(field(ind)%ival4d(ii_size*jj_size,dim1,dim2))
+        IF (data_type==type_real)    ALLOCATE(field(ind)%rval4d(ii_size*jj_size,dim1,dim2))
+        IF (data_type==type_logical) ALLOCATE(field(ind)%lval4d(ii_size*jj_size,dim1,dim2))
+      ELSE IF (field(ind)%ndim==3) THEN
+        IF (data_type==type_integer) ALLOCATE(field(ind)%ival3d(ii_size*jj_size,dim1))
+        IF (data_type==type_real)    ALLOCATE(field(ind)%rval3d(ii_size*jj_size,dim1))
+        IF (data_type==type_logical) ALLOCATE(field(ind)%lval3d(ii_size*jj_size,dim1))
+      ELSE IF (field(ind)%ndim==2) THEN
+        IF (data_type==type_integer) ALLOCATE(field(ind)%ival2d(ii_size*jj_size))
+        IF (data_type==type_real)    ALLOCATE(field(ind)%rval2d(ii_size*jj_size))
+        IF (data_type==type_logical) ALLOCATE(field(ind)%lval2d(ii_size*jj_size))
+      ENDIF
+      
+   ENDDO
+!$OMP BARRIER
+   
+ END SUBROUTINE allocate_field_
+
+  SUBROUTINE allocate_field_glo(field,field_type,data_type,dim1,dim2,name)
+  USE domain_mod
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    INTEGER,INTENT(IN) :: field_type
+    INTEGER,INTENT(IN) :: data_type
+    INTEGER,OPTIONAL :: dim1,dim2
+    CHARACTER(*), OPTIONAL :: name
+    INTEGER :: ind
+    INTEGER :: ii_size,jj_size
+
+    ALLOCATE(field(ndomain_glo))    
+
+    DO ind=1,ndomain_glo
+  
+      IF (PRESENT(dim2)) THEN
+        field(ind)%ndim=4 
+        field(ind)%dim4=dim2 
+        field(ind)%dim3=dim1 
+      ELSE IF (PRESENT(dim1)) THEN
+        field(ind)%ndim=3
+        field(ind)%dim3=dim1 
+      ELSE
+        field(ind)%ndim=2
+      ENDIF
+    
+      IF(PRESENT(name)) THEN
+         field(ind)%name = name
+      ELSE
+         field(ind)%name = '(undefined)'
+      END IF
+    
+      field(ind)%data_type=data_type
+      field(ind)%field_type=field_type
+    
+      IF (field_type==field_T) THEN 
+        jj_size=domain_glo(ind)%jjm
+      ELSE IF (field_type==field_U) THEN 
+        jj_size=3*domain_glo(ind)%jjm
+      ELSE IF (field_type==field_Z) THEN 
+        jj_size=2*domain_glo(ind)%jjm
+      ENDIF
+      
+      ii_size=domain_glo(ind)%iim
+        
+      IF (field(ind)%ndim==4) THEN
+        IF (data_type==type_integer) ALLOCATE(field(ind)%ival4d(ii_size*jj_size,dim1,dim2))
+        IF (data_type==type_real)    ALLOCATE(field(ind)%rval4d(ii_size*jj_size,dim1,dim2))
+        IF (data_type==type_logical) ALLOCATE(field(ind)%lval4d(ii_size*jj_size,dim1,dim2))
+      ELSE IF (field(ind)%ndim==3) THEN
+        IF (data_type==type_integer) ALLOCATE(field(ind)%ival3d(ii_size*jj_size,dim1))
+        IF (data_type==type_real)    ALLOCATE(field(ind)%rval3d(ii_size*jj_size,dim1))
+        IF (data_type==type_logical) ALLOCATE(field(ind)%lval3d(ii_size*jj_size,dim1))
+      ELSE IF (field(ind)%ndim==2) THEN
+        IF (data_type==type_integer) ALLOCATE(field(ind)%ival2d(ii_size*jj_size))
+        IF (data_type==type_real)    ALLOCATE(field(ind)%rval2d(ii_size*jj_size))
+        IF (data_type==type_logical) ALLOCATE(field(ind)%lval2d(ii_size*jj_size))
+      ENDIF
+      
+   ENDDO
+  
+  END SUBROUTINE allocate_field_glo
+
+  SUBROUTINE deallocate_field(field)
+    USE domain_mod
+    USE omp_para
+    IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    !$OMP BARRIER
+    CALL deallocate_field_(field)
+    !$OMP BARRIER
+    !$OMP MASTER
+    DEALLOCATE(field)
+    !$OMP END MASTER
+    !$OMP BARRIER
+  END SUBROUTINE deallocate_field
+  
+  SUBROUTINE deallocate_fields(field)
+    USE domain_mod
+    USE omp_para
+    IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:,:)
+    INTEGER :: i
+    !$OMP BARRIER
+    DO i=1,SIZE(field,2)
+       CALL deallocate_field_(field(:,i))
+    END DO
+    !$OMP BARRIER
+    !$OMP MASTER
+    DEALLOCATE(field)
+    !$OMP END MASTER
+    !$OMP BARRIER
+  END SUBROUTINE deallocate_fields
+
+  SUBROUTINE deallocate_field_(field)
+  USE domain_mod
+  USE omp_para
+  IMPLICIT NONE
+    TYPE(t_field) :: field(:)
+    INTEGER :: data_type
+    INTEGER :: ind
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
+
+      data_type=field(ind)%data_type
+        
+      IF (field(ind)%ndim==4) THEN
+        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival4d)
+        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval4d)
+        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval4d)
+      ELSE IF (field(ind)%ndim==3) THEN
+        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival3d)
+        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval3d)
+        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval3d)
+      ELSE IF (field(ind)%ndim==2) THEN
+        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival2d)
+        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval2d)
+        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval2d)
+      ENDIF
+      
+   ENDDO
+  END SUBROUTINE deallocate_field_
+
+  SUBROUTINE deallocate_field_glo(field)
+  USE domain_mod
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    INTEGER :: data_type
+    INTEGER :: ind
+
+    DO ind=1,ndomain_glo
+
+      data_type=field(ind)%data_type
+        
+      IF (field(ind)%ndim==4) THEN
+        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival4d)
+        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval4d)
+        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval4d)
+      ELSE IF (field(ind)%ndim==3) THEN
+        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival3d)
+        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval3d)
+        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval3d)
+      ELSE IF (field(ind)%ndim==2) THEN
+        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival2d)
+        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval2d)
+        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval2d)
+      ENDIF
+      
+   ENDDO
+   DEALLOCATE(field)
+       
+  END SUBROUTINE deallocate_field_glo
+    
+  SUBROUTINE extract_slice(field_in, field_out, l)  
+  USE domain_mod
+  USE omp_para
+  IMPLICIT NONE  
+    TYPE(t_field) :: field_in(:)
+    TYPE(t_field) :: field_out(:)
+    INTEGER,INTENT(IN) :: l
+    
+    INTEGER :: ind
+    INTEGER :: data_type
+
+!$OMP BARRIER
+    DO ind=1,ndomain
+      data_type=field_in(ind)%data_type
+      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
+      
+      IF (field_in(ind)%ndim==3 .AND. field_out(ind)%ndim==2) THEN  
+        IF (data_type==type_integer)  field_out(ind)%ival2d=field_in(ind)%ival3d(:,l)
+        IF (data_type==type_real)     field_out(ind)%rval2d=field_in(ind)%rval3d(:,l)
+        IF (data_type==type_logical)  field_out(ind)%lval2d=field_in(ind)%lval3d(:,l)
+      ELSE IF  (field_in(ind)%ndim==4 .AND. field_out(ind)%ndim==3) THEN
+        IF (data_type==type_integer)  field_out(ind)%ival3d=field_in(ind)%ival4d(:,:,l)
+        IF (data_type==type_real)     field_out(ind)%rval3d=field_in(ind)%rval4d(:,:,l)
+        IF (data_type==type_logical)  field_out(ind)%lval3d=field_in(ind)%lval4d(:,:,l)
+      ELSE
+        PRINT *, 'extract_slice : cannot extract slice, dimension incompatible'
+        STOP       
+      ENDIF
+   ENDDO 
+!$OMP BARRIER    
+  END  SUBROUTINE extract_slice  
+  
+  
+  SUBROUTINE insert_slice(field_in, field_out, l)  
+  USE domain_mod
+  USE omp_para
+  IMPLICIT NONE  
+    TYPE(t_field) :: field_in(:)
+    TYPE(t_field) :: field_out(:)
+    INTEGER,INTENT(IN) :: l
+    
+    INTEGER :: ind
+    INTEGER :: data_type
+
+!$OMP BARRIER
+    DO ind=1,ndomain
+      data_type=field_in(ind)%data_type
+      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
+      
+      IF (field_in(ind)%ndim==2 .AND. field_out(ind)%ndim==3) THEN  
+        IF (data_type==type_integer)  field_out(ind)%ival3d(:,l)=field_in(ind)%ival2d(:)
+        IF (data_type==type_real)     field_out(ind)%rval3d(:,l)=field_in(ind)%rval2d(:)
+        IF (data_type==type_logical)  field_out(ind)%lval3d(:,l)=field_in(ind)%lval2d(:)
+      ELSE IF  (field_in(ind)%ndim==4 .AND. field_out(ind)%ndim==3) THEN
+        IF (data_type==type_integer)  field_out(ind)%ival4d(:,:,l)=field_out(ind)%ival3d(:,:)
+        IF (data_type==type_real)     field_out(ind)%rval4d(:,:,l)=field_out(ind)%rval3d(:,:)
+        IF (data_type==type_logical)  field_out(ind)%lval4d(:,:,l)=field_out(ind)%lval3d(:,:)
+      ELSE
+        PRINT *, 'extract_slice : cannot insert slice, dimension incompatible'
+        STOP       
+      ENDIF
+   ENDDO 
+!$OMP BARRIER    
+  
+  END SUBROUTINE insert_slice
+    
+  SUBROUTINE getval_r2d(field_pt,field)
+  IMPLICIT NONE  
+    REAL(rstd),POINTER,INTENT(INOUT) :: field_pt(:)
+    TYPE(t_field),INTENT(IN) :: field
+    
+    IF (field%ndim/=2 .OR. field%data_type/=type_real) THEN
+       PRINT *, 'get_val_r2d : bad pointer assignment with ' // TRIM(field%name) 
+       STOP
+    END IF
+    field_pt=>field%rval2d
+  END SUBROUTINE  getval_r2d
+
+  SUBROUTINE getval_r3d(field_pt,field)
+  IMPLICIT NONE  
+    REAL(rstd),POINTER,INTENT(INOUT) :: field_pt(:,:)
+    TYPE(t_field),INTENT(IN) :: field
+    
+    IF (field%ndim/=3 .OR. field%data_type/=type_real) THEN
+       PRINT *, 'get_val_r3d : bad pointer assignment with ' // TRIM(field%name) 
+       STOP
+!       CALL ABORT
+    END IF
+    field_pt=>field%rval3d
+  END SUBROUTINE  getval_r3d
+
+  SUBROUTINE getval_r4d(field_pt,field)
+  IMPLICIT NONE  
+    REAL(rstd),POINTER,INTENT(INOUT) :: field_pt(:,:,:)
+    TYPE(t_field),INTENT(IN) :: field
+    
+    IF (field%ndim/=4 .OR. field%data_type/=type_real) THEN
+       PRINT *, 'get_val_r4d : bad pointer assignment with ' // TRIM(field%name)
+       STOP
+    END IF
+    field_pt=>field%rval4d
+  END SUBROUTINE  getval_r4d  
+
+  
+  SUBROUTINE getval_i2d(field_pt,field)
+  IMPLICIT NONE  
+    INTEGER,POINTER,INTENT(INOUT) :: field_pt(:)
+    TYPE(t_field),INTENT(IN) :: field
+    
+    IF (field%ndim/=2 .OR. field%data_type/=type_integer) STOP 'get_val_i2d : bad pointer assignment'        
+    field_pt=>field%ival2d
+  END SUBROUTINE  getval_i2d
+
+  SUBROUTINE getval_i3d(field_pt,field)
+  IMPLICIT NONE  
+    INTEGER,POINTER,INTENT(INOUT) :: field_pt(:,:)
+    TYPE(t_field),INTENT(IN) :: field
+    
+    IF (field%ndim/=3 .OR. field%data_type/=type_integer) STOP 'get_val_i3d : bad pointer assignment'        
+    field_pt=>field%ival3d
+  END SUBROUTINE  getval_i3d
+
+  SUBROUTINE getval_i4d(field_pt,field)
+  IMPLICIT NONE  
+    INTEGER,POINTER,INTENT(INOUT) :: field_pt(:,:,:)
+    TYPE(t_field),INTENT(IN) :: field
+    
+    IF (field%ndim/=4 .OR. field%data_type/=type_integer) STOP 'get_val_i4d : bad pointer assignment'        
+    field_pt=>field%ival4d
+  END SUBROUTINE  getval_i4d
+
+  SUBROUTINE getval_l2d(field_pt,field)
+  IMPLICIT NONE  
+    LOGICAL,POINTER,INTENT(INOUT) :: field_pt(:)
+    TYPE(t_field),INTENT(IN) :: field
+    
+    IF (field%ndim/=2 .OR. field%data_type/=type_logical) STOP 'get_val_l2d : bad pointer assignment'        
+    field_pt=>field%lval2d
+  END SUBROUTINE  getval_l2d
+
+  SUBROUTINE getval_l3d(field_pt,field)
+  IMPLICIT NONE  
+    LOGICAL,POINTER,INTENT(INOUT) :: field_pt(:,:)
+    TYPE(t_field),INTENT(IN) :: field
+    
+    IF (field%ndim/=3 .OR. field%data_type/=type_logical) STOP 'get_val_l3d : bad pointer assignment'        
+    field_pt=>field%lval3d
+  END SUBROUTINE  getval_l3d
+
+  SUBROUTINE getval_l4d(field_pt,field)
+  IMPLICIT NONE  
+    LOGICAL,POINTER,INTENT(INOUT) :: field_pt(:,:,:)
+    TYPE(t_field),INTENT(IN) :: field
+    
+    IF (field%ndim/=4 .OR. field%data_type/=type_logical) STOP 'get_val_l4d : bad pointer assignment'        
+    field_pt=>field%lval4d
+  END SUBROUTINE  getval_l4d    
+
+END MODULE field_mod   
Index: codes/icosagcm/devel/src/base/genmod.f90
===================================================================
--- codes/icosagcm/devel/src/base/genmod.f90	(revision 533)
+++ codes/icosagcm/devel/src/base/genmod.f90	(revision 533)
@@ -0,0 +1,5 @@
+MODULE genmod
+  USE prec
+  USE math_const
+  USE earth_const
+END MODULE genmod
Index: codes/icosagcm/devel/src/base/getin.f90
===================================================================
--- codes/icosagcm/devel/src/base/getin.f90	(revision 533)
+++ codes/icosagcm/devel/src/base/getin.f90	(revision 533)
@@ -0,0 +1,78 @@
+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
+  USE mpipara
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: name
+    CHARACTER(LEN=*) :: value
+
+!$OMP MASTER    
+    CALL getin_(name,value)
+    IF(is_mpi_root) PRINT *,'GETIN ',TRIM(name),' = ', TRIM(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
+  USE mpipara
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: name
+    LOGICAL          :: value
+
+!$OMP MASTER    
+    CALL getin_(name,value)
+    IF(is_mpi_root) PRINT *,'GETIN ',TRIM(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
+  USE mpipara
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: name
+    INTEGER          :: value
+
+!$OMP MASTER    
+    CALL getin_(name,value)
+    IF(is_mpi_root) PRINT *,'GETIN ',TRIM(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 mpipara
+  USE transfert_omp_mod
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: name
+    REAL             :: value
+
+!$OMP MASTER    
+    CALL getin_(name,value)
+    IF(is_mpi_root) PRINT *,'GETIN ',TRIM(name), ' = ', value
+!$OMP END MASTER
+    IF (omp_in_parallel()) CALL bcast_omp(value)
+  END SUBROUTINE getin_r
+ 
+END MODULE getin_mod
Index: codes/icosagcm/devel/src/base/grid_param.f90
===================================================================
--- codes/icosagcm/devel/src/base/grid_param.f90	(revision 533)
+++ codes/icosagcm/devel/src/base/grid_param.f90	(revision 533)
@@ -0,0 +1,29 @@
+MODULE grid_param
+  INTEGER  :: iim_glo=40
+  INTEGER  :: jjm_glo
+  INTEGER,PARAMETER  :: nb_face=10
+  INTEGER  :: llm=19
+  INTEGER  :: nqtot ! number of tracers handled by advection scheme
+  INTEGER  :: nqdyn ! number of dynamical tracers : 1 if dry, more if moist
+
+CONTAINS
+
+  SUBROUTINE init_grid_param(is_mpi_root)
+    USE ioipsl
+    IMPLICIT NONE
+    LOGICAL :: is_mpi_root
+    CALL getin('nbp',iim_glo)
+    jjm_glo=iim_glo
+    CALL getin('llm',llm)
+    nqtot=1
+    CALL getin('nqtot',nqtot)
+    IF(is_mpi_root) THEN
+       PRINT *, 'GETIN nbp = ',iim_glo
+       PRINT *, 'GETIN llm = ',llm
+       PRINT *, 'GETIN nqtot = ',nqtot
+    END IF
+    
+  END SUBROUTINE  init_grid_param
+
+END MODULE grid_param
+    
Index: codes/icosagcm/devel/src/base/math_const.f90
===================================================================
--- codes/icosagcm/devel/src/base/math_const.f90	(revision 533)
+++ codes/icosagcm/devel/src/base/math_const.f90	(revision 533)
@@ -0,0 +1,7 @@
+MODULE math_const
+  USE PREC
+  
+  REAL(rstd),PARAMETER :: Pi=acos(-1._rstd)
+  COMPLEX(cstd), PARAMETER :: Imag=(0,1)
+  
+END MODULE math_const
Index: codes/icosagcm/devel/src/base/prec.f90
===================================================================
--- codes/icosagcm/devel/src/base/prec.f90	(revision 533)
+++ codes/icosagcm/devel/src/base/prec.f90	(revision 533)
@@ -0,0 +1,14 @@
+MODULE prec
+  INTEGER, PARAMETER :: i4=selected_int_kind(10)
+  INTEGER, PARAMETER :: i8=selected_int_kind(18)
+  INTEGER, PARAMETER :: r4=selected_real_kind(7)
+  INTEGER, PARAMETER :: r8=selected_real_kind(15)
+  INTEGER, PARAMETER :: c4=r4
+  INTEGER, PARAMETER :: c8=r8
+  INTEGER, PARAMETER :: istd=i4
+  INTEGER, PARAMETER :: rstd=r8
+  INTEGER, PARAMETER :: cstd=c8
+END MODULE prec
+  
+ 
+  
Index: codes/icosagcm/devel/src/base/trace.F90
===================================================================
--- codes/icosagcm/devel/src/base/trace.F90	(revision 533)
+++ codes/icosagcm/devel/src/base/trace.F90	(revision 533)
@@ -0,0 +1,129 @@
+MODULE trace
+
+  INTEGER,SAVE :: markId
+  
+CONTAINS
+
+  SUBROUTINE init_trace
+  IMPLICIT NONE
+#ifdef VTRACE
+#include <vt_user.inc>
+#endif 
+
+#ifdef VTRACE
+     VT_MARKER_DEF("marker", VT_MARKER_TYPE_HINT, markId)
+#endif
+  
+  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
+    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_start    
+
+
+  SUBROUTINE trace_end(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_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
+  CHARACTER(LEN=*),INTENT(IN) :: name
+#ifdef VTRACE
+#include <vt_user.inc>
+#endif 
+
+!$OMP MASTER
+#ifdef VTRACE
+     VT_MARKER(markId,name)
+#endif
+!$OMP END MASTER
+
+  END SUBROUTINE Marker
+
+END MODULE trace
Index: codes/icosagcm/devel/src/check_conserve.f90
===================================================================
--- codes/icosagcm/devel/src/check_conserve.f90	(revision 531)
+++ 	(revision )
@@ -1,418 +1,0 @@
-MODULE check_conserve_mod
-  USE icosa 
-  IMPLICIT NONE 
-
-  PRIVATE
-  
-  INTEGER, PARAMETER, PUBLIC :: check_basic=1, check_detailed=2, &
-       AAM_dissip=1, AAM_dyn=2, AAM_phys=3
-  INTEGER, SAVE :: check_type
-
-  TYPE(t_field),POINTER,SAVE :: f_pk(:), f_pks(:), f_p(:)
-  TYPE(t_field),POINTER,SAVE :: f_vort(:)
-  TYPE(t_field),POINTER,SAVE :: f_rhodz(:) 
-  
-  REAL(rstd),SAVE :: AAM_mass, AAM_mass_old, AAM_vel, AAM_vel_old, &
-       AAM_mass_source(3), AAM_vel_source(3) ! read/written only IF is_master
-  REAL(rstd),SAVE :: mtot0,ztot0,etot0,angtot0,stot0,rmsvtot0
-  !$OMP THREADPRIVATE(check_type, mtot0,ztot0,etot0,angtot0,stot0,rmsvtot0)
-  
-  PUBLIC :: init_check_conserve, check_conserve_detailed, check_conserve
-CONTAINS 
-
-!---------------------------------------------------------------------
-
-  SUBROUTINE init_check_conserve
-    USE getin_mod
-    USE omp_para, ONLY : is_master
-    CHARACTER(LEN=255) :: check_type_str
-    CALL allocate_field(f_pk,field_t,type_real,llm)
-    CALL allocate_field(f_p,field_t,type_real,llm+1)
-    CALL allocate_field(f_pks,field_t,type_real)
-    CALL allocate_field(f_rhodz,field_t,type_real,llm)
-    CALL allocate_field(f_vort,field_z,type_real,llm)
-    
-    check_type_str='basic'
-    CALL getin("check_conservation",check_type_str)
-    SELECT CASE(TRIM(check_type_str))
-    CASE('basic')
-       check_type=check_basic
-    CASE('detailed')
-       check_type=check_detailed
-    CASE DEFAULT
-       IF(is_master) PRINT*,'Bad selector <', TRIM(check_type_str), &
-            '> for variable check_conservation : options are <basic>, <detailed>'
-       STOP
-    END SELECT
-  END SUBROUTINE init_check_conserve
-
-!--------------------------------- Basic check --------------------------------
-
-  SUBROUTINE check_conserve(f_ps,f_dps,f_ue,f_theta_rhodz,f_phis,it) 
-  USE pression_mod
-  USE vorticity_mod
-  USE caldyn_gcm_mod
-  USE exner_mod 
-!  USE mpipara, ONLY : is_mpi_master, comm_icosa
-  USE omp_para, ONLY : is_master
-    TYPE(t_field),POINTER :: f_ps(:)
-    TYPE(t_field),POINTER :: f_dps(:)
-    TYPE(t_field),POINTER :: f_ue(:)
-    TYPE(t_field),POINTER :: f_theta_rhodz(:)
-    TYPE(t_field),POINTER :: f_phis(:)
-    INTEGER, INTENT(IN) :: it
-
-    REAL(rstd),POINTER :: p(:,:),rhodz(:,:) 
-    INTEGER :: ind,ierr
-    REAL(rstd) :: mtot, angtot, rmsdpdt
-    REAL(rstd) :: etot, stot, ang_mass, ang_vel, rmsvtot, ztot
-
-    CALL transfert_request(f_ue,req_e1_vect)
-    CALL pression(f_ps,f_p)
-
-    DO ind=1,ndomain 
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      p=f_p(ind) 
-      rhodz=f_rhodz(ind)
-      CALL compute_rhodz(p,rhodz) 
-    END DO
-
-    CALL vorticity(f_ue,f_vort)
-    CALL check_mass_conserve(f_ps,f_dps,mtot,rmsdpdt)
-    CALL check_PV(ztot) 
-    CALL exner(f_ps,f_p,f_pks,f_pk)
-    CALL check_energy(f_ue,f_theta_rhodz,f_phis, etot, stot, ang_mass, ang_vel, rmsvtot) 
-
-    IF (is_master) THEN ! is_master = is_omp_master && is_mpi_master
-       ! AAM_mass and AAM_vel must be read/written only IF is_master
-       AAM_mass = ang_mass
-       AAM_vel = ang_vel
-       angtot  = ang_mass + ang_vel
-       IF ( it == itau0  ) THEN 
-          ztot0 = ztot
-          mtot0 = mtot
-          etot0 = etot 
-          angtot0  = angtot
-          stot0 = stot 
-          AAM_mass_old=AAM_mass
-          AAM_vel_old=AAM_vel
-          AAM_mass_source=0.
-          AAM_vel_source=0.
-       END IF
-       rmsvtot=SQRT(rmsvtot/mtot) 
-       ztot=ztot/ztot0-1. ; mtot=mtot/mtot0-1. 
-       etot=etot/etot0-1. ; angtot=angtot/angtot0-1. ; stot=stot/stot0-1. 
-       rmsdpdt= daysec*1.e-2*sqrt(rmsdpdt/ncell_glo)  
-       
-       OPEN(134,file="checkconsicosa.txt",position='append')
-       WRITE(134,4000)mtot,rmsdpdt,etot,ztot,stot,rmsvtot,angtot
-       WRITE(134,*)mtot,rmsdpdt,etot,ztot,stot,rmsvtot,angtot 
-       WRITE(134,*)"=================================================="
-       WRITE(*,4000)mtot,rmsdpdt,etot,ztot,stot,rmsvtot,angtot
-       
-4000   FORMAT(10x,'masse',5x,'rmsdpdt',5x,'energie',5x,'enstrophie'  &
-            ,5x,'entropie',5x,'rmsv',5x,'mt.ang',/,'GLOB  '          &
-            ,e10.3,e13.6,5e13.3/)     
-       CLOSE(134)
-
-       IF(check_type == check_detailed) THEN
-          !ang_mass = AAM_mass-AAM_mass_old 
-          !WRITE(*,'(A,3E12.4)') 'AAM_mass sanity check', SUM(AAM_mass_source), ang_mass, SUM(AAM_mass_source)-ang_mass
-          !ang_vel = AAM_vel-AAM_vel_old 
-          !WRITE(*,'(A,3E12.4)') 'AAM_vel  sanity check', SUM(AAM_vel_source), ang_vel, SUM(AAM_vel_source)-ang_vel
-          WRITE(*,'(A,6E12.4)') 'AAM_mass : time,old,new,dissip,dyn,phys', dt*it, AAM_mass_old, AAM_mass, &
-               AAM_mass_source(AAM_dissip), AAM_mass_source(AAM_dyn), AAM_mass_source(AAM_phys)
-          WRITE(*,'(A,6E12.4)') 'AAM_vel  : time,old,new,dissip,dyn,phys', dt*it, AAM_vel_old, AAM_vel, &
-               AAM_vel_source(AAM_dissip), AAM_vel_source(AAM_dyn), AAM_vel_source(AAM_phys)
-          AAM_mass_old=AAM_mass
-          AAM_vel_old=AAM_vel
-          AAM_mass_source=0.
-          AAM_vel_source=0.
-       END IF
-    END IF
-
-  END SUBROUTINE check_conserve
-
-!------------------------ Detailed check (Lauritzen et al., 2014) -----------------------------
-
-  SUBROUTINE check_conserve_detailed(it,tag, f_ps,f_dps,f_ue,f_theta_rhodz,f_phis) 
-    USE pression_mod
-    USE vorticity_mod
-    USE caldyn_gcm_mod
-    USE exner_mod 
-!    USE mpipara, ONLY : is_mpi_root, comm_icosa
-    USE omp_para, ONLY : is_master
-    INTEGER, INTENT(IN) :: tag
-    TYPE(t_field),POINTER :: f_ps(:)
-    TYPE(t_field),POINTER :: f_dps(:)
-    TYPE(t_field),POINTER :: f_ue(:)
-    TYPE(t_field),POINTER :: f_theta_rhodz(:)
-    TYPE(t_field),POINTER :: f_phis(:)
-    INTEGER, INTENT(IN) ::it
-
-    REAL(rstd),POINTER :: p(:,:),rhodz(:,:) 
-    INTEGER::ind,ierr
-    REAL(rstd) :: mtot, ztot, rmsdpdt, etot,stot,rmsv, ang_mass, ang_vel
-    
-    IF(check_type == check_detailed) THEN
-
-       CALL transfert_request(f_ue,req_e1_vect)
-       CALL pression(f_ps,f_p)
-       DO ind=1,ndomain 
-          IF (.NOT. assigned_domain(ind)) CYCLE
-          CALL swap_dimensions(ind)
-          CALL swap_geometry(ind)
-          p=f_p(ind) 
-          rhodz=f_rhodz(ind)
-          CALL compute_rhodz(p,rhodz) 
-       END DO
-       CALL exner(f_ps,f_p,f_pks,f_pk)
-       CALL check_energy(f_ue,f_theta_rhodz,f_phis, etot, stot, ang_mass, ang_vel, rmsv) 
-       
-       IF (is_master) THEN
-          ! XXX=mass,vel
-          ! AAM_XXX = value of total AAM_XXX at last check
-          ! ang_XXX = value of total AAM_XXX now
-          ! AAM_XXX_source(tag) = source of AAA_XXX due to tag=dissip,dyn,phys
-          !WRITE(*,'(A,3E12.2)') 'AAM_mass', tag, ang_mass, AAM_mass, ang_mass-AAM_mass ! FIXME
-          !WRITE(*,'(A,3E12.2)') 'AAM_vel ', tag, ang_vel, AAM_vel, ang_vel-AAM_vel ! FIXME
-          AAM_mass_source(tag) = AAM_mass_source(tag) + ang_mass - AAM_mass
-          AAM_vel_source(tag) = AAM_vel_source(tag) + ang_vel - AAM_vel
-          AAM_mass = ang_mass
-          AAM_vel = ang_vel
-       END IF
-    END IF
-  END SUBROUTINE check_conserve_detailed
- 
-!---------------------------------------------------------------------
-
-  SUBROUTINE global_sum(loc_sum, glob_sum)
-    USE mpi_mod
-    USE mpipara
-    USE transfert_omp_mod
-    REAL(rstd), INTENT(IN) :: loc_sum
-    REAL(rstd), INTENT(OUT) :: glob_sum
-    REAL(rstd) :: sum
-
-    CALL reduce_sum_omp(loc_sum, sum)
-    IF (using_mpi) THEN
-!$OMP MASTER    
-      CALL MPI_REDUCE(sum, glob_sum, 1, MPI_REAL8, MPI_SUM, 0, comm_icosa, ierr)
-!$OMP END MASTER
-    ELSE
-      glob_sum=loc_sum
-    ENDIF
-  END SUBROUTINE global_sum
-
-  SUBROUTINE check_mass_conserve(f_ps,f_dps,mtot,rmsdpdt)
-  USE mpi_mod
-  USE mpipara
-  USE transfert_omp_mod
-  USE omp_para
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_ps(:)
-    TYPE(t_field),POINTER :: f_dps(:)
-    REAL(rstd),POINTER :: ps(:),dps(:) 
-    REAL(rstd), INTENT(OUT) :: mtot, rmsdpdt
-
-    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) .OR. .NOT. is_omp_level_master) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      dps=f_dps(ind) 
-      ps=f_ps(ind)
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          IF (domain(ind)%own(i,j)) THEN
-             mloc=mloc+ps(ij)*Ai(ij)
-             rmsloc=rmsloc+dps(ij)*dps(ij)
-	  ENDIF
-        ENDDO
-      ENDDO
-    ENDDO
-    
-    CALL global_sum(mloc, mtot)
-    CALL global_sum(rmsloc, rmsdpdt)
-  END SUBROUTINE check_mass_conserve
-
-!---------------------------------------------------------------------
-
-  SUBROUTINE check_energy(f_ue,f_theta_rhodz,f_phis, etot, &
-                      stot, AAM_mass_tot, AAM_vel_tot, rmsvtot)  
-  USE pression_mod
-  USE vorticity_mod
-    TYPE(t_field), POINTER :: f_ue(:)
-    TYPE(t_field), POINTER :: f_theta_rhodz(:)
-    TYPE(t_field), POINTER :: f_phis(:)
-    REAL(rstd),INTENT(OUT) :: etot, stot, AAM_mass_tot, AAM_vel_tot, rmsvtot
-    REAL(rstd), POINTER :: ue(:,:)
-    REAL(rstd), POINTER :: p(:,:) 
-    REAL(rstd), POINTER :: theta_rhodz(:,:,:) 
-    REAL(rstd), POINTER :: pk(:,:) 
-    REAL(rstd), POINTER :: phis(:) 
-    REAL(rstd), POINTER :: rhodz(:,:) 
-    REAL(rstd) :: e, s, AAM_mass, AAM_vel, rmsv
-    INTEGER :: ind
-
-    e = 0 ; s = 0 ; AAM_mass = 0 ; AAM_vel=0 ; rmsv = 0
-
-    DO ind=1,ndomain 
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      ue=f_ue(ind) 
-      p=f_p(ind)
-      rhodz=f_rhodz(ind) 
-      theta_rhodz=f_theta_rhodz(ind) 
-      pk=f_pk(ind) 
-      phis=f_phis(ind) 
-      CALL compute_energy(ind,ue,p,rhodz,theta_rhodz(:,:,1),pk,phis, &
-           e, s, AAM_mass, AAM_vel, rmsv)
-    END DO 
-
-    CALL global_sum(e, etot)
-    CALL global_sum(s, stot)
-    CALL global_sum(rmsv, rmsvtot)
-    CALL global_sum(AAM_mass, AAM_mass_tot)
-    CALL global_sum(AAM_vel, AAM_vel_tot)
-  END SUBROUTINE check_energy
-
-  SUBROUTINE compute_energy(ind,u,p,rhodz,theta_rhodz,pk,phis, e, s, AAM_mass, AAM_vel, rmsv)
-    USE disvert_mod
-    USE wind_mod
-    USE omp_para
-    INTEGER,INTENT(IN)::ind 
-    REAL(rstd),INTENT(IN) :: u(3*iim*jjm,llm)
-    REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
-    REAL(rstd),INTENT(IN) :: rhodz(iim*jjm,llm)
-    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
-    REAL(rstd),INTENT(IN) :: pk(iim*jjm,llm)
-    REAL(rstd),INTENT(IN) :: phis(iim*jjm)
-    REAL(rstd),INTENT(INOUT) :: e, s, AAM_mass, AAM_vel, rmsv
-    
-    REAL(rstd) :: ucenter(iim*jjm,3,llm)
-    REAL(rstd) :: ulon(iim*jjm,llm)
-    REAL(rstd) :: ulat(iim*jjm,llm)
-    
-    REAL(rstd) :: mass_ij, theta_ij, KE_ij, rad,radomeg,lat
-    INTEGER :: i,j,ij,l
-    
-    CALL compute_wind_centered(u,ucenter)
-    CALL compute_wind_centered_lonlat_compound(ucenter,ulon,ulat)
-    rad = radius 
-    radomeg = rad*omega
-    
-    DO l = ll_begin,ll_end
-       DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-             ij=(j-1)*iim+i
-             IF (domain(ind)%own(i,j)) THEN
-                lat = lat_i(ij)  
-                mass_ij = rhodz(ij,l)*Ai(ij) 
-                theta_ij = theta_rhodz(ij,l)/rhodz(ij,l)
-                KE_ij = 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 +           &
-                     le(ij+u_left)*de(ij+u_left)*u(ij+u_left,l)**2 +        &
-                     le(ij+u_ldown)*de(ij+u_ldown)*u(ij+u_ldown,l)**2 +     &
-                     le(ij+u_rdown)*de(ij+u_rdown)*u(ij+u_rdown,l)**2 )  
-                rmsv = rmsv + 2*mass_ij*KE_ij
-                s    = s + Ai(ij)*theta_rhodz(ij,l)
-                e    = e + mass_ij*(phis(ij)+theta_ij*pk(ij,l)+KE_ij)
-                AAM_mass = AAM_mass + rad*cos(lat)*mass_ij*radomeg*cos(lat)
-                AAM_vel  = AAM_vel  + rad*cos(lat)*mass_ij*ulon(ij,l)
-             END IF
-          END DO
-       END DO
-    END DO
-    
-  END SUBROUTINE compute_energy
-
-!---------------------------------------------------------------------
-  
-  SUBROUTINE check_PV(ztot)
-    REAL(rstd),INTENT(OUT) :: ztot
-    REAL(rstd), POINTER :: vort(:,:)
-    REAL(rstd), POINTER :: rhodz(:,:) 
-    INTEGER :: ind
-    REAL(rstd) :: z,z_mpi
-    
-    z=0
-    DO ind=1,ndomain 
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       vort=f_vort(ind)
-       rhodz=f_rhodz(ind) 
-       CALL compute_PV(vort,rhodz,z) 
-    ENDDO
-    CALL global_sum(z, ztot)
-  END SUBROUTINE check_PV 
-
-  SUBROUTINE compute_PV(vort,rhodz,z) 
-  USE disvert_mod
-  USE omp_para
-    REAL(rstd),INTENT(IN) :: vort(2*iim*jjm,llm)
-    REAL(rstd),INTENT(IN) :: rhodz(iim*jjm,llm) 
-    REAL(rstd),INTENT(INOUT) :: z
-    REAL(rstd)::qv1,qv2 
-    REAL(rstd)::hv1,hv2  
-    INTEGER :: i,j,ij,l,ij2
-
-    hv1 = 0.0 ; hv2 = 0.0 
-   
-    DO l = ll_begin,ll_end
-      DO j=jj_begin+1,jj_end-1
-        DO i=ii_begin+1,ii_end-1
-          ij=(j-1)*iim+i
-          hv1 =  Riv2(ij,vup)        * rhodz(ij,l)           &
-            + Riv2(ij+t_rup,vldown) * rhodz(ij+t_rup,l)     &
-            + Riv2(ij+t_lup,vrdown) * rhodz(ij+t_lup,l)
-    
-          qv1 = ( vort(ij+z_up,l)+fv(ij+z_up) )/hv1
-          
-          hv2  =  Riv2(ij,vdown)     * rhodz(ij,l)          &
-            + Riv2(ij+t_ldown,vrup) * rhodz(ij+t_ldown,l)  &
-            + Riv2(ij+t_rdown,vlup) * rhodz(ij+t_rdown,l)
-                     
-          qv2 =( vort(ij+z_down,l)+fv(ij+z_down) )/hv2
-
-          z = z + (qv1*qv1*hv1 + qv2*qv2*hv2) 
-
-        ENDDO
-      ENDDO
-      
-    ENDDO
-
-  END SUBROUTINE compute_PV
-!---------------------------------------------------------------------
-
-   SUBROUTINE compute_rhodz(p,rhodz) 
-     REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
-     REAL(rstd),INTENT(OUT):: rhodz(iim*jjm,llm)
-     REAL(rstd) ::mass(iim*jjm,llm)
-     INTEGER :: i,j,ij,l 
-	
-     DO l = 1, llm
-      DO j=jj_begin,jj_end
-       DO i=ii_begin,ii_end
-         ij=(j-1)*iim+i
-         mass(ij,l) = ( p(ij,l) - p(ij,l+1) ) * Ai(ij)/g
-         rhodz(ij,l) = mass(ij,l) / Ai(ij)
-       ENDDO
-      ENDDO
-     ENDDO
-
-   END SUBROUTINE compute_rhodz
-!====================================================================
-
-
- END MODULE check_conserve_mod
Index: codes/icosagcm/devel/src/checksum.f90
===================================================================
--- codes/icosagcm/devel/src/checksum.f90	(revision 531)
+++ 	(revision )
@@ -1,150 +1,0 @@
-MODULE checksum_mod
-
-
-! simple function to perform checksum on T field
-! works only on 1 process
-! usefull to check openMP synchronisation problem
-! need to be enhanced...
-
-CONTAINS
-
-  SUBROUTINE checksum(field)
-  USE icosa
-  USE mpi_mod
-  USE mpipara
-  IMPLICIT NONE
-    TYPE(t_field) :: field(:)
-
-    INTEGER :: intval(2)
-    INTEGER :: ind,i,j,ij,l,k
-    INTEGER :: tot_sum
-    INTEGER :: tot_sum_mpi(mpi_size)
-        
-
-!$OMP BARRIER
-!$OMP MASTER
-    tot_sum=0
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-       
-      IF (field(ind)%field_type==field_T) THEN
-
-        IF (field(ind)%ndim==2) THEN
-          DO j=jj_begin,jj_end
-             DO i=ii_begin,ii_end
-                ij=(j-1)*iim+i
-                IF (domain(ind)%own(i,j)) THEN
-                  intval=transfer(field(ind)%rval2d(ij),intval,2)  
-                  tot_sum=tot_sum+intval(1)+intval(2)
-                ENDIF
-             ENDDO
-          ENDDO
-     
-        ELSE IF (field(ind)%ndim==3) THEN
-          
-          DO l=1,size(field(ind)%rval3d,2)
-            DO j=jj_begin,jj_end
-               DO i=ii_begin,ii_end
-                  ij=(j-1)*iim+i
-                  IF (domain(ind)%own(i,j)) THEN
-                    intval=transfer(field(ind)%rval3d(ij,l),intval,2)  
-                    tot_sum=tot_sum+intval(1)+intval(2)
-                  ENDIF
-               ENDDO
-            ENDDO
-          ENDDO
-
-        ELSE IF (field(ind)%ndim==4) THEN
-          
-          DO k=1,size(field(ind)%rval4d,3)
-            DO l=1,size(field(ind)%rval4d,2)
-              DO j=jj_begin,jj_end
-                 DO i=ii_begin,ii_end
-                    ij=(j-1)*iim+i
-                    IF (domain(ind)%own(i,j)) THEN
-                      intval=transfer(field(ind)%rval4d(ij,l,k),intval,2)  
-                      tot_sum=tot_sum+intval(1)+intval(2)
-                    ENDIF
-                 ENDDO
-              ENDDO
-            ENDDO
-          ENDDO
-       
-        ENDIF
-
-      ELSE IF (field(ind)%field_type==field_U) THEN
-
-        IF (field(ind)%ndim==2) THEN
-          DO j=jj_begin,jj_end
-             DO i=ii_begin,ii_end-1
-                ij=(j-1)*iim+i
-                intval=transfer(field(ind)%rval2d(ij+u_right),intval,2)  
-                tot_sum=tot_sum+intval(1)+intval(2)
-             ENDDO
-          ENDDO
-
-          DO j=jj_begin,jj_end-1
-             DO i=ii_begin+1,ii_end
-                ij=(j-1)*iim+i
-                intval=transfer(field(ind)%rval2d(ij+u_lup),intval,2)  
-                tot_sum=tot_sum+intval(1)+intval(2)
-             ENDDO
-          ENDDO
-    
-          DO j=jj_begin+1,jj_end
-             DO i=ii_begin,ii_end
-                ij=(j-1)*iim+i
-                intval=transfer(field(ind)%rval2d(ij+u_ldown),intval,2)  
-                tot_sum=tot_sum+intval(1)+intval(2)
-             ENDDO
-          ENDDO
-
-        ELSE IF (field(ind)%ndim==3) THEN
-          
-          DO l=1,size(field(ind)%rval3d,2)
-          DO j=jj_begin,jj_end
-             DO i=ii_begin,ii_end-1
-                ij=(j-1)*iim+i
-                intval=transfer(field(ind)%rval3d(ij+u_right,l),intval,2)  
-                tot_sum=tot_sum+intval(1)+intval(2)
-             ENDDO
-          ENDDO
-
-          DO j=jj_begin,jj_end-1
-             DO i=ii_begin+1,ii_end
-                ij=(j-1)*iim+i
-                intval=transfer(field(ind)%rval3d(ij+u_lup,l),intval,2)  
-                tot_sum=tot_sum+intval(1)+intval(2)
-             ENDDO
-          ENDDO
-    
-          DO j=jj_begin+1,jj_end
-             DO i=ii_begin,ii_end
-                ij=(j-1)*iim+i
-                intval=transfer(field(ind)%rval3d(ij+u_ldown,l),intval,2)  
-                tot_sum=tot_sum+intval(1)+intval(2)
-             ENDDO
-          ENDDO
-          ENDDO
-
-        
-        ENDIF
-     ENDIF
-
-    ENDDO
-!$OMP END MASTER
-!$OMP BARRIER    
-    
-!$OMP MASTER
-    CALL MPI_Gather(tot_sum,1,MPI_INTEGER,tot_sum_mpi,1,MPI_INTEGER,0,comm_icosa,ierr)
-    IF (mpi_rank==0) PRINT*,"CheckSum Field : ",field(1)%name,sum(tot_sum_mpi), tot_sum_mpi
-    
-!$OMP END MASTER
-  
-  
-  
-  END SUBROUTINE checksum
-  
-END MODULE checksum_mod
-  
Index: codes/icosagcm/devel/src/dcmip/guided_ncar_mod.f90
===================================================================
--- codes/icosagcm/devel/src/dcmip/guided_ncar_mod.f90	(revision 533)
+++ codes/icosagcm/devel/src/dcmip/guided_ncar_mod.f90	(revision 533)
@@ -0,0 +1,164 @@
+MODULE guided_ncar_mod
+  USE icosa
+  PRIVATE
+  
+  INTEGER,SAVE :: case_wind
+!$OMP THREADPRIVATE(case_wind)
+  
+  REAL(rstd), PARAMETER :: alpha=0.0 ! tilt of solid-body rotation
+  REAL(rstd), PARAMETER :: tau_hadley=daysec, tau = 12*daysec ! 12 days               ! see p. 16
+  REAL(rstd), PARAMETER :: w0_deform = 23000*pi/tau, b=0.2, ptop=25494.4  ! see p. 16 
+  REAL(rstd), PARAMETER :: u0_hadley=40.,w0_hadley=0.15 ,ztop= 12000. 
+  INTEGER, PARAMETER    :: K_hadley=5
+
+  PUBLIC init_guided, guided
+
+CONTAINS
+
+  SUBROUTINE init_guided
+    IMPLICIT NONE
+    CHARACTER(LEN=255) :: wind
+    wind='deform'
+    CALL getin('dcmip1_wind',wind)
+    SELECT CASE(TRIM(wind))
+    CASE('solid')
+       case_wind=0
+    CASE('deform')
+       case_wind=1
+    CASE('hadley')
+       case_wind=2
+    CASE DEFAULT
+       PRINT*,'Bad selector for variable ncar_adv_wind : <', TRIM(wind),'> options are <solid>, <deform>, <hadley>'
+       END SELECT
+  END SUBROUTINE init_guided
+  
+  SUBROUTINE guided(tt, f_ps, f_theta_rhodz, f_u, f_q)
+  USE icosa
+    IMPLICIT NONE
+    REAL(rstd), INTENT(IN):: tt
+    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(:)  
+    
+    REAL(rstd),POINTER :: ue(:,:)
+    INTEGER :: ind
+    
+    DO ind = 1 , ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind) 
+      ue = f_u(ind)  
+      CALL wind_profile(tt,ue)
+    END DO    
+
+  END SUBROUTINE guided
+  
+
+  SUBROUTINE wind_profile(tt,ue)
+    USE icosa
+    USE disvert_mod
+    IMPLICIT NONE
+    REAL(rstd),INTENT(IN)  :: tt ! current time 
+    REAL(rstd),INTENT(OUT) :: ue(iim*3*jjm,llm)
+    REAL(rstd) :: lon, lat
+    REAL(rstd) :: nx(3),n_norm,Velocity(3,llm)
+    REAL(rstd) :: rr1,rr2,bb,cc,aa,hmx
+    REAL(rstd) :: v1(3),v2(3),ny(3)
+    INTEGER :: i,j,n,l
+    REAL(rstd) :: pitbytau,kk, pr, zr, u0, u1, v0
+
+    pitbytau = pi*tt/tau
+    kk = 10*radius/tau
+    u0 = 2*pi*radius/tau ! for solid-body rotation
+!---------------------------------------------------------
+    DO l = 1,llm 
+       pr = presnivs(l)
+       zr = -kappa*cpp*ncar_T0/g*log(pr/ncar_p0)  ! reciprocal of (1) p. 13, isothermal atmosphere
+       u1 = w0_deform*radius/b/ptop*cos(2*pitbytau)*(exp((ptop-pr)/b/ptop)-exp((pr-ncar_p0)/b/ptop))
+       v0 = -radius*w0_hadley*pi/(5.0*ztop)*(ncar_p0/pr)*cos(pi*zr/ztop)*cos(pi*tt/tau_hadley) ! for Hadley cell
+
+       DO j=jj_begin-1,jj_end+1
+          DO i=ii_begin-1,ii_end+1
+             n=(j-1)*iim+i
+             CALL compute_velocity(xyz_e(n+u_right,:),l,velocity(:,l))
+             CALL cross_product2(xyz_v(n+z_rdown,:)/radius,xyz_v(n+z_rup,:)/radius,nx)       
+             ue(n+u_right,l)=1e-10
+             n_norm=sqrt(sum(nx(:)**2))
+             IF (n_norm>1e-30) THEN
+                nx=-nx/n_norm*ne(n,right)
+                ue(n+u_right,l)=sum(nx(:)*velocity(:,l))
+                IF (ABS(ue(n+u_right,l))<1e-100) PRINT *,"ue(n+u_right)==0",i,j,velocity(:,1)
+             ENDIF
+             
+             CALL compute_velocity(xyz_e(n+u_lup,:),l,velocity(:,l))
+             CALL cross_product2(xyz_v(n+z_up,:)/radius,xyz_v(n+z_lup,:)/radius,nx)
+             
+             ue(n+u_lup,l)=1e-10
+             n_norm=sqrt(sum(nx(:)**2))
+             IF (n_norm>1e-30) THEN
+                nx=-nx/n_norm*ne(n,lup)
+                ue(n+u_lup,l)=sum(nx(:)*velocity(:,l))
+             ENDIF
+             
+             CALL compute_velocity(xyz_e(n+u_ldown,:),l,velocity(:,l))
+             CALL cross_product2(xyz_v(n+z_ldown,:)/radius,xyz_v(n+z_down,:)/radius,nx)
+             
+             ue(n+u_ldown,l)=1e-10
+             n_norm=sqrt(sum(nx(:)**2))
+             IF (n_norm>1e-30) THEN
+                nx=-nx/n_norm*ne(n,ldown)
+                ue(n+u_ldown,l)=sum(nx(:)*velocity(:,l))
+                IF (ABS(ue(n+u_ldown,l))<1e-100) PRINT *,"ue(n+u_ldown)==0",i,j
+             ENDIF
+          ENDDO
+       ENDDO
+    END DO
+    
+  CONTAINS
+	   
+    SUBROUTINE compute_velocity(x,l,velocity)
+      IMPLICIT NONE
+      REAL(rstd),INTENT(IN)  :: x(3)
+      INTEGER,INTENT(IN)::l
+      REAL(rstd),INTENT(OUT) :: velocity(3)
+      REAL(rstd) :: e_lat(3), e_lon(3)
+      REAL(rstd) :: lon,lat
+      REAL(rstd) :: u,v
+	      
+      CALL xyz2lonlat(x/radius,lon,lat)
+      e_lat(1) = -cos(lon)*sin(lat)
+      e_lat(2) = -sin(lon)*sin(lat)
+      e_lat(3) = cos(lat)
+        
+      e_lon(1) = -sin(lon)
+      e_lon(2) = cos(lon)
+      e_lon(3) = 0
+
+      u = 0.0 ; v = 0.0
+    
+      SELECT CASE(case_wind) 
+      CASE(0)  ! Solid-body rotation
+         u=u0*(cos(lat)*cos(alpha)+sin(lat)*sin(alpha)*cos(lon))
+         v=-u0*sin(lon)*sin(alpha)
+      CASE(1)  ! 3D Deformational flow - 
+         lon = lon-2*pitbytau
+         u = kk*sin(lon)*sin(lon)*sin(2*lat)*cos(pitbytau)+ u0*cos(lat)
+         u = u + u1*cos(lon)*cos(lat)**2
+         v = kk*sin(2*lon)*cos(lat)*cos(pitbytau) 
+      CASE(2) ! Hadley-like flow
+         u = u0_hadley*cos(lat)
+         v = v0*cos(lat)*sin(5.*lat)    ! Eq. 37 p. 19
+      CASE DEFAULT 
+         PRINT*,"not valid choice of wind" 
+      END SELECT
+      
+      Velocity(:)=(u*e_lon(:)+v*e_lat(:)+1e-50)
+      
+    END SUBROUTINE compute_velocity
+    
+  END SUBROUTINE  wind_profile
+
+
+END MODULE guided_ncar_mod
Index: codes/icosagcm/devel/src/dcmip/terminator.f90
===================================================================
--- codes/icosagcm/devel/src/dcmip/terminator.f90	(revision 533)
+++ codes/icosagcm/devel/src/dcmip/terminator.f90	(revision 533)
@@ -0,0 +1,124 @@
+!================================================================================================
+! This is the "toy" chemistry module.
+!================================================================================================
+
+MODULE Terminator
+
+implicit none
+private
+save
+
+public :: initial_value_Terminator       ! initialize cl and cl2
+public :: tendency_Terminator             ! interface to tendency computation
+
+!integer, parameter :: 8 = selected_real_kind (12)
+
+real(8), parameter :: cly_constant = 4.e-6_8
+real(8), parameter :: pi = 3.1415926535897932384626433832795028841971693993751058209749445923078164_8
+real(8), parameter :: half_pi = pi*0.5_8
+real(8), parameter :: degrees_to_radians = pi/180.0_8
+real(8), parameter :: k1_lat_center =   20.d0*degrees_to_radians
+real(8), parameter :: k1_lon_center =  300.d0*degrees_to_radians
+
+contains
+
+!===============================================================================
+!  Solar photolysis rate and recombination rate
+!===============================================================================
+
+subroutine k_vals( lat, lon, k1, k2 )
+
+!-----------------------------------------------------------------------
+! Arguments:
+!-----------------------------------------------------------------------
+real(8), intent(in)    :: lat, lon  ! latitude and longitude, radians
+real(8), intent(out)   :: k1, k2    ! reaction rates
+
+k1 = 1.0_8*max(0.d0,sin(lat)*sin(k1_lat_center) + cos(lat)*cos(k1_lat_center)*cos(lon-k1_lon_center))
+k2 = 1._8
+
+return
+
+end subroutine k_vals
+
+!===============================================================================
+!  Tendencies of cl and cl2
+!===============================================================================
+
+subroutine tendency_Terminator( lat, lon, cl, cl2, dt, cl_f, cl2_f )
+
+!-----------------------------------------------------------------------
+! Arguments:
+!-----------------------------------------------------------------------
+
+real(8), intent(in)    :: lat, lon  ! latitude and longitude, degrees
+real(8), intent(in)    :: cl, cl2   ! molar mixing ratio of cl and cl2
+real(8), intent(in)    :: dt        ! size of physics time step
+
+real(8), intent(out)   :: cl_f, cl2_f  ! time rate of change of cl and cl2
+
+!-----------------------------------------------------------------------
+! Local variables
+!-----------------------------------------------------------------------
+
+real(8) :: r, det, expdt, el ! useful algebaic quantities used in the computation
+real(8) :: k1, k2            ! reaction rates
+real(8) :: cly               ! quantity that should be conseved
+
+call k_vals( lat, lon, k1, k2 )
+
+r = k1 / (4._8*k2)
+cly = cl + 2._8* cl2
+
+det = sqrt( r*r + 2._8*r*cly )
+expdt = exp( -4._8*k2*det*dt )
+
+if ( abs(det * k2 * dt) .gt. 1e-16 ) then
+el = (1._8 - expdt) /det /dt
+else
+el = 4._8*k2
+endif
+
+cl_f  = -el * (cl - det + r)*(cl + det + r) / (1._8 + expdt + dt*el*(cl + r))
+cl2_f = -cl_f / 2._8
+
+return
+
+end subroutine tendency_Terminator
+
+!===============================================================================
+!  Compute initial values
+!===============================================================================
+
+subroutine initial_value_Terminator( lat, lon, cl, cl2 )
+
+!-----------------------------------------------------------------------
+! Arguments:
+!-----------------------------------------------------------------------
+
+real(8), intent(in)  :: lat, lon  ! latitude and longitude, degrees
+real(8), intent(out) :: cl, cl2   ! molar mixing ratio of cl and cl2
+
+!-----------------------------------------------------------------------
+! Local variables
+!-----------------------------------------------------------------------
+
+real(8) :: r, det  ! useful algebraic forms
+real(8) :: k1, k2  ! reaction rates
+
+call k_vals( lat, lon, k1, k2 )
+
+r = k1 / (4._8*k2)
+det = sqrt(r*r + 2._8*cly_constant*r)
+
+cl  = (det-r)
+cl2 = cly_constant/2._8 - (det-r)/2._8
+
+return
+
+end subroutine initial_value_Terminator
+
+end module Terminator
+
+
+
Index: codes/icosagcm/devel/src/diagnostics/check_conserve.f90
===================================================================
--- codes/icosagcm/devel/src/diagnostics/check_conserve.f90	(revision 533)
+++ codes/icosagcm/devel/src/diagnostics/check_conserve.f90	(revision 533)
@@ -0,0 +1,418 @@
+MODULE check_conserve_mod
+  USE icosa 
+  IMPLICIT NONE 
+
+  PRIVATE
+  
+  INTEGER, PARAMETER, PUBLIC :: check_basic=1, check_detailed=2, &
+       AAM_dissip=1, AAM_dyn=2, AAM_phys=3
+  INTEGER, SAVE :: check_type
+
+  TYPE(t_field),POINTER,SAVE :: f_pk(:), f_pks(:), f_p(:)
+  TYPE(t_field),POINTER,SAVE :: f_vort(:)
+  TYPE(t_field),POINTER,SAVE :: f_rhodz(:) 
+  
+  REAL(rstd),SAVE :: AAM_mass, AAM_mass_old, AAM_vel, AAM_vel_old, &
+       AAM_mass_source(3), AAM_vel_source(3) ! read/written only IF is_master
+  REAL(rstd),SAVE :: mtot0,ztot0,etot0,angtot0,stot0,rmsvtot0
+  !$OMP THREADPRIVATE(check_type, mtot0,ztot0,etot0,angtot0,stot0,rmsvtot0)
+  
+  PUBLIC :: init_check_conserve, check_conserve_detailed, check_conserve
+CONTAINS 
+
+!---------------------------------------------------------------------
+
+  SUBROUTINE init_check_conserve
+    USE getin_mod
+    USE omp_para, ONLY : is_master
+    CHARACTER(LEN=255) :: check_type_str
+    CALL allocate_field(f_pk,field_t,type_real,llm)
+    CALL allocate_field(f_p,field_t,type_real,llm+1)
+    CALL allocate_field(f_pks,field_t,type_real)
+    CALL allocate_field(f_rhodz,field_t,type_real,llm)
+    CALL allocate_field(f_vort,field_z,type_real,llm)
+    
+    check_type_str='basic'
+    CALL getin("check_conservation",check_type_str)
+    SELECT CASE(TRIM(check_type_str))
+    CASE('basic')
+       check_type=check_basic
+    CASE('detailed')
+       check_type=check_detailed
+    CASE DEFAULT
+       IF(is_master) PRINT*,'Bad selector <', TRIM(check_type_str), &
+            '> for variable check_conservation : options are <basic>, <detailed>'
+       STOP
+    END SELECT
+  END SUBROUTINE init_check_conserve
+
+!--------------------------------- Basic check --------------------------------
+
+  SUBROUTINE check_conserve(f_ps,f_dps,f_ue,f_theta_rhodz,f_phis,it) 
+  USE pression_mod
+  USE vorticity_mod
+  USE caldyn_gcm_mod
+  USE exner_mod 
+!  USE mpipara, ONLY : is_mpi_master, comm_icosa
+  USE omp_para, ONLY : is_master
+    TYPE(t_field),POINTER :: f_ps(:)
+    TYPE(t_field),POINTER :: f_dps(:)
+    TYPE(t_field),POINTER :: f_ue(:)
+    TYPE(t_field),POINTER :: f_theta_rhodz(:)
+    TYPE(t_field),POINTER :: f_phis(:)
+    INTEGER, INTENT(IN) :: it
+
+    REAL(rstd),POINTER :: p(:,:),rhodz(:,:) 
+    INTEGER :: ind,ierr
+    REAL(rstd) :: mtot, angtot, rmsdpdt
+    REAL(rstd) :: etot, stot, ang_mass, ang_vel, rmsvtot, ztot
+
+    CALL transfert_request(f_ue,req_e1_vect)
+    CALL pression(f_ps,f_p)
+
+    DO ind=1,ndomain 
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      p=f_p(ind) 
+      rhodz=f_rhodz(ind)
+      CALL compute_rhodz(p,rhodz) 
+    END DO
+
+    CALL vorticity(f_ue,f_vort)
+    CALL check_mass_conserve(f_ps,f_dps,mtot,rmsdpdt)
+    CALL check_PV(ztot) 
+    CALL exner(f_ps,f_p,f_pks,f_pk)
+    CALL check_energy(f_ue,f_theta_rhodz,f_phis, etot, stot, ang_mass, ang_vel, rmsvtot) 
+
+    IF (is_master) THEN ! is_master = is_omp_master && is_mpi_master
+       ! AAM_mass and AAM_vel must be read/written only IF is_master
+       AAM_mass = ang_mass
+       AAM_vel = ang_vel
+       angtot  = ang_mass + ang_vel
+       IF ( it == itau0  ) THEN 
+          ztot0 = ztot
+          mtot0 = mtot
+          etot0 = etot 
+          angtot0  = angtot
+          stot0 = stot 
+          AAM_mass_old=AAM_mass
+          AAM_vel_old=AAM_vel
+          AAM_mass_source=0.
+          AAM_vel_source=0.
+       END IF
+       rmsvtot=SQRT(rmsvtot/mtot) 
+       ztot=ztot/ztot0-1. ; mtot=mtot/mtot0-1. 
+       etot=etot/etot0-1. ; angtot=angtot/angtot0-1. ; stot=stot/stot0-1. 
+       rmsdpdt= daysec*1.e-2*sqrt(rmsdpdt/ncell_glo)  
+       
+       OPEN(134,file="checkconsicosa.txt",position='append')
+       WRITE(134,4000)mtot,rmsdpdt,etot,ztot,stot,rmsvtot,angtot
+       WRITE(134,*)mtot,rmsdpdt,etot,ztot,stot,rmsvtot,angtot 
+       WRITE(134,*)"=================================================="
+       WRITE(*,4000)mtot,rmsdpdt,etot,ztot,stot,rmsvtot,angtot
+       
+4000   FORMAT(10x,'masse',5x,'rmsdpdt',5x,'energie',5x,'enstrophie'  &
+            ,5x,'entropie',5x,'rmsv',5x,'mt.ang',/,'GLOB  '          &
+            ,e10.3,e13.6,5e13.3/)     
+       CLOSE(134)
+
+       IF(check_type == check_detailed) THEN
+          !ang_mass = AAM_mass-AAM_mass_old 
+          !WRITE(*,'(A,3E12.4)') 'AAM_mass sanity check', SUM(AAM_mass_source), ang_mass, SUM(AAM_mass_source)-ang_mass
+          !ang_vel = AAM_vel-AAM_vel_old 
+          !WRITE(*,'(A,3E12.4)') 'AAM_vel  sanity check', SUM(AAM_vel_source), ang_vel, SUM(AAM_vel_source)-ang_vel
+          WRITE(*,'(A,6E12.4)') 'AAM_mass : time,old,new,dissip,dyn,phys', dt*it, AAM_mass_old, AAM_mass, &
+               AAM_mass_source(AAM_dissip), AAM_mass_source(AAM_dyn), AAM_mass_source(AAM_phys)
+          WRITE(*,'(A,6E12.4)') 'AAM_vel  : time,old,new,dissip,dyn,phys', dt*it, AAM_vel_old, AAM_vel, &
+               AAM_vel_source(AAM_dissip), AAM_vel_source(AAM_dyn), AAM_vel_source(AAM_phys)
+          AAM_mass_old=AAM_mass
+          AAM_vel_old=AAM_vel
+          AAM_mass_source=0.
+          AAM_vel_source=0.
+       END IF
+    END IF
+
+  END SUBROUTINE check_conserve
+
+!------------------------ Detailed check (Lauritzen et al., 2014) -----------------------------
+
+  SUBROUTINE check_conserve_detailed(it,tag, f_ps,f_dps,f_ue,f_theta_rhodz,f_phis) 
+    USE pression_mod
+    USE vorticity_mod
+    USE caldyn_gcm_mod
+    USE exner_mod 
+!    USE mpipara, ONLY : is_mpi_root, comm_icosa
+    USE omp_para, ONLY : is_master
+    INTEGER, INTENT(IN) :: tag
+    TYPE(t_field),POINTER :: f_ps(:)
+    TYPE(t_field),POINTER :: f_dps(:)
+    TYPE(t_field),POINTER :: f_ue(:)
+    TYPE(t_field),POINTER :: f_theta_rhodz(:)
+    TYPE(t_field),POINTER :: f_phis(:)
+    INTEGER, INTENT(IN) ::it
+
+    REAL(rstd),POINTER :: p(:,:),rhodz(:,:) 
+    INTEGER::ind,ierr
+    REAL(rstd) :: mtot, ztot, rmsdpdt, etot,stot,rmsv, ang_mass, ang_vel
+    
+    IF(check_type == check_detailed) THEN
+
+       CALL transfert_request(f_ue,req_e1_vect)
+       CALL pression(f_ps,f_p)
+       DO ind=1,ndomain 
+          IF (.NOT. assigned_domain(ind)) CYCLE
+          CALL swap_dimensions(ind)
+          CALL swap_geometry(ind)
+          p=f_p(ind) 
+          rhodz=f_rhodz(ind)
+          CALL compute_rhodz(p,rhodz) 
+       END DO
+       CALL exner(f_ps,f_p,f_pks,f_pk)
+       CALL check_energy(f_ue,f_theta_rhodz,f_phis, etot, stot, ang_mass, ang_vel, rmsv) 
+       
+       IF (is_master) THEN
+          ! XXX=mass,vel
+          ! AAM_XXX = value of total AAM_XXX at last check
+          ! ang_XXX = value of total AAM_XXX now
+          ! AAM_XXX_source(tag) = source of AAA_XXX due to tag=dissip,dyn,phys
+          !WRITE(*,'(A,3E12.2)') 'AAM_mass', tag, ang_mass, AAM_mass, ang_mass-AAM_mass ! FIXME
+          !WRITE(*,'(A,3E12.2)') 'AAM_vel ', tag, ang_vel, AAM_vel, ang_vel-AAM_vel ! FIXME
+          AAM_mass_source(tag) = AAM_mass_source(tag) + ang_mass - AAM_mass
+          AAM_vel_source(tag) = AAM_vel_source(tag) + ang_vel - AAM_vel
+          AAM_mass = ang_mass
+          AAM_vel = ang_vel
+       END IF
+    END IF
+  END SUBROUTINE check_conserve_detailed
+ 
+!---------------------------------------------------------------------
+
+  SUBROUTINE global_sum(loc_sum, glob_sum)
+    USE mpi_mod
+    USE mpipara
+    USE transfert_omp_mod
+    REAL(rstd), INTENT(IN) :: loc_sum
+    REAL(rstd), INTENT(OUT) :: glob_sum
+    REAL(rstd) :: sum
+
+    CALL reduce_sum_omp(loc_sum, sum)
+    IF (using_mpi) THEN
+!$OMP MASTER    
+      CALL MPI_REDUCE(sum, glob_sum, 1, MPI_REAL8, MPI_SUM, 0, comm_icosa, ierr)
+!$OMP END MASTER
+    ELSE
+      glob_sum=loc_sum
+    ENDIF
+  END SUBROUTINE global_sum
+
+  SUBROUTINE check_mass_conserve(f_ps,f_dps,mtot,rmsdpdt)
+  USE mpi_mod
+  USE mpipara
+  USE transfert_omp_mod
+  USE omp_para
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_ps(:)
+    TYPE(t_field),POINTER :: f_dps(:)
+    REAL(rstd),POINTER :: ps(:),dps(:) 
+    REAL(rstd), INTENT(OUT) :: mtot, rmsdpdt
+
+    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) .OR. .NOT. is_omp_level_master) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      dps=f_dps(ind) 
+      ps=f_ps(ind)
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          IF (domain(ind)%own(i,j)) THEN
+             mloc=mloc+ps(ij)*Ai(ij)
+             rmsloc=rmsloc+dps(ij)*dps(ij)
+	  ENDIF
+        ENDDO
+      ENDDO
+    ENDDO
+    
+    CALL global_sum(mloc, mtot)
+    CALL global_sum(rmsloc, rmsdpdt)
+  END SUBROUTINE check_mass_conserve
+
+!---------------------------------------------------------------------
+
+  SUBROUTINE check_energy(f_ue,f_theta_rhodz,f_phis, etot, &
+                      stot, AAM_mass_tot, AAM_vel_tot, rmsvtot)  
+  USE pression_mod
+  USE vorticity_mod
+    TYPE(t_field), POINTER :: f_ue(:)
+    TYPE(t_field), POINTER :: f_theta_rhodz(:)
+    TYPE(t_field), POINTER :: f_phis(:)
+    REAL(rstd),INTENT(OUT) :: etot, stot, AAM_mass_tot, AAM_vel_tot, rmsvtot
+    REAL(rstd), POINTER :: ue(:,:)
+    REAL(rstd), POINTER :: p(:,:) 
+    REAL(rstd), POINTER :: theta_rhodz(:,:,:) 
+    REAL(rstd), POINTER :: pk(:,:) 
+    REAL(rstd), POINTER :: phis(:) 
+    REAL(rstd), POINTER :: rhodz(:,:) 
+    REAL(rstd) :: e, s, AAM_mass, AAM_vel, rmsv
+    INTEGER :: ind
+
+    e = 0 ; s = 0 ; AAM_mass = 0 ; AAM_vel=0 ; rmsv = 0
+
+    DO ind=1,ndomain 
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      ue=f_ue(ind) 
+      p=f_p(ind)
+      rhodz=f_rhodz(ind) 
+      theta_rhodz=f_theta_rhodz(ind) 
+      pk=f_pk(ind) 
+      phis=f_phis(ind) 
+      CALL compute_energy(ind,ue,p,rhodz,theta_rhodz(:,:,1),pk,phis, &
+           e, s, AAM_mass, AAM_vel, rmsv)
+    END DO 
+
+    CALL global_sum(e, etot)
+    CALL global_sum(s, stot)
+    CALL global_sum(rmsv, rmsvtot)
+    CALL global_sum(AAM_mass, AAM_mass_tot)
+    CALL global_sum(AAM_vel, AAM_vel_tot)
+  END SUBROUTINE check_energy
+
+  SUBROUTINE compute_energy(ind,u,p,rhodz,theta_rhodz,pk,phis, e, s, AAM_mass, AAM_vel, rmsv)
+    USE disvert_mod
+    USE wind_mod
+    USE omp_para
+    INTEGER,INTENT(IN)::ind 
+    REAL(rstd),INTENT(IN) :: u(3*iim*jjm,llm)
+    REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
+    REAL(rstd),INTENT(IN) :: rhodz(iim*jjm,llm)
+    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
+    REAL(rstd),INTENT(IN) :: pk(iim*jjm,llm)
+    REAL(rstd),INTENT(IN) :: phis(iim*jjm)
+    REAL(rstd),INTENT(INOUT) :: e, s, AAM_mass, AAM_vel, rmsv
+    
+    REAL(rstd) :: ucenter(iim*jjm,3,llm)
+    REAL(rstd) :: ulon(iim*jjm,llm)
+    REAL(rstd) :: ulat(iim*jjm,llm)
+    
+    REAL(rstd) :: mass_ij, theta_ij, KE_ij, rad,radomeg,lat
+    INTEGER :: i,j,ij,l
+    
+    CALL compute_wind_centered(u,ucenter)
+    CALL compute_wind_centered_lonlat_compound(ucenter,ulon,ulat)
+    rad = radius 
+    radomeg = rad*omega
+    
+    DO l = ll_begin,ll_end
+       DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+             ij=(j-1)*iim+i
+             IF (domain(ind)%own(i,j)) THEN
+                lat = lat_i(ij)  
+                mass_ij = rhodz(ij,l)*Ai(ij) 
+                theta_ij = theta_rhodz(ij,l)/rhodz(ij,l)
+                KE_ij = 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 +           &
+                     le(ij+u_left)*de(ij+u_left)*u(ij+u_left,l)**2 +        &
+                     le(ij+u_ldown)*de(ij+u_ldown)*u(ij+u_ldown,l)**2 +     &
+                     le(ij+u_rdown)*de(ij+u_rdown)*u(ij+u_rdown,l)**2 )  
+                rmsv = rmsv + 2*mass_ij*KE_ij
+                s    = s + Ai(ij)*theta_rhodz(ij,l)
+                e    = e + mass_ij*(phis(ij)+theta_ij*pk(ij,l)+KE_ij)
+                AAM_mass = AAM_mass + rad*cos(lat)*mass_ij*radomeg*cos(lat)
+                AAM_vel  = AAM_vel  + rad*cos(lat)*mass_ij*ulon(ij,l)
+             END IF
+          END DO
+       END DO
+    END DO
+    
+  END SUBROUTINE compute_energy
+
+!---------------------------------------------------------------------
+  
+  SUBROUTINE check_PV(ztot)
+    REAL(rstd),INTENT(OUT) :: ztot
+    REAL(rstd), POINTER :: vort(:,:)
+    REAL(rstd), POINTER :: rhodz(:,:) 
+    INTEGER :: ind
+    REAL(rstd) :: z,z_mpi
+    
+    z=0
+    DO ind=1,ndomain 
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       vort=f_vort(ind)
+       rhodz=f_rhodz(ind) 
+       CALL compute_PV(vort,rhodz,z) 
+    ENDDO
+    CALL global_sum(z, ztot)
+  END SUBROUTINE check_PV 
+
+  SUBROUTINE compute_PV(vort,rhodz,z) 
+  USE disvert_mod
+  USE omp_para
+    REAL(rstd),INTENT(IN) :: vort(2*iim*jjm,llm)
+    REAL(rstd),INTENT(IN) :: rhodz(iim*jjm,llm) 
+    REAL(rstd),INTENT(INOUT) :: z
+    REAL(rstd)::qv1,qv2 
+    REAL(rstd)::hv1,hv2  
+    INTEGER :: i,j,ij,l,ij2
+
+    hv1 = 0.0 ; hv2 = 0.0 
+   
+    DO l = ll_begin,ll_end
+      DO j=jj_begin+1,jj_end-1
+        DO i=ii_begin+1,ii_end-1
+          ij=(j-1)*iim+i
+          hv1 =  Riv2(ij,vup)        * rhodz(ij,l)           &
+            + Riv2(ij+t_rup,vldown) * rhodz(ij+t_rup,l)     &
+            + Riv2(ij+t_lup,vrdown) * rhodz(ij+t_lup,l)
+    
+          qv1 = ( vort(ij+z_up,l)+fv(ij+z_up) )/hv1
+          
+          hv2  =  Riv2(ij,vdown)     * rhodz(ij,l)          &
+            + Riv2(ij+t_ldown,vrup) * rhodz(ij+t_ldown,l)  &
+            + Riv2(ij+t_rdown,vlup) * rhodz(ij+t_rdown,l)
+                     
+          qv2 =( vort(ij+z_down,l)+fv(ij+z_down) )/hv2
+
+          z = z + (qv1*qv1*hv1 + qv2*qv2*hv2) 
+
+        ENDDO
+      ENDDO
+      
+    ENDDO
+
+  END SUBROUTINE compute_PV
+!---------------------------------------------------------------------
+
+   SUBROUTINE compute_rhodz(p,rhodz) 
+     REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
+     REAL(rstd),INTENT(OUT):: rhodz(iim*jjm,llm)
+     REAL(rstd) ::mass(iim*jjm,llm)
+     INTEGER :: i,j,ij,l 
+	
+     DO l = 1, llm
+      DO j=jj_begin,jj_end
+       DO i=ii_begin,ii_end
+         ij=(j-1)*iim+i
+         mass(ij,l) = ( p(ij,l) - p(ij,l+1) ) * Ai(ij)/g
+         rhodz(ij,l) = mass(ij,l) / Ai(ij)
+       ENDDO
+      ENDDO
+     ENDDO
+
+   END SUBROUTINE compute_rhodz
+!====================================================================
+
+
+ END MODULE check_conserve_mod
Index: codes/icosagcm/devel/src/diagnostics/exner.f90
===================================================================
--- codes/icosagcm/devel/src/diagnostics/exner.f90	(revision 533)
+++ codes/icosagcm/devel/src/diagnostics/exner.f90	(revision 533)
@@ -0,0 +1,76 @@
+MODULE exner_mod
+
+  INTEGER,SAVE :: caldyn_exner
+!$OMP THREADPRIVATE(caldyn_exner)
+
+  INTEGER, PARAMETER :: lmdz=3, direct=4
+
+CONTAINS
+  
+  SUBROUTINE exner(f_ps,f_p,f_pks,f_pk)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ps(:)  ! IN
+    TYPE(t_field), POINTER :: f_p(:)   ! IN
+    TYPE(t_field), POINTER :: f_pks(:) ! OUT
+    TYPE(t_field), POINTER :: f_pk(:)  ! OUT
+  
+    REAL(rstd), POINTER :: ps(:)
+    REAL(rstd), POINTER :: p(:,:)
+    REAL(rstd), POINTER :: pks(:)
+    REAL(rstd), POINTER :: pk(:,:)
+    INTEGER :: ind
+
+!$OMP BARRIER
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      ps=f_ps(ind)
+      p=f_p(ind)
+      pks=f_pks(ind)
+      pk=f_pk(ind)
+      CALL compute_exner(ps, p, pks, pk, 0)
+    ENDDO
+!$OMP BARRIER
+  
+  END SUBROUTINE exner
+  
+  SUBROUTINE compute_exner(ps,p,pks,pk,offset)
+  USE icosa
+  USE disvert_mod
+  USE pression_mod
+  USE omp_para
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
+    REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
+    REAL(rstd),INTENT(OUT) :: pks(iim*jjm)
+    REAL(rstd),INTENT(OUT) :: pk(iim*jjm,llm)
+    INTEGER,INTENT(IN) :: offset
+    INTEGER :: i,j,ij,l
+    
+    ! surface : pks
+    IF (is_omp_level_master) THEN
+       
+       DO j=jj_begin-offset,jj_end+offset
+          DO i=ii_begin-offset,ii_end+offset
+             ij=(j-1)*iim+i
+             pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
+          ENDDO
+       ENDDO
+       
+    ENDIF
+    
+    ! 3D : pk
+    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
+             pk(ij,l) = cpp * ((.5/preff)*(p(ij,l)+p(ij,l+1))) ** kappa
+             ENDDO
+          ENDDO
+       ENDDO
+       
+  END SUBROUTINE compute_exner
+  
+END MODULE exner_mod
Index: codes/icosagcm/devel/src/diagnostics/geopotential_mod.f90
===================================================================
--- codes/icosagcm/devel/src/diagnostics/geopotential_mod.f90	(revision 533)
+++ codes/icosagcm/devel/src/diagnostics/geopotential_mod.f90	(revision 533)
@@ -0,0 +1,87 @@
+MODULE geopotential_mod
+  IMPLICIT NONE
+  PRIVATE
+  
+  PUBLIC :: compute_geopotential
+CONTAINS
+  
+  SUBROUTINE thetarhodz2geopot(f_ps,f_phis,f_theta_rhodz, f_p,f_theta,f_phi) ! FIXME : never called, dry only
+    USE icosa
+    USE omp_para
+    USE pression_mod
+    USE theta2theta_rhodz_mod
+    TYPE(t_field), POINTER :: f_ps(:), f_phis(:), f_theta_rhodz(:), &  ! IN                                       
+         f_p(:), f_theta(:), f_phi(:)               ! OUT                                                         
+    REAL(rstd),POINTER :: pk(:,:), p(:,:), theta(:,:,:), theta_rhodz(:,:,:), &
+         phi(:,:), phis(:), ps(:)
+    INTEGER :: ind
+    
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       ps = f_ps(ind)
+       p  = f_p(ind)
+!$OMP BARRIER                                                                                                     
+       CALL compute_pression(ps,p,0)
+!$OMP BARRIER                                                                                                     
+       theta_rhodz = f_theta_rhodz(ind)
+       theta = f_theta(ind)
+       CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0)
+       phis = f_phis(ind)
+       phi = f_phi(ind)
+       CALL compute_geopotential(phis,p,theta,phi,0)
+    END DO
+
+  END SUBROUTINE thetarhodz2geopot
+
+
+  SUBROUTINE compute_geopotential(phis,p,theta,phi,offset)
+    USE icosa
+    USE omp_para
+    REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
+    REAL(rstd),INTENT(IN) :: phis(iim*jjm)
+    REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm,nqdyn)
+    REAL(rstd),INTENT(OUT) :: phi(iim*jjm,llm)
+    INTEGER,INTENT(IN) :: offset
+    INTEGER :: i,j,ij,l
+    REAL(rstd) :: mg_ij, p_ij, exner_ij
+
+!!! Compute geopotential
+  ! LMD-Z : dh=pi.dtheta-vdp  => (1/rho) dp = pi.dtheta - d(h=pi.theta) = -dtheta.gradpi
+  ! g.dz =  -(1/rho)dp =  theta.gradpi
+  ! direct (variational)
+  ! dz = -(1/rho.g)dp, rho = RT/p = (R/C_p).theta.pi/p
+   
+  ! for first layer
+
+! flush pks, pk thetha, phis
+!$OMP BARRIER
+    IF(is_omp_level_master) THEN
+       DO j=jj_begin-offset,jj_end+offset
+          DO i=ii_begin-offset,ii_end+offset
+             ij=(j-1)*iim+i
+             phi( ij,1 ) = phis( ij )
+          END DO
+       END DO
+          
+    ! for other layers
+     DO l = 1, llm-1
+       DO j=jj_begin-offset,jj_end+offset
+         DO i=ii_begin-offset,ii_end+offset
+           ij=(j-1)*iim+i
+           mg_ij = p(ij,l+1)-p(ij,l)
+           ! v=RT/p=(kappa.cpp).Theta.(p/preff)**kappa /p
+           p_ij=.5*(p(ij,l+1)+p(ij,l))
+           exner_ij = (p_ij/preff)**kappa ! NB : no cpp factor
+           phi(ij,l+1) = phi(ij,l) + (kappa*cpp)*mg_ij*theta(ij,l,1)*exner_ij/p_ij
+         ENDDO
+       ENDDO
+     ENDDO
+   ENDIF
+! flush phi
+!$OMP BARRIER
+   
+  END SUBROUTINE compute_geopotential
+
+END MODULE geopotential_mod
Index: codes/icosagcm/devel/src/diagnostics/kinetic.f90
===================================================================
--- codes/icosagcm/devel/src/diagnostics/kinetic.f90	(revision 533)
+++ codes/icosagcm/devel/src/diagnostics/kinetic.f90	(revision 533)
@@ -0,0 +1,198 @@
+MODULE kinetic_mod
+IMPLICIT NONE
+PRIVATE
+
+PUBLIC :: kinetic, kinetic_v, kinetic_new, gradient
+
+CONTAINS
+  
+  SUBROUTINE kinetic(f_ue,f_Ki)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ue(:)
+    TYPE(t_field), POINTER :: f_Ki(:)
+  
+    REAL(rstd), POINTER :: ue(:,:)
+    REAL(rstd), POINTER :: Ki(:,:)
+    INTEGER :: ind
+  
+    CALL transfert_request(f_ue,req_e1_vect)
+    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)
+      ue=f_ue(ind)
+      Ki=f_Ki(ind)
+      CALL compute_kinetic(ue, Ki)
+    ENDDO  
+  END SUBROUTINE kinetic
+  
+  SUBROUTINE kinetic_new(f_ue,f_Ki)
+    USE icosa
+    IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ue(:)
+    TYPE(t_field), POINTER :: f_Ki(:)
+    
+    REAL(rstd), POINTER :: ue(:,:)
+    REAL(rstd), POINTER :: Ki(:,:)
+    INTEGER :: ind
+    
+    CALL transfert_request(f_ue,req_e1_vect)
+    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)
+       ue=f_ue(ind)
+       Ki=f_Ki(ind)
+       CALL compute_Ki_new(ue, Ki)
+    ENDDO
+  END SUBROUTINE kinetic_new
+  
+  SUBROUTINE kinetic_v(f_ue,f_Kv)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ue(:)
+    TYPE(t_field), POINTER :: f_Kv(:)
+  
+    REAL(rstd), POINTER :: ue(:,:)
+    REAL(rstd), POINTER :: Kv(:,:)
+    INTEGER :: ind
+  
+    CALL transfert_request(f_ue,req_e1_vect)
+    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)
+      ue=f_ue(ind)
+      Kv=f_Kv(ind)
+      CALL compute_kv(ue, Kv)
+    ENDDO  
+  END SUBROUTINE kinetic_v
+  
+  SUBROUTINE compute_kinetic(ue, Ki)
+  USE icosa
+  USE omp_para
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN) :: ue(3*iim*jjm,llm)
+    REAL(rstd),INTENT(OUT) :: Ki(iim*jjm,llm)
+    INTEGER :: i,j,ij,l
+    
+    DO l=ll_begin,ll_end
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+
+          Ki(ij,l)=1/(4*Ai(ij))*(le(ij+u_right)*de(ij+u_right)*ue(ij+u_right,l)**2 +  &
+                               le(ij+u_rup)*de(ij+u_rup)*ue(ij+u_rup,l)**2 +        &
+                               le(ij+u_lup)*de(ij+u_lup)*ue(ij+u_lup,l)**2 +        &
+                               le(ij+u_left)*de(ij+u_left)*ue(ij+u_left,l)**2 +     &
+                               le(ij+u_ldown)*de(ij+u_ldown)*ue(ij+u_ldown,l)**2 +  &
+                               le(ij+u_rdown)*de(ij+u_rdown)*ue(ij+u_rdown,l)**2 )  
+       
+        ENDDO
+      ENDDO
+    ENDDO
+  END SUBROUTINE compute_kinetic
+  
+  SUBROUTINE compute_kv(ue, Kv)
+  USE icosa
+  USE omp_para
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN) :: ue(3*iim*jjm,llm)
+    REAL(rstd),INTENT(OUT) :: Kv(2*iim*jjm,llm)
+    INTEGER :: ij,l, u_up, u_down
+
+    u_up    = t_lup + u_right
+    u_down  = t_rdown + u_left
+    
+    DO l=ll_begin,ll_end
+      DO ij=ij_begin,ij_end
+          Kv(ij+z_up,l) = (radius**2/Av(ij+z_up))*(                         &
+                               S1(ij,vup)*ue(ij+u_rup,l)**2 +        &
+                               S2(ij,vup)*ue(ij+u_lup,l)**2 +        &
+                               S2(ij+t_lup,vrdown)*ue(ij+u_up,l)**2)
+
+          Kv(ij+z_down,l) = (radius**2/Av(ij+z_down))*(                         &
+                               S1(ij,vdown)*ue(ij+u_ldown,l)**2 +       &
+                               S2(ij,vdown)*ue(ij+u_rdown,l)**2 +       &
+                               S2(ij+t_rdown,vlup)*ue(ij+u_down,l)**2 )
+       ENDDO
+    ENDDO
+  END SUBROUTINE compute_kv
+  
+  SUBROUTINE compute_Ki_new(ue, Ki)
+    USE icosa
+    USE omp_para
+    IMPLICIT NONE
+    REAL(rstd),INTENT(IN) :: ue(3*iim*jjm,llm)
+    REAL(rstd),INTENT(OUT):: Ki(iim*jjm,llm)
+    REAL(rstd) :: Kv(2*iim*jjm,llm)
+    INTEGER :: ij,l, u_up, u_down
+    
+    CALL compute_kv(ue,Kv)
+    
+    DO l=ll_begin,ll_end
+       DO ij=ij_begin,ij_end
+          Ki(ij,l) = Riv(ij,vup)*Kv(ij+z_up,l) + &
+               Riv(ij,vlup)  *Kv(ij+z_lup,l) + &
+               Riv(ij,vldown)*Kv(ij+z_ldown,l) + &
+               Riv(ij,vdown) *Kv(ij+z_down,l) + &
+               Riv(ij,vrdown)*Kv(ij+z_rdown,l) + &
+               Riv(ij,vrup)  *Kv(ij+z_rup,l)
+       END DO
+    END DO
+  END SUBROUTINE compute_Ki_new
+  
+  SUBROUTINE gradient(f_berni, f_du)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_berni(:)
+    TYPE(t_field), POINTER :: f_du(:)
+  
+    REAL(rstd), POINTER :: du(:,:)
+    REAL(rstd), POINTER :: berni(:,:)
+    INTEGER :: ind
+  
+    CALL transfert_request(f_du,req_e1_vect)
+    CALL transfert_request(f_du,req_e1_vect)
+
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      berni=f_berni(ind)
+      du=f_du(ind)
+      CALL compute_grad(berni, du)
+    ENDDO
+  
+  END SUBROUTINE gradient
+  
+  SUBROUTINE compute_grad(berni, du)
+  USE icosa
+  USE omp_para
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN) :: berni(iim*jjm,llm)
+    REAL(rstd),INTENT(OUT) :: du(3*iim*jjm,llm)
+    INTEGER :: i,j,ij,l
+    
+    DO l=ll_begin,ll_end
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+            du(ij+u_right,l) = ne_right*(berni(ij,l)-berni(ij+t_right,l))/de(ij+u_right)
+            du(ij+u_lup,l)   = ne_lup*(berni(ij,l)-berni(ij+t_lup,l))/de(ij+u_right)
+            du(ij+u_ldown,l) = ne_ldown*(berni(ij,l)-berni(ij+t_ldown,l))/de(ij+u_right)
+         ENDDO
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE compute_grad
+
+
+END MODULE kinetic_mod
Index: codes/icosagcm/devel/src/diagnostics/observable.f90
===================================================================
--- codes/icosagcm/devel/src/diagnostics/observable.f90	(revision 533)
+++ codes/icosagcm/devel/src/diagnostics/observable.f90	(revision 533)
@@ -0,0 +1,332 @@
+MODULE observable_mod
+  USE icosa
+  IMPLICIT NONE
+  PRIVATE
+
+  TYPE(t_field),POINTER, SAVE :: f_buf_i(:), &
+       f_buf_uh(:), & ! horizontal velocity, different from prognostic velocity if NH
+       f_buf_ulon(:), f_buf_ulat(:), &
+       f_buf_u3d(:) ! unused, remove ?
+  TYPE(t_field),POINTER, SAVE :: f_buf1_i(:), f_buf2_i(:)
+  TYPE(t_field),POINTER, SAVE :: f_buf_v(:), f_buf_s(:), f_buf_p(:)
+  TYPE(t_field),POINTER, SAVE :: f_pmid(:)
+
+! temporary shared variable for caldyn
+  TYPE(t_field),POINTER, SAVE :: f_theta(:)
+
+  PUBLIC init_observable, write_output_fields_basic, f_theta
+
+CONTAINS
+  
+  SUBROUTINE init_observable
+    CALL allocate_field(f_buf_i,   field_t,type_real,llm,name="buffer_i")
+    CALL allocate_field(f_buf1_i,   field_t,type_real,llm,name="buffer1_i")
+    CALL allocate_field(f_buf2_i,   field_t,type_real,llm,name="buffer2_i")
+    CALL allocate_field(f_buf_p,   field_t,type_real,llm+1) 
+    CALL allocate_field(f_buf_u3d, field_t,type_real,3,llm)  ! 3D vel at cell centers
+    CALL allocate_field(f_buf_ulon,field_t,type_real,llm, name="buf_ulon")
+    CALL allocate_field(f_buf_ulat,field_t,type_real,llm, name="buf_ulat")
+    CALL allocate_field(f_buf_uh,  field_u,type_real,llm, name="buf_uh")
+    CALL allocate_field(f_buf_v,   field_z,type_real,llm, name="buf_v")
+    CALL allocate_field(f_buf_s,   field_t,type_real, name="buf_s")
+
+    CALL allocate_field(f_theta, field_t,type_real,llm,nqdyn,  name='theta') ! potential temperature
+    CALL allocate_field(f_pmid,  field_t,type_real,llm,  name='pmid')       ! mid layer pressure
+  END SUBROUTINE init_observable
+
+  SUBROUTINE write_output_fields_basic(init, f_phis, f_ps, f_mass, f_geopot, f_theta_rhodz, f_u, f_W, f_q)
+    USE xios_mod
+    USE disvert_mod
+    USE wind_mod
+    USE output_field_mod
+    USE omp_para
+    USE time_mod
+    USE xios_mod
+    USE earth_const
+    USE pression_mod
+    USE vertical_interp_mod
+    USE theta2theta_rhodz_mod
+    USE omega_mod
+    LOGICAL, INTENT(IN) :: init
+    INTEGER :: l
+    REAL :: scalar(1)
+    REAL :: mid_ap(llm)
+    REAL :: mid_bp(llm)
+
+    TYPE(t_field),POINTER :: f_phis(:), f_ps(:), f_mass(:), f_geopot(:), f_theta_rhodz(:), f_u(:), f_W(:), f_q(:)
+!    IF (is_master) PRINT *,'CALL write_output_fields_basic'
+
+    CALL transfert_request(f_ps,req_i1)
+    
+    IF(init) THEN
+       scalar(1)=dt
+       IF (is_omp_master) CALL xios_send_field("timestep", scalar)
+       scalar(1)=preff
+       IF (is_omp_master) CALL xios_send_field("preff", scalar)
+       IF (is_omp_master) CALL xios_send_field("ap",ap)
+       IF (is_omp_master) CALL xios_send_field("bp",bp)
+       DO l=1,llm
+          mid_ap(l)=(ap(l)+ap(l+1))/2
+          mid_bp(l)=(bp(l)+bp(l+1))/2
+       ENDDO
+       IF (is_omp_master) CALL xios_send_field("mid_ap",mid_ap)
+       IF (is_omp_master) CALL xios_send_field("mid_bp",mid_bp)
+
+       CALL output_field("phis",f_phis)
+       CALL output_field("Ai",geom%Ai)       
+    END IF
+
+    IF(nqdyn>1) THEN
+       CALL divide_by_mass(2, f_mass, f_theta_rhodz, f_buf_i)
+       IF(init) THEN
+          CALL output_field("dyn_q_init",f_buf_i)
+       ELSE
+          CALL output_field("dyn_q",f_buf_i)
+       END IF
+    END IF
+
+    CALL divide_by_mass(1, f_mass, f_theta_rhodz, f_buf_i)
+    IF(init) THEN
+       CALL output_field("theta_init",f_buf_i)
+    ELSE
+       CALL output_field("theta",f_buf_i)
+    END IF
+
+    CALL pression_mid(f_ps, f_pmid)
+    CALL diagnose_temperature(f_pmid, f_q, f_buf_i) ! f_buf_i : IN = theta, out = T
+
+    IF(init) THEN
+       CALL output_field("temp_init",f_buf_i)
+    ELSE
+       CALL output_field("temp",f_buf_i)
+       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,85000.)
+       CALL output_field("t850",f_buf_s)
+       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,50000.)
+       CALL output_field("t500",f_buf_s)
+       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,preff)
+       CALL output_field("SST",f_buf_s)       
+    END IF
+    
+    CALL progonostic_vel_to_horiz(f_geopot, f_ps, f_mass, f_u, f_W, f_buf_uh, f_buf_i)
+    CALL transfert_request(f_buf_uh,req_e1_vect) 
+    CALL un2ulonlat(f_buf_uh, f_buf_ulon, f_buf_ulat)
+    IF(init) THEN
+       CALL output_field("uz_init",f_buf_i)
+       CALL output_field("ulon_init",f_buf_ulon)
+       CALL output_field("ulat_init",f_buf_ulat)
+       CALL output_field("p_init",f_pmid)
+       CALL output_field("ps_init",f_ps)
+       CALL output_field("mass_init",f_mass)
+       CALL output_field("geopot_init",f_geopot)
+       CALL output_field("q_init",f_q)
+    ELSE
+       CALL output_field("uz",f_buf_i)
+       CALL output_field("ulon",f_buf_ulon)
+       CALL output_field("ulat",f_buf_ulat)
+       CALL output_field("p",f_pmid)
+       CALL output_field("ps",f_ps)
+       CALL output_field("mass",f_mass)
+       CALL output_field("geopot",f_geopot)
+       CALL output_field("q",f_q)
+
+       !       CALL output_field("exner",f_pk)
+       !       CALL output_field("pv",f_qv)
+       
+       CALL vertical_interp(f_pmid,f_buf_ulon,f_buf_s,85000.)
+       CALL output_field("u850",f_buf_s)
+       CALL vertical_interp(f_pmid,f_buf_ulon,f_buf_s,50000.)
+       CALL output_field("u500",f_buf_s)
+       
+       CALL vertical_interp(f_pmid,f_buf_ulat,f_buf_s,85000.)
+       CALL output_field("v850",f_buf_s)
+       CALL vertical_interp(f_pmid,f_buf_ulat,f_buf_s,50000.)
+       CALL output_field("v500",f_buf_s)
+
+       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,85000.)
+       CALL output_field("w850",f_buf_s)
+       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,50000.)
+       CALL output_field("w500",f_buf_s)    
+
+       CALL w_omega(f_ps, f_u, f_buf_i)
+       CALL output_field("omega",f_buf_i)
+       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,85000.)
+       CALL output_field("omega850",f_buf_s)
+       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,50000.)
+       CALL output_field("omega500",f_buf_s)
+    END IF
+
+  END SUBROUTINE write_output_fields_basic
+  
+ !------------------- Conversion from prognostic to observable variables ------------------
+
+  SUBROUTINE progonostic_vel_to_horiz(f_geopot, f_ps, f_rhodz, f_u, f_W, f_uh, f_uz)
+    USE disvert_mod
+    TYPE(t_field), POINTER :: f_geopot(:), f_ps(:), f_rhodz(:), &
+         f_u(:), f_W(:), f_uz(:), &  ! IN
+         f_uh(:)                         ! OUT
+    REAL(rstd),POINTER :: geopot(:,:), ps(:), rhodz(:,:), u(:,:), W(:,:), uh(:,:), uz(:,:)
+    INTEGER :: ind
+    
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       geopot = f_geopot(ind)
+       rhodz = f_rhodz(ind)
+       u = f_u(ind)
+       W = f_W(ind)
+       uh  = f_uh(ind)
+       IF(caldyn_eta==eta_mass) THEN
+          ps=f_ps(ind)
+          CALL compute_rhodz(.TRUE., ps, rhodz)
+       END IF
+       uz = f_uz(ind)
+       CALL compute_prognostic_vel_to_horiz(geopot,rhodz,u,W,uh,uz)
+    END DO
+  END SUBROUTINE progonostic_vel_to_horiz
+  
+  SUBROUTINE compute_prognostic_vel_to_horiz(Phi, rhodz, u, W, uh, uz)
+    USE omp_para
+    REAL(rstd), INTENT(IN) :: Phi(iim*jjm,llm+1)
+    REAL(rstd), INTENT(IN) :: rhodz(iim*jjm,llm)
+    REAL(rstd), INTENT(IN) :: u(3*iim*jjm,llm)
+    REAL(rstd), INTENT(IN) :: W(iim*jjm,llm+1)
+    REAL(rstd), INTENT(OUT) :: uh(3*iim*jjm,llm)
+    REAL(rstd), INTENT(OUT) :: uz(iim*jjm,llm)
+    INTEGER :: ij,l
+    REAL(rstd) :: F_el(3*iim*jjm,llm+1)
+    REAL(rstd) :: uu_right, uu_lup, uu_ldown, W_el, DePhil
+    ! NB : u and uh are not in DEC form, they are normal components    
+    ! => we must divide by de
+    IF(hydrostatic) THEN
+       uh(:,:)=u(:,:)
+       uz(:,:)=0.
+    ELSE
+       DO l=ll_begin, ll_endp1 ! compute on l levels (interfaces)
+          DO ij=ij_begin_ext, ij_end_ext
+             ! Compute on edge 'right'
+             W_el   = .5*( W(ij,l)+W(ij+t_right,l) )
+             DePhil = ne_right*(Phi(ij+t_right,l)-Phi(ij,l))
+             F_el(ij+u_right,l)   = DePhil*W_el/de(ij+u_right)
+             ! Compute on edge 'lup'
+             W_el   = .5*( W(ij,l)+W(ij+t_lup,l) )
+             DePhil = ne_lup*(Phi(ij+t_lup,l)-Phi(ij,l))
+             F_el(ij+u_lup,l)   = DePhil*W_el/de(ij+u_lup)
+             ! Compute on edge 'ldown'
+             W_el   = .5*( W(ij,l)+W(ij+t_ldown,l) )
+             DePhil = ne_ldown*(Phi(ij+t_ldown,l)-Phi(ij,l))
+             F_el(ij+u_ldown,l) = DePhil*W_el/de(ij+u_ldown)
+          END DO
+       END DO
+
+       DO l=ll_begin, ll_end ! compute on k levels (full levels)
+          DO ij=ij_begin_ext, ij_end_ext
+             ! w = vertical momentum = g^-2*dPhi/dt = uz/g
+             uz(ij,l) = (.5*g)*(W(ij,l)+W(ij,l+1))/rhodz(ij,l)
+             ! uh = u-w.grad(Phi) = u - uz.grad(z)
+             uh(ij+u_right,l) = u(ij+u_right,l) - (F_el(ij+u_right,l)+F_el(ij+u_right,l+1)) / (rhodz(ij,l)+rhodz(ij+t_right,l))
+             uh(ij+u_lup,l)   = u(ij+u_lup,l)   - (F_el(ij+u_lup,l)+F_el(ij+u_lup,l+1))     / (rhodz(ij,l)+rhodz(ij+t_lup,l))
+             uh(ij+u_ldown,l) = u(ij+u_ldown,l) - (F_el(ij+u_ldown,l)+F_el(ij+u_ldown,l+1)) / (rhodz(ij,l)+rhodz(ij+t_ldown,l))
+          END DO
+       END DO
+
+    END IF
+  END SUBROUTINE compute_prognostic_vel_to_horiz
+
+  SUBROUTINE diagnose_temperature(f_pmid,f_q,f_temp)
+    USE icosa
+    USE pression_mod
+    IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_pmid(:)           ! IN
+    TYPE(t_field), POINTER :: f_q(:)            ! IN
+    TYPE(t_field), POINTER :: f_temp(:)         ! INOUT
+    
+    REAL(rstd), POINTER :: pmid(:,:)
+    REAL(rstd), POINTER :: q(:,:,:)
+    REAL(rstd), POINTER :: temp(:,:)
+    INTEGER :: ind
+    
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       pmid=f_pmid(ind)
+       q=f_q(ind)
+       temp=f_temp(ind)
+       CALL compute_diagnose_temp(pmid,q,temp)
+    END DO
+  END SUBROUTINE diagnose_temperature
+  
+  SUBROUTINE compute_diagnose_temp(pmid,q,temp)
+    USE omp_para
+    USE pression_mod
+    REAL(rstd),INTENT(IN)    :: pmid(iim*jjm,llm)
+    REAL(rstd),INTENT(IN)    :: q(iim*jjm,llm,nqtot)
+    REAL(rstd),INTENT(INOUT) :: temp(iim*jjm,llm)
+
+    REAL(rstd) :: Rd, p_ik, theta_ik, temp_ik, qv, chi, Rmix
+    INTEGER :: ij,l
+
+    Rd = kappa*cpp
+    DO l=ll_begin,ll_end
+       DO ij=ij_begin,ij_end
+          p_ik = pmid(ij,l)
+          theta_ik = temp(ij,l)
+          qv = q(ij,l,1) ! water vaper mixing ratio = mv/md
+          SELECT CASE(caldyn_thermo)
+          CASE(thermo_theta)
+             temp_ik = theta_ik*((p_ik/preff)**kappa)
+          CASE(thermo_entropy)
+             temp_ik = Treff*exp((theta_ik + Rd*log(p_ik/preff))/cpp)
+          CASE(thermo_moist)
+             Rmix = Rd+qv*Rv
+             chi = ( theta_ik + Rmix*log(p_ik/preff) ) / (cpp + qv*cppv) ! log(T/Treff)
+             temp_ik = Treff*exp(chi)
+          END SELECT
+          IF(physics_thermo==thermo_fake_moist) temp_ik=temp_ik/(1+0.608*qv)
+          temp(ij,l)=temp_ik
+       END DO
+    END DO
+  END SUBROUTINE compute_diagnose_temp
+
+  SUBROUTINE Tv2T(f_Tv, f_q, f_T)
+    TYPE(t_field), POINTER :: f_TV(:)
+    TYPE(t_field), POINTER :: f_q(:)
+    TYPE(t_field), POINTER :: f_T(:)
+    
+    REAL(rstd),POINTER :: Tv(:,:), q(:,:,:), T(:,:)
+    INTEGER :: ind
+    
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       Tv=f_Tv(ind)
+       T=f_T(ind)
+       SELECT CASE(physics_thermo)
+       CASE(thermo_dry)
+          T=Tv
+       CASE(thermo_fake_moist)
+          q=f_q(ind)
+          T=Tv/(1+0.608*q(:,:,1))
+       END SELECT
+    END DO
+  END SUBROUTINE Tv2T
+
+  SUBROUTINE divide_by_mass(iq, f_mass, f_theta_rhodz, f_theta)
+    INTEGER, INTENT(IN) :: iq
+    TYPE(t_field), POINTER :: f_mass(:), f_theta_rhodz(:), f_theta(:)
+    REAL(rstd), POINTER :: mass(:,:), theta_rhodz(:,:,:), theta(:,:)
+    INTEGER :: ind
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       mass=f_mass(ind)
+       theta_rhodz=f_theta_rhodz(ind)
+       theta=f_theta(ind)
+       theta(:,:) = theta_rhodz(:,:,iq) / mass(:,:)
+    END DO
+  END SUBROUTINE divide_by_mass
+    
+END MODULE observable_mod
Index: codes/icosagcm/devel/src/diagnostics/omega.f90
===================================================================
--- codes/icosagcm/devel/src/diagnostics/omega.f90	(revision 533)
+++ codes/icosagcm/devel/src/diagnostics/omega.f90	(revision 533)
@@ -0,0 +1,157 @@
+MODULE omega_mod
+
+  USE icosa
+  PRIVATE
+
+  PUBLIC :: w_omega, compute_omega
+
+CONTAINS
+
+  SUBROUTINE w_omega(f_ps, f_u, f_omega) ! Compute omega = Dp/Dt
+    TYPE(t_field),POINTER :: f_ps(:), f_u(:), f_omega(:)
+    INTEGER :: ind
+    REAL(rstd),POINTER :: ps(:), u(:,:), om(:,:)
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       ps=f_ps(ind)
+       u=f_u(ind)
+       om=f_omega(ind)
+       CALL compute_omega(ps,u,om)
+    END DO
+  END SUBROUTINE W_omega
+
+
+
+  SUBROUTINE compute_omega(ps,u, w)
+    USE disvert_mod, ONLY : ap,bp
+    USE omp_para
+    IMPLICIT NONE
+    REAL(rstd),INTENT(IN) :: u(iim*3*jjm,llm), ps(iim*jjm)
+    REAL(rstd),INTENT(OUT):: w(iim*jjm,llm)
+    REAL(rstd):: convm(iim*jjm,llm+1)
+    REAL(rstd):: p(iim*jjm,llm+1), rhodz(iim*jjm,llm), Fe(iim*3*jjm,llm)
+    REAL(rstd):: ugradps
+    
+    INTEGER :: i,j,l,ij
+
+!$OMP BARRIER    
+    IF (is_omp_level_master) THEN
+      DO    l    = 1, llm+1
+         DO j=jj_begin-1,jj_end+1
+           DO i=ii_begin-1,ii_end+1
+               ij=(j-1)*iim+i
+               p(ij,l) = ap(l) + bp(l) * ps(ij)
+            ENDDO
+         ENDDO
+      ENDDO
+    
+!!! Compute mass
+      DO l = 1, llm
+         DO j=jj_begin-1,jj_end+1
+            DO i=ii_begin-1,ii_end+1
+               ij=(j-1)*iim+i
+               rhodz(ij,l) = ( p(ij,l) - p(ij,l+1) ) / g
+            ENDDO
+         ENDDO
+      ENDDO
+    
+!!!  Compute mass flux
+      DO l = 1, llm
+         DO j=jj_begin-1,jj_end+1
+            DO i=ii_begin-1,ii_end+1
+               ij=(j-1)*iim+i
+               Fe(ij+u_right,l)=0.5*(rhodz(ij,l)+rhodz(ij+t_right,l))*u(ij+u_right,l)*le(ij+u_right)
+               Fe(ij+u_lup,l)=0.5*(rhodz(ij,l)+rhodz(ij+t_lup,l))*u(ij+u_lup,l)*le(ij+u_lup)
+               Fe(ij+u_ldown,l)=0.5*(rhodz(ij,l)+rhodz(ij+t_ldown,l))*u(ij+u_ldown,l)*le(ij+u_ldown)
+            ENDDO
+         ENDDO
+      ENDDO
+    
+!!! mass flux convergence computation  
+    
+    ! horizontal convergence
+      DO l = 1, llm
+         DO j=jj_begin,jj_end
+            DO i=ii_begin,ii_end
+               ij=(j-1)*iim+i
+               ! convm = +div(mass flux), sign convention as in Ringler et al. 2012, eq. 21
+               convm(ij,l)= 1./Ai(ij)*(ne(ij,right)*Fe(ij+u_right,l)   +  &
+                    ne(ij,rup)*Fe(ij+u_rup,l)       +  &  
+                    ne(ij,lup)*Fe(ij+u_lup,l)       +  &  
+                    ne(ij,left)*Fe(ij+u_left,l)     +  &  
+                    ne(ij,ldown)*Fe(ij+u_ldown,l)   +  &  
+                    ne(ij,rdown)*Fe(ij+u_rdown,l))
+            ENDDO
+         ENDDO
+      ENDDO
+    
+      ! vertical integration from up to down
+      DO  l = llm-1, 1, -1
+         DO j=jj_begin,jj_end
+            DO i=ii_begin,ii_end
+               ij=(j-1)*iim+i
+               convm(ij,l) = convm(ij,l) + convm(ij,l+1)
+            ENDDO
+         ENDDO
+      ENDDO
+      convm(:,llm+1)=0.
+
+!!! Compute dps
+    !  DO j=jj_begin,jj_end
+    !    DO i=ii_begin,ii_end
+    !      ij=(j-1)*iim+i
+    !      ! dps/dt = -int(div flux)dz
+    !      dps(ij)=-convm(ij,1) * g 
+    !      convm(ij,llm+1)=0.
+    !    ENDDO
+    !  ENDDO
+    
+    ! Compute Omega = Dp/Dt
+    ! with p = A(eta)+B(eta)ps
+    !      Dp/Dt = dp/deta.Deta/Dt + B(eta)Dps/Dt
+    !            = -mg.Deta/Dt + B.Dps/Dt
+    ! By definition the mass flux through model levels is W=m.Deta/Dt with m=-1/g dp/deta
+    ! therefore 
+    !  Dp/Dt = -g.W + B.dps/dt + Bu.grad ps
+    !        = B.u.grad ps - g*convm
+    
+!!! Compute vertical flux through model layers
+    !  DO l = 1,llm-1
+    !    DO j=jj_begin,jj_end
+    !      DO i=ii_begin,ii_end
+    !        ij=(j-1)*iim+i
+    !        ! w = int(z,ztop,div(flux)dz) + B(eta)dps/dt
+    !        ! => w>0 for upward transport
+    !        w( ij, l+1 ) = convm( ij, l+1 ) - bp(l+1) * convm( ij, 1 ) ! g.W = g.convm + B dps/dt
+    !      ENDDO
+    !    ENDDO
+    !  ENDDO
+    
+    
+!!! Compute omega
+    ! -grad ps : ( ne(ij,ldown)*ps(ij,l) + ne(ij+t_ldown,rup)*ps(ij+t_ldown,l) ) ) / de(ij+u_ldown)
+
+       DO l = 1,llm
+         DO j=jj_begin,jj_end 
+           DO i=ii_begin,ii_end
+             ij=(j-1)*iim+i
+             ugradps = &
+                  le(ij+u_right)*u(ij+u_right,l)*( ne(ij,right)*ps(ij) + ne(ij+t_right,left)*ps(ij+t_right) )  &
+                  + le(ij+u_rup)*u(ij+u_rup,l)*( ne(ij,rup)*ps(ij) + ne(ij+t_rup,ldown)*ps(ij+t_rup) )  &
+                  + le(ij+u_lup)*u(ij+u_lup,l)*( ne(ij,lup)*ps(ij) + ne(ij+t_lup,rdown)*ps(ij+t_lup) )         &
+                  + le(ij+u_left)*u(ij+u_left,l)*( ne(ij,left)*ps(ij) + ne(ij+t_left,right)*ps(ij+t_left) )    &
+                  + le(ij+u_ldown)*u(ij+u_ldown,l)*( ne(ij,ldown)*ps(ij) + ne(ij+t_ldown,rup)*ps(ij+t_ldown) ) &
+                  + le(ij+u_rdown)*u(ij+u_rdown,l)*( ne(ij,rdown)*ps(ij) + ne(ij+t_rdown,lup)*ps(ij+t_rdown) )
+             ugradps = .5*(bp(l)+bp(l+1)) *ugradps/(-4*Ai(ij))  ! sign convention as in Ringler et al. 2010, Eq. 22 p.3072
+             w( ij, l) =  ugradps - g*.5*(convm( ij,l+1)+convm(ij,l)) 
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDIF
+!$OMP BARRIER
+    
+  END SUBROUTINE compute_omega
+  
+END MODULE omega_mod
Index: codes/icosagcm/devel/src/diagnostics/pression.f90
===================================================================
--- codes/icosagcm/devel/src/diagnostics/pression.f90	(revision 533)
+++ codes/icosagcm/devel/src/diagnostics/pression.f90	(revision 533)
@@ -0,0 +1,98 @@
+MODULE pression_mod
+
+CONTAINS
+
+  SUBROUTINE pression(f_ps,f_p)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ps(:)
+    TYPE(t_field), POINTER :: f_p(:)
+  
+    REAL(rstd), POINTER :: ps(:)
+    REAL(rstd), POINTER :: p(:,:)
+    INTEGER :: ind
+
+!$OMP BARRIER
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      ps=f_ps(ind)
+      p=f_p(ind)
+      CALL compute_pression(ps, p,0)
+    ENDDO
+!$OMP BARRIER
+  
+  END SUBROUTINE pression
+
+  SUBROUTINE pression_mid(f_ps,f_pmid)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ps(:)
+    TYPE(t_field), POINTER :: f_pmid(:)
+  
+    REAL(rstd), POINTER :: ps(:)
+    REAL(rstd), POINTER :: pmid(:,:)
+    INTEGER :: ind
+
+!$OMP BARRIER
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      ps=f_ps(ind)
+      pmid=f_pmid(ind)
+      CALL compute_pression_mid(ps, pmid,0)
+    ENDDO
+!$OMP BARRIER
+  
+  END SUBROUTINE pression_mid
+
+  SUBROUTINE compute_pression(ps,p,offset)
+  USE icosa
+  USE disvert_mod
+  USE omp_para
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
+    REAL(rstd),INTENT(OUT) :: p(iim*jjm,llm+1)
+    INTEGER,INTENT(IN) :: offset
+    INTEGER :: i,j,ij,l
+
+    IF(ap_bp_present) THEN
+      DO    l    = ll_begin, ll_endp1
+!      DO    l    = 1, llm + 1
+        DO j=jj_begin-offset,jj_end+offset
+          DO i=ii_begin-offset,ii_end+offset
+            ij=(j-1)*iim+i
+            p(ij,l) = ap(l) + bp(l) * ps(ij)
+          ENDDO
+        ENDDO
+      ENDDO
+    END IF
+
+  END SUBROUTINE compute_pression
+  
+  SUBROUTINE compute_pression_mid(ps,pmid,offset)
+  USE icosa
+  USE disvert_mod
+  USE omp_para
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
+    REAL(rstd),INTENT(OUT) :: pmid(iim*jjm,llm)
+    INTEGER,INTENT(IN) :: offset
+    INTEGER :: i,j,ij,l
+
+    IF(ap_bp_present) THEN
+      DO    l    = ll_begin, ll_end
+        DO j=jj_begin-offset,jj_end+offset
+          DO i=ii_begin-offset,ii_end+offset
+            ij=(j-1)*iim+i
+            pmid(ij,l) = 0.5*(ap(l)+ap(l+1) + (bp(l)+bp(l+1)) * ps(ij))
+          ENDDO
+        ENDDO
+      ENDDO
+    END IF
+
+  END SUBROUTINE compute_pression_mid
+
+END MODULE pression_mod
Index: codes/icosagcm/devel/src/diagnostics/theta_rhodz.f90
===================================================================
--- codes/icosagcm/devel/src/diagnostics/theta_rhodz.f90	(revision 533)
+++ codes/icosagcm/devel/src/diagnostics/theta_rhodz.f90	(revision 533)
@@ -0,0 +1,258 @@
+MODULE theta2theta_rhodz_mod
+  USE field_mod
+  PRIVATE
+  TYPE(t_field), POINTER, SAVE  :: f_p(:)
+
+  PUBLIC :: init_theta2theta_rhodz, theta_rhodz2theta, &
+       theta_rhodz2temperature, temperature2theta_rhodz, &
+       theta2theta_rhodz, &
+       compute_theta2theta_rhodz, compute_theta_rhodz2theta
+
+CONTAINS
+  
+  SUBROUTINE init_theta2theta_rhodz
+  USE icosa
+  USE field_mod
+  IMPLICIT NONE
+    CALL allocate_field(f_p,field_t,type_real,llm+1,name='p (theta2theta_rhodz_mod)')    
+  END SUBROUTINE init_theta2theta_rhodz
+
+
+  SUBROUTINE theta_rhodz2theta(f_ps,f_theta_rhodz,f_theta)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ps(:)
+    TYPE(t_field), POINTER :: f_theta_rhodz(:)
+    TYPE(t_field), POINTER :: f_theta(:)
+  
+    REAL(rstd), POINTER :: ps(:)
+    REAL(rstd), POINTER :: theta_rhodz(:,:)
+    REAL(rstd), POINTER :: theta(:,:)
+    INTEGER :: ind
+
+!$OMP BARRIER
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      ps=f_ps(ind)
+      theta_rhodz=f_theta_rhodz(ind)
+      theta=f_theta(ind)
+      CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0)
+    ENDDO
+!$OMP BARRIER
+  
+  END SUBROUTINE theta_rhodz2theta
+
+  SUBROUTINE theta_rhodz2temperature(f_ps,f_theta_rhodz,f_temp)
+  USE icosa
+  USE pression_mod
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ps(:)
+    TYPE(t_field), POINTER :: f_theta_rhodz(:)
+    TYPE(t_field), POINTER :: f_temp(:)
+  
+    REAL(rstd), POINTER :: ps(:)
+    REAL(rstd), POINTER :: theta_rhodz(:,:,:)
+    REAL(rstd), POINTER :: temp(:,:)
+    REAL(rstd), POINTER :: p(:,:)
+    INTEGER :: ind
+
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      ps=f_ps(ind)
+      p=f_p(ind)
+      theta_rhodz=f_theta_rhodz(ind)
+      temp=f_temp(ind)
+
+!$OMP BARRIER
+      CALL compute_pression(ps,p,0)
+!$OMP BARRIER
+      CALL compute_theta_rhodz2temperature(p, theta_rhodz(:,:,1),temp,0)
+    ENDDO
+!$OMP BARRIER
+  
+  END SUBROUTINE theta_rhodz2temperature
+ 
+  SUBROUTINE temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
+  USE icosa
+  USE pression_mod
+  USE exner_mod
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ps(:)
+    TYPE(t_field), POINTER :: f_theta_rhodz(:)
+    TYPE(t_field), POINTER :: f_temp(:)
+  
+    REAL(rstd), POINTER :: ps(:)
+    REAL(rstd), POINTER :: theta_rhodz(:,:,:)
+    REAL(rstd), POINTER :: temp(:,:)
+    REAL(rstd), POINTER :: p(:,:)
+    INTEGER :: ind
+
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      ps=f_ps(ind)
+      p=f_p(ind)
+      theta_rhodz=f_theta_rhodz(ind)
+      temp=f_temp(ind)
+
+!$OMP BARRIER
+      CALL compute_pression(ps,p,0)
+!$OMP BARRIER
+      CALL compute_temperature2theta_rhodz(p, temp, theta_rhodz(:,:,1), 0)
+    ENDDO
+!$OMP BARRIER
+  
+  END SUBROUTINE temperature2theta_rhodz
+ 
+ 
+    
+  SUBROUTINE theta2theta_rhodz(f_ps,f_theta,f_theta_rhodz)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ps(:)
+    TYPE(t_field), POINTER :: f_theta(:)
+    TYPE(t_field), POINTER :: f_theta_rhodz(:)
+  
+    REAL(rstd), POINTER :: ps(:)
+    REAL(rstd), POINTER :: theta(:,:)
+    REAL(rstd), POINTER :: theta_rhodz(:,:)
+    INTEGER :: ind
+
+!$OMP BARRIER
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      ps=f_ps(ind)
+      theta=f_theta(ind)
+      theta_rhodz=f_theta_rhodz(ind)
+      CALL compute_theta2theta_rhodz(ps, theta, theta_rhodz,0)
+    ENDDO
+!$OMP BARRIER
+  
+  END SUBROUTINE theta2theta_rhodz
+  
+  SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset)
+  USE icosa
+  USE disvert_mod
+  USE omp_para
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
+    REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm)
+    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
+    INTEGER,INTENT(IN) :: offset
+    REAL(rstd) :: rhodz
+    INTEGER :: i,j,ij,l
+    
+!$OMP BARRIER
+    DO    l    = ll_begin, ll_end
+      DO j=jj_begin-offset,jj_end+offset
+        DO i=ii_begin-offset,ii_end+offset
+          ij=(j-1)*iim+i
+          rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g
+          theta_rhodz(ij,l) = theta(ij,l) * rhodz
+        ENDDO
+      ENDDO
+    ENDDO
+!$OMP BARRIER
+
+
+  END SUBROUTINE compute_theta2theta_rhodz
+
+  SUBROUTINE compute_theta_rhodz2theta(ps,theta_rhodz,theta,offset)
+  USE icosa
+  USE disvert_mod
+  USE omp_para
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
+    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
+    REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm)
+    INTEGER,INTENT(IN) :: offset
+    REAL(rstd) :: rhodz
+    INTEGER :: i,j,ij,l
+
+!$OMP BARRIER
+    DO    l    = ll_begin, ll_end
+      DO j=jj_begin-offset,jj_end+offset
+        DO i=ii_begin-offset,ii_end+offset
+          ij=(j-1)*iim+i
+          rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g
+          theta(ij,l) = theta_rhodz(ij,l) / rhodz
+        ENDDO
+      ENDDO
+    ENDDO
+!$OMP BARRIER
+
+    
+  END SUBROUTINE compute_theta_rhodz2theta
+
+
+
+
+
+
+  SUBROUTINE compute_theta_rhodz2temperature(p,theta_rhodz,temp,offset)
+  USE icosa
+  USE pression_mod
+  USE exner_mod
+  USE omp_para
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
+    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
+    REAL(rstd),INTENT(OUT) :: temp(iim*jjm,llm)
+    INTEGER,INTENT(IN) :: offset
+    REAL(rstd) :: pk_ij
+    INTEGER :: i,j,ij,l
+        
+! flush p
+!$OMP BARRIER
+    DO    l    = ll_begin, ll_end
+      DO j=jj_begin-offset,jj_end+offset
+        DO i=ii_begin-offset,ii_end+offset
+          ij=(j-1)*iim+i
+          pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa
+          temp(ij,l) = ( theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g) ) * pk_ij
+        ENDDO
+      ENDDO
+    ENDDO
+!$OMP BARRIER
+    
+    
+  END SUBROUTINE compute_theta_rhodz2temperature
+
+  SUBROUTINE compute_temperature2theta_rhodz(p,temp,theta_rhodz,offset)
+  USE icosa
+  USE pression_mod
+  USE exner_mod
+  USE omp_para
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN)  :: p(iim*jjm,llm+1)
+    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
+    REAL(rstd),INTENT(IN)  :: temp(iim*jjm,llm)
+    INTEGER,INTENT(IN) :: offset
+    REAL(rstd) :: pk_ij
+    INTEGER :: i,j,ij,l
+
+        
+! flush p
+!$OMP BARRIER
+
+    DO    l    = ll_begin, ll_end
+      DO j=jj_begin-offset,jj_end+offset
+        DO i=ii_begin-offset,ii_end+offset
+          ij=(j-1)*iim+i
+          pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa
+          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / pk_ij
+        ENDDO
+      ENDDO
+    ENDDO
+!$OMP BARRIER
+    
+  END SUBROUTINE compute_temperature2theta_rhodz
+   
+END MODULE theta2theta_rhodz_mod
Index: codes/icosagcm/devel/src/diagnostics/vorticity.f90
===================================================================
--- codes/icosagcm/devel/src/diagnostics/vorticity.f90	(revision 533)
+++ codes/icosagcm/devel/src/diagnostics/vorticity.f90	(revision 533)
@@ -0,0 +1,56 @@
+MODULE vorticity_mod
+
+CONTAINS
+
+  SUBROUTINE vorticity(f_ue,f_vort)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ue(:)
+    TYPE(t_field), POINTER :: f_vort(:)
+  
+    REAL(rstd), POINTER :: ue(:,:)
+    REAL(rstd), POINTER :: vort(:,:)
+    INTEGER :: ind
+
+    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)
+      ue=f_ue(ind)
+      vort=f_vort(ind)
+      CALL compute_vorticity(ue, vort)
+    ENDDO
+  
+  END SUBROUTINE vorticity
+  
+  SUBROUTINE compute_vorticity(ue,vort)
+  USE icosa
+  USE disvert_mod
+  USE omp_para
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN)  :: ue(3*iim*jjm,llm)
+    REAL(rstd),INTENT(OUT) :: vort(2*iim*jjm,llm)
+    INTEGER :: i,j,ij,l
+
+    DO l = ll_begin,ll_end
+      DO j=jj_begin-1,jj_end+1
+        DO i=ii_begin-1,ii_end+1
+          ij=(j-1)*iim+i
+        
+           vort(ij+z_up,l) = 1./Av(ij+z_up)*(  ne(ij,rup)        * ue(ij+u_rup,l)        * de(ij+u_rup)         &
+                                + ne(ij+t_rup,left) * ue(ij+t_rup+u_left,l) * de(ij+t_rup+u_left)               &
+                                - ne(ij,lup)        * ue(ij+u_lup,l)        * de(ij+u_lup) )                               
+
+           vort(ij+z_down,l) = 1./Av(ij+z_down)*(  ne(ij,ldown)         * ue(ij+u_ldown,l)         * de(ij+u_ldown)          &
+                                   + ne(ij+t_ldown,right) * ue(ij+t_ldown+u_right,l) * de(ij+t_ldown+u_right)                &
+                                   - ne(ij,rdown)         * ue(ij+u_rdown,l)          * de(ij+u_rdown) )
+
+        ENDDO
+      ENDDO
+    ENDDO
+    
+  END SUBROUTINE compute_vorticity
+
+END MODULE vorticity_mod
Index: codes/icosagcm/devel/src/diagnostics/wind.f90
===================================================================
--- codes/icosagcm/devel/src/diagnostics/wind.f90	(revision 533)
+++ codes/icosagcm/devel/src/diagnostics/wind.f90	(revision 533)
@@ -0,0 +1,408 @@
+MODULE wind_mod
+
+CONTAINS
+
+  SUBROUTINE un2ulonlat(f_u, f_ulon, f_ulat)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_u(:) ! IN  : normal velocity components on edges
+    TYPE(t_field), POINTER :: f_ulon(:), f_ulat(:) ! OUT : velocity reconstructed at hexagons
+    
+    REAL(rstd),POINTER :: u(:,:),  ulon(:,:), ulat(:,:)
+    INTEGER :: ind
+
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       u=f_u(ind)
+       ulon=f_ulon(ind)
+       ulat=f_ulat(ind)
+       CALL compute_un2ulonlat(u,ulon, ulat)
+    END DO
+
+  END SUBROUTINE un2ulonlat
+
+  SUBROUTINE ulonlat2un(f_ulon, f_ulat,f_u)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ulon(:), f_ulat(:) ! IN : velocity reconstructed at hexagons
+    TYPE(t_field), POINTER :: f_u(:) ! OUT  : normal velocity components on edges
+    
+    REAL(rstd),POINTER :: u(:,:),  ulon(:,:), ulat(:,:)
+    INTEGER :: ind
+
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       u=f_u(ind)
+       ulon=f_ulon(ind)
+       ulat=f_ulat(ind)
+       CALL compute_ulonlat2un(ulon, ulat,u)
+    END DO
+
+  END SUBROUTINE ulonlat2un
+ 
+  SUBROUTINE compute_wind_centered(ue,ucenter)
+  USE icosa
+  USE omp_para
+  IMPLICIT NONE
+  REAL(rstd) :: ue(3*iim*jjm,llm)
+  REAL(rstd) :: ucenter(iim*jjm,3,llm)
+  INTEGER :: i,j,ij,l    
+ 
+    DO l=ll_begin,ll_end
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          ucenter(ij,:,l)=1/Ai(ij)*                                                                                                &
+                        ( ne(ij,right)*ue(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_v(ij+z_rup,:))/2-centroid(ij,:))  &
+                         + ne(ij,rup)*ue(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_v(ij+z_up,:))/2-centroid(ij,:))          &
+                         + ne(ij,lup)*ue(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_v(ij+z_lup,:))/2-centroid(ij,:))          &
+                         + ne(ij,left)*ue(ij+u_left,l)*le(ij+u_left)*((xyz_v(ij+z_lup,:)+xyz_v(ij+z_ldown,:))/2-centroid(ij,:))    &
+                         + ne(ij,ldown)*ue(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_v(ij+z_ldown,:)+xyz_v(ij+z_down,:))/2-centroid(ij,:))&
+                         + ne(ij,rdown)*ue(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_v(ij+z_down,:)+xyz_v(ij+z_rdown,:))/2-centroid(ij,:)))
+        ENDDO
+      ENDDO
+    ENDDO
+ 
+ END SUBROUTINE compute_wind_centered
+ 
+  
+ SUBROUTINE compute_wind_on_edge(ue,uedge)
+  USE icosa
+  USE omp_para
+    
+  IMPLICIT NONE
+  REAL(rstd) :: ue(3*iim*jjm,llm)
+  REAL(rstd) :: uedge(3*iim*jjm,3,llm)
+
+  REAL(rstd) :: ut(3*iim*jjm,llm)
+  INTEGER :: i,j,ij,l     
+    
+    CALL compute_tangential_compound(ue,ut)
+  
+    DO l=ll_begin,ll_end
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          uedge(ij+u_right,:,l)=ue(ij+u_right,l)*ep_e(ij+u_right,:)*ne(ij,right) + ut(ij+u_right,l)*et_e(ij+u_right,:)*ne(ij,right) 
+          uedge(ij+u_lup,:,l)=ue(ij+u_lup,l)*ep_e(ij+u_lup,:)*ne(ij,lup) + ut(ij+u_lup,l)*et_e(ij+u_lup,:)*ne(ij,lup)
+          uedge(ij+u_ldown,:,l)=ue(ij+u_ldown,l)*ep_e(ij+u_ldown,:)*ne(ij,ldown) + ut(ij+u_ldown,l)*et_e(ij+u_ldown,:)*ne(ij,ldown)
+        ENDDO
+      ENDDO
+    ENDDO
+ 
+ END SUBROUTINE compute_wind_on_edge
+ 
+ 
+ 
+ SUBROUTINE compute_tangential_compound(ue,ut)
+  USE icosa  
+  USE omp_para
+  IMPLICIT NONE
+  REAL(rstd) :: ue(3*iim*jjm,llm)
+  REAL(rstd) :: ut(3*iim*jjm,llm)
+  INTEGER :: i,j,l,ij
+    
+  DO l=ll_begin,ll_end
+    DO j=jj_begin,jj_end
+      DO i=ii_begin,ii_end
+        ij=(j-1)*iim+i
+   
+        ut(ij+u_right,l) = 1/de(ij+u_right) *                                            &  
+                         ( wee(ij+u_right,1,1)*ue(ij+u_rup,l)+                           &
+                           wee(ij+u_right,2,1)*ue(ij+u_lup,l)+                           &
+                           wee(ij+u_right,3,1)*ue(ij+u_left,l)+                          &
+                           wee(ij+u_right,4,1)*ue(ij+u_ldown,l)+                         &
+                           wee(ij+u_right,5,1)*ue(ij+u_rdown,l)+                         & 
+                           wee(ij+u_right,1,2)*ue(ij+t_right+u_ldown,l)+                 &
+                           wee(ij+u_right,2,2)*ue(ij+t_right+u_rdown,l)+                 &
+                           wee(ij+u_right,3,2)*ue(ij+t_right+u_right,l)+                 &
+                           wee(ij+u_right,4,2)*ue(ij+t_right+u_rup,l)+                   &
+                           wee(ij+u_right,5,2)*ue(ij+t_right+u_lup,l) )   
+     
+        ut(ij+u_lup,l) =  1/de(ij+u_lup) *                                           &  
+                         ( wee(ij+u_lup,1,1)*ue(ij+u_left,l)+                        &
+                           wee(ij+u_lup,2,1)*ue(ij+u_ldown,l)+                       &
+                           wee(ij+u_lup,3,1)*ue(ij+u_rdown,l)+                       &
+                           wee(ij+u_lup,4,1)*ue(ij+u_right,l)+                       &
+                           wee(ij+u_lup,5,1)*ue(ij+u_rup,l)+                         & 
+                           wee(ij+u_lup,1,2)*ue(ij+t_lup+u_right,l)+                 &
+                           wee(ij+u_lup,2,2)*ue(ij+t_lup+u_rup,l)+                   &
+                           wee(ij+u_lup,3,2)*ue(ij+t_lup+u_lup,l)+                   &
+                           wee(ij+u_lup,4,2)*ue(ij+t_lup+u_left,l)+                  &
+                           wee(ij+u_lup,5,2)*ue(ij+t_lup+u_ldown,l) )
+
+    
+        ut(ij+u_ldown,l) = 1/de(ij+u_ldown) *   &  
+                         ( wee(ij+u_ldown,1,1)*ue(ij+u_rdown,l)+                      &
+                           wee(ij+u_ldown,2,1)*ue(ij+u_right,l)+                      &
+                           wee(ij+u_ldown,3,1)*ue(ij+u_rup,l)+                        &
+                           wee(ij+u_ldown,4,1)*ue(ij+u_lup,l)+                        &
+                           wee(ij+u_ldown,5,1)*ue(ij+u_left,l)+                       & 
+                           wee(ij+u_ldown,1,2)*ue(ij+t_ldown+u_lup,l)+                &
+                           wee(ij+u_ldown,2,2)*ue(ij+t_ldown+u_left,l)+               &
+                           wee(ij+u_ldown,3,2)*ue(ij+t_ldown+u_ldown,l)+              &
+                           wee(ij+u_ldown,4,2)*ue(ij+t_ldown+u_rdown,l)+              &
+                           wee(ij+u_ldown,5,2)*ue(ij+t_ldown+u_right,l) )  
+        
+        ENDDO
+      ENDDO
+    ENDDO
+                        
+ END SUBROUTINE compute_tangential_compound
+ 
+ SUBROUTINE compute_wind_lonlat_compound(u, ulon, ulat)
+  USE icosa  
+  USE omp_para
+    
+  IMPLICIT NONE
+  REAL(rstd) :: u(3*iim*jjm,3,llm)
+  REAL(rstd) :: ulon(3*iim*jjm,3,llm)
+  REAL(rstd) :: ulat(3*iim*jjm,3,llm)
+
+  INTEGER :: i,j,ij,l     
+    
+  
+    DO l=ll_begin,ll_end
+      DO j=jj_begin-1,jj_end+1
+        DO i=ii_begin-1,ii_end+1
+          ij=(j-1)*iim+i
+          ulon(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elon_e(ij+u_right,:))*elon_e(ij+u_right,:) 
+          ulon(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elon_e(ij+u_lup,:))*elon_e(ij+u_lup,:)
+          ulon(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elon_e(ij+u_ldown,:))*elon_e(ij+u_ldown,:)
+          
+          ulat(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elat_e(ij+u_right,:))*elat_e(ij+u_right,:) 
+          ulat(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elat_e(ij+u_lup,:))*elat_e(ij+u_lup,:) 
+          ulat(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elat_e(ij+u_ldown,:))*elat_e(ij+u_ldown,:) 
+          
+        ENDDO
+      ENDDO
+    ENDDO
+ 
+ END SUBROUTINE compute_wind_lonlat_compound
+ 
+  SUBROUTINE compute_wind_from_lonlat_compound(ulon, ulat, u)
+  USE icosa  
+  USE omp_para
+    
+  IMPLICIT NONE
+  REAL(rstd) :: u(3*iim*jjm,3,llm)
+  REAL(rstd) :: ulon(3*iim*jjm,llm)
+  REAL(rstd) :: ulat(3*iim*jjm,llm)
+
+  INTEGER :: i,j,ij,l     
+  
+    DO l=ll_begin,ll_end
+      DO j=jj_begin-1,jj_end+1
+        DO i=ii_begin-1,ii_end+1
+          ij=(j-1)*iim+i
+          u(ij+u_right,:,l)=ulon(ij+u_right,l)*elon_e(ij+u_right,:)+ ulat(ij+u_right,l)*elat_e(ij+u_right,:)
+          u(ij+u_lup,:,l)=ulon(ij+u_lup,l)*elon_e(ij+u_lup,:) + ulat(ij+u_lup,l)*elat_e(ij+u_lup,:)
+          u(ij+u_ldown,:,l)=ulon(ij+u_ldown,l)*elon_e(ij+u_ldown,:) + ulat(ij+u_ldown,l)*elat_e(ij+u_ldown,:)
+        ENDDO
+      ENDDO
+    ENDDO
+ 
+  END SUBROUTINE compute_wind_from_lonlat_compound
+ 
+  SUBROUTINE compute_wind_centered_from_lonlat_compound(ulon, ulat, u)
+  USE icosa  
+  USE omp_para
+    
+  IMPLICIT NONE
+  REAL(rstd) :: u(iim*jjm,3,llm)
+  REAL(rstd) :: ulon(iim*jjm,llm)
+  REAL(rstd) :: ulat(iim*jjm,llm)
+
+  INTEGER :: i,j,ij,l     
+  DO l=ll_begin,ll_end
+      DO j=jj_begin-1,jj_end+1
+        DO i=ii_begin-1,ii_end+1
+          ij=(j-1)*iim+i
+          u(ij,:,l)=ulon(ij,l)*elon_i(ij,:)+ ulat(ij,l)*elat_i(ij,:)
+        ENDDO
+      ENDDO
+    ENDDO
+ 
+  END SUBROUTINE compute_wind_centered_from_lonlat_compound
+ 
+  SUBROUTINE compute_wind2D_from_lonlat_compound(ulon, ulat, u)
+  USE icosa  
+  
+  IMPLICIT NONE
+  REAL(rstd) :: u(3*iim*jjm,3)
+  REAL(rstd) :: ulon(3*iim*jjm)
+  REAL(rstd) :: ulat(3*iim*jjm)
+  
+  INTEGER :: i,j,ij
+  
+  DO j=jj_begin-1,jj_end+1
+     DO i=ii_begin-1,ii_end+1
+        ij=(j-1)*iim+i
+        u(ij+u_right,:)=ulon(ij+u_right)*elon_e(ij+u_right,:)+ ulat(ij+u_right)*elat_e(ij+u_right,:)
+        u(ij+u_lup,:)=ulon(ij+u_lup)*elon_e(ij+u_lup,:) + ulat(ij+u_lup)*elat_e(ij+u_lup,:)
+        u(ij+u_ldown,:)=ulon(ij+u_ldown)*elon_e(ij+u_ldown,:) + ulat(ij+u_ldown)*elat_e(ij+u_ldown,:)
+     ENDDO
+  ENDDO
+    
+  END SUBROUTINE compute_wind2D_from_lonlat_compound
+ 
+  SUBROUTINE compute_wind_perp_from_lonlat_compound(ulon, ulat, up)
+  USE icosa  
+  USE omp_para
+    
+  IMPLICIT NONE
+  REAL(rstd) :: up(3*iim*jjm,llm)
+  REAL(rstd) :: ulon(3*iim*jjm,llm)
+  REAL(rstd) :: ulat(3*iim*jjm,llm)
+  REAL(rstd) :: u(3*iim*jjm,3,llm)
+
+  INTEGER :: i,j,ij,l     
+  
+   CALL compute_wind_from_lonlat_compound(ulon, ulat, u)
+
+    DO l=ll_begin,ll_end
+      DO j=jj_begin-1,jj_end+1
+        DO i=ii_begin-1,ii_end+1
+          ij=(j-1)*iim+i
+          up(ij+u_right,l)=sum(u(ij+u_right,:,l)*ep_e(ij+u_right,:))
+          up(ij+u_lup,l)=sum(u(ij+u_lup,:,l)*ep_e(ij+u_lup,:))
+          up(ij+u_ldown,l)=sum(u(ij+u_ldown,:,l)*ep_e(ij+u_ldown,:))
+        ENDDO
+      ENDDO
+    ENDDO
+ 
+  END SUBROUTINE compute_wind_perp_from_lonlat_compound
+   
+  SUBROUTINE compute_wind2D_perp_from_lonlat_compound(ulon, ulat, up)
+  USE icosa  
+    
+  IMPLICIT NONE
+  REAL(rstd) :: up(3*iim*jjm)
+  REAL(rstd) :: ulon(3*iim*jjm)
+  REAL(rstd) :: ulat(3*iim*jjm)
+  REAL(rstd) :: u(3*iim*jjm,3)
+
+  INTEGER :: i,j,ij 
+  
+  CALL compute_wind2D_from_lonlat_compound(ulon, ulat, u)
+  DO j=jj_begin-1,jj_end+1
+     DO i=ii_begin-1,ii_end+1
+        ij=(j-1)*iim+i
+        up(ij+u_right)=sum(u(ij+u_right,:)*ep_e(ij+u_right,:))
+        up(ij+u_lup)=sum(u(ij+u_lup,:)*ep_e(ij+u_lup,:))
+        up(ij+u_ldown)=sum(u(ij+u_ldown,:)*ep_e(ij+u_ldown,:))
+     ENDDO
+  ENDDO
+   
+  END SUBROUTINE compute_wind2D_perp_from_lonlat_compound
+   
+ SUBROUTINE compute_wind_centered_lonlat_compound(uc, ulon, ulat)
+  USE icosa  
+  USE omp_para
+    
+  IMPLICIT NONE
+  REAL(rstd) :: uc(iim*jjm,3,llm)
+  REAL(rstd) :: ulon(iim*jjm,llm)
+  REAL(rstd) :: ulat(iim*jjm,llm)
+
+  INTEGER :: i,j,ij,l     
+    
+  
+    DO l=ll_begin,ll_end
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          ulon(ij,l)=sum(uc(ij,:,l)*elon_i(ij,:))
+          ulat(ij,l)=sum(uc(ij,:,l)*elat_i(ij,:)) 
+        ENDDO
+      ENDDO
+    ENDDO
+ 
+ END SUBROUTINE compute_wind_centered_lonlat_compound
+
+ SUBROUTINE compute_wind_centered_from_wind_lonlat_centered(ulon, ulat,uc)
+  USE icosa  
+  USE omp_para
+    
+  IMPLICIT NONE
+  REAL(rstd) :: ulon(iim*jjm,llm)
+  REAL(rstd) :: ulat(iim*jjm,llm)
+  REAL(rstd) :: uc(iim*jjm,3,llm)
+
+  INTEGER :: i,j,ij,l     
+    
+  
+    DO l=ll_begin,ll_end
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          uc(ij,:,l)=ulon(ij,l)*elon_i(ij,:)+ulat(ij,l)*elat_i(ij,:)
+        ENDDO
+      ENDDO
+    ENDDO
+ 
+ END SUBROUTINE compute_wind_centered_from_wind_lonlat_centered
+
+
+
+ SUBROUTINE compute_wind_perp_from_wind_centered(uc,un)
+  USE icosa  
+  USE omp_para
+    
+  IMPLICIT NONE
+  REAL(rstd),INTENT(IN)   :: uc(iim*jjm,3,llm)
+  REAL(rstd),INTENT(OUT)  :: un(3*iim*jjm,llm)
+
+  INTEGER :: i,j,ij,l     
+    
+  
+    DO l=ll_begin,ll_end
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          un(ij+u_right,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:))
+          un(ij+u_lup,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:))
+          un(ij+u_ldown,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:))
+         ENDDO
+      ENDDO
+    ENDDO
+ 
+ END SUBROUTINE compute_wind_perp_from_wind_centered
+
+
+ SUBROUTINE compute_un2ulonlat(un, ulon, ulat)
+  USE icosa  
+    
+  IMPLICIT NONE
+  REAL(rstd),INTENT(IN)  :: un(3*iim*jjm,llm)
+  REAL(rstd),INTENT(OUT) :: ulon(iim*jjm,llm)
+  REAL(rstd),INTENT(OUT) :: ulat(iim*jjm,llm)
+
+  REAL(rstd)             :: uc(iim*jjm,3,llm)
+    
+  CALL compute_wind_centered(un,uc)  
+  CALL compute_wind_centered_lonlat_compound(uc, ulon, ulat)
+ 
+ END SUBROUTINE compute_un2ulonlat
+
+ SUBROUTINE compute_ulonlat2un(ulon, ulat,un)
+  USE icosa  
+    
+  IMPLICIT NONE
+  REAL(rstd),INTENT(IN) :: ulon(iim*jjm,llm)
+  REAL(rstd),INTENT(IN) :: ulat(iim*jjm,llm)
+  REAL(rstd),INTENT(OUT)  :: un(3*iim*jjm,llm)
+
+  REAL(rstd)             :: uc(iim*jjm,3,llm)
+    
+    CALL compute_wind_centered_from_wind_lonlat_centered(ulon, ulat, uc)  
+    CALL compute_wind_perp_from_wind_centered(uc, un)
+ 
+ END SUBROUTINE compute_ulonlat2un
+
+
+END MODULE wind_mod
Index: codes/icosagcm/devel/src/dimensions.f90
===================================================================
--- codes/icosagcm/devel/src/dimensions.f90	(revision 531)
+++ 	(revision )
@@ -1,127 +1,0 @@
-MODULE dimensions
-
-    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,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,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,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,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
-
-  SUBROUTINE swap_dimensions(ind)
-  USE domain_mod
-  IMPLICIT NONE
-    INTEGER,INTENT(IN) :: ind
-    
-    TYPE(t_domain),POINTER :: d
-    
-    d=>domain(ind)
-     
-     iim=d%iim
-     jjm=d%jjm
-     ii_begin=d%ii_begin
-     jj_begin=d%jj_begin
-     ii_end=d%ii_end
-     jj_end=d%jj_end
-     ii_nb=d%ii_nb
-     jj_nb=d%jj_nb
-    
-     ij_begin=(jj_begin-1)*iim+ii_begin
-     ij_end=(jj_end-1)*iim+ii_end 
-     ij_begin_ext=((jj_begin-1)-1)*iim+ii_begin-1
-     ij_end_ext = ((jj_end+1)-1)*iim+ii_end+1
-        
-     t_right=d%t_right
-     t_rup=d%t_rup
-     t_lup=d%t_lup
-     t_left=d%t_left
-     t_ldown=d%t_ldown
-     t_rdown=d%t_rdown
-
-     u_right=d%u_right
-     u_rup=d%u_rup
-     u_lup=d%u_lup
-     u_left=d%u_left
-     u_ldown=d%u_ldown
-     u_rdown=d%u_rdown
-
-     z_rup=d%z_rup
-     z_up=d%z_up
-     z_lup=d%z_lup
-     z_ldown=d%z_ldown
-     z_down=d%z_down
-     z_rdown=d%z_rdown
-     
-     t_pos(:)=d%t_pos(:)
-     u_pos(:)=d%u_pos(:)
-     z_pos(:)=d%z_pos(:)
-
-   END SUBROUTINE swap_dimensions
-   
-END MODULE dimensions   
-    
Index: codes/icosagcm/devel/src/dimphys.f90
===================================================================
--- codes/icosagcm/devel/src/dimphys.f90	(revision 531)
+++ 	(revision )
@@ -1,27 +1,0 @@
-MODULE dimphys_mod
-        USE ICOSA
-      INTEGER::nsoilmx=10,offset
-      INTEGER::ngridmx,nlayermx
-      LOGICAL::callrad,calldifv,calladj,callcond,callsoil
-      LOGICAL::season,diurnal,lverbose
-      INTEGER:: iradia
-      REAL:: period_sort,timeperi
-      REAL:: aphelie,periheli,year_day,peri_day,obliquit
-      REAL::e_elips,p_elips,unitastr
-      REAL:: coefvis,coefir
-
-      REAL,ALLOCATABLE:: albedo(:),emissiv(:),inertie(:)
-      REAL,ALLOCATABLE:: tsurf(:),tsoil(:,:)
-      REAL,ALLOCATABLE:: z0(:),rnatur(:)
-      REAL,ALLOCATABLE:: dtrad(:,:) ,fluxrad(:)
-      REAL,ALLOCATABLE:: capcal(:)  ,fluxgrd(:)
-      REAL,ALLOCATABLE:: q2(:,:),q2l(:,:)
-
-
-!      REAL,allocatable:: albedo(:),emissiv(:),inertie(:)
-!      REAL,allocatable:: z0(:),rnatur(:)
-
-!      REAL,allocatable::tsurf(:),tsoil(:,:)
-!      REAL,allocatable::fluxrad(:),fluxgrd(:)
-!      REAL,ALLOCATABLE::capcal(:)
-END MODULE dimphys_mod
Index: codes/icosagcm/devel/src/dissip/dissip_gcm.f90
===================================================================
--- codes/icosagcm/devel/src/dissip/dissip_gcm.f90	(revision 533)
+++ codes/icosagcm/devel/src/dissip/dissip_gcm.f90	(revision 533)
@@ -0,0 +1,907 @@
+MODULE dissip_gcm_mod
+  USE icosa
+
+  PRIVATE
+
+  TYPE(t_field),POINTER,SAVE :: f_due_diss1(:)
+  TYPE(t_field),POINTER,SAVE :: f_due_diss2(:)
+
+  TYPE(t_field),POINTER,SAVE :: f_dtheta_diss(:)
+  TYPE(t_field),POINTER,SAVE :: f_dtheta_rhodz_diss(:)
+  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
+!$OMP THREADPRIVATE(rayleigh_friction_type)
+!$OMP THREADPRIVATE(rayleigh_shear)
+  REAL, SAVE    :: rayleigh_tau
+!$OMP THREADPRIVATE(rayleigh_tau)
+  
+  REAL,SAVE    :: dtdissip
+!$OMP THREADPRIVATE(dtdissip)
+ 
+  PUBLIC init_dissip, dissip
+CONTAINS
+
+  SUBROUTINE allocate_dissip
+  USE icosa
+  IMPLICIT NONE  
+    CALL allocate_field(f_due_diss1,field_u,type_real,llm)
+    CALL allocate_field(f_due_diss2,field_u,type_real,llm)
+    CALL allocate_field(f_dtheta_diss,field_t,type_real,llm)
+    CALL allocate_field(f_dtheta_rhodz_diss,field_t,type_real,llm)
+    ALLOCATE(tau_graddiv(llm))
+    ALLOCATE(tau_gradrot(llm))    
+    ALLOCATE(tau_divgrad(llm))
+  END SUBROUTINE allocate_dissip
+ 
+  SUBROUTINE init_dissip
+  USE icosa
+  USE disvert_mod
+  USE mpi_mod
+  USE mpipara
+  USE transfert_mod
+  USE time_mod
+  USE transfert_omp_mod
+  USE omp_para
+  IMPLICIT NONE
+  
+  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(:)
+  REAL(rstd)            :: dumax,dumax1
+  REAL(rstd)            :: dthetamax,dthetamax1
+  REAL(rstd)            :: r
+  REAL(rstd)            :: tau
+  REAL(rstd)            :: zz, zvert, fact
+  INTEGER               :: l
+  CHARACTER(len=255)    :: rayleigh_friction_key
+  REAL(rstd)            :: mintau
+  INTEGER               :: seed_size
+  INTEGER,ALLOCATABLE   :: seed(:)
+  
+            
+  INTEGER :: i,j,ij,ind,it,iter
+
+   rayleigh_friction_key='none'
+   CALL getin("rayleigh_friction_type",rayleigh_friction_key)
+   SELECT CASE(TRIM(rayleigh_friction_key))
+   CASE('none')
+      rayleigh_friction_type=0
+      IF (is_master) PRINT *, 'No Rayleigh friction'
+   CASE('dcmip2_schaer_noshear')
+      rayleigh_friction_type=1
+      rayleigh_shear=0
+      IF (is_master) PRINT *, 'Rayleigh friction : Schaer-like mountain without shear DCMIP2.1'
+   CASE('dcmip2_schaer_shear')
+      rayleigh_shear=1
+      rayleigh_friction_type=2
+      IF (is_master) PRINT *, 'Rayleigh friction : Schaer-like mountain with shear DCMIP2.2'
+   CASE DEFAULT
+      IF (is_master) PRINT *, 'Bad selector : rayleigh_friction_type =', TRIM(rayleigh_friction_key), &
+        ' in dissip_gcm.f90/init_dissip'
+      STOP
+   END SELECT
+
+   IF(rayleigh_friction_type>0) THEN
+      rayleigh_tau=0.
+      CALL getin("rayleigh_friction_tau",rayleigh_tau)
+      rayleigh_tau = rayleigh_tau / scale_factor
+      IF(rayleigh_tau<=0) THEN
+         IF (is_master) PRINT *, 'Forbidden : negative value for rayleigh_friction_tau =',rayleigh_tau
+         STOP
+      END IF
+   END IF
+
+    CALL allocate_dissip
+    CALL allocate_field(f_u,field_u,type_real)
+    CALL allocate_field(f_du,field_u,type_real)
+    CALL allocate_field(f_theta,field_t,type_real)
+    CALL allocate_field(f_dtheta,field_t,type_real)
+    
+    CALL init_message(f_due_diss1,req_e1_vect,req_due)
+    CALL init_message(f_dtheta_diss,req_i1,req_dtheta)
+
+    tau_graddiv(:)=5000
+    CALL getin("tau_graddiv",tau)
+    tau_graddiv(:)=tau/scale_factor
+
+    CALL getin("nitergdiv",nitergdiv)
+    
+    tau_gradrot(:)=5000
+    CALL getin("tau_gradrot",tau)
+    tau_gradrot(:)=tau/scale_factor
+
+    CALL getin("nitergrot",nitergrot)
+    
+
+    tau_divgrad(:)=5000
+    CALL getin("tau_divgrad",tau)
+    tau_divgrad(:)=tau/scale_factor
+
+    CALL getin("niterdivgrad",niterdivgrad)
+
+
+    cgraddiv=-1
+    cdivgrad=-1
+    cgradrot=-1
+
+!$OMP BARRIER
+!$OMP MASTER
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      u=f_u(ind)
+
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i   
+          CALL RANDOM_NUMBER(r)
+          u(ij+u_right)=r-0.5
+          CALL RANDOM_NUMBER(r)
+          u(ij+u_lup)=r-0.5
+          CALL RANDOM_NUMBER(r)
+          u(ij+u_ldown)=r-0.5
+        ENDDO
+      ENDDO        
+    ENDDO
+!$OMP END MASTER  
+!$OMP BARRIER
+
+    DO it=1,20
+      
+      dumax=0
+      DO iter=1,nitergdiv
+        CALL transfert_request(f_u,req_e1_vect)
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+          CALL swap_dimensions(ind)
+          CALL swap_geometry(ind)
+          u=f_u(ind)
+          du=f_du(ind)
+          CALL compute_gradiv(u,du,1,1)
+          u=du
+        ENDDO
+      ENDDO
+
+      CALL transfert_request(f_du,req_e1_vect)
+      
+      DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+        u=f_u(ind)
+        du=f_du(ind)
+         
+        DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+            ij=(j-1)*iim+i   
+            if (le(ij+u_right)>1e-100) dumax=MAX(dumax,ABS(du(ij+u_right)))
+            if (le(ij+u_lup)>1e-100)   dumax=MAX(dumax,ABS(du(ij+u_lup)))
+            if (le(ij+u_ldown)>1e-100) dumax=MAX(dumax,ABS(du(ij+u_ldown)))
+          ENDDO
+        ENDDO
+      ENDDO
+
+      IF (using_mpi) THEN 
+        CALL reduce_max_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_max_omp(dumax,dumax1)
+        dumax=dumax1
+      ENDIF  
+			
+      DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+        u=f_u(ind)
+        du=f_du(ind)
+        u=du/dumax
+      ENDDO
+      IF (is_master) PRINT *,"gradiv : it :",it ,": dumax",dumax
+
+    ENDDO 
+    IF (is_master) PRINT *,"gradiv : dumax",dumax
+    IF (is_master) PRINT *, 'mean T-cell edge size (km)', 1.45*radius/iim_glo/1000., &
+                              'effective T-cell half-edge size (km)', dumax**(-.5/nitergdiv)/1000
+    IF (is_master)  PRINT *, 'Max. time step assuming c=340 m/s and Courant number=3 (ARK2.3) :', &
+                               3./340.*dumax**(-.5/nitergdiv)
+
+    cgraddiv=dumax**(-1./nitergdiv)
+    IF (is_master) PRINT *,"cgraddiv : ",cgraddiv
+
+!$OMP BARRIER
+!$OMP MASTER
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      u=f_u(ind)
+
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i   
+          CALL RANDOM_NUMBER(r)
+          u(ij+u_right)=r-0.5
+          CALL RANDOM_NUMBER(r)
+          u(ij+u_lup)=r-0.5
+          CALL RANDOM_NUMBER(r)
+          u(ij+u_ldown)=r-0.5
+        ENDDO
+      ENDDO        
+    ENDDO
+!$OMP END MASTER  
+!$OMP BARRIER
+
+
+    DO it=1,20
+ 
+      dumax=0
+      DO iter=1,nitergrot
+        CALL transfert_request(f_u,req_e1_vect)
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+          CALL swap_dimensions(ind)
+          CALL swap_geometry(ind)
+          u=f_u(ind)
+          du=f_du(ind)
+          CALL compute_gradrot(u,du,1,1)
+          u=du
+        ENDDO
+      ENDDO
+
+      CALL transfert_request(f_du,req_e1_vect)
+      
+      DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+        u=f_u(ind)
+        du=f_du(ind)
+        
+        DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+            ij=(j-1)*iim+i   
+            if (le(ij+u_right)>1e-100) dumax=MAX(dumax,ABS(du(ij+u_right)))
+            if (le(ij+u_lup)>1e-100) dumax=MAX(dumax,ABS(du(ij+u_lup)))
+            if (le(ij+u_ldown)>1e-100) dumax=MAX(dumax,ABS(du(ij+u_ldown)))
+          ENDDO
+        ENDDO
+      ENDDO
+
+      IF (using_mpi) THEN 
+        CALL reduce_max_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_max_omp(dumax,dumax1)
+        dumax=dumax1
+      ENDIF  
+
+      
+      DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+        u=f_u(ind)
+        du=f_du(ind)
+        u=du/dumax
+      ENDDO
+      
+      IF (is_master) PRINT *,"gradrot : it :",it ,": dumax",dumax
+
+    ENDDO 
+    IF (is_master) PRINT *,"gradrot : dumax",dumax
+  
+    cgradrot=dumax**(-1./nitergrot) 
+    IF (is_master) PRINT *,"cgradrot : ",cgradrot
+   
+
+
+!$OMP BARRIER
+!$OMP MASTER
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      theta=f_theta(ind)
+ 
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i   
+          CALL RANDOM_NUMBER(r)
+          theta(ij)=r-0.5
+        ENDDO
+      ENDDO  
+    ENDDO
+!$OMP END MASTER
+!$OMP BARRIER
+
+    DO it=1,20
+
+      dthetamax=0
+      DO iter=1,niterdivgrad
+        CALL transfert_request(f_theta,req_i1)
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+          CALL swap_dimensions(ind)
+          CALL swap_geometry(ind)
+          theta=f_theta(ind)
+          dtheta=f_dtheta(ind)
+          CALL compute_divgrad(theta,dtheta,1,1)
+          theta=dtheta
+        ENDDO
+      ENDDO
+
+      CALL transfert_request(f_dtheta,req_i1)
+      
+      DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+        theta=f_theta(ind)
+        dtheta=f_dtheta(ind)
+        
+        DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+            ij=(j-1)*iim+i   
+            dthetamax=MAX(dthetamax,ABS(dtheta(ij)))
+          ENDDO
+        ENDDO
+      ENDDO
+
+      IF (using_mpi) THEN 
+        CALL reduce_max_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_max_omp(dthetamax,dthetamax1)
+        dumax=dumax1
+      ENDIF  
+      
+      IF (is_master) PRINT *,"divgrad : it :",it ,": dthetamax",dthetamax
+
+      DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+        theta=f_theta(ind)
+        dtheta=f_dtheta(ind)
+        theta=dtheta/dthetamax
+      ENDDO
+    ENDDO 
+
+    IF (is_master) PRINT *,"divgrad : divgrad",dthetamax
+  
+    cdivgrad=dthetamax**(-1./niterdivgrad) 
+    IF (is_master) PRINT *,"cdivgrad : ",cdivgrad
+
+     
+    fact=2
+    DO l=1,llm
+       IF(ap_bp_present) THEN ! height-dependent dissipation
+          zz= 1. - preff/presnivs(l)
+       ELSE
+          zz = 0.
+       END IF
+       zvert=fact-(fact-1)/(1+zz*zz)
+       tau_graddiv(l) = tau_graddiv(l)/zvert
+       tau_gradrot(l) = tau_gradrot(l)/zvert
+       tau_divgrad(l) = tau_divgrad(l)/zvert
+    ENDDO
+
+    mintau=tau_graddiv(1)
+    DO l=1,llm
+      mintau=MIN(mintau,tau_graddiv(l))
+      mintau=MIN(mintau,tau_gradrot(l))
+      mintau=MIN(mintau,tau_divgrad(l))
+    ENDDO
+
+    IF(rayleigh_friction_type>0) mintau=MIN(mintau,rayleigh_tau)
+
+    IF(mintau>0) THEN
+       itau_dissip=INT(mintau/dt)
+       dtdissip=itau_dissip*dt
+    ELSE
+       IF (is_master) PRINT *,"No dissipation time set, setting itau_dissip to 1000000000"
+       itau_dissip=100000000
+    END IF
+    itau_dissip=MAX(1,itau_dissip)
+    IF (is_master) PRINT *,"rayleigh_tau",rayleigh_tau, "mintau ",mintau, &
+         "itau_dissip",itau_dissip," dtdissip ",dtdissip
+
+  END SUBROUTINE init_dissip 
+ 
+  
+  SUBROUTINE dissip(f_ps,f_mass,f_phis,f_geopot,f_theta_rhodz,f_ue, f_dtheta_rhodz,f_due)
+  USE icosa
+  USE theta2theta_rhodz_mod
+  USE pression_mod
+  USE exner_mod
+  USE geopotential_mod
+  USE trace
+  USE time_mod
+  USE omp_para
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_ps(:), f_mass(:), f_phis(:), f_geopot(:)
+    TYPE(t_field),POINTER :: f_theta_rhodz(:), f_dtheta_rhodz(:)
+    TYPE(t_field),POINTER :: f_ue(:), f_due(:)
+
+    REAL(rstd),POINTER         :: due(:,:)
+    REAL(rstd),POINTER         :: phi(:,:), ue(:,:)
+    REAL(rstd),POINTER         :: due_diss1(:,:)
+    REAL(rstd),POINTER         :: due_diss2(:,:)
+    REAL(rstd),POINTER         :: dtheta_rhodz(:,:,:)
+    REAL(rstd),POINTER         :: dtheta_rhodz_diss(:,:)
+
+    INTEGER :: ind, shear
+    INTEGER :: l,ij
+
+!$OMP BARRIER
+    
+    CALL trace_start("dissip")
+    CALL gradiv(f_ue,f_due_diss1)
+    CALL gradrot(f_ue,f_due_diss2)
+
+    CALL divgrad_theta_rhodz(f_mass,f_theta_rhodz,f_dtheta_rhodz_diss)
+    
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      due=f_due(ind) 
+      due_diss1=f_due_diss1(ind)
+      due_diss2=f_due_diss2(ind)
+      dtheta_rhodz=f_dtheta_rhodz(ind)
+      dtheta_rhodz_diss=f_dtheta_rhodz_diss(ind)
+
+      DO l=ll_begin,ll_end
+!DIR$ SIMD
+        DO ij=ij_begin,ij_end
+
+            due(ij+u_right,l) = -0.5*( due_diss1(ij+u_right,l)/tau_graddiv(l) + due_diss2(ij+u_right,l)/tau_gradrot(l))*itau_dissip 
+            due(ij+u_lup,l)   = -0.5*( due_diss1(ij+u_lup,l)  /tau_graddiv(l) + due_diss2(ij+u_lup,l)  /tau_gradrot(l))*itau_dissip
+            due(ij+u_ldown,l) = -0.5*( due_diss1(ij+u_ldown,l)/tau_graddiv(l) + due_diss2(ij+u_ldown,l)/tau_gradrot(l))*itau_dissip
+
+            dtheta_rhodz(ij,l,1) = -0.5*dtheta_rhodz_diss(ij,l)/tau_divgrad(l)*itau_dissip
+        ENDDO
+      ENDDO
+
+!      dtheta_rhodz=0
+!      due=0
+
+      IF(rayleigh_friction_type>0) THEN
+         phi=f_geopot(ind)
+         ue=f_ue(ind)
+         DO l=ll_begin,ll_end
+            DO ij=ij_begin,ij_end
+               CALL relax(t_right, u_right)
+               CALL relax(t_lup,   u_lup)
+               CALL relax(t_ldown, u_ldown)
+            ENDDO
+         END DO
+      END IF
+   END DO
+
+   CALL trace_end("dissip")
+
+!$OMP BARRIER
+
+    CONTAINS
+      SUBROUTINE relax(shift_t, shift_u)
+        USE dcmip_initial_conditions_test_1_2_3
+        REAL(rstd) :: z, ulon,ulat, lon,lat, & ! input to test2_schaer_mountain
+             p,hyam,hybm,w,t,phis,ps,rho,q, &   ! unused input/output to test2_schaer_mountain
+             fz, u3d(3), uref
+        REAL(rstd), PARAMETER :: zh=2e4,ztop=3e4  ! DCMIP values
+        LOGICAL :: hybrid_eta
+        INTEGER :: shift_u, shift_t, zcoords, nn
+        z = (phi(ij,l)+phi(ij+shift_t,l))/(2.*g)
+        IF(z>zh) THEN  ! relax only in the sponge layer z>zh
+
+           nn = ij+shift_u
+           zcoords = 1 ; hybrid_eta = .FALSE. ! use z instead of p or hyam/hybm
+           CALL test2_schaer_mountain(lon_e(nn),lat_e(nn),p,z,zcoords,hybrid_eta, &
+                hyam,hybm,shear,ulon,ulat,w,t,phis,ps,rho,q)
+!           u3d = ulon*elon_e(nn,:) + ulat*elat_e(nn,:)
+           u3d = ulon*elon_e(nn,:) ! ulat=0
+           uref = sum(u3d*ep_e(nn,:))
+
+           fz = sin((pi/2)*(z-zh)/(ztop-zh))
+           fz = fz*fz/rayleigh_tau
+           due(nn,l) = due(nn,l) - itau_dissip*fz*(ue(nn,l)-uref)
+!           fz = 1./rayleigh_tau
+!           due(nn,l) = due(nn,l) - fz*ue(nn,l)
+         END IF
+       END SUBROUTINE relax
+      
+  END SUBROUTINE dissip
+
+  SUBROUTINE gradiv(f_ue,f_due)
+  USE icosa
+  USE trace
+  USE omp_para
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_ue(:)
+    TYPE(t_field),POINTER :: f_due(:)
+    REAL(rstd),POINTER    :: ue(:,:)
+    REAL(rstd),POINTER    :: due(:,:)
+    INTEGER :: ind
+    INTEGER :: it,l,ij
+       
+    CALL trace_start("gradiv")
+
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      ue=f_ue(ind)
+      due=f_due(ind) 
+      DO  l = ll_begin, ll_end
+!DIR$ SIMD
+        DO ij=ij_begin,ij_end
+             due(ij+u_right,l)=ue(ij+u_right,l)
+             due(ij+u_lup,l)=ue(ij+u_lup,l)
+             due(ij+u_ldown,l)=ue(ij+u_ldown,l)
+        ENDDO
+      ENDDO
+    ENDDO
+
+    DO it=1,nitergdiv
+        
+      CALL send_message(f_due,req_due)
+      CALL wait_message(req_due)
+        
+      DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+        due=f_due(ind) 
+        CALL compute_gradiv(due,due,ll_begin,ll_end)
+      ENDDO
+    ENDDO
+
+   CALL trace_end("gradiv")
+
+  END SUBROUTINE gradiv
+  
+
+  SUBROUTINE gradrot(f_ue,f_due)
+  USE icosa
+  USE trace
+  USE omp_para
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_ue(:)
+    TYPE(t_field),POINTER :: f_due(:)
+    REAL(rstd),POINTER    :: ue(:,:)
+    REAL(rstd),POINTER    :: due(:,:)
+    INTEGER :: ind
+    INTEGER :: it,l,ij
+       
+    CALL trace_start("gradrot")
+
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      ue=f_ue(ind)
+      due=f_due(ind) 
+      DO  l = ll_begin, ll_end
+!DIR$ SIMD
+        DO ij=ij_begin,ij_end
+             due(ij+u_right,l)=ue(ij+u_right,l)
+             due(ij+u_lup,l)=ue(ij+u_lup,l)
+             due(ij+u_ldown,l)=ue(ij+u_ldown,l)
+        ENDDO
+      ENDDO
+    ENDDO
+
+    DO it=1,nitergrot
+        
+      CALL send_message(f_due,req_due)
+      CALL wait_message(req_due)
+        
+      DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+        due=f_due(ind) 
+        CALL compute_gradrot(due,due,ll_begin,ll_end)
+      ENDDO
+
+    ENDDO
+
+    CALL trace_end("gradrot")
+
+  END SUBROUTINE gradrot
+  
+  SUBROUTINE divgrad(f_theta,f_dtheta)
+  USE icosa
+  USE trace
+  USE omp_para
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_theta(:)
+    TYPE(t_field),POINTER :: f_dtheta(:)
+    REAL(rstd),POINTER    :: theta(:,:)
+    REAL(rstd),POINTER    :: dtheta(:,:)
+    INTEGER :: ind
+    INTEGER :: it
+
+    CALL trace_start("divgrad")
+       
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      theta=f_theta(ind)
+      dtheta=f_dtheta(ind) 
+      dtheta=theta
+    ENDDO
+
+    DO it=1,niterdivgrad
+        
+      CALL transfert_request(f_dtheta,req_i1)
+        
+      DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+        dtheta=f_dtheta(ind) 
+        CALL compute_divgrad(dtheta,dtheta,ll_begin,ll_end)
+      ENDDO
+
+    ENDDO
+
+    CALL trace_end("divgrad")
+
+  END SUBROUTINE divgrad
+   
+  SUBROUTINE divgrad_theta_rhodz(f_mass,f_theta_rhodz,f_dtheta_rhodz)
+  USE icosa
+  USE trace
+  USE omp_para
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_mass(:)
+    TYPE(t_field),POINTER :: f_theta_rhodz(:)
+    TYPE(t_field),POINTER :: f_dtheta_rhodz(:)
+    
+    REAL(rstd),POINTER :: mass(:,:)
+    REAL(rstd),POINTER :: theta_rhodz(:,:,:)
+    REAL(rstd),POINTER :: dtheta_rhodz(:,:)
+
+    INTEGER :: ind
+    INTEGER :: it,l,ij
+
+    CALL trace_start("divgrad")
+
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      mass=f_mass(ind)
+      theta_rhodz=f_theta_rhodz(ind)
+      dtheta_rhodz=f_dtheta_rhodz(ind) 
+      DO  l = ll_begin, ll_end
+!DIR$ SIMD
+        DO ij=ij_begin,ij_end
+            dtheta_rhodz(ij,l) = theta_rhodz(ij,l,1) / mass(ij,l)
+        ENDDO
+      ENDDO
+    ENDDO
+
+    DO it=1,niterdivgrad
+        
+      CALL send_message(f_dtheta_rhodz,req_dtheta)
+      CALL wait_message(req_dtheta)
+      DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+        dtheta_rhodz=f_dtheta_rhodz(ind) 
+        CALL compute_divgrad(dtheta_rhodz,dtheta_rhodz,ll_begin,ll_end)
+      ENDDO
+
+    ENDDO
+
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      dtheta_rhodz=f_dtheta_rhodz(ind) 
+      mass=f_mass(ind)
+    
+      DO  l = ll_begin, ll_end
+!DIR$ SIMD
+        DO ij=ij_begin,ij_end
+            dtheta_rhodz(ij,l) = dtheta_rhodz(ij,l) * mass(ij,l)
+        ENDDO
+      ENDDO
+    ENDDO
+
+
+    CALL trace_end("divgrad")
+
+  END SUBROUTINE divgrad_theta_rhodz  
+  
+  SUBROUTINE compute_gradiv(ue,gradivu_e,llb,lle)
+  USE icosa
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)     :: llb
+    INTEGER,INTENT(IN)     :: lle
+    REAL(rstd),INTENT(IN)  :: ue(iim*3*jjm,llm)
+    REAL(rstd),INTENT(OUT) :: gradivu_e(iim*3*jjm,llm)
+    REAL(rstd) :: divu_i(iim*jjm,llb:lle)
+    
+    INTEGER :: ij,l
+
+    DO l=llb,lle
+!DIR$ SIMD
+      DO ij=ij_begin,ij_end
+          divu_i(ij,l)=1./Ai(ij)*(ne(ij,right)*ue(ij+u_right,l)*le(ij+u_right)  +  &
+                             ne(ij,rup)*ue(ij+u_rup,l)*le(ij+u_rup)        +  &  
+                             ne(ij,lup)*ue(ij+u_lup,l)*le(ij+u_lup)        +  &  
+                             ne(ij,left)*ue(ij+u_left,l)*le(ij+u_left)     +  &  
+                             ne(ij,ldown)*ue(ij+u_ldown,l)*le(ij+u_ldown)  +  &  
+                             ne(ij,rdown)*ue(ij+u_rdown,l)*le(ij+u_rdown))
+      ENDDO
+    ENDDO
+    
+    DO l=llb,lle
+!DIR$ SIMD
+      DO ij=ij_begin,ij_end
+ 
+          gradivu_e(ij+u_right,l)=-1/de(ij+u_right)*(ne(ij,right)*divu_i(ij,l)+ ne(ij+t_right,left)*divu_i(ij+t_right,l) )       
+
+          gradivu_e(ij+u_lup,l)=-1/de(ij+u_lup)*(ne(ij,lup)*divu_i(ij,l)+ ne(ij+t_lup,rdown)*divu_i(ij+t_lup,l))       
+    
+          gradivu_e(ij+u_ldown,l)=-1/de(ij+u_ldown)*(ne(ij,ldown)*divu_i(ij,l)+ne(ij+t_ldown,rup)*divu_i(ij+t_ldown,l) )
+
+      ENDDO
+    ENDDO
+
+    DO l=llb,lle
+!DIR$ SIMD
+      DO ij=ij_begin,ij_end
+          gradivu_e(ij+u_right,l)=-gradivu_e(ij+u_right,l)*cgraddiv
+          gradivu_e(ij+u_lup,l)=-gradivu_e(ij+u_lup,l)*cgraddiv
+          gradivu_e(ij+u_ldown,l)=-gradivu_e(ij+u_ldown,l)*cgraddiv
+      ENDDO
+    ENDDO
+
+   
+  END SUBROUTINE compute_gradiv
+  
+  SUBROUTINE compute_divgrad(theta,divgrad_i,llb,lle)
+  USE icosa
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)     :: llb
+    INTEGER,INTENT(IN)     :: lle
+    REAL(rstd),INTENT(IN)  :: theta(iim*jjm,llm)
+    REAL(rstd),INTENT(OUT) :: divgrad_i(iim*jjm,llm)
+    REAL(rstd)  :: grad_e(3*iim*jjm,llb:lle)
+
+    INTEGER :: ij,l
+
+       
+    DO l=llb,lle
+!DIR$ SIMD
+      DO ij=ij_begin_ext,ij_end_ext
+ 
+          grad_e(ij+u_right,l)=-1/de(ij+u_right)*(ne(ij,right)*theta(ij,l)+ ne(ij+t_right,left)*theta(ij+t_right,l) )        
+
+          grad_e(ij+u_lup,l)=-1/de(ij+u_lup)*(ne(ij,lup)*theta(ij,l)+ ne(ij+t_lup,rdown)*theta(ij+t_lup,l ))       
+    
+          grad_e(ij+u_ldown,l)=-1/de(ij+u_ldown)*(ne(ij,ldown)*theta(ij,l)+ne(ij+t_ldown,rup)*theta(ij+t_ldown,l) )
+
+      ENDDO
+    ENDDO
+    
+    
+    DO l=llb,lle
+!DIR$ SIMD
+      DO ij=ij_begin,ij_end
+
+          divgrad_i(ij,l)=1./Ai(ij)*(ne(ij,right)*grad_e(ij+u_right,l)*le(ij+u_right)  +  &
+                             ne(ij,rup)*grad_e(ij+u_rup,l)*le(ij+u_rup)              +  &  
+                             ne(ij,lup)*grad_e(ij+u_lup,l)*le(ij+u_lup)              +  &  
+                             ne(ij,left)*grad_e(ij+u_left,l)*le(ij+u_left)           +  &  
+                             ne(ij,ldown)*grad_e(ij+u_ldown,l)*le(ij+u_ldown)        +  &  
+                             ne(ij,rdown)*grad_e(ij+u_rdown,l)*le(ij+u_rdown))
+      ENDDO
+    ENDDO
+   
+    DO l=llb,lle
+      DO ij=ij_begin,ij_end
+          divgrad_i(ij,l)=-divgrad_i(ij,l)*cdivgrad
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE compute_divgrad
+
+    
+  SUBROUTINE compute_gradrot(ue,gradrot_e,llb,lle)
+  USE icosa
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)     :: llb
+    INTEGER,INTENT(IN)     :: lle
+    REAL(rstd),INTENT(IN)  :: ue(iim*3*jjm,llm)
+    REAL(rstd),INTENT(OUT) :: gradrot_e(iim*3*jjm,llm)
+    REAL(rstd) :: rot_v(2*iim*jjm,llb:lle)
+
+    INTEGER :: ij,l
+     
+    DO l=llb,lle
+!DIR$ SIMD
+      DO ij=ij_begin_ext,ij_end_ext
+        
+          rot_v(ij+z_up,l)= 1./Av(ij+z_up)*(  ne(ij,rup)*ue(ij+u_rup,l)*de(ij+u_rup)                     &
+                                + ne(ij+t_rup,left)*ue(ij+t_rup+u_left,l)*de(ij+t_rup+u_left)          &
+                                - ne(ij,lup)*ue(ij+u_lup,l)*de(ij+u_lup) ) 
+                              
+          rot_v(ij+z_down,l) = 1./Av(ij+z_down)*( ne(ij,ldown)*ue(ij+u_ldown,l)*de(ij+u_ldown)                 &
+                                     + ne(ij+t_ldown,right)*ue(ij+t_ldown+u_right,l)*de(ij+t_ldown+u_right)  &
+                                     - ne(ij,rdown)*ue(ij+u_rdown,l)*de(ij+u_rdown) )
+  
+      ENDDO
+    ENDDO                              
+  
+    DO l=llb,lle
+!DIR$ SIMD
+      DO ij=ij_begin,ij_end
+  
+          gradrot_e(ij+u_right,l)=1/le(ij+u_right)*ne(ij,right)*(rot_v(ij+z_rdown,l)-rot_v(ij+z_rup,l)) 
+         
+          gradrot_e(ij+u_lup,l)=1/le(ij+u_lup)*ne(ij,lup)*(rot_v(ij+z_up,l)-rot_v(ij+z_lup,l)) 
+        
+          gradrot_e(ij+u_ldown,l)=1/le(ij+u_ldown)*ne(ij,ldown)*(rot_v(ij+z_ldown,l)-rot_v(ij+z_down,l))
+        
+      ENDDO
+    ENDDO
+
+    DO l=llb,lle
+!DIR$ SIMD
+      DO ij=ij_begin,ij_end
+    
+          gradrot_e(ij+u_right,l)=-gradrot_e(ij+u_right,l)*cgradrot       
+          gradrot_e(ij+u_lup,l)=-gradrot_e(ij+u_lup,l)*cgradrot
+          gradrot_e(ij+u_ldown,l)=-gradrot_e(ij+u_ldown,l)*cgradrot
+        
+      ENDDO
+    ENDDO  
+   
+  END SUBROUTINE compute_gradrot
+
+
+END MODULE dissip_gcm_mod
+       
Index: codes/icosagcm/devel/src/dissip/guided_mod.f90
===================================================================
--- codes/icosagcm/devel/src/dissip/guided_mod.f90	(revision 533)
+++ codes/icosagcm/devel/src/dissip/guided_mod.f90	(revision 533)
@@ -0,0 +1,54 @@
+MODULE guided_mod
+
+  CHARACTER(LEN=255),SAVE :: guided_type
+!$OMP THREADPRIVATE(guided_type)
+
+CONTAINS
+
+
+  SUBROUTINE init_guided
+  USE icosa
+  USE guided_ncar_mod, ONLY : init_guided_ncar => init_guided
+  IMPLICIT NONE
+    
+    guided_type='none'
+    CALL getin("guided_type",guided_type)
+    
+    SELECT CASE(TRIM(guided_type))
+      CASE ('none')
+      
+      CASE ('dcmip1')
+        CALL init_guided_ncar
+        
+      CASE DEFAULT
+         PRINT*,"Bad selector for varaible guided_type >",TRIM(guided_type),"> option are <none>, <dcmip1>"
+         STOP
+    END SELECT 
+    
+  END SUBROUTINE init_guided
+
+  
+  SUBROUTINE guided(tt, f_ps, f_theta_rhodz, f_u, f_q)
+  USE icosa
+  USE guided_ncar_mod, ONLY : guided_ncar => guided
+  IMPLICIT NONE
+    REAL(rstd), INTENT(IN):: tt
+    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(:)  
+
+    SELECT CASE(TRIM(guided_type))
+      CASE ('none')
+      CASE ('dcmip1')
+        CALL guided_ncar(tt, f_ps, f_theta_rhodz, f_u, f_q)
+      CASE DEFAULT
+         PRINT*,"Bad selector for varaible guided_type >",TRIM(guided_type),"> option are <none>, <dcmip1>"
+         STOP
+    END SELECT 
+  
+  END SUBROUTINE guided
+  
+END MODULE guided_mod
+  
Index: codes/icosagcm/devel/src/dissip/sponge.f90
===================================================================
--- codes/icosagcm/devel/src/dissip/sponge.f90	(revision 533)
+++ codes/icosagcm/devel/src/dissip/sponge.f90	(revision 533)
@@ -0,0 +1,148 @@
+MODULE sponge_mod
+  USE icosa
+
+  PRIVATE
+  
+  REAL,SAVE :: tau_sponge !inverse of charactericstic relaxation time scale at the topmost layer (Hz)
+  INTEGER,SAVE :: iflag_sponge !0 --> for no sponge
+			       !1 --> for sponge over 4 topmost layers
+			       !2 --> for sponge from top to ~1% of top layer pressure
+  INTEGER,SAVE :: mode_sponge !1 --> u and v relax towards 0
+                              !2 --> u and v relax towards their zonal mean
+                              !3 --> u,v and pot. temp. relax towards their zonal mean
+!$OMP THREADPRIVATE(tau_sponge,iflag_sponge,mode_sponge)
+  REAL,ALLOCATABLE,SAVE :: rdamp(:) ! quenching coefficient
+  REAL,ALLOCATABLE,SAVE:: lambda(:) ! inverse or quenching time scale (Hz)
+
+  PUBLIC sponge, init_sponge, iflag_sponge
+
+CONTAINS
+
+  SUBROUTINE init_sponge
+  USE icosa
+  USE disvert_mod
+  USE omp_para
+  USE mpipara, ONLY: is_mpi_master
+  IMPLICIT NONE
+    INTEGER :: l
+
+    tau_sponge = 1.e-4
+    CALL getin("tau_sponge",tau_sponge)
+    PRINT*,'tau_sponge = ',tau_sponge
+
+    iflag_sponge = 0
+    CALL getin("iflag_sponge",iflag_sponge)
+    PRINT*,'iflag_sponge = ',iflag_sponge
+    
+    mode_sponge = 1
+    CALL getin("mode_sponge",mode_sponge)
+    PRINT*,'mode_sponge = ',mode_sponge
+
+    IF (iflag_sponge == 0) THEN
+      PRINT*,'init_sponge: no sponge'
+      RETURN
+    ENDIF
+
+!$OMP MASTER
+    ALLOCATE(rdamp(llm))
+    ALLOCATE(lambda(llm))
+
+    IF (iflag_sponge == 1) THEN
+! sponge quenching over the topmost 4 atmospheric layers
+        lambda(:)=0.
+        lambda(llm)=tau_sponge
+        lambda(llm-1)=tau_sponge/2.
+        lambda(llm-2)=tau_sponge/4.
+        lambda(llm-3)=tau_sponge/8.
+    ELSE IF (iflag_sponge == 2) THEN
+! sponge quenching over topmost layers down to pressures which are
+! higher than 100 times the topmost layer pressure
+        lambda(:)=tau_sponge*max(presnivs(llm)/presnivs(:)-0.01,0.)
+    ELSE
+      PRINT*,'Bad selector for variable iflag_sponge : <',iflag_sponge,             &
+            '> options are 0,1,2'
+      STOP
+    ENDIF
+
+! quenching coefficient rdamp(:)
+!         rdamp(:)=dt*lambda(:) ! Explicit Euler approx.
+!      rdamp(:)=1.-exp(-lambda(:)*dt)
+    rdamp(:)=itau_dissip*lambda(:)
+
+
+    IF (is_mpi_master) THEN
+      PRINT*,'lambda = '
+      DO l=ll_begin,ll_end
+        PRINT*,l,lambda(l)
+      ENDDO
+      PRINT*,'rdamp = '
+      DO l=ll_begin,ll_end
+        PRINT*,l,rdamp(l)
+      ENDDO
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+
+  END SUBROUTINE init_sponge
+
+  SUBROUTINE sponge(f_ue,f_due,f_theta_rhodz,f_dtheta_rhodz)
+  USE icosa
+  USE theta2theta_rhodz_mod
+  USE pression_mod
+  USE exner_mod
+  USE geopotential_mod
+  USE trace
+  USE time_mod
+  USE omp_para
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_ue(:)
+    TYPE(t_field),POINTER :: f_due(:)
+    TYPE(t_field),POINTER :: f_theta_rhodz(:)
+    TYPE(t_field),POINTER :: f_dtheta_rhodz(:)
+
+    REAL(rstd),POINTER         :: due(:,:)!,due_sponge(:,:)
+    REAL(rstd),POINTER         :: ue(:,:)
+    REAL(rstd),POINTER         :: theta_rhodz(:,:,:)
+    REAL(rstd),POINTER         :: dtheta_rhodz(:,:,:)!,dtheta_sponge(:,:)
+
+    INTEGER :: ind
+    INTEGER :: l,ij
+
+!$OMP BARRIER
+    
+    CALL trace_start("sponge")
+
+    IF (mode_sponge == 1) THEN
+      DO ind=1,ndomain
+        IF (.NOT. assigned_domain(ind)) CYCLE
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+        ue=f_ue(ind) 
+        due=f_due(ind) 
+        theta_rhodz=f_theta_rhodz(ind)
+        dtheta_rhodz=f_dtheta_rhodz(ind)
+
+        DO l=ll_begin,ll_end
+!$SIMD
+          DO ij=ij_begin,ij_end
+
+            due(ij+u_right,l) = -rdamp(l)*ue(ij+u_right,l)
+            due(ij+u_lup,l)   = -rdamp(l)*ue(ij+u_lup,l)
+            due(ij+u_ldown,l) = -rdamp(l)*ue(ij+u_ldown,l)
+
+            dtheta_rhodz(ij,l,:) = 0.0
+          ENDDO
+        ENDDO
+      END DO
+    ELSE
+      PRINT*,'Bad selector for variable mode_sponge : <',mode_sponge,             &
+            '> options 2 and 3 not available for the moment!'
+      STOP
+    ENDIF
+
+   CALL trace_end("sponge")
+
+!$OMP BARRIER
+  END SUBROUTINE sponge
+
+END MODULE sponge_mod
Index: codes/icosagcm/devel/src/dissip_gcm.f90
===================================================================
--- codes/icosagcm/devel/src/dissip_gcm.f90	(revision 531)
+++ 	(revision )
@@ -1,907 +1,0 @@
-MODULE dissip_gcm_mod
-  USE icosa
-
-  PRIVATE
-
-  TYPE(t_field),POINTER,SAVE :: f_due_diss1(:)
-  TYPE(t_field),POINTER,SAVE :: f_due_diss2(:)
-
-  TYPE(t_field),POINTER,SAVE :: f_dtheta_diss(:)
-  TYPE(t_field),POINTER,SAVE :: f_dtheta_rhodz_diss(:)
-  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
-!$OMP THREADPRIVATE(rayleigh_friction_type)
-!$OMP THREADPRIVATE(rayleigh_shear)
-  REAL, SAVE    :: rayleigh_tau
-!$OMP THREADPRIVATE(rayleigh_tau)
-  
-  REAL,SAVE    :: dtdissip
-!$OMP THREADPRIVATE(dtdissip)
- 
-  PUBLIC init_dissip, dissip
-CONTAINS
-
-  SUBROUTINE allocate_dissip
-  USE icosa
-  IMPLICIT NONE  
-    CALL allocate_field(f_due_diss1,field_u,type_real,llm)
-    CALL allocate_field(f_due_diss2,field_u,type_real,llm)
-    CALL allocate_field(f_dtheta_diss,field_t,type_real,llm)
-    CALL allocate_field(f_dtheta_rhodz_diss,field_t,type_real,llm)
-    ALLOCATE(tau_graddiv(llm))
-    ALLOCATE(tau_gradrot(llm))    
-    ALLOCATE(tau_divgrad(llm))
-  END SUBROUTINE allocate_dissip
- 
-  SUBROUTINE init_dissip
-  USE icosa
-  USE disvert_mod
-  USE mpi_mod
-  USE mpipara
-  USE transfert_mod
-  USE time_mod
-  USE transfert_omp_mod
-  USE omp_para
-  IMPLICIT NONE
-  
-  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(:)
-  REAL(rstd)            :: dumax,dumax1
-  REAL(rstd)            :: dthetamax,dthetamax1
-  REAL(rstd)            :: r
-  REAL(rstd)            :: tau
-  REAL(rstd)            :: zz, zvert, fact
-  INTEGER               :: l
-  CHARACTER(len=255)    :: rayleigh_friction_key
-  REAL(rstd)            :: mintau
-  INTEGER               :: seed_size
-  INTEGER,ALLOCATABLE   :: seed(:)
-  
-            
-  INTEGER :: i,j,ij,ind,it,iter
-
-   rayleigh_friction_key='none'
-   CALL getin("rayleigh_friction_type",rayleigh_friction_key)
-   SELECT CASE(TRIM(rayleigh_friction_key))
-   CASE('none')
-      rayleigh_friction_type=0
-      IF (is_master) PRINT *, 'No Rayleigh friction'
-   CASE('dcmip2_schaer_noshear')
-      rayleigh_friction_type=1
-      rayleigh_shear=0
-      IF (is_master) PRINT *, 'Rayleigh friction : Schaer-like mountain without shear DCMIP2.1'
-   CASE('dcmip2_schaer_shear')
-      rayleigh_shear=1
-      rayleigh_friction_type=2
-      IF (is_master) PRINT *, 'Rayleigh friction : Schaer-like mountain with shear DCMIP2.2'
-   CASE DEFAULT
-      IF (is_master) PRINT *, 'Bad selector : rayleigh_friction_type =', TRIM(rayleigh_friction_key), &
-        ' in dissip_gcm.f90/init_dissip'
-      STOP
-   END SELECT
-
-   IF(rayleigh_friction_type>0) THEN
-      rayleigh_tau=0.
-      CALL getin("rayleigh_friction_tau",rayleigh_tau)
-      rayleigh_tau = rayleigh_tau / scale_factor
-      IF(rayleigh_tau<=0) THEN
-         IF (is_master) PRINT *, 'Forbidden : negative value for rayleigh_friction_tau =',rayleigh_tau
-         STOP
-      END IF
-   END IF
-
-    CALL allocate_dissip
-    CALL allocate_field(f_u,field_u,type_real)
-    CALL allocate_field(f_du,field_u,type_real)
-    CALL allocate_field(f_theta,field_t,type_real)
-    CALL allocate_field(f_dtheta,field_t,type_real)
-    
-    CALL init_message(f_due_diss1,req_e1_vect,req_due)
-    CALL init_message(f_dtheta_diss,req_i1,req_dtheta)
-
-    tau_graddiv(:)=5000
-    CALL getin("tau_graddiv",tau)
-    tau_graddiv(:)=tau/scale_factor
-
-    CALL getin("nitergdiv",nitergdiv)
-    
-    tau_gradrot(:)=5000
-    CALL getin("tau_gradrot",tau)
-    tau_gradrot(:)=tau/scale_factor
-
-    CALL getin("nitergrot",nitergrot)
-    
-
-    tau_divgrad(:)=5000
-    CALL getin("tau_divgrad",tau)
-    tau_divgrad(:)=tau/scale_factor
-
-    CALL getin("niterdivgrad",niterdivgrad)
-
-
-    cgraddiv=-1
-    cdivgrad=-1
-    cgradrot=-1
-
-!$OMP BARRIER
-!$OMP MASTER
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      u=f_u(ind)
-
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i   
-          CALL RANDOM_NUMBER(r)
-          u(ij+u_right)=r-0.5
-          CALL RANDOM_NUMBER(r)
-          u(ij+u_lup)=r-0.5
-          CALL RANDOM_NUMBER(r)
-          u(ij+u_ldown)=r-0.5
-        ENDDO
-      ENDDO        
-    ENDDO
-!$OMP END MASTER  
-!$OMP BARRIER
-
-    DO it=1,20
-      
-      dumax=0
-      DO iter=1,nitergdiv
-        CALL transfert_request(f_u,req_e1_vect)
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-          CALL swap_dimensions(ind)
-          CALL swap_geometry(ind)
-          u=f_u(ind)
-          du=f_du(ind)
-          CALL compute_gradiv(u,du,1,1)
-          u=du
-        ENDDO
-      ENDDO
-
-      CALL transfert_request(f_du,req_e1_vect)
-      
-      DO ind=1,ndomain
-        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        u=f_u(ind)
-        du=f_du(ind)
-         
-        DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-            ij=(j-1)*iim+i   
-            if (le(ij+u_right)>1e-100) dumax=MAX(dumax,ABS(du(ij+u_right)))
-            if (le(ij+u_lup)>1e-100)   dumax=MAX(dumax,ABS(du(ij+u_lup)))
-            if (le(ij+u_ldown)>1e-100) dumax=MAX(dumax,ABS(du(ij+u_ldown)))
-          ENDDO
-        ENDDO
-      ENDDO
-
-      IF (using_mpi) THEN 
-        CALL reduce_max_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_max_omp(dumax,dumax1)
-        dumax=dumax1
-      ENDIF  
-			
-      DO ind=1,ndomain
-        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        u=f_u(ind)
-        du=f_du(ind)
-        u=du/dumax
-      ENDDO
-      IF (is_master) PRINT *,"gradiv : it :",it ,": dumax",dumax
-
-    ENDDO 
-    IF (is_master) PRINT *,"gradiv : dumax",dumax
-    IF (is_master) PRINT *, 'mean T-cell edge size (km)', 1.45*radius/iim_glo/1000., &
-                              'effective T-cell half-edge size (km)', dumax**(-.5/nitergdiv)/1000
-    IF (is_master)  PRINT *, 'Max. time step assuming c=340 m/s and Courant number=3 (ARK2.3) :', &
-                               3./340.*dumax**(-.5/nitergdiv)
-
-    cgraddiv=dumax**(-1./nitergdiv)
-    IF (is_master) PRINT *,"cgraddiv : ",cgraddiv
-
-!$OMP BARRIER
-!$OMP MASTER
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      u=f_u(ind)
-
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i   
-          CALL RANDOM_NUMBER(r)
-          u(ij+u_right)=r-0.5
-          CALL RANDOM_NUMBER(r)
-          u(ij+u_lup)=r-0.5
-          CALL RANDOM_NUMBER(r)
-          u(ij+u_ldown)=r-0.5
-        ENDDO
-      ENDDO        
-    ENDDO
-!$OMP END MASTER  
-!$OMP BARRIER
-
-
-    DO it=1,20
- 
-      dumax=0
-      DO iter=1,nitergrot
-        CALL transfert_request(f_u,req_e1_vect)
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-          CALL swap_dimensions(ind)
-          CALL swap_geometry(ind)
-          u=f_u(ind)
-          du=f_du(ind)
-          CALL compute_gradrot(u,du,1,1)
-          u=du
-        ENDDO
-      ENDDO
-
-      CALL transfert_request(f_du,req_e1_vect)
-      
-      DO ind=1,ndomain
-        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        u=f_u(ind)
-        du=f_du(ind)
-        
-        DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-            ij=(j-1)*iim+i   
-            if (le(ij+u_right)>1e-100) dumax=MAX(dumax,ABS(du(ij+u_right)))
-            if (le(ij+u_lup)>1e-100) dumax=MAX(dumax,ABS(du(ij+u_lup)))
-            if (le(ij+u_ldown)>1e-100) dumax=MAX(dumax,ABS(du(ij+u_ldown)))
-          ENDDO
-        ENDDO
-      ENDDO
-
-      IF (using_mpi) THEN 
-        CALL reduce_max_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_max_omp(dumax,dumax1)
-        dumax=dumax1
-      ENDIF  
-
-      
-      DO ind=1,ndomain
-        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        u=f_u(ind)
-        du=f_du(ind)
-        u=du/dumax
-      ENDDO
-      
-      IF (is_master) PRINT *,"gradrot : it :",it ,": dumax",dumax
-
-    ENDDO 
-    IF (is_master) PRINT *,"gradrot : dumax",dumax
-  
-    cgradrot=dumax**(-1./nitergrot) 
-    IF (is_master) PRINT *,"cgradrot : ",cgradrot
-   
-
-
-!$OMP BARRIER
-!$OMP MASTER
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      theta=f_theta(ind)
- 
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i   
-          CALL RANDOM_NUMBER(r)
-          theta(ij)=r-0.5
-        ENDDO
-      ENDDO  
-    ENDDO
-!$OMP END MASTER
-!$OMP BARRIER
-
-    DO it=1,20
-
-      dthetamax=0
-      DO iter=1,niterdivgrad
-        CALL transfert_request(f_theta,req_i1)
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-          CALL swap_dimensions(ind)
-          CALL swap_geometry(ind)
-          theta=f_theta(ind)
-          dtheta=f_dtheta(ind)
-          CALL compute_divgrad(theta,dtheta,1,1)
-          theta=dtheta
-        ENDDO
-      ENDDO
-
-      CALL transfert_request(f_dtheta,req_i1)
-      
-      DO ind=1,ndomain
-        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        theta=f_theta(ind)
-        dtheta=f_dtheta(ind)
-        
-        DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-            ij=(j-1)*iim+i   
-            dthetamax=MAX(dthetamax,ABS(dtheta(ij)))
-          ENDDO
-        ENDDO
-      ENDDO
-
-      IF (using_mpi) THEN 
-        CALL reduce_max_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_max_omp(dthetamax,dthetamax1)
-        dumax=dumax1
-      ENDIF  
-      
-      IF (is_master) PRINT *,"divgrad : it :",it ,": dthetamax",dthetamax
-
-      DO ind=1,ndomain
-        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        theta=f_theta(ind)
-        dtheta=f_dtheta(ind)
-        theta=dtheta/dthetamax
-      ENDDO
-    ENDDO 
-
-    IF (is_master) PRINT *,"divgrad : divgrad",dthetamax
-  
-    cdivgrad=dthetamax**(-1./niterdivgrad) 
-    IF (is_master) PRINT *,"cdivgrad : ",cdivgrad
-
-     
-    fact=2
-    DO l=1,llm
-       IF(ap_bp_present) THEN ! height-dependent dissipation
-          zz= 1. - preff/presnivs(l)
-       ELSE
-          zz = 0.
-       END IF
-       zvert=fact-(fact-1)/(1+zz*zz)
-       tau_graddiv(l) = tau_graddiv(l)/zvert
-       tau_gradrot(l) = tau_gradrot(l)/zvert
-       tau_divgrad(l) = tau_divgrad(l)/zvert
-    ENDDO
-
-    mintau=tau_graddiv(1)
-    DO l=1,llm
-      mintau=MIN(mintau,tau_graddiv(l))
-      mintau=MIN(mintau,tau_gradrot(l))
-      mintau=MIN(mintau,tau_divgrad(l))
-    ENDDO
-
-    IF(rayleigh_friction_type>0) mintau=MIN(mintau,rayleigh_tau)
-
-    IF(mintau>0) THEN
-       itau_dissip=INT(mintau/dt)
-       dtdissip=itau_dissip*dt
-    ELSE
-       IF (is_master) PRINT *,"No dissipation time set, setting itau_dissip to 1000000000"
-       itau_dissip=100000000
-    END IF
-    itau_dissip=MAX(1,itau_dissip)
-    IF (is_master) PRINT *,"rayleigh_tau",rayleigh_tau, "mintau ",mintau, &
-         "itau_dissip",itau_dissip," dtdissip ",dtdissip
-
-  END SUBROUTINE init_dissip 
- 
-  
-  SUBROUTINE dissip(f_ps,f_mass,f_phis,f_geopot,f_theta_rhodz,f_ue, f_dtheta_rhodz,f_due)
-  USE icosa
-  USE theta2theta_rhodz_mod
-  USE pression_mod
-  USE exner_mod
-  USE geopotential_mod
-  USE trace
-  USE time_mod
-  USE omp_para
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_ps(:), f_mass(:), f_phis(:), f_geopot(:)
-    TYPE(t_field),POINTER :: f_theta_rhodz(:), f_dtheta_rhodz(:)
-    TYPE(t_field),POINTER :: f_ue(:), f_due(:)
-
-    REAL(rstd),POINTER         :: due(:,:)
-    REAL(rstd),POINTER         :: phi(:,:), ue(:,:)
-    REAL(rstd),POINTER         :: due_diss1(:,:)
-    REAL(rstd),POINTER         :: due_diss2(:,:)
-    REAL(rstd),POINTER         :: dtheta_rhodz(:,:,:)
-    REAL(rstd),POINTER         :: dtheta_rhodz_diss(:,:)
-
-    INTEGER :: ind, shear
-    INTEGER :: l,ij
-
-!$OMP BARRIER
-    
-    CALL trace_start("dissip")
-    CALL gradiv(f_ue,f_due_diss1)
-    CALL gradrot(f_ue,f_due_diss2)
-
-    CALL divgrad_theta_rhodz(f_mass,f_theta_rhodz,f_dtheta_rhodz_diss)
-    
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      due=f_due(ind) 
-      due_diss1=f_due_diss1(ind)
-      due_diss2=f_due_diss2(ind)
-      dtheta_rhodz=f_dtheta_rhodz(ind)
-      dtheta_rhodz_diss=f_dtheta_rhodz_diss(ind)
-
-      DO l=ll_begin,ll_end
-!DIR$ SIMD
-        DO ij=ij_begin,ij_end
-
-            due(ij+u_right,l) = -0.5*( due_diss1(ij+u_right,l)/tau_graddiv(l) + due_diss2(ij+u_right,l)/tau_gradrot(l))*itau_dissip 
-            due(ij+u_lup,l)   = -0.5*( due_diss1(ij+u_lup,l)  /tau_graddiv(l) + due_diss2(ij+u_lup,l)  /tau_gradrot(l))*itau_dissip
-            due(ij+u_ldown,l) = -0.5*( due_diss1(ij+u_ldown,l)/tau_graddiv(l) + due_diss2(ij+u_ldown,l)/tau_gradrot(l))*itau_dissip
-
-            dtheta_rhodz(ij,l,1) = -0.5*dtheta_rhodz_diss(ij,l)/tau_divgrad(l)*itau_dissip
-        ENDDO
-      ENDDO
-
-!      dtheta_rhodz=0
-!      due=0
-
-      IF(rayleigh_friction_type>0) THEN
-         phi=f_geopot(ind)
-         ue=f_ue(ind)
-         DO l=ll_begin,ll_end
-            DO ij=ij_begin,ij_end
-               CALL relax(t_right, u_right)
-               CALL relax(t_lup,   u_lup)
-               CALL relax(t_ldown, u_ldown)
-            ENDDO
-         END DO
-      END IF
-   END DO
-
-   CALL trace_end("dissip")
-
-!$OMP BARRIER
-
-    CONTAINS
-      SUBROUTINE relax(shift_t, shift_u)
-        USE dcmip_initial_conditions_test_1_2_3
-        REAL(rstd) :: z, ulon,ulat, lon,lat, & ! input to test2_schaer_mountain
-             p,hyam,hybm,w,t,phis,ps,rho,q, &   ! unused input/output to test2_schaer_mountain
-             fz, u3d(3), uref
-        REAL(rstd), PARAMETER :: zh=2e4,ztop=3e4  ! DCMIP values
-        LOGICAL :: hybrid_eta
-        INTEGER :: shift_u, shift_t, zcoords, nn
-        z = (phi(ij,l)+phi(ij+shift_t,l))/(2.*g)
-        IF(z>zh) THEN  ! relax only in the sponge layer z>zh
-
-           nn = ij+shift_u
-           zcoords = 1 ; hybrid_eta = .FALSE. ! use z instead of p or hyam/hybm
-           CALL test2_schaer_mountain(lon_e(nn),lat_e(nn),p,z,zcoords,hybrid_eta, &
-                hyam,hybm,shear,ulon,ulat,w,t,phis,ps,rho,q)
-!           u3d = ulon*elon_e(nn,:) + ulat*elat_e(nn,:)
-           u3d = ulon*elon_e(nn,:) ! ulat=0
-           uref = sum(u3d*ep_e(nn,:))
-
-           fz = sin((pi/2)*(z-zh)/(ztop-zh))
-           fz = fz*fz/rayleigh_tau
-           due(nn,l) = due(nn,l) - itau_dissip*fz*(ue(nn,l)-uref)
-!           fz = 1./rayleigh_tau
-!           due(nn,l) = due(nn,l) - fz*ue(nn,l)
-         END IF
-       END SUBROUTINE relax
-      
-  END SUBROUTINE dissip
-
-  SUBROUTINE gradiv(f_ue,f_due)
-  USE icosa
-  USE trace
-  USE omp_para
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_ue(:)
-    TYPE(t_field),POINTER :: f_due(:)
-    REAL(rstd),POINTER    :: ue(:,:)
-    REAL(rstd),POINTER    :: due(:,:)
-    INTEGER :: ind
-    INTEGER :: it,l,ij
-       
-    CALL trace_start("gradiv")
-
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      ue=f_ue(ind)
-      due=f_due(ind) 
-      DO  l = ll_begin, ll_end
-!DIR$ SIMD
-        DO ij=ij_begin,ij_end
-             due(ij+u_right,l)=ue(ij+u_right,l)
-             due(ij+u_lup,l)=ue(ij+u_lup,l)
-             due(ij+u_ldown,l)=ue(ij+u_ldown,l)
-        ENDDO
-      ENDDO
-    ENDDO
-
-    DO it=1,nitergdiv
-        
-      CALL send_message(f_due,req_due)
-      CALL wait_message(req_due)
-        
-      DO ind=1,ndomain
-        IF (.NOT. assigned_domain(ind)) CYCLE
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        due=f_due(ind) 
-        CALL compute_gradiv(due,due,ll_begin,ll_end)
-      ENDDO
-    ENDDO
-
-   CALL trace_end("gradiv")
-
-  END SUBROUTINE gradiv
-  
-
-  SUBROUTINE gradrot(f_ue,f_due)
-  USE icosa
-  USE trace
-  USE omp_para
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_ue(:)
-    TYPE(t_field),POINTER :: f_due(:)
-    REAL(rstd),POINTER    :: ue(:,:)
-    REAL(rstd),POINTER    :: due(:,:)
-    INTEGER :: ind
-    INTEGER :: it,l,ij
-       
-    CALL trace_start("gradrot")
-
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      ue=f_ue(ind)
-      due=f_due(ind) 
-      DO  l = ll_begin, ll_end
-!DIR$ SIMD
-        DO ij=ij_begin,ij_end
-             due(ij+u_right,l)=ue(ij+u_right,l)
-             due(ij+u_lup,l)=ue(ij+u_lup,l)
-             due(ij+u_ldown,l)=ue(ij+u_ldown,l)
-        ENDDO
-      ENDDO
-    ENDDO
-
-    DO it=1,nitergrot
-        
-      CALL send_message(f_due,req_due)
-      CALL wait_message(req_due)
-        
-      DO ind=1,ndomain
-        IF (.NOT. assigned_domain(ind)) CYCLE
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        due=f_due(ind) 
-        CALL compute_gradrot(due,due,ll_begin,ll_end)
-      ENDDO
-
-    ENDDO
-
-    CALL trace_end("gradrot")
-
-  END SUBROUTINE gradrot
-  
-  SUBROUTINE divgrad(f_theta,f_dtheta)
-  USE icosa
-  USE trace
-  USE omp_para
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_theta(:)
-    TYPE(t_field),POINTER :: f_dtheta(:)
-    REAL(rstd),POINTER    :: theta(:,:)
-    REAL(rstd),POINTER    :: dtheta(:,:)
-    INTEGER :: ind
-    INTEGER :: it
-
-    CALL trace_start("divgrad")
-       
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      theta=f_theta(ind)
-      dtheta=f_dtheta(ind) 
-      dtheta=theta
-    ENDDO
-
-    DO it=1,niterdivgrad
-        
-      CALL transfert_request(f_dtheta,req_i1)
-        
-      DO ind=1,ndomain
-        IF (.NOT. assigned_domain(ind)) CYCLE
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        dtheta=f_dtheta(ind) 
-        CALL compute_divgrad(dtheta,dtheta,ll_begin,ll_end)
-      ENDDO
-
-    ENDDO
-
-    CALL trace_end("divgrad")
-
-  END SUBROUTINE divgrad
-   
-  SUBROUTINE divgrad_theta_rhodz(f_mass,f_theta_rhodz,f_dtheta_rhodz)
-  USE icosa
-  USE trace
-  USE omp_para
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_mass(:)
-    TYPE(t_field),POINTER :: f_theta_rhodz(:)
-    TYPE(t_field),POINTER :: f_dtheta_rhodz(:)
-    
-    REAL(rstd),POINTER :: mass(:,:)
-    REAL(rstd),POINTER :: theta_rhodz(:,:,:)
-    REAL(rstd),POINTER :: dtheta_rhodz(:,:)
-
-    INTEGER :: ind
-    INTEGER :: it,l,ij
-
-    CALL trace_start("divgrad")
-
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      mass=f_mass(ind)
-      theta_rhodz=f_theta_rhodz(ind)
-      dtheta_rhodz=f_dtheta_rhodz(ind) 
-      DO  l = ll_begin, ll_end
-!DIR$ SIMD
-        DO ij=ij_begin,ij_end
-            dtheta_rhodz(ij,l) = theta_rhodz(ij,l,1) / mass(ij,l)
-        ENDDO
-      ENDDO
-    ENDDO
-
-    DO it=1,niterdivgrad
-        
-      CALL send_message(f_dtheta_rhodz,req_dtheta)
-      CALL wait_message(req_dtheta)
-      DO ind=1,ndomain
-        IF (.NOT. assigned_domain(ind)) CYCLE
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        dtheta_rhodz=f_dtheta_rhodz(ind) 
-        CALL compute_divgrad(dtheta_rhodz,dtheta_rhodz,ll_begin,ll_end)
-      ENDDO
-
-    ENDDO
-
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      dtheta_rhodz=f_dtheta_rhodz(ind) 
-      mass=f_mass(ind)
-    
-      DO  l = ll_begin, ll_end
-!DIR$ SIMD
-        DO ij=ij_begin,ij_end
-            dtheta_rhodz(ij,l) = dtheta_rhodz(ij,l) * mass(ij,l)
-        ENDDO
-      ENDDO
-    ENDDO
-
-
-    CALL trace_end("divgrad")
-
-  END SUBROUTINE divgrad_theta_rhodz  
-  
-  SUBROUTINE compute_gradiv(ue,gradivu_e,llb,lle)
-  USE icosa
-  IMPLICIT NONE
-    INTEGER,INTENT(IN)     :: llb
-    INTEGER,INTENT(IN)     :: lle
-    REAL(rstd),INTENT(IN)  :: ue(iim*3*jjm,llm)
-    REAL(rstd),INTENT(OUT) :: gradivu_e(iim*3*jjm,llm)
-    REAL(rstd) :: divu_i(iim*jjm,llb:lle)
-    
-    INTEGER :: ij,l
-
-    DO l=llb,lle
-!DIR$ SIMD
-      DO ij=ij_begin,ij_end
-          divu_i(ij,l)=1./Ai(ij)*(ne(ij,right)*ue(ij+u_right,l)*le(ij+u_right)  +  &
-                             ne(ij,rup)*ue(ij+u_rup,l)*le(ij+u_rup)        +  &  
-                             ne(ij,lup)*ue(ij+u_lup,l)*le(ij+u_lup)        +  &  
-                             ne(ij,left)*ue(ij+u_left,l)*le(ij+u_left)     +  &  
-                             ne(ij,ldown)*ue(ij+u_ldown,l)*le(ij+u_ldown)  +  &  
-                             ne(ij,rdown)*ue(ij+u_rdown,l)*le(ij+u_rdown))
-      ENDDO
-    ENDDO
-    
-    DO l=llb,lle
-!DIR$ SIMD
-      DO ij=ij_begin,ij_end
- 
-          gradivu_e(ij+u_right,l)=-1/de(ij+u_right)*(ne(ij,right)*divu_i(ij,l)+ ne(ij+t_right,left)*divu_i(ij+t_right,l) )       
-
-          gradivu_e(ij+u_lup,l)=-1/de(ij+u_lup)*(ne(ij,lup)*divu_i(ij,l)+ ne(ij+t_lup,rdown)*divu_i(ij+t_lup,l))       
-    
-          gradivu_e(ij+u_ldown,l)=-1/de(ij+u_ldown)*(ne(ij,ldown)*divu_i(ij,l)+ne(ij+t_ldown,rup)*divu_i(ij+t_ldown,l) )
-
-      ENDDO
-    ENDDO
-
-    DO l=llb,lle
-!DIR$ SIMD
-      DO ij=ij_begin,ij_end
-          gradivu_e(ij+u_right,l)=-gradivu_e(ij+u_right,l)*cgraddiv
-          gradivu_e(ij+u_lup,l)=-gradivu_e(ij+u_lup,l)*cgraddiv
-          gradivu_e(ij+u_ldown,l)=-gradivu_e(ij+u_ldown,l)*cgraddiv
-      ENDDO
-    ENDDO
-
-   
-  END SUBROUTINE compute_gradiv
-  
-  SUBROUTINE compute_divgrad(theta,divgrad_i,llb,lle)
-  USE icosa
-  IMPLICIT NONE
-    INTEGER,INTENT(IN)     :: llb
-    INTEGER,INTENT(IN)     :: lle
-    REAL(rstd),INTENT(IN)  :: theta(iim*jjm,llm)
-    REAL(rstd),INTENT(OUT) :: divgrad_i(iim*jjm,llm)
-    REAL(rstd)  :: grad_e(3*iim*jjm,llb:lle)
-
-    INTEGER :: ij,l
-
-       
-    DO l=llb,lle
-!DIR$ SIMD
-      DO ij=ij_begin_ext,ij_end_ext
- 
-          grad_e(ij+u_right,l)=-1/de(ij+u_right)*(ne(ij,right)*theta(ij,l)+ ne(ij+t_right,left)*theta(ij+t_right,l) )        
-
-          grad_e(ij+u_lup,l)=-1/de(ij+u_lup)*(ne(ij,lup)*theta(ij,l)+ ne(ij+t_lup,rdown)*theta(ij+t_lup,l ))       
-    
-          grad_e(ij+u_ldown,l)=-1/de(ij+u_ldown)*(ne(ij,ldown)*theta(ij,l)+ne(ij+t_ldown,rup)*theta(ij+t_ldown,l) )
-
-      ENDDO
-    ENDDO
-    
-    
-    DO l=llb,lle
-!DIR$ SIMD
-      DO ij=ij_begin,ij_end
-
-          divgrad_i(ij,l)=1./Ai(ij)*(ne(ij,right)*grad_e(ij+u_right,l)*le(ij+u_right)  +  &
-                             ne(ij,rup)*grad_e(ij+u_rup,l)*le(ij+u_rup)              +  &  
-                             ne(ij,lup)*grad_e(ij+u_lup,l)*le(ij+u_lup)              +  &  
-                             ne(ij,left)*grad_e(ij+u_left,l)*le(ij+u_left)           +  &  
-                             ne(ij,ldown)*grad_e(ij+u_ldown,l)*le(ij+u_ldown)        +  &  
-                             ne(ij,rdown)*grad_e(ij+u_rdown,l)*le(ij+u_rdown))
-      ENDDO
-    ENDDO
-   
-    DO l=llb,lle
-      DO ij=ij_begin,ij_end
-          divgrad_i(ij,l)=-divgrad_i(ij,l)*cdivgrad
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE compute_divgrad
-
-    
-  SUBROUTINE compute_gradrot(ue,gradrot_e,llb,lle)
-  USE icosa
-  IMPLICIT NONE
-    INTEGER,INTENT(IN)     :: llb
-    INTEGER,INTENT(IN)     :: lle
-    REAL(rstd),INTENT(IN)  :: ue(iim*3*jjm,llm)
-    REAL(rstd),INTENT(OUT) :: gradrot_e(iim*3*jjm,llm)
-    REAL(rstd) :: rot_v(2*iim*jjm,llb:lle)
-
-    INTEGER :: ij,l
-     
-    DO l=llb,lle
-!DIR$ SIMD
-      DO ij=ij_begin_ext,ij_end_ext
-        
-          rot_v(ij+z_up,l)= 1./Av(ij+z_up)*(  ne(ij,rup)*ue(ij+u_rup,l)*de(ij+u_rup)                     &
-                                + ne(ij+t_rup,left)*ue(ij+t_rup+u_left,l)*de(ij+t_rup+u_left)          &
-                                - ne(ij,lup)*ue(ij+u_lup,l)*de(ij+u_lup) ) 
-                              
-          rot_v(ij+z_down,l) = 1./Av(ij+z_down)*( ne(ij,ldown)*ue(ij+u_ldown,l)*de(ij+u_ldown)                 &
-                                     + ne(ij+t_ldown,right)*ue(ij+t_ldown+u_right,l)*de(ij+t_ldown+u_right)  &
-                                     - ne(ij,rdown)*ue(ij+u_rdown,l)*de(ij+u_rdown) )
-  
-      ENDDO
-    ENDDO                              
-  
-    DO l=llb,lle
-!DIR$ SIMD
-      DO ij=ij_begin,ij_end
-  
-          gradrot_e(ij+u_right,l)=1/le(ij+u_right)*ne(ij,right)*(rot_v(ij+z_rdown,l)-rot_v(ij+z_rup,l)) 
-         
-          gradrot_e(ij+u_lup,l)=1/le(ij+u_lup)*ne(ij,lup)*(rot_v(ij+z_up,l)-rot_v(ij+z_lup,l)) 
-        
-          gradrot_e(ij+u_ldown,l)=1/le(ij+u_ldown)*ne(ij,ldown)*(rot_v(ij+z_ldown,l)-rot_v(ij+z_down,l))
-        
-      ENDDO
-    ENDDO
-
-    DO l=llb,lle
-!DIR$ SIMD
-      DO ij=ij_begin,ij_end
-    
-          gradrot_e(ij+u_right,l)=-gradrot_e(ij+u_right,l)*cgradrot       
-          gradrot_e(ij+u_lup,l)=-gradrot_e(ij+u_lup,l)*cgradrot
-          gradrot_e(ij+u_ldown,l)=-gradrot_e(ij+u_ldown,l)*cgradrot
-        
-      ENDDO
-    ENDDO  
-   
-  END SUBROUTINE compute_gradrot
-
-
-END MODULE dissip_gcm_mod
-       
Index: codes/icosagcm/devel/src/domain.f90
===================================================================
--- codes/icosagcm/devel/src/domain.f90	(revision 531)
+++ 	(revision )
@@ -1,590 +1,0 @@
-MODULE domain_mod
-  USE domain_param
-
-  TYPE t_domain
-    INTEGER :: face
-    INTEGER :: iim
-    INTEGER :: jjm
-    INTEGER :: ii_begin
-    INTEGER :: jj_begin
-    INTEGER :: ii_end
-    INTEGER :: jj_end
-    INTEGER :: ii_nb
-    INTEGER :: jj_nb
-    INTEGER :: ii_begin_glo
-    INTEGER :: jj_begin_glo
-    INTEGER :: ii_end_glo
-    INTEGER :: jj_end_glo
-    INTEGER,POINTER  :: assign_domain(:,:)
-    INTEGER,POINTER  :: assign_cell_glo(:,:)
-    INTEGER,POINTER  :: assign_i(:,:)
-    INTEGER,POINTER  :: assign_j(:,:)
-    INTEGER,POINTER  :: edge_assign_domain(:,:,:)
-    INTEGER,POINTER  :: edge_assign_i(:,:,:)
-    INTEGER,POINTER  :: edge_assign_j(:,:,:)
-    INTEGER,POINTER  :: edge_assign_pos(:,:,:)
-    INTEGER,POINTER  :: edge_assign_sign(:,:,:)
-    REAL,POINTER     :: xyz(:,:,:)
-    REAL,POINTER     :: neighbour(:,:,:,:)
-    INTEGER,POINTER  :: delta(:,:)
-    REAL,POINTER     :: vertex(:,:,:,:)
-    LOGICAL,POINTER  :: own(:,:)
-    INTEGER,POINTER  :: ne(:,:,:)
-    
-    INTEGER :: t_right
-    INTEGER :: t_rup
-    INTEGER :: t_lup
-    INTEGER :: t_left
-    INTEGER :: t_ldown
-    INTEGER :: t_rdown
-
-    INTEGER :: u_right
-    INTEGER :: u_rup
-    INTEGER :: u_lup
-    INTEGER :: u_left
-    INTEGER :: u_ldown
-    INTEGER :: u_rdown
-
-    INTEGER :: z_rup
-    INTEGER :: z_up
-    INTEGER :: z_lup
-    INTEGER :: z_ldown
-    INTEGER :: z_down
-    INTEGER :: z_rdown
-   
-    INTEGER :: t_pos(6)
-    INTEGER :: u_pos(6)
-    INTEGER :: z_pos(6)
-     
-  END TYPE t_domain
-
-  INTEGER,SAVE :: ndomain
-  INTEGER,SAVE :: ndomain_glo
-
-  TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain(:)
-  TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain_glo(:)
-
-  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
-
-  SUBROUTINE create_domain
-  USE grid_param
-  USE mpipara
-  USE ioipsl
-  IMPLICIT NONE
-  INTEGER :: ind,nf,ni,nj,i,j
-  INTEGER :: quotient, rest
-  INTEGER :: halo_i,halo_j
-  
-  TYPE(t_domain),POINTER :: d
- 
-    ndomain_glo=nsplit_i*nsplit_j*nb_face
-    ALLOCATE(domain_glo(ndomain_glo))
-    ALLOCATE(domglo_rank(ndomain_glo))
-    ALLOCATE(domglo_loc_ind(ndomain_glo))
-   
-    halo_i=0
-    CALL getin("halo_i",halo_i)
-    halo_j=1
-    CALL getin("halo_j",halo_j)
-
-    ind=0
-    DO nf=1,nb_face
-      DO nj=1,nsplit_j
-        DO ni=1,nsplit_i
-          ind=ind+1
-          d=>domain_glo(ind)
-          quotient=(iim_glo/nsplit_i)
-          rest=MOD(iim_glo,nsplit_i)
-          IF (ni-1 < rest) THEN
-            d%ii_nb=quotient+1
-            d%ii_begin_glo=(quotient+1)*(ni-1)+1
-          ELSE 
-            d%ii_nb=quotient
-            d%ii_begin_glo=(quotient+1)*rest+(ni-1-rest) * quotient+1
-          ENDIF
-          d%ii_end_glo=d%ii_begin_glo+d%ii_nb-1
- 
-          IF (ni/=1) THEN 
-            d%ii_nb=d%ii_nb+1
-            d%ii_begin_glo=d%ii_begin_glo-1
-          ENDIF
-         
-        
-          quotient=(jjm_glo/nsplit_j)
-          rest=MOD(jjm_glo,nsplit_j)
-          IF (nj-1 < rest) THEN
-            d%jj_nb=quotient+1
-            d%jj_begin_glo=(quotient+1)*(nj-1)+1
-          ELSE
-            d%jj_nb=quotient
-            d%jj_begin_glo=(quotient+1)*rest+(nj-1-rest) * quotient+1
-          ENDIF
-          d%jj_end_glo=d%jj_begin_glo+d%jj_nb-1
-
-          IF (nj/=1) THEN 
-            d%jj_nb=d%jj_nb+1
-            d%jj_begin_glo=d%jj_begin_glo-1
-          ENDIF
-
-
-          d%iim=d%ii_nb+2*halo  + halo_i*2
-          d%jjm=d%jj_nb+2*halo  + halo_j*2
-          d%ii_begin=halo+1  + halo_i
-          d%jj_begin=halo+1  + halo_j
-          d%ii_end=d%ii_begin+d%ii_nb-1
-          d%jj_end=d%jj_begin+d%jj_nb-1
-          d%face=nf        
-          ALLOCATE(d%assign_domain(d%iim,d%jjm))
-          ALLOCATE(d%assign_cell_glo(d%iim,d%jjm))
-          ALLOCATE(d%assign_i(d%iim,d%jjm))
-          ALLOCATE(d%assign_j(d%iim,d%jjm))
-          ALLOCATE(d%edge_assign_domain(0:5,d%iim,d%jjm))
-          ALLOCATE(d%edge_assign_i(0:5,d%iim,d%jjm))
-          ALLOCATE(d%edge_assign_j(0:5,d%iim,d%jjm))
-          ALLOCATE(d%edge_assign_pos(0:5,d%iim,d%jjm))
-          ALLOCATE(d%edge_assign_sign(0:5,d%iim,d%jjm))
-          ALLOCATE(d%delta(d%iim,d%jjm))
-          ALLOCATE(d%xyz(3,d%iim,d%jjm))
-          ALLOCATE(d%vertex(3,0:5,d%iim,d%jjm))
-          ALLOCATE(d%neighbour(3,0:5,d%iim,d%jjm))
-          ALLOCATE(d%own(d%iim,d%jjm))
-          ALLOCATE(d%ne(0:5,d%iim,d%jjm))
-          
-          IF (is_mpi_root) PRINT *,"Domain ",ind," : size ",d%ii_nb,"x",d%jj_nb
-          
-        END DO
-      END DO
-    END DO
-    
-  END SUBROUTINE create_domain
-  
-  SUBROUTINE copy_domain(d1,d2)
-  IMPLICIT NONE
-  INTEGER :: face
-  TYPE(t_domain),TARGET,INTENT(IN) :: d1
-  TYPE(t_domain), INTENT(OUT) :: d2
-  
-    d2%iim = d1%iim
-    d2%jjm = d1%jjm
-    d2%ii_begin = d1%ii_begin
-    d2%jj_begin = d1%jj_begin
-    d2%ii_end = d1%ii_end
-    d2%jj_end = d1%jj_end
-    d2%ii_nb =  d1%ii_nb
-    d2%jj_nb = d1%jj_nb
-    d2%ii_begin_glo = d1%ii_begin_glo
-    d2%jj_begin_glo = d1%jj_begin_glo
-    d2%ii_end_glo = d1%ii_end_glo
-    d2%jj_end_glo = d1%jj_end_glo
-    d2%assign_domain => d1%assign_domain
-    d2%assign_cell_glo => d1%assign_cell_glo
-    d2%assign_i => d1%assign_i
-    d2%assign_j => d1%assign_j
-    d2%edge_assign_domain => d1%edge_assign_domain
-    d2%edge_assign_i => d1%edge_assign_i
-    d2%edge_assign_j => d1%edge_assign_j
-    d2%edge_assign_pos => d1%edge_assign_pos
-    d2%edge_assign_sign => d1%edge_assign_sign
-    d2%xyz => d1%xyz
-    d2%neighbour => d1%neighbour
-    d2%delta => d1%delta
-    d2%vertex => d1%vertex
-    d2%own => d1%own
-    d2%ne => d1%ne
-    
-    d2%t_right = d1%t_right
-    d2%t_rup = d1%t_rup
-    d2%t_lup = d1%t_lup
-    d2%t_left = d1%t_left
-    d2%t_ldown = d1%t_ldown
-    d2%t_rdown = d1%t_rdown
-
-    d2%u_right = d1%u_right
-    d2%u_rup = d1%u_rup
-    d2%u_lup = d1%u_lup
-    d2%u_left = d1%u_left
-    d2%u_ldown = d1%u_ldown
-    d2%u_rdown = d1%u_rdown
-
-    d2%z_rup = d1%z_rup
-    d2%z_up = d1%z_up
-    d2%z_lup = d1%z_lup
-    d2%z_ldown = d1%z_ldown
-    d2%z_down = d1%z_down
-    d2%z_rdown = d1%z_rdown
-   
-    d2%t_pos = d1%t_pos
-    d2%u_pos = d1%u_pos
-    d2%z_pos = d1%z_pos
-    
-  END SUBROUTINE copy_domain
-  
-  
-  SUBROUTINE assign_cell
-  USE metric
-  IMPLICIT NONE
-    INTEGER :: ind_d,ind,ind2,e
-    INTEGER :: nf,nf2
-    INTEGER :: i,j,k,ii,jj
-    TYPE(t_domain),POINTER :: d
-    INTEGER :: delta
-     
-    
-    DO ind_d=1,ndomain_glo
-      d=>domain_glo(ind_d)
-      nf=d%face
-      DO j=d%jj_begin,d%jj_end
-        DO i=d%ii_begin,d%ii_end
-          ii=d%ii_begin_glo-d%ii_begin+i
-          jj=d%jj_begin_glo-d%jj_begin+j
-          ind=vertex_glo(ii,jj,nf)%ind
-          delta=vertex_glo(ii,jj,nf)%delta
-          IF (cell_glo(ind)%assign_face==nf) THEN 
-            cell_glo(ind)%assign_domain=ind_d
-            cell_glo(ind)%assign_i=i
-            cell_glo(ind)%assign_j=j
-          ENDIF
-          IF ( i+1 <= d%ii_end ) CALL assign_edge(ind_d,ind,i,j,delta,0)
-          IF ( j+1 <= d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,1)
-          IF ( i-1 >= d%ii_begin .AND. j+1<=d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,2)
-          IF ( i-1 >= d%ii_begin ) CALL assign_edge(ind_d,ind,i,j,delta,3)
-          IF ( j-1 >= d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,4)
-          IF ( i+1 <= d%ii_end .AND. j-1 >=d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,5)
-        ENDDO
-      ENDDO
-    ENDDO
-    
-    
-    DO ind_d=1,ndomain_glo
-      d=>domain_glo(ind_d)
-      nf=d%face
-      DO j=d%jj_begin-1,d%jj_end+1
-        DO i=d%ii_begin-1,d%ii_end+1
-          ii=d%ii_begin_glo-d%ii_begin+i
-          jj=d%jj_begin_glo-d%jj_begin+j
-          ind=vertex_glo(ii,jj,nf)%ind
-          d%assign_cell_glo(i,j) = ind  
-          d%assign_domain(i,j)=cell_glo(ind)%assign_domain
-          d%assign_i(i,j)=cell_glo(ind)%assign_i
-          d%assign_j(i,j)=cell_glo(ind)%assign_j
-          delta=vertex_glo(ii,jj,nf)%delta
-          d%delta(i,j)=vertex_glo(ii,jj,nf)%delta
-          DO k=0,5
-            ind2=vertex_glo(ii,jj,nf)%neighbour(k)
-            d%neighbour(:,k,i,j)=cell_glo(ind2)%xyz(:)
-
-            d%ne(k,i,j)=1-2*MOD(k,2)
-
-            e=cell_glo(ind)%edge(MOD(k+delta+6,6))
-            d%edge_assign_domain(k,i,j)=edge_glo(e)%assign_domain
-            d%edge_assign_i(k,i,j)=edge_glo(e)%assign_i
-            d%edge_assign_j(k,i,j)=edge_glo(e)%assign_j
-            d%edge_assign_pos(k,i,j)=edge_glo(e)%assign_pos
-            nf2=domain_glo(edge_glo(e)%assign_domain)%face
-            d%edge_assign_sign(k,i,j)=1-2*MOD(12+tab_index(nf,nf2,0),2)
-            IF (MOD(6+k+tab_index(nf,nf2,0),6)/=edge_glo(e)%assign_pos .AND. MOD(6+k+tab_index(nf,nf2,0),6) & 
-                /= MOD(edge_glo(e)%assign_pos+3,6)) THEN
-              d%edge_assign_sign(k,i,j)=-d%edge_assign_sign(k,i,j)
-            ENDIF
-             
-          ENDDO
-          d%xyz(:,i,j)=cell_glo(ind)%xyz(:)
-          IF (d%assign_domain(i,j)==ind_d) THEN
-           d%own(i,j)=.TRUE.
-          ELSE
-           d%own(i,j)=.FALSE.
-          ENDIF
-        ENDDO
-      ENDDO
-    ENDDO
-
-  CONTAINS
-
-    SUBROUTINE assign_edge(ind_d,ind,i,j,delta,k)
-      INTEGER :: ind_d,ind,i,j,delta,k
-      INTEGER :: e
-      e=cell_glo(ind)%edge(MOD(k+delta+6,6))
-      edge_glo(e)%assign_domain=ind_d
-      edge_glo(e)%assign_i=i
-      edge_glo(e)%assign_j=j
-      edge_glo(e)%assign_pos=k
-      edge_glo(e)%assign_delta=delta
-
-     END  SUBROUTINE assign_edge
-         
-  END SUBROUTINE assign_cell
-
-  SUBROUTINE compute_boundary
-  USE spherical_geom_mod
-  IMPLICIT NONE
-    INTEGER :: ind_d
-    INTEGER :: i,j,k
-    TYPE(t_domain),POINTER :: d 
-    REAL(rstd) :: ng1(3),ng2(3) 
-
-    DO ind_d=1,ndomain_glo
-      d=>domain_glo(ind_d)
-      DO j=d%jj_begin-1,d%jj_end+1
-        DO i=d%ii_begin-1,d%ii_end+1
-          DO k=0,5
-            ng1=d%neighbour(:,MOD(k,6),i,j)
-            ng2=d%neighbour(:,MOD(k+1,6),i,j)
-            IF (sqrt(sum((ng1-ng2)**2))<1e-16) ng2=d%neighbour(:,MOD(k+2,6),i,j)
-            CALL circumcenter(d%xyz(:,i,j),ng1,ng2,d%vertex(:,k,i,j))
-          ENDDO
-        ENDDO
-      ENDDO
-    ENDDO        
-  END SUBROUTINE compute_boundary
-
-  SUBROUTINE set_neighbour_indice
-  USE metric
-  IMPLICIT NONE
-    INTEGER :: ind_d
-    TYPE(t_domain),POINTER :: d 
-    
-    DO ind_d=1,ndomain_glo
-      d=>domain_glo(ind_d)
-      d%t_right=1
-      d%t_left=-1
-      d%t_rup=d%iim
-      d%t_lup=d%iim-1
-      d%t_ldown=-d%iim
-      d%t_rdown=-d%iim+1
-      
-      d%u_right=0
-      d%u_lup=d%iim*d%jjm
-      d%u_ldown=2*d%iim*d%jjm
-      
-      d%u_rup=d%t_rup+d%u_ldown
-      d%u_left=d%t_left+d%u_right
-      d%u_rdown=d%t_rdown+d%u_lup
-      
-      d%z_up=0
-      d%z_down=d%iim*d%jjm
-      d%z_rup=d%t_rup+d%z_down
-      d%z_lup=d%t_lup+d%z_down
-      d%z_ldown=d%t_ldown+d%z_up
-      d%z_rdown=d%t_rdown+d%z_up
-      
-      d%t_pos(right)=d%t_right
-      d%t_pos(rup)=d%t_rup
-      d%t_pos(lup)=d%t_lup
-      d%t_pos(left)=d%t_left
-      d%t_pos(ldown)=d%t_ldown
-      d%t_pos(rdown)=d%t_rdown
-
-      d%u_pos(right)=d%u_right
-      d%u_pos(rup)=d%u_rup
-      d%u_pos(lup)=d%u_lup
-      d%u_pos(left)=d%u_left
-      d%u_pos(ldown)=d%u_ldown
-      d%u_pos(rdown)=d%u_rdown
-      
-      d%z_pos(vrup)=d%z_rup
-      d%z_pos(vup)=d%z_up
-      d%z_pos(vlup)=d%z_lup
-      d%z_pos(vldown)=d%z_ldown
-      d%z_pos(vdown)=d%z_down
-      d%z_pos(vrdown)=d%z_rdown
-      
-    ENDDO  
-  
-  END SUBROUTINE set_neighbour_indice
-      
-  SUBROUTINE assign_domain
-  USE mpipara
-  USE grid_param
-  IMPLICIT NONE
-    INTEGER :: nb_domain(0:mpi_size-1)
-    INTEGER :: rank, ind,ind_glo
-    INTEGER :: block_j,jb,i,j,nd_glo,n,nf
-    LOGICAL :: exit
-    
-    DO rank=0,mpi_size-1
-      nb_domain(rank)=ndomain_glo/mpi_size
-      IF ( rank < MOD(ndomain_glo,mpi_size) ) nb_domain(rank)=nb_domain(rank)+1
-    ENDDO
-    
-    ndomain=nb_domain(mpi_rank)
-    ALLOCATE(domain(ndomain))
-    ALLOCATE(domloc_glo_ind(ndomain))
-    
-    
-    block_j=sqrt(nsplit_i*nsplit_j*nb_face*1./mpi_size)
-    exit=.FALSE.
-    jb=1
-    i=1
-    j=1
-    ind=1
-    nd_glo=0
-    rank=0
-    DO WHILE (.NOT. exit)
-
-      IF (j==MIN(jb+block_j,nsplit_j*nb_face+1)) THEN
-        j=jb
-        i=i+1
-      ENDIF
-
-      IF (i>nsplit_i) THEN 
-        i=1
-        jb=jb+block_j
-        j=jb
-      ENDIF
-      
-      IF (ind>nb_domain(rank)) THEN
-        rank=rank+1
-        ind=1
-      ENDIF 
-      ind_glo=(j-1)*nsplit_i+i
-
-      nd_glo=nd_glo+1
-      IF (nd_glo==ndomain_glo) THEN
-
-        exit=.TRUE.
-        IF (.NOT. (rank==mpi_size-1 .AND. ind==nb_domain(rank) )) THEN
-          PRINT *, "Distribution problem in assign_domain"
-          STOP
-        ENDIF
-
-      ENDIF
-
-      domglo_rank(ind_glo)=rank
-      domglo_loc_ind(ind_glo)=ind
-      IF (rank==mpi_rank) THEN 
-        CALL copy_domain(domain_glo(ind_glo),domain(ind))
-        domloc_glo_ind(ind)=ind_glo
-      ENDIF
-      
-      j=j+1
-      ind=ind+1
-      
-    ENDDO
-
-    IF (is_mpi_master) THEN
-   
-      ind_glo=0
-      PRINT *,''
-      PRINT*, '      MPI PROCESS DISTRIBUTION'
-      PRINT *,''
-      
-      WRITE(*,"(' ')", ADVANCE='NO')
-      DO n=1,nsplit_i*7-1
-        WRITE(*,"('=')", ADVANCE='NO')
-      ENDDO
-      PRINT *,''
-
-      DO nf=1,nb_face
-        DO j=1,nsplit_j
-          IF (j>1) THEN
-            WRITE(*,"(' ')", ADVANCE='NO')
-            DO n=1,nsplit_i*7-1
-              WRITE(*,"('-')", ADVANCE='NO')
-            ENDDO
-            PRINT *,''
-          ENDIF
-
-          WRITE(*,"('|')", ADVANCE='NO')
-          DO i=1,nsplit_i
-            WRITE(*,"(' ','    ',' |')",ADVANCE='NO')         
-          ENDDO
-          PRINT *,''
-
-          WRITE(*,"('|')", ADVANCE='NO')
-          DO i=1,nsplit_i
-            ind_glo=ind_glo+1
-            WRITE(*,"(' ',i4.4  ,' |')",ADVANCE='NO'),domglo_rank(ind_glo)           
-          END DO
-          PRINT *,''
-
-          WRITE(*,"('|')", ADVANCE='NO')
-          DO i=1,nsplit_i
-            WRITE(*,"(' ','    ',' |')",ADVANCE='NO')         
-          ENDDO
-          PRINT *,''
-
-        ENDDO
-          
-        WRITE(*,"(' ')", ADVANCE='NO')
-        DO n=1,nsplit_i*7-1
-          WRITE(*,"('=')", ADVANCE='NO')
-        ENDDO
-        PRINT *,''
-      ENDDO
-    ENDIF
-              
-!    rank=0
-!    ind=0
-!    DO ind_glo=1,ndomain_glo
-!      ind=ind+1
-!      domglo_rank(ind_glo)=rank
-!      domglo_loc_ind(ind_glo)=ind
-!      IF (rank==mpi_rank) THEN 
-!        CALL copy_domain(domain_glo(ind_glo),domain(ind))
-!        domloc_glo_ind(ind)=ind_glo
-!      ENDIF
-!      
-!      IF (ind==nb_domain(rank)) THEN
-!        rank=rank+1
-!        ind=0
-!      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_domain_size-1
-      nb_domain=ndomain/omp_domain_size
-      IF ( rank < MOD(ndomain,omp_domain_size) ) nb_domain=nb_domain+1
-    
-      DO i=1,nb_domain
-       ind=ind+1
-       IF (rank==omp_domain_rank) THEN 
-         assigned_domain(ind)=.TRUE.
-         WRITE(*,'(A,I6.6,A,I4.4,A,I4.4,A,I8.8)') "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
-  IMPLICIT NONE
-    CALL init_domain_param
-    CALL create_domain
-    CALL assign_cell
-    CALL compute_boundary
-    CALL set_neighbour_indice
-    CALL assign_domain
-      
-  END SUBROUTINE compute_domain
-          
-END MODULE domain_mod 
-  
Index: codes/icosagcm/devel/src/domain_param.f90
===================================================================
--- codes/icosagcm/devel/src/domain_param.f90	(revision 531)
+++ 	(revision )
@@ -1,25 +1,0 @@
-MODULE domain_param
-  IMPLICIT NONE
-  PRIVATE
-  INTEGER :: nsplit_i
-  INTEGER :: nsplit_j
-  INTEGER :: halo=1
-
-  INTEGER, PARAMETER :: default_nsplit_i=1
-  INTEGER, PARAMETER :: default_nsplit_j=1
-
-  PUBLIC nsplit_i, nsplit_j, halo, init_domain_param
-
-CONTAINS
-  
-  SUBROUTINE init_domain_param
-    USE ioipsl
-    !$OMP CRITICAL
-    nsplit_i=default_nsplit_i
-    nsplit_j=default_nsplit_j
-    CALL getin('nsplit_i',nsplit_i)
-    CALL getin('nsplit_j',nsplit_j)
-    !$OMP END CRITICAL
-  END SUBROUTINE init_domain_param
-  
-END MODULE domain_param
Index: codes/icosagcm/devel/src/earth_const.f90
===================================================================
--- codes/icosagcm/devel/src/earth_const.f90	(revision 531)
+++ 	(revision )
@@ -1,64 +1,0 @@
-MODULE earth_const
-  USE prec
-  USE math_const
-  
-  REAL(rstd),SAVE :: radius=6.37122E6
-  REAL(rstd),SAVE :: g=9.80616
-  REAL(rstd),PARAMETER :: daysec=86400
-  REAL(rstd),SAVE :: omega=7.292E-5
-  REAL(rstd),SAVE :: kappa=0.2857143
-  REAL(rstd),SAVE :: cpp=1004.70885
-  REAL(rstd),SAVE :: cppv=1860.
-  REAL(rstd),SAVE :: Rv=461.5
-  REAL(rstd),SAVE :: Treff=273.
-  REAL(rstd),SAVE :: preff=101325.
-  REAL(rstd),SAVE :: pa=50000.
-  REAL(rstd),SAVE :: scale_height=8000. ! atmospheric scale height (m)
-  REAL(rstd),SAVE :: scale_factor=1.
-  REAL(rstd),SAVE :: gas_constant = 8.3144621 
-  REAL(rstd),SAVE :: mu                 ! molar mass of the atmosphere
-
-  INTEGER, PARAMETER,PUBLIC :: thermo_theta=1, thermo_entropy=2, &
-       thermo_moist=3, thermo_moist_debug=10, thermo_dry=4, thermo_fake_moist=5 
-  INTEGER, PUBLIC :: caldyn_thermo, physics_thermo
-  !$OMP THREADPRIVATE(caldyn_thermo) 
-  !$OMP THREADPRIVATE(physics_thermo) 
-
-  LOGICAL, SAVE :: boussinesq, hydrostatic
-
-CONTAINS
-  
-  SUBROUTINE init_earth_const
-  USE getin_mod
-  IMPLICIT NONE
-  REAL(rstd) :: X=1
-  
-    CALL getin("radius",radius)
-    CALL getin("g",g)
-    CALL getin("scale_factor",scale_factor)
-    CALL getin("omega",omega)  
-    CALL getin("kappa",kappa)  
-    CALL getin("cpp",cpp)  
-    CALL getin("cppv",cppv)
-    CALL getin("Rv",Rv)
-    CALL getin("preff",preff)  
-    CALL getin("Treff",Treff)  
-    CALL getin("scale_height",scale_height)
-    
-    boussinesq=.FALSE.
-    CALL getin("boussinesq",boussinesq)  
-    hydrostatic=.TRUE.
-    CALL getin("hydrostatic",hydrostatic)  
-    IF(boussinesq .AND. .NOT. hydrostatic) THEN
-       PRINT *, 'boussinesq=.TRUE. and hydrostatic=.FALSE. : Non-hydrostatic boussinesq equations are not supported'
-       STOP
-    END IF
-    
-    mu=kappa/cpp
-    radius=radius/scale_factor
-    omega=omega*scale_factor
-    
-  END SUBROUTINE init_earth_const
-  
-  
-END MODULE earth_const
Index: codes/icosagcm/devel/src/euler_scheme.f90
===================================================================
--- codes/icosagcm/devel/src/euler_scheme.f90	(revision 531)
+++ 	(revision )
@@ -1,219 +1,0 @@
-MODULE euler_scheme_mod
-  USE field_mod
-  IMPLICIT NONE
-  PRIVATE
-
-  TYPE(t_field),POINTER,SAVE,PUBLIC :: f_geopot(:), f_q(:), &
-       f_rhodz(:), f_mass(:), f_massm1(:), f_massm2(:), f_dmass(:), & ! current and previous time steps + tendency of mass,
-       f_phis(:), f_ps(:),f_psm1(:), f_psm2(:), f_dps(:), &           ! column-integrated mass
-       f_u(:),f_um1(:),f_um2(:), f_du(:), f_W(:), &                   ! 'horizontal' and vertical (NH) momentum
-       f_theta_rhodz(:),f_theta_rhodzm1(:),f_theta_rhodzm2(:), f_dtheta_rhodz(:), & ! mass-weighted theta/entropy
-       f_hflux(:), f_wflux(:), f_hfluxt(:), f_wfluxt(:), &            ! accumulated mass fluxes
-       f_du_slow(:,:), f_du_fast(:,:), &                              ! slow/fast trend arrays 
-       f_dmass_slow(:,:), f_dps_slow(:,:), f_dtheta_rhodz_slow(:,:), &! for HEVI time scheme 
-       f_dPhi_slow(:,:), f_dPhi_fast(:,:), &                          ! geopotential tendencies (NH)
-       f_dW_slow(:,:), f_dW_fast(:,:)                                 ! vertical momentum tendencies (NH)
-
-  INTEGER, PARAMETER, PUBLIC :: explicit=1, hevi=2, euler=1, rk4=2, mlf=3, rk25=4, ark23=6, ark33=7
-
-  INTEGER,SAVE, PUBLIC :: nb_stage, matsuno_period, scheme, scheme_family
-  !$OMP THREADPRIVATE(nb_stage, matsuno_period, scheme, scheme_family)
-
-  PUBLIC :: euler_scheme, accumulate_fluxes, legacy_to_DEC, DEC_to_legacy
-CONTAINS
-
-  SUBROUTINE Euler_scheme(with_dps,fluxt_zero)
-    USE icosa
-    USE disvert_mod
-    USE omp_para
-    USE trace
-    LOGICAL :: with_dps
-    LOGICAL, OPTIONAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating fluxes in time
-    REAL(rstd),POINTER :: ps(:), dps(:)
-    REAL(rstd),POINTER :: u(:,:) , du(:,:)
-    REAL(rstd),POINTER :: mass(:,:), dmass(:,:)
-    REAL(rstd),POINTER :: theta_rhodz(:,:,:), dtheta_rhodz(:,:,:)
-    REAL(rstd),POINTER :: hflux(:,:),wflux(:,:),hfluxt(:,:),wfluxt(:,:)
-    INTEGER :: ind
-    INTEGER :: i,j,ij,l
-    CALL trace_start("Euler_scheme")  
-
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-
-       IF(with_dps) THEN ! update ps/mass
-          IF(caldyn_eta==eta_mass) THEN ! update ps
-             ps=f_ps(ind) ; dps=f_dps(ind) ;              
-             IF (is_omp_first_level) THEN
-                !DIR$ SIMD
-                DO ij=ij_begin,ij_end
-                   ps(ij)=ps(ij)+dt*dps(ij)
-                ENDDO
-             ENDIF
-          ELSE ! update mass
-             mass=f_mass(ind) ; dmass=f_dmass(ind) ;              
-             DO l=ll_begin,ll_end
-                !DIR$ SIMD
-                DO ij=ij_begin,ij_end
-                   mass(ij,l)=mass(ij,l)+dt*dmass(ij,l)
-                ENDDO
-             END DO
-          END IF
-
-          hflux=f_hflux(ind);     hfluxt=f_hfluxt(ind)
-          wflux=f_wflux(ind);     wfluxt=f_wfluxt(ind)
-          CALL accumulate_fluxes(hflux,wflux,hfluxt,wfluxt,dt,fluxt_zero(ind))
-       END IF ! update ps/mass
-
-       u=f_u(ind) ; theta_rhodz=f_theta_rhodz(ind)
-       du=f_du(ind) ; dtheta_rhodz=f_dtheta_rhodz(ind)
-
-       DO l=ll_begin,ll_end
-          !DIR$ SIMD
-          DO ij=ij_begin,ij_end
-             u(ij+u_right,l)=u(ij+u_right,l)+dt*du(ij+u_right,l)
-             u(ij+u_lup,l)=u(ij+u_lup,l)+dt*du(ij+u_lup,l)
-             u(ij+u_ldown,l)=u(ij+u_ldown,l)+dt*du(ij+u_ldown,l)
-             theta_rhodz(ij,l,1)=theta_rhodz(ij,l,1)+dt*dtheta_rhodz(ij,l,1)
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL trace_end("Euler_scheme")  
-
-  END SUBROUTINE Euler_scheme
-
-  SUBROUTINE accumulate_fluxes(hflux,wflux, hfluxt,wfluxt, tau,fluxt_zero)
-    USE dimensions
-    USE omp_para
-    USE disvert_mod
-    IMPLICIT NONE
-    REAL(rstd), INTENT(IN)    :: hflux(3*iim*jjm,llm), wflux(iim*jjm,llm+1)
-    REAL(rstd), INTENT(INOUT) :: hfluxt(3*iim*jjm,llm), wfluxt(iim*jjm,llm+1)
-    REAL(rstd), INTENT(IN) :: tau
-    LOGICAL, INTENT(INOUT) :: fluxt_zero
-    INTEGER :: l,i,j,ij
-
-    IF(fluxt_zero) THEN
-
-       fluxt_zero=.FALSE.
-
-       DO l=ll_begin,ll_end
-          !DIR$ SIMD
-          DO ij=ij_begin_ext,ij_end_ext
-             hfluxt(ij+u_right,l) = tau*hflux(ij+u_right,l)
-             hfluxt(ij+u_lup,l) = tau*hflux(ij+u_lup,l)
-             hfluxt(ij+u_ldown,l) = tau*hflux(ij+u_ldown,l)
-          ENDDO
-       ENDDO
-
-       IF(caldyn_eta==eta_mass) THEN ! no need for vertical fluxes if eta_lag
-          DO l=ll_begin,ll_endp1
-             !DIR$ SIMD
-             DO ij=ij_begin,ij_end
-                wfluxt(ij,l) = tau*wflux(ij,l)
-             ENDDO
-          ENDDO
-       END IF
-
-    ELSE
-
-       DO l=ll_begin,ll_end
-          !DIR$ SIMD
-          DO ij=ij_begin_ext,ij_end_ext
-             hfluxt(ij+u_right,l) = hfluxt(ij+u_right,l)+tau*hflux(ij+u_right,l)
-             hfluxt(ij+u_lup,l) = hfluxt(ij+u_lup,l)+tau*hflux(ij+u_lup,l)
-             hfluxt(ij+u_ldown,l) = hfluxt(ij+u_ldown,l)+tau*hflux(ij+u_ldown,l)
-          ENDDO
-       ENDDO
-
-       IF(caldyn_eta==eta_mass) THEN ! no need for vertical fluxes if eta_lag
-          DO l=ll_begin,ll_endp1
-             !DIR$ SIMD
-             DO ij=ij_begin,ij_end
-                wfluxt(ij,l) = wfluxt(ij,l)+tau*wflux(ij,l)
-             ENDDO
-          ENDDO
-       END IF
-
-    END IF
-
-  END SUBROUTINE accumulate_fluxes
-
-  SUBROUTINE legacy_to_DEC(f_ps, f_u)
-    USE icosa
-    USE disvert_mod
-    USE omp_para
-    USE trace
-    TYPE(t_field),POINTER :: f_ps(:), f_u(:)
-    REAL(rstd), POINTER :: ps(:), u(:,:)
-    INTEGER :: ind,ij,l
-    CALL trace_start("legacy_to_DEC")
-
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-
-       IF(caldyn_eta==eta_mass .AND. is_omp_first_level) THEN ! update ps
-          ps=f_ps(ind)
-          !DIR$ SIMD
-          DO ij=ij_begin,ij_end
-             ps(ij)=(ps(ij)-ptop)/g ! convert ps to column-integrated mass
-          ENDDO
-       END IF
-
-       u=f_u(ind)
-       DO l=ll_begin,ll_end
-          !DIR$ SIMD
-          DO ij=ij_begin,ij_end
-             u(ij+u_right,l)=u(ij+u_right,l)*de(ij+u_right)
-             u(ij+u_lup,l)=u(ij+u_lup,l)*de(ij+u_lup)
-             u(ij+u_ldown,l)=u(ij+u_ldown,l)*de(ij+u_ldown)
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL trace_end("legacy_to_DEC")  
-  END SUBROUTINE Legacy_to_DEC
-
-  SUBROUTINE DEC_to_legacy(f_ps, f_u)
-    USE icosa
-    USE disvert_mod
-    USE omp_para
-    USE trace
-    TYPE(t_field),POINTER :: f_ps(:), f_u(:)
-    REAL(rstd), POINTER :: ps(:), u(:,:)
-    INTEGER :: ind,ij,l
-    CALL trace_start("legacy_to_DEC")
-
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-
-       IF(caldyn_eta==eta_mass .AND. is_omp_first_level) THEN
-          ps=f_ps(ind)
-          !DIR$ SIMD
-          DO ij=ij_begin,ij_end
-             ps(ij)=ptop+ps(ij)*g ! convert column-integrated mass to ps
-          ENDDO
-       ENDIF
-       
-       u=f_u(ind)
-       DO l=ll_begin,ll_end
-          !DIR$ SIMD
-          DO ij=ij_begin,ij_end
-             u(ij+u_right,l)=u(ij+u_right,l)/de(ij+u_right)
-             u(ij+u_lup,l)=u(ij+u_lup,l)/de(ij+u_lup)
-             u(ij+u_ldown,l)=u(ij+u_ldown,l)/de(ij+u_ldown)
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL trace_end("DEC_to_legacy")  
-  END SUBROUTINE DEC_to_legacy
-
-END MODULE euler_scheme_mod
Index: codes/icosagcm/devel/src/exner.f90
===================================================================
--- codes/icosagcm/devel/src/exner.f90	(revision 531)
+++ 	(revision )
@@ -1,76 +1,0 @@
-MODULE exner_mod
-
-  INTEGER,SAVE :: caldyn_exner
-!$OMP THREADPRIVATE(caldyn_exner)
-
-  INTEGER, PARAMETER :: lmdz=3, direct=4
-
-CONTAINS
-  
-  SUBROUTINE exner(f_ps,f_p,f_pks,f_pk)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ps(:)  ! IN
-    TYPE(t_field), POINTER :: f_p(:)   ! IN
-    TYPE(t_field), POINTER :: f_pks(:) ! OUT
-    TYPE(t_field), POINTER :: f_pk(:)  ! OUT
-  
-    REAL(rstd), POINTER :: ps(:)
-    REAL(rstd), POINTER :: p(:,:)
-    REAL(rstd), POINTER :: pks(:)
-    REAL(rstd), POINTER :: pk(:,:)
-    INTEGER :: ind
-
-!$OMP BARRIER
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      ps=f_ps(ind)
-      p=f_p(ind)
-      pks=f_pks(ind)
-      pk=f_pk(ind)
-      CALL compute_exner(ps, p, pks, pk, 0)
-    ENDDO
-!$OMP BARRIER
-  
-  END SUBROUTINE exner
-  
-  SUBROUTINE compute_exner(ps,p,pks,pk,offset)
-  USE icosa
-  USE disvert_mod
-  USE pression_mod
-  USE omp_para
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
-    REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
-    REAL(rstd),INTENT(OUT) :: pks(iim*jjm)
-    REAL(rstd),INTENT(OUT) :: pk(iim*jjm,llm)
-    INTEGER,INTENT(IN) :: offset
-    INTEGER :: i,j,ij,l
-    
-    ! surface : pks
-    IF (is_omp_level_master) THEN
-       
-       DO j=jj_begin-offset,jj_end+offset
-          DO i=ii_begin-offset,ii_end+offset
-             ij=(j-1)*iim+i
-             pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
-          ENDDO
-       ENDDO
-       
-    ENDIF
-    
-    ! 3D : pk
-    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
-             pk(ij,l) = cpp * ((.5/preff)*(p(ij,l)+p(ij,l+1))) ** kappa
-             ENDDO
-          ENDDO
-       ENDDO
-       
-  END SUBROUTINE compute_exner
-  
-END MODULE exner_mod
Index: codes/icosagcm/devel/src/explicit_scheme.f90
===================================================================
--- codes/icosagcm/devel/src/explicit_scheme.f90	(revision 531)
+++ 	(revision )
@@ -1,225 +1,0 @@
-MODULE explicit_scheme_mod
-  USE euler_scheme_mod
-  USE prec
-  USE domain_mod
-  USE field_mod
-  IMPLICIT NONE
-  PRIVATE
-
-  REAL(rstd), DIMENSION(4), PARAMETER :: coef_rk4 = (/ .25, 1./3., .5, 1. /)
-  REAL(rstd), DIMENSION(5), PARAMETER :: coef_rk25 = (/ .25, 1./6., 3./8., .5, 1. /)
-
-  PUBLIC :: explicit_scheme
-CONTAINS
-
-  SUBROUTINE explicit_scheme(it, fluxt_zero)
-    USE time_mod
-    USE omp_para
-    USE caldyn_mod
-    USE trace
-    USE dimensions
-    USE geometry
-!    USE caldyn_gcm_mod, ONLY : req_ps, req_mass
-
-    REAL(rstd),POINTER :: q(:,:,:)
-    REAL(rstd),POINTER :: phis(:), ps(:) ,psm1(:), psm2(:), dps(:)
-    REAL(rstd),POINTER :: u(:,:) , um1(:,:), um2(:,:), du(:,:)
-    REAL(rstd),POINTER :: rhodz(:,:), mass(:,:), massm1(:,:), massm2(:,:), dmass(:,:)
-    REAL(rstd),POINTER :: theta_rhodz(:,:,:) , theta_rhodzm1(:,:,:), theta_rhodzm2(:,:,:), dtheta_rhodz(:,:,:)
-    REAL(rstd),POINTER :: hflux(:,:),wflux(:,:),hfluxt(:,:),wfluxt(:,:)
-    LOGICAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating fluxes in time
-    INTEGER :: it,stage
-    
-    CALL legacy_to_DEC(f_ps, f_u)
-    DO stage=1,nb_stage
-       !       CALL checksum(f_ps)
-       !       CALL checksum(f_theta_rhodz)
-       !       CALL checksum(f_mass)
-       CALL caldyn((stage==1) .AND. (MOD(it,itau_out)==0), &
-            f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q, &
-            f_geopot, f_hflux, f_wflux, f_dps, f_dmass, f_dtheta_rhodz, f_du)
-       !       CALL checksum(f_dps)
-       !       CALL checksum(f_dtheta_rhodz)
-       !       CALL checksum(f_dmass)
-       SELECT CASE (scheme)
-       CASE(euler)
-          CALL euler_scheme(.TRUE., fluxt_zero)
-       CASE (rk4)
-          CALL rk_scheme(stage, coef_rk4)
-       CASE (rk25)
-          CALL rk_scheme(stage, coef_rk25)
-       CASE (mlf)
-          CALL  leapfrog_matsuno_scheme(stage)
-       CASE DEFAULT
-          STOP
-       END SELECT
-    END DO
-    CALL DEC_to_legacy(f_ps, f_u)
-
-  CONTAINS
-
-    SUBROUTINE RK_scheme(stage,coef)
-      USE disvert_mod
-      INTEGER :: ind, stage
-      REAL(rstd), INTENT(IN) :: coef(:)
-      REAL(rstd) :: tau
-      INTEGER :: i,j,ij,l
-
-      CALL trace_start("RK_scheme")  
-
-      tau = dt*coef(stage)
-
-      ! if mass coordinate, deal with ps first on one core
-      IF(caldyn_eta==eta_mass) THEN
-         IF (is_omp_first_level) THEN
-
-            DO ind=1,ndomain
-               IF (.NOT. assigned_domain(ind)) CYCLE
-               CALL swap_dimensions(ind)
-               CALL swap_geometry(ind)
-               ps=f_ps(ind) ; psm1=f_psm1(ind) ; dps=f_dps(ind) 
-
-               IF (stage==1) THEN ! first stage : save model state in XXm1
-                  !DIR$ SIMD
-                  DO ij=ij_begin,ij_end
-                     psm1(ij)=ps(ij)
-                  ENDDO
-               ENDIF
-
-               ! updates are of the form x1 := x0 + tau*f(x1)
-               !DIR$ SIMD
-               DO ij=ij_begin,ij_end
-                  ps(ij)=psm1(ij)+tau*dps(ij)
-               ENDDO
-            ENDDO
-         ENDIF
-         !         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)
-            mass=f_mass(ind); dmass=f_dmass(ind); massm1=f_massm1(ind)
-
-            IF (stage==1) THEN ! first stage : save model state in XXm1
-               DO l=ll_begin,ll_end
-                  !DIR$ SIMD
-                  DO ij=ij_begin,ij_end
-                     massm1(ij,l)=mass(ij,l)
-                  ENDDO
-               ENDDO
-            END IF
-
-            ! updates are of the form x1 := x0 + tau*f(x1)
-            DO l=ll_begin,ll_end
-               !DIR$ SIMD
-               DO ij=ij_begin,ij_end
-                  mass(ij,l)=massm1(ij,l)+tau*dmass(ij,l)
-               ENDDO
-            ENDDO
-         END DO
-         !         CALL send_message(f_mass,req_mass)
-         !ym no overlap for now         
-         !         CALL wait_message(req_mass)  
-
-      END IF
-
-      ! now deal with other prognostic variables
-      DO ind=1,ndomain
-         IF (.NOT. assigned_domain(ind)) CYCLE
-         CALL swap_dimensions(ind)
-         CALL swap_geometry(ind)
-         u=f_u(ind)      ; du=f_du(ind)      ; um1=f_um1(ind) 
-         theta_rhodz=f_theta_rhodz(ind)
-         theta_rhodzm1=f_theta_rhodzm1(ind)
-         dtheta_rhodz=f_dtheta_rhodz(ind)
-
-         IF (stage==1) THEN ! first stage : save model state in XXm1
-            DO l=ll_begin,ll_end
-               !DIR$ SIMD
-               DO ij=ij_begin,ij_end
-                  um1(ij+u_right,l)=u(ij+u_right,l)
-                  um1(ij+u_lup,l)=u(ij+u_lup,l)
-                  um1(ij+u_ldown,l)=u(ij+u_ldown,l)
-                  theta_rhodzm1(ij,l,1)=theta_rhodz(ij,l,1)
-               ENDDO
-            ENDDO
-         END IF
-
-         DO l=ll_begin,ll_end
-            !DIR$ SIMD
-            DO ij=ij_begin,ij_end
-               u(ij+u_right,l)=um1(ij+u_right,l)+tau*du(ij+u_right,l)
-               u(ij+u_lup,l)=um1(ij+u_lup,l)+tau*du(ij+u_lup,l)
-               u(ij+u_ldown,l)=um1(ij+u_ldown,l)+tau*du(ij+u_ldown,l)
-               theta_rhodz(ij,l,1)=theta_rhodzm1(ij,l,1)+tau*dtheta_rhodz(ij,l,1)
-            ENDDO
-         ENDDO
-
-         IF(stage==nb_stage) THEN ! accumulate mass fluxes at last stage
-            hflux=f_hflux(ind);     hfluxt=f_hfluxt(ind)
-            wflux=f_wflux(ind);     wfluxt=f_wfluxt(ind)
-            CALL accumulate_fluxes(hflux,wflux, hfluxt,wfluxt, dt,fluxt_zero(ind))
-         END IF
-      END DO
-
-      CALL trace_end("RK_scheme")
-
-    END SUBROUTINE RK_scheme
-
-    SUBROUTINE leapfrog_matsuno_scheme(stage)
-      IMPLICIT NONE
-      INTEGER :: ind, stage
-      REAL :: tau
-
-      CALL trace_start("leapfrog_matsuno_scheme")
-
-      tau = dt/nb_stage
-      DO ind=1,ndomain
-         IF (.NOT. assigned_domain(ind)) CYCLE
-         CALL swap_dimensions(ind)
-         CALL swap_geometry(ind)
-
-         ps=f_ps(ind)   ; u=f_u(ind)   ; theta_rhodz=f_theta_rhodz(ind)
-         psm1=f_psm1(ind) ; um1=f_um1(ind) ; theta_rhodzm1=f_theta_rhodzm1(ind)
-         psm2=f_psm2(ind) ; um2=f_um2(ind) ; theta_rhodzm2=f_theta_rhodzm2(ind)
-         dps=f_dps(ind) ; du=f_du(ind) ; dtheta_rhodz=f_dtheta_rhodz(ind)
-
-
-         IF (stage==1) THEN
-            psm1(:)=ps(:) ; um1(:,:)=u(:,:) ; theta_rhodzm1(:,:,:)=theta_rhodz(:,:,:)
-            ps(:)=psm1(:)+tau*dps(:)
-            u(:,:)=um1(:,:)+tau*du(:,:)
-            theta_rhodz(:,:,:)=theta_rhodzm1(:,:,:)+tau*dtheta_rhodz(:,:,:)
-
-         ELSE IF (stage==2) THEN
-
-            ps(:)=psm1(:)+tau*dps(:)
-            u(:,:)=um1(:,:)+tau*du(:,:)
-            theta_rhodz(:,:,:)=theta_rhodzm1(:,:,:)+tau*dtheta_rhodz(:,:,:)
-
-            psm2(:)=psm1(:) ; theta_rhodzm2(:,:,:)=theta_rhodzm1(:,:,:) ; um2(:,:)=um1(:,:) 
-            psm1(:)=ps(:) ; theta_rhodzm1(:,:,:)=theta_rhodz(:,:,:) ; um1(:,:)=u(:,:) 
-
-         ELSE 
-
-            ps(:)=psm2(:)+2*tau*dps(:)
-            u(:,:)=um2(:,:)+2*tau*du(:,:)
-            theta_rhodz(:,:,:)=theta_rhodzm2(:,:,:)+2*tau*dtheta_rhodz(:,:,:)
-
-            psm2(:)=psm1(:) ; theta_rhodzm2(:,:,:)=theta_rhodzm1(:,:,:) ; um2(:,:)=um1(:,:) 
-            psm1(:)=ps(:) ; theta_rhodzm1(:,:,:)=theta_rhodz(:,:,:) ; um1(:,:)=u(:,:) 
-
-         ENDIF
-
-      ENDDO
-      CALL trace_end("leapfrog_matsuno_scheme")
-
-    END SUBROUTINE leapfrog_matsuno_scheme
-
-  END SUBROUTINE Explicit_scheme
-
-END MODULE explicit_scheme_mod
Index: codes/icosagcm/devel/src/field.f90
===================================================================
--- codes/icosagcm/devel/src/field.f90	(revision 531)
+++ 	(revision )
@@ -1,462 +1,0 @@
-MODULE field_mod
-  USE genmod
-  IMPLICIT NONE
-  
-  INTEGER,PARAMETER :: field_T=1
-  INTEGER,PARAMETER :: field_U=2
-  INTEGER,PARAMETER :: field_Z=3
-
-  INTEGER,PARAMETER :: type_integer=1
-  INTEGER,PARAMETER :: type_real=2
-  INTEGER,PARAMETER :: type_logical=3
-    
-  TYPE t_field
-    CHARACTER(30)      :: name
-    REAL(rstd),POINTER :: rval2d(:)
-    REAL(rstd),POINTER :: rval3d(:,:)
-    REAL(rstd),POINTER :: rval4d(:,:,:)
-
-    INTEGER,POINTER :: ival2d(:)
-    INTEGER,POINTER :: ival3d(:,:)
-    INTEGER,POINTER :: ival4d(:,:,:)
-    
-    LOGICAL,POINTER :: lval2d(:)
-    LOGICAL,POINTER :: lval3d(:,:)
-    LOGICAL,POINTER :: lval4d(:,:,:)
-
-    INTEGER :: ndim
-    INTEGER :: field_type
-    INTEGER :: data_type 
-    INTEGER :: dim3
-    INTEGER :: dim4
-  END TYPE t_field   
-
-  INTERFACE get_val
-    MODULE PROCEDURE getval_r2d,getval_r3d,getval_r4d, &
-                     getval_i2d,getval_i3d,getval_i4d, &
-                     getval_l2d,getval_l3d,getval_l4d
-  END INTERFACE
-                   
-  INTERFACE ASSIGNMENT(=)
-    MODULE PROCEDURE getval_r2d,getval_r3d,getval_r4d, &
-                     getval_i2d,getval_i3d,getval_i4d, &
-                     getval_l2d,getval_l3d,getval_l4d 
-  END INTERFACE
-
-  PRIVATE :: allocate_field_
-
-CONTAINS
-
-  SUBROUTINE allocate_field(field,field_type,data_type,dim1,dim2,name)
-  USE domain_mod
-  USE omp_para
-    TYPE(t_field),POINTER :: field(:)
-    INTEGER,INTENT(IN) :: field_type
-    INTEGER,INTENT(IN) :: data_type
-    INTEGER,OPTIONAL :: dim1,dim2
-    CHARACTER(*), OPTIONAL :: name
-!$OMP BARRIER
-!$OMP MASTER
-    ALLOCATE(field(ndomain))
-!$OMP END MASTER
-!$OMP BARRIER
-    CALL allocate_field_(field,field_type,data_type,dim1,dim2,name)
-  END SUBROUTINE allocate_field
-
-  SUBROUTINE allocate_fields(nfield,field,field_type,data_type,dim1,dim2,name)
-  USE domain_mod
-  USE omp_para
-    INTEGER,INTENT(IN) :: nfield
-    TYPE(t_field),POINTER :: field(:,:)
-    INTEGER,INTENT(IN) :: field_type
-    INTEGER,INTENT(IN) :: data_type
-    INTEGER,OPTIONAL :: dim1,dim2
-    CHARACTER(*), OPTIONAL :: name
-    INTEGER :: i
-!$OMP BARRIER
-!$OMP MASTER
-    ALLOCATE(field(ndomain,nfield))
-!$OMP END MASTER
-!$OMP BARRIER
-    DO i=1,nfield
-       CALL allocate_field_(field(:,i),field_type,data_type,dim1,dim2,name)
-    END DO
-  END SUBROUTINE allocate_fields
-
-  SUBROUTINE allocate_field_(field,field_type,data_type,dim1,dim2,name)
-  USE domain_mod
-  USE omp_para
-  IMPLICIT NONE
-    TYPE(t_field) :: field(:)
-    INTEGER,INTENT(IN) :: field_type
-    INTEGER,INTENT(IN) :: data_type
-    INTEGER,OPTIONAL :: dim1,dim2
-    CHARACTER(*), OPTIONAL :: name
-    INTEGER :: ind
-    INTEGER :: ii_size,jj_size
-
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
-
-      IF(PRESENT(name)) THEN
-         field(ind)%name = name
-      ELSE
-         field(ind)%name = '(undefined)'
-      END IF
-
-      IF (PRESENT(dim2)) THEN
-        field(ind)%ndim=4 
-        field(ind)%dim4=dim2 
-        field(ind)%dim3=dim1
-      ELSE IF (PRESENT(dim1)) THEN
-        field(ind)%ndim=3
-        field(ind)%dim3=dim1
-      ELSE
-        field(ind)%ndim=2
-      ENDIF
-    
-    
-      field(ind)%data_type=data_type
-      field(ind)%field_type=field_type
-    
-      IF (field_type==field_T) THEN 
-        jj_size=domain(ind)%jjm
-      ELSE IF (field_type==field_U) THEN 
-        jj_size=3*domain(ind)%jjm
-      ELSE IF (field_type==field_Z) THEN 
-        jj_size=2*domain(ind)%jjm
-      ENDIF
-      
-      ii_size=domain(ind)%iim
-        
-      IF (field(ind)%ndim==4) THEN
-        IF (data_type==type_integer) ALLOCATE(field(ind)%ival4d(ii_size*jj_size,dim1,dim2))
-        IF (data_type==type_real)    ALLOCATE(field(ind)%rval4d(ii_size*jj_size,dim1,dim2))
-        IF (data_type==type_logical) ALLOCATE(field(ind)%lval4d(ii_size*jj_size,dim1,dim2))
-      ELSE IF (field(ind)%ndim==3) THEN
-        IF (data_type==type_integer) ALLOCATE(field(ind)%ival3d(ii_size*jj_size,dim1))
-        IF (data_type==type_real)    ALLOCATE(field(ind)%rval3d(ii_size*jj_size,dim1))
-        IF (data_type==type_logical) ALLOCATE(field(ind)%lval3d(ii_size*jj_size,dim1))
-      ELSE IF (field(ind)%ndim==2) THEN
-        IF (data_type==type_integer) ALLOCATE(field(ind)%ival2d(ii_size*jj_size))
-        IF (data_type==type_real)    ALLOCATE(field(ind)%rval2d(ii_size*jj_size))
-        IF (data_type==type_logical) ALLOCATE(field(ind)%lval2d(ii_size*jj_size))
-      ENDIF
-      
-   ENDDO
-!$OMP BARRIER
-   
- END SUBROUTINE allocate_field_
-
-  SUBROUTINE allocate_field_glo(field,field_type,data_type,dim1,dim2,name)
-  USE domain_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    INTEGER,INTENT(IN) :: field_type
-    INTEGER,INTENT(IN) :: data_type
-    INTEGER,OPTIONAL :: dim1,dim2
-    CHARACTER(*), OPTIONAL :: name
-    INTEGER :: ind
-    INTEGER :: ii_size,jj_size
-
-    ALLOCATE(field(ndomain_glo))    
-
-    DO ind=1,ndomain_glo
-  
-      IF (PRESENT(dim2)) THEN
-        field(ind)%ndim=4 
-        field(ind)%dim4=dim2 
-        field(ind)%dim3=dim1 
-      ELSE IF (PRESENT(dim1)) THEN
-        field(ind)%ndim=3
-        field(ind)%dim3=dim1 
-      ELSE
-        field(ind)%ndim=2
-      ENDIF
-    
-      IF(PRESENT(name)) THEN
-         field(ind)%name = name
-      ELSE
-         field(ind)%name = '(undefined)'
-      END IF
-    
-      field(ind)%data_type=data_type
-      field(ind)%field_type=field_type
-    
-      IF (field_type==field_T) THEN 
-        jj_size=domain_glo(ind)%jjm
-      ELSE IF (field_type==field_U) THEN 
-        jj_size=3*domain_glo(ind)%jjm
-      ELSE IF (field_type==field_Z) THEN 
-        jj_size=2*domain_glo(ind)%jjm
-      ENDIF
-      
-      ii_size=domain_glo(ind)%iim
-        
-      IF (field(ind)%ndim==4) THEN
-        IF (data_type==type_integer) ALLOCATE(field(ind)%ival4d(ii_size*jj_size,dim1,dim2))
-        IF (data_type==type_real)    ALLOCATE(field(ind)%rval4d(ii_size*jj_size,dim1,dim2))
-        IF (data_type==type_logical) ALLOCATE(field(ind)%lval4d(ii_size*jj_size,dim1,dim2))
-      ELSE IF (field(ind)%ndim==3) THEN
-        IF (data_type==type_integer) ALLOCATE(field(ind)%ival3d(ii_size*jj_size,dim1))
-        IF (data_type==type_real)    ALLOCATE(field(ind)%rval3d(ii_size*jj_size,dim1))
-        IF (data_type==type_logical) ALLOCATE(field(ind)%lval3d(ii_size*jj_size,dim1))
-      ELSE IF (field(ind)%ndim==2) THEN
-        IF (data_type==type_integer) ALLOCATE(field(ind)%ival2d(ii_size*jj_size))
-        IF (data_type==type_real)    ALLOCATE(field(ind)%rval2d(ii_size*jj_size))
-        IF (data_type==type_logical) ALLOCATE(field(ind)%lval2d(ii_size*jj_size))
-      ENDIF
-      
-   ENDDO
-  
-  END SUBROUTINE allocate_field_glo
-
-  SUBROUTINE deallocate_field(field)
-    USE domain_mod
-    USE omp_para
-    IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    !$OMP BARRIER
-    CALL deallocate_field_(field)
-    !$OMP BARRIER
-    !$OMP MASTER
-    DEALLOCATE(field)
-    !$OMP END MASTER
-    !$OMP BARRIER
-  END SUBROUTINE deallocate_field
-  
-  SUBROUTINE deallocate_fields(field)
-    USE domain_mod
-    USE omp_para
-    IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:,:)
-    INTEGER :: i
-    !$OMP BARRIER
-    DO i=1,SIZE(field,2)
-       CALL deallocate_field_(field(:,i))
-    END DO
-    !$OMP BARRIER
-    !$OMP MASTER
-    DEALLOCATE(field)
-    !$OMP END MASTER
-    !$OMP BARRIER
-  END SUBROUTINE deallocate_fields
-
-  SUBROUTINE deallocate_field_(field)
-  USE domain_mod
-  USE omp_para
-  IMPLICIT NONE
-    TYPE(t_field) :: field(:)
-    INTEGER :: data_type
-    INTEGER :: ind
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
-
-      data_type=field(ind)%data_type
-        
-      IF (field(ind)%ndim==4) THEN
-        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival4d)
-        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval4d)
-        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval4d)
-      ELSE IF (field(ind)%ndim==3) THEN
-        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival3d)
-        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval3d)
-        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval3d)
-      ELSE IF (field(ind)%ndim==2) THEN
-        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival2d)
-        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval2d)
-        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval2d)
-      ENDIF
-      
-   ENDDO
-  END SUBROUTINE deallocate_field_
-
-  SUBROUTINE deallocate_field_glo(field)
-  USE domain_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    INTEGER :: data_type
-    INTEGER :: ind
-
-    DO ind=1,ndomain_glo
-
-      data_type=field(ind)%data_type
-        
-      IF (field(ind)%ndim==4) THEN
-        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival4d)
-        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval4d)
-        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval4d)
-      ELSE IF (field(ind)%ndim==3) THEN
-        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival3d)
-        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval3d)
-        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval3d)
-      ELSE IF (field(ind)%ndim==2) THEN
-        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival2d)
-        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval2d)
-        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval2d)
-      ENDIF
-      
-   ENDDO
-   DEALLOCATE(field)
-       
-  END SUBROUTINE deallocate_field_glo
-    
-  SUBROUTINE extract_slice(field_in, field_out, l)  
-  USE domain_mod
-  USE omp_para
-  IMPLICIT NONE  
-    TYPE(t_field) :: field_in(:)
-    TYPE(t_field) :: field_out(:)
-    INTEGER,INTENT(IN) :: l
-    
-    INTEGER :: ind
-    INTEGER :: data_type
-
-!$OMP BARRIER
-    DO ind=1,ndomain
-      data_type=field_in(ind)%data_type
-      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
-      
-      IF (field_in(ind)%ndim==3 .AND. field_out(ind)%ndim==2) THEN  
-        IF (data_type==type_integer)  field_out(ind)%ival2d=field_in(ind)%ival3d(:,l)
-        IF (data_type==type_real)     field_out(ind)%rval2d=field_in(ind)%rval3d(:,l)
-        IF (data_type==type_logical)  field_out(ind)%lval2d=field_in(ind)%lval3d(:,l)
-      ELSE IF  (field_in(ind)%ndim==4 .AND. field_out(ind)%ndim==3) THEN
-        IF (data_type==type_integer)  field_out(ind)%ival3d=field_in(ind)%ival4d(:,:,l)
-        IF (data_type==type_real)     field_out(ind)%rval3d=field_in(ind)%rval4d(:,:,l)
-        IF (data_type==type_logical)  field_out(ind)%lval3d=field_in(ind)%lval4d(:,:,l)
-      ELSE
-        PRINT *, 'extract_slice : cannot extract slice, dimension incompatible'
-        STOP       
-      ENDIF
-   ENDDO 
-!$OMP BARRIER    
-  END  SUBROUTINE extract_slice  
-  
-  
-  SUBROUTINE insert_slice(field_in, field_out, l)  
-  USE domain_mod
-  USE omp_para
-  IMPLICIT NONE  
-    TYPE(t_field) :: field_in(:)
-    TYPE(t_field) :: field_out(:)
-    INTEGER,INTENT(IN) :: l
-    
-    INTEGER :: ind
-    INTEGER :: data_type
-
-!$OMP BARRIER
-    DO ind=1,ndomain
-      data_type=field_in(ind)%data_type
-      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
-      
-      IF (field_in(ind)%ndim==2 .AND. field_out(ind)%ndim==3) THEN  
-        IF (data_type==type_integer)  field_out(ind)%ival3d(:,l)=field_in(ind)%ival2d(:)
-        IF (data_type==type_real)     field_out(ind)%rval3d(:,l)=field_in(ind)%rval2d(:)
-        IF (data_type==type_logical)  field_out(ind)%lval3d(:,l)=field_in(ind)%lval2d(:)
-      ELSE IF  (field_in(ind)%ndim==4 .AND. field_out(ind)%ndim==3) THEN
-        IF (data_type==type_integer)  field_out(ind)%ival4d(:,:,l)=field_out(ind)%ival3d(:,:)
-        IF (data_type==type_real)     field_out(ind)%rval4d(:,:,l)=field_out(ind)%rval3d(:,:)
-        IF (data_type==type_logical)  field_out(ind)%lval4d(:,:,l)=field_out(ind)%lval3d(:,:)
-      ELSE
-        PRINT *, 'extract_slice : cannot insert slice, dimension incompatible'
-        STOP       
-      ENDIF
-   ENDDO 
-!$OMP BARRIER    
-  
-  END SUBROUTINE insert_slice
-    
-  SUBROUTINE getval_r2d(field_pt,field)
-  IMPLICIT NONE  
-    REAL(rstd),POINTER,INTENT(INOUT) :: field_pt(:)
-    TYPE(t_field),INTENT(IN) :: field
-    
-    IF (field%ndim/=2 .OR. field%data_type/=type_real) THEN
-       PRINT *, 'get_val_r2d : bad pointer assignment with ' // TRIM(field%name) 
-       STOP
-    END IF
-    field_pt=>field%rval2d
-  END SUBROUTINE  getval_r2d
-
-  SUBROUTINE getval_r3d(field_pt,field)
-  IMPLICIT NONE  
-    REAL(rstd),POINTER,INTENT(INOUT) :: field_pt(:,:)
-    TYPE(t_field),INTENT(IN) :: field
-    
-    IF (field%ndim/=3 .OR. field%data_type/=type_real) THEN
-       PRINT *, 'get_val_r3d : bad pointer assignment with ' // TRIM(field%name) 
-       STOP
-!       CALL ABORT
-    END IF
-    field_pt=>field%rval3d
-  END SUBROUTINE  getval_r3d
-
-  SUBROUTINE getval_r4d(field_pt,field)
-  IMPLICIT NONE  
-    REAL(rstd),POINTER,INTENT(INOUT) :: field_pt(:,:,:)
-    TYPE(t_field),INTENT(IN) :: field
-    
-    IF (field%ndim/=4 .OR. field%data_type/=type_real) THEN
-       PRINT *, 'get_val_r4d : bad pointer assignment with ' // TRIM(field%name)
-       STOP
-    END IF
-    field_pt=>field%rval4d
-  END SUBROUTINE  getval_r4d  
-
-  
-  SUBROUTINE getval_i2d(field_pt,field)
-  IMPLICIT NONE  
-    INTEGER,POINTER,INTENT(INOUT) :: field_pt(:)
-    TYPE(t_field),INTENT(IN) :: field
-    
-    IF (field%ndim/=2 .OR. field%data_type/=type_integer) STOP 'get_val_i2d : bad pointer assignment'        
-    field_pt=>field%ival2d
-  END SUBROUTINE  getval_i2d
-
-  SUBROUTINE getval_i3d(field_pt,field)
-  IMPLICIT NONE  
-    INTEGER,POINTER,INTENT(INOUT) :: field_pt(:,:)
-    TYPE(t_field),INTENT(IN) :: field
-    
-    IF (field%ndim/=3 .OR. field%data_type/=type_integer) STOP 'get_val_i3d : bad pointer assignment'        
-    field_pt=>field%ival3d
-  END SUBROUTINE  getval_i3d
-
-  SUBROUTINE getval_i4d(field_pt,field)
-  IMPLICIT NONE  
-    INTEGER,POINTER,INTENT(INOUT) :: field_pt(:,:,:)
-    TYPE(t_field),INTENT(IN) :: field
-    
-    IF (field%ndim/=4 .OR. field%data_type/=type_integer) STOP 'get_val_i4d : bad pointer assignment'        
-    field_pt=>field%ival4d
-  END SUBROUTINE  getval_i4d
-
-  SUBROUTINE getval_l2d(field_pt,field)
-  IMPLICIT NONE  
-    LOGICAL,POINTER,INTENT(INOUT) :: field_pt(:)
-    TYPE(t_field),INTENT(IN) :: field
-    
-    IF (field%ndim/=2 .OR. field%data_type/=type_logical) STOP 'get_val_l2d : bad pointer assignment'        
-    field_pt=>field%lval2d
-  END SUBROUTINE  getval_l2d
-
-  SUBROUTINE getval_l3d(field_pt,field)
-  IMPLICIT NONE  
-    LOGICAL,POINTER,INTENT(INOUT) :: field_pt(:,:)
-    TYPE(t_field),INTENT(IN) :: field
-    
-    IF (field%ndim/=3 .OR. field%data_type/=type_logical) STOP 'get_val_l3d : bad pointer assignment'        
-    field_pt=>field%lval3d
-  END SUBROUTINE  getval_l3d
-
-  SUBROUTINE getval_l4d(field_pt,field)
-  IMPLICIT NONE  
-    LOGICAL,POINTER,INTENT(INOUT) :: field_pt(:,:,:)
-    TYPE(t_field),INTENT(IN) :: field
-    
-    IF (field%ndim/=4 .OR. field%data_type/=type_logical) STOP 'get_val_l4d : bad pointer assignment'        
-    field_pt=>field%lval4d
-  END SUBROUTINE  getval_l4d    
-
-END MODULE field_mod   
Index: codes/icosagcm/devel/src/free_unit_mod.f90
===================================================================
--- codes/icosagcm/devel/src/free_unit_mod.f90	(revision 531)
+++ 	(revision )
@@ -1,26 +1,0 @@
-MODULE free_unit_mod
-
-  PRIVATE 
-
-  INTEGER, PARAMETER :: start_unit=1000
-
-  PUBLIC :: free_unit
-
-CONTAINS
-
-  FUNCTION free_unit()
-    INTEGER :: free_unit
-    LOGICAL :: out
-    
-    out=.FALSE.
-    free_unit=start_unit
-    
-    DO WHILE (.NOT. out)
-      free_unit=free_unit+1
-      INQUIRE(unit=free_unit, exist=out)
-    END DO
-    
-  END FUNCTION free_unit
-  
-END MODULE free_unit_mod
-  
Index: codes/icosagcm/devel/src/genmod.f90
===================================================================
--- codes/icosagcm/devel/src/genmod.f90	(revision 531)
+++ 	(revision )
@@ -1,5 +1,0 @@
-MODULE genmod
-  USE prec
-  USE math_const
-  USE earth_const
-END MODULE genmod
Index: codes/icosagcm/devel/src/geometry.f90
===================================================================
--- codes/icosagcm/devel/src/geometry.f90	(revision 531)
+++ 	(revision )
@@ -1,729 +1,0 @@
-MODULE geometry
-  USE field_mod
-  IMPLICIT NONE
-
-  TYPE t_geometry
-    TYPE(t_field),POINTER :: centroid(:)
-    TYPE(t_field),POINTER :: xyz_i(:)
-    TYPE(t_field),POINTER :: xyz_e(:)
-    TYPE(t_field),POINTER :: xyz_v(:)
-    TYPE(t_field),POINTER :: lon_i(:)
-    TYPE(t_field),POINTER :: lon_e(:)
-    TYPE(t_field),POINTER :: lat_i(:)
-    TYPE(t_field),POINTER :: lat_e(:)
-    TYPE(t_field),POINTER :: ep_e(:)
-    TYPE(t_field),POINTER :: et_e(:)
-    TYPE(t_field),POINTER :: elon_i(:)
-    TYPE(t_field),POINTER :: elat_i(:)
-    TYPE(t_field),POINTER :: elon_e(:)
-    TYPE(t_field),POINTER :: elat_e(:)
-    TYPE(t_field),POINTER :: Ai(:)
-    TYPE(t_field),POINTER :: Av(:)
-    TYPE(t_field),POINTER :: de(:)
-    TYPE(t_field),POINTER :: le(:)
-    TYPE(t_field),POINTER :: le_de(:) ! le/de, 0. if de=0.
-    TYPE(t_field),POINTER :: Riv(:)
-    TYPE(t_field),POINTER :: S1(:)
-    TYPE(t_field),POINTER :: S2(:)
-    TYPE(t_field),POINTER :: Riv2(:)
-    TYPE(t_field),POINTER :: ne(:)
-    TYPE(t_field),POINTER :: Wee(:)
-    TYPE(t_field),POINTER :: bi(:)
-    TYPE(t_field),POINTER :: fv(:)
-  END TYPE t_geometry    
-
-  TYPE(t_geometry),SAVE,TARGET :: geom
-
-  
-  REAL(rstd),POINTER :: Ai(:)          ! area of a cell
-!$OMP THREADPRIVATE(Ai)
-  REAL(rstd),POINTER :: centroid(:,:)  ! coordinate of the centroid of the cell
-!$OMP THREADPRIVATE(centroid)
-  REAL(rstd),POINTER :: xyz_i(:,:)     ! coordinate of the center of the cell (voronoi)
-!$OMP THREADPRIVATE(xyz_i)
-  REAL(rstd),POINTER :: xyz_e(:,:)     ! coordinate of a wind point on the cell on a edge
-!$OMP THREADPRIVATE(xyz_e)
-  REAL(rstd),POINTER :: xyz_v(:,:)     ! coordinate of a vertex (center of the dual mesh)
-!$OMP THREADPRIVATE(xyz_v)
-  REAL(rstd),POINTER :: lon_i(:)       ! longitude of the center of the cell (voronoi)
-!$OMP THREADPRIVATE(lon_i)
-  REAL(rstd),POINTER :: lon_e(:)       ! longitude of a wind point on the cell on a edge
-!$OMP THREADPRIVATE(lon_e)
-  REAL(rstd),POINTER :: lat_i(:)       ! latitude of the center of the cell (voronoi)
-!$OMP THREADPRIVATE(lat_i)
-  REAL(rstd),POINTER :: lat_e(:)       ! latitude of a wind point on the cell on a edge
-!$OMP THREADPRIVATE(lat_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 :: 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 :: le_de(:)       ! le/de
-!$OMP THREADPRIVATE(le_de)
-  REAL(rstd),POINTER :: S1(:,:)        ! area of sub-triangle
-!$OMP THREADPRIVATE(S1)
-  REAL(rstd),POINTER :: S2(:,:)        ! area of sub-tirangle
-!$OMP THREADPRIVATE(S2)
-  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)
-     
-
-  INTEGER, PARAMETER :: ne_right=1
-  INTEGER, PARAMETER :: ne_rup=-1
-  INTEGER, PARAMETER :: ne_lup=1
-  INTEGER, PARAMETER :: ne_left=-1
-  INTEGER, PARAMETER :: ne_ldown=1
-  INTEGER, PARAMETER :: ne_rdown=-1
-
-CONTAINS
-
-  SUBROUTINE allocate_geometry
-  USE field_mod
-  IMPLICIT NONE
-  
-    CALL allocate_field(geom%Ai,field_t,type_real,name='Ai')
-
-    CALL allocate_field(geom%xyz_i,field_t,type_real,3)
-    CALL allocate_field(geom%lon_i,field_t,type_real)
-    CALL allocate_field(geom%lat_i,field_t,type_real)
-    CALL allocate_field(geom%elon_i,field_t,type_real,3)
-    CALL allocate_field(geom%elat_i,field_t,type_real,3)
-    CALL allocate_field(geom%centroid,field_t,type_real,3)
-
-    CALL allocate_field(geom%xyz_e,field_u,type_real,3)
-    CALL allocate_field(geom%lon_e,field_u,type_real)
-    CALL allocate_field(geom%lat_e,field_u,type_real)
-    CALL allocate_field(geom%elon_e,field_u,type_real,3)
-    CALL allocate_field(geom%elat_e,field_u,type_real,3)
-    CALL allocate_field(geom%ep_e,field_u,type_real,3)
-    CALL allocate_field(geom%et_e,field_u,type_real,3)
-
-    CALL allocate_field(geom%xyz_v,field_z,type_real,3)
-    CALL allocate_field(geom%de,field_u,type_real)
-    CALL allocate_field(geom%le,field_u,type_real)
-    CALL allocate_field(geom%le_de,field_u,type_real)
-    CALL allocate_field(geom%bi,field_t,type_real)
-    CALL allocate_field(geom%Av,field_z,type_real)
-    CALL allocate_field(geom%S1,field_t,type_real,6)
-    CALL allocate_field(geom%S2,field_t,type_real,6)
-    CALL allocate_field(geom%Riv,field_t,type_real,6)
-    CALL allocate_field(geom%Riv2,field_t,type_real,6)
-    CALL allocate_field(geom%ne,field_t,type_integer,6)
-    CALL allocate_field(geom%Wee,field_u,type_real,5,2)
-    CALL allocate_field(geom%bi,field_t,type_real)
-    CALL allocate_field(geom%fv,field_z,type_real)
-
-  END SUBROUTINE allocate_geometry
-  
-  
-  SUBROUTINE swap_geometry(ind)
-  USE field_mod
-  IMPLICIT NONE
-    INTEGER,INTENT(IN) :: ind
-!!$OMP MASTER
-    Ai=geom%Ai(ind)
-    xyz_i=geom%xyz_i(ind)
-    centroid=geom%centroid(ind)
-    xyz_e=geom%xyz_e(ind)
-    ep_e=geom%ep_e(ind)
-    et_e=geom%et_e(ind)
-    lon_i=geom%lon_i(ind)
-    lat_i=geom%lat_i(ind)
-    lon_e=geom%lon_e(ind)
-    lat_e=geom%lat_e(ind)
-    elon_i=geom%elon_i(ind)
-    elat_i=geom%elat_i(ind)
-    elon_e=geom%elon_e(ind)
-    elat_e=geom%elat_e(ind)
-    xyz_v=geom%xyz_v(ind)
-    de=geom%de(ind)
-    le=geom%le(ind)
-    le_de=geom%le_de(ind)
-    Av=geom%Av(ind)
-    S1=geom%S1(ind)
-    S2=geom%S2(ind)
-    Riv=geom%Riv(ind)
-    Riv2=geom%Riv2(ind)
-    ne=geom%ne(ind)
-    Wee=geom%Wee(ind)
-    bi=geom%bi(ind)
-    fv=geom%fv(ind)
-!!$OMP END MASTER
-!!$OMP BARRIER    
-  END SUBROUTINE swap_geometry
-
-  SUBROUTINE update_circumcenters 
-    USE domain_mod
-    USE dimensions
-    USE spherical_geom_mod
-    USE vector
-    USE transfert_mod
-    USE omp_para
-
-    IMPLICIT NONE
-    REAL(rstd) :: x1(3),x2(3)
-    REAL(rstd) :: vect(3,6)
-    REAL(rstd) :: centr(3)
-    INTEGER :: ind,i,j,n,k
-    TYPE(t_message),SAVE :: message0, message1
-    LOGICAL, SAVE :: first=.TRUE.
-!$OMP THREADPRIVATE(first)    
-    
-    IF (first) THEN
-      CALL init_message(geom%xyz_i, req_i0 ,message0)
-      CALL init_message(geom%xyz_i, req_i1 ,message1)
-      first=.FALSE.
-    ENDIF
-    
-    CALL transfert_message(geom%xyz_i,message0)
-    CALL transfert_message(geom%xyz_i,message1)
-    
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          n=(j-1)*iim+i
-          DO k=0,5
-            x1(:) = xyz_i(n+t_pos(k+1),:)
-            x2(:) = xyz_i(n+t_pos(MOD(k+1,6)+1),:)
-            if (norm(x1-x2)<1e-16) x2(:) = xyz_i(n+t_pos(MOD(k+2,6)+1),:)
-            CALL circumcenter(xyz_i(n,:), x1, x2, xyz_v(n+z_pos(k+1),:))
-          ENDDO
-        ENDDO
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE update_circumcenters
-
-  SUBROUTINE remap_schmidt_loc
-    USE spherical_geom_mod
-    USE getin_mod
-    USE omp_para
-    USE domain_mod
-    USE dimensions
-    IMPLICIT NONE
-    INTEGER :: ind,i,j,n
-    REAL(rstd) :: schmidt_factor, schmidt_lon, schmidt_lat
-
-    ! Schmidt transform parameters
-    schmidt_factor = 1.
-    CALL getin('schmidt_factor', schmidt_factor)
-    schmidt_factor =  schmidt_factor**2.
-    
-    schmidt_lon = 0.
-    CALL getin('schmidt_lon', schmidt_lon)
-    schmidt_lon = schmidt_lon * pi/180.
-
-    schmidt_lat = 45.
-    CALL getin('schmidt_lat', schmidt_lat)
-    schmidt_lat = schmidt_lat * pi/180.
-
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          n=(j-1)*iim+i
-          CALL schmidt_transform(xyz_i(n,:), schmidt_factor, schmidt_lon, schmidt_lat)
-        ENDDO
-      ENDDO
-    ENDDO
-  END SUBROUTINE remap_schmidt_loc
-
-  SUBROUTINE optimize_geometry
-  USE metric
-  USE spherical_geom_mod
-  USE domain_mod
-  USE dimensions
-  USE transfert_mod
-  USE vector
-  USE getin_mod
-  USE omp_para
-  IMPLICIT NONE
-    INTEGER :: nb_it=0
-    TYPE(t_domain),POINTER :: d
-    INTEGER :: ind,it,i,j,n,k
-    REAL(rstd) :: x1(3),x2(3)
-    REAL(rstd) :: vect(3,6)
-    REAL(rstd) :: centr(3)
-    REAL(rstd) :: sum
-    LOGICAL    :: check
-    
-    
-    CALL getin('optim_it',nb_it)
-    
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
-      d=>domain(ind)
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      xyz_i(:,1) = 0 ; xyz_i(:,2) = 0 ;  xyz_i(:,3) = 1
-      
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          n=(j-1)*iim+i
-          xyz_i(n,:)=d%xyz(:,i,j) 
-        ENDDO
-      ENDDO
-    ENDDO
-    
-    CALL update_circumcenters
-
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master ) CYCLE
-      d=>domain(ind)
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          n=(j-1)*iim+i
-          DO k=0,5
-            x1(:) = xyz_v(n+z_pos(k+1),:)
-            x2(:) = d%vertex(:,k,i,j) 
-            IF (norm(x1-x2)>1e-10) THEN
-              PRINT*,"vertex diff ",ind,i,j,k
-              PRINT*,x1
-              PRINT*,x2
-            ENDIF
-          ENDDO
-        ENDDO
-      ENDDO
-    ENDDO
-    
-    
-    DO it=1,nb_it
-      IF (MOD(it,100)==0) THEN 
-        check=is_master
-      ELSE
-        check=.FALSE.
-      ENDIF
-      
-      sum=0
-      DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master ) CYCLE
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-            n=(j-1)*iim+i
-            vect(:,1)=xyz_v(n+z_rup,:)
-            vect(:,2)=xyz_v(n+z_up,:)
-            vect(:,3)=xyz_v(n+z_lup,:)
-            vect(:,4)=xyz_v(n+z_ldown,:)
-            vect(:,5)=xyz_v(n+z_down,:)
-            vect(:,6)=xyz_v(n+z_rdown,:)
-            CALL compute_centroid(vect,6,centr)
-            IF (check) THEN
-              sum=MAX(sum,norm(xyz_i(n,:)-centr(:)))
-            ENDIF
-            xyz_i(n,:)=centr(:)
-          ENDDO
-        ENDDO
-        
-      ENDDO
-
-      IF (check) PRINT *,"it = ",it,"  diff centroid circumcenter ",sum
-
-     CALL update_circumcenters
-
-    ENDDO
-    
-  END SUBROUTINE optimize_geometry
-
-  SUBROUTINE update_domain 
-    ! copy position of generators and vertices back into domain(:)%xyz/vertex
-    ! so that XIOS/create_header_gen gets the right values
-    USE omp_para
-    USE dimensions
-    USE domain_mod 
-    USE transfert_mpi_mod
-
-    INTEGER :: ind,i,j,k,n
-    TYPE(t_domain),POINTER :: d
-    TYPE(t_field),POINTER,SAVE :: xyz_glo(:), xyz_loc(:), vertex_glo(:), vertex_loc(:)
-    REAL(rstd), POINTER :: xyz(:,:), vertex(:,:)
-    
-    CALL allocate_field(xyz_loc, field_t, type_real, 3)
-    CALL allocate_field(vertex_loc, field_z, type_real, 3)
-
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master ) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       xyz = xyz_loc(ind)
-       xyz(:,:) = xyz_i(:,:)
-       vertex = vertex_loc(ind)
-       vertex(:,:) = xyz_v(:,:)
-    END DO
-
-!$OMP BARRIER    
-!$OMP MASTER
-    CALL allocate_field_glo(xyz_glo, field_t, type_real, 3)
-    CALL allocate_field_glo(vertex_glo, field_z, type_real, 3)
-
-    CALL gather_field(xyz_loc, xyz_glo)
-    CALL gather_field(vertex_loc, vertex_glo)
-
-    CALL bcast_field(xyz_glo)
-    CALL bcast_field(vertex_glo)
-
-    DO ind=1,ndomain_glo
-       d=>domain_glo(ind)
-       xyz = xyz_glo(ind)
-       vertex = vertex_glo(ind)
-       DO j=d%jj_begin,d%jj_end
-          DO i=d%ii_begin,d%ii_end          
-             n=(j-1)*d%iim+i
-             d%xyz(:,i,j)=xyz(n,:)
-             DO k=0,5
-                d%vertex(:,k,i,j) = vertex(n+d%z_pos(k+1),:)
-             END DO
-          END DO
-       END DO
-    END DO
-
-    CALL deallocate_field_glo(vertex_glo)
-    CALL deallocate_field_glo(xyz_glo)
-!$OMP END MASTER
-!$OMP BARRIER
-    CALL deallocate_field(vertex_loc)
-    CALL deallocate_field(xyz_loc)
-
-  END SUBROUTINE update_domain
-  
-  SUBROUTINE set_geometry
-  USE metric
-  USE vector
-  USE spherical_geom_mod
-  USE domain_mod
-  USE dimensions
-  USE transfert_mod
-  USE getin_mod
-  USE omp_para
-  IMPLICIT NONE
-
-    REAL(rstd) :: surf(6)
-    REAL(rstd) :: surf_v(6)
-    REAL(rstd) :: vect(3,6)
-    REAL(rstd) :: centr(3)
-    REAL(rstd) :: vet(3),vep(3), vertex(3)
-    INTEGER :: ind,i,j,k,n
-    TYPE(t_domain),POINTER :: d
-    REAL(rstd) ::  S12
-    REAL(rstd) :: w(6)
-    REAL(rstd) :: lon,lat
-    INTEGER :: ii_glo,jj_glo
-    REAL(rstd) :: S
-          
-      
-    CALL optimize_geometry
-    CALL remap_schmidt_loc
-    CALL update_circumcenters
-    ! copy position of generators and vertices back into domain(:)%xyz/vertex
-    ! so that XIOS gets the right values
-    CALL update_domain
-
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master ) CYCLE
-      d=>domain(ind)
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      lon_i(:)=0 ; lat_i(:)=0
-      lon_e(:)=0 ; lat_e(:)=0
-      DO j=jj_begin-1,jj_end+1
-        DO i=ii_begin-1,ii_end+1
-          n=(j-1)*iim+i
-
-          DO k=0,5
-            ne(n,k+1)=d%ne(k,i,j)
-          ENDDO
-
-          vect(:,1)=xyz_v(n+z_rup,:)
-          vect(:,2)=xyz_v(n+z_up,:)
-          vect(:,3)=xyz_v(n+z_lup,:)
-          vect(:,4)=xyz_v(n+z_ldown,:)
-          vect(:,5)=xyz_v(n+z_down,:)
-          vect(:,6)=xyz_v(n+z_rdown,:)
-          CALL compute_centroid(vect,6,centr)
-          centroid(n,:)=centr(:)
-
-               
-          CALL xyz2lonlat(xyz_v(n+z_up,:),lon,lat)
-          fv(n+z_up)=2*sin(lat)*omega
-          CALL xyz2lonlat(xyz_v(n+z_down,:),lon,lat)
-          fv(n+z_down)=2*sin(lat)*omega
-          
-          bi(n)=0. 
-        
-          CALL dist_cart(xyz_i(n,:),xyz_i(n+t_right,:),de(n+u_right))
-          CALL dist_cart(xyz_i(n,:),xyz_i(n+t_lup,:),de(n+u_lup))
-          CALL dist_cart(xyz_i(n,:),xyz_i(n+t_ldown,:),de(n+u_ldown))
-          
-          CALL div_arc_bis(xyz_i(n,:),xyz_i(n+t_right,:),0.5,xyz_e(n+u_right,:))
-          CALL div_arc_bis(xyz_i(n,:),xyz_i(n+t_lup,:),0.5,xyz_e(n+u_lup,:))
-          CALL div_arc_bis(xyz_i(n,:),xyz_i(n+t_ldown,:),0.5,xyz_e(n+u_ldown,:))
-
-          CALL dist_cart(xyz_v(n+z_rdown,:), xyz_v(n+z_rup,:),le(n+u_right))
-          CALL dist_cart(xyz_v(n+z_up,:), xyz_v(n+z_lup,:),le(n+u_lup))
-          CALL dist_cart(xyz_v(n+z_ldown,:), xyz_v(n+z_down,:),le(n+u_ldown))
-
-          le_de(n+u_right)=le(n+u_right)/de(n+u_right) ! NaN possible but should be harmless
-          le_de(n+u_lup)  =le(n+u_lup)  /de(n+u_lup)
-          le_de(n+u_ldown)=le(n+u_ldown)/de(n+u_ldown)
-
-          Ai(n)=0
-          DO k=0,5
-            CALL surf_triangle(xyz_i(n,:),xyz_i(n+t_pos(k+1),:),xyz_i(n+t_pos(MOD((k+1+6),6)+1),:),surf_v(k+1))
-            CALL surf_triangle(xyz_i(n,:),xyz_v(n+z_pos(MOD((k-1+6),6)+1),:),xyz_v(n+z_pos(k+1),:),surf(k+1))
-            Ai(n)=Ai(n)+surf(k+1)
-            IF (i==ii_end .AND. j==jj_begin) THEN
-              IF (Ai(n)<1e20) THEN
-              ELSE
-                PRINT *,"PB !!",Ai(n),k,surf(k+1)
-                PRINT*,xyz_i(n,:),xyz_v(n+z_pos(MOD((k-1+6),6)+1),:),xyz_v(n+z_pos(k+1),:)
-              ENDIF
-            ENDIF
-          ENDDO
-
-          ! Sign convention : Ringler et al., JCP 2010, eq. 21 p. 3071
-          ! Normal component is along outgoing normal vector if ne=1
-
-          CALL cross_product2(xyz_v(n+z_rdown,:),xyz_v(n+z_rup,:),vep)
-          IF (norm(vep)>1e-30) THEN
-            vep(:)=vep(:)/norm(vep)                         ! Inward normal vector
-            CALL cross_product2(vep,xyz_e(n+u_right,:),vet) ! Counter-clockwise tangent vector 
-            vet(:)=vet(:)/norm(vet)
-            ep_e(n+u_right,:)=-vep(:)*ne(n,right)
-            et_e(n+u_right,:)=vet(:)*ne(n,right)
-          ENDIF
-
-          CALL cross_product2(xyz_v(n+z_up,:),xyz_v(n+z_lup,:),vep)
-          IF (norm(vep)>1e-30) THEN
-            vep(:)=vep(:)/norm(vep)
-            CALL cross_product2(vep,xyz_e(n+u_lup,:),vet)
-            vet(:)=vet(:)/norm(vet)
-            ep_e(n+u_lup,:)=-vep(:)*ne(n,lup)
-            et_e(n+u_lup,:)=vet(:)*ne(n,lup)
-          ENDIF
-
-          CALL cross_product2(xyz_v(n+z_ldown,:),xyz_v(n+z_down,:),vep)
-          IF (norm(vep)>1e-30) THEN
-            vep(:)=vep(:)/norm(vep)
-            CALL cross_product2(vep,xyz_e(n+u_ldown,:),vet)
-            vet(:)=vet(:)/norm(vet)
-            ep_e(n+u_ldown,:)=-vep(:)*ne(n,ldown)
-            et_e(n+u_ldown,:)=vet(:)*ne(n,ldown)
-          ENDIF
-
-          CALL xyz2lonlat(xyz_i(n,:),lon,lat)
-          lon_i(n)=lon
-          lat_i(n)=lat
-          elon_i(n,1) = -sin(lon)
-          elon_i(n,2) = cos(lon)
-          elon_i(n,3) = 0
-          elat_i(n,1) = -cos(lon)*sin(lat)
-          elat_i(n,2) = -sin(lon)*sin(lat)
-          elat_i(n,3) = cos(lat)
-
-          
-          CALL xyz2lonlat(xyz_e(n+u_right,:),lon,lat)
-          lon_e(n+u_right)=lon
-          lat_e(n+u_right)=lat
-          elon_e(n+u_right,1) = -sin(lon)
-          elon_e(n+u_right,2) = cos(lon)
-          elon_e(n+u_right,3) = 0
-          elat_e(n+u_right,1) = -cos(lon)*sin(lat)
-          elat_e(n+u_right,2) = -sin(lon)*sin(lat)
-          elat_e(n+u_right,3) = cos(lat)
-          
-          CALL xyz2lonlat(xyz_e(n+u_lup,:),lon,lat)
-          lon_e(n+u_lup)=lon
-          lat_e(n+u_lup)=lat
-          elon_e(n+u_lup,1) = -sin(lon)
-          elon_e(n+u_lup,2) = cos(lon)
-          elon_e(n+u_lup,3) = 0
-          elat_e(n+u_lup,1) = -cos(lon)*sin(lat)
-          elat_e(n+u_lup,2) = -sin(lon)*sin(lat)
-          elat_e(n+u_lup,3) = cos(lat)
- 
-          CALL xyz2lonlat(xyz_e(n+u_ldown,:),lon,lat)
-          lon_e(n+u_ldown)=lon
-          lat_e(n+u_ldown)=lat
-          elon_e(n+u_ldown,1) = -sin(lon)
-          elon_e(n+u_ldown,2) = cos(lon)
-          elon_e(n+u_ldown,3) = 0
-          elat_e(n+u_ldown,1) = -cos(lon)*sin(lat)
-          elat_e(n+u_ldown,2) = -sin(lon)*sin(lat)
-          elat_e(n+u_ldown,3) = cos(lat)
- 
-          
-          DO k=0,5
-            CALL surf_triangle(xyz_i(n,:), xyz_v(n+z_pos(k+1),:), xyz_i(n+t_pos(k+1),:),S1(n,k+1) )
-            CALL surf_triangle(xyz_i(n,:), xyz_v(n+z_pos(k+1),:), xyz_i(n+t_pos(MOD(k+1+6,6)+1),:),S2(n,k+1) )
-            S12 = .5*(S1(n,k+1)+S2(n,k+1))
-            Riv(n,k+1)=S12/Ai(n)
-            Riv2(n,k+1)=S12/surf_v(k+1)
-          ENDDO
-
-          DO k=1,6
-            IF (ABS(surf_v(k))<1e-30) THEN
-              Riv(n,k)=0.
-            ENDIF
-          ENDDO
-          
-          Av(n+z_up)=surf_v(vup)+1e-100
-          Av(n+z_down)=surf_v(vdown)+1e-100
-        
-        ENDDO
-      ENDDO
-      
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          n=(j-1)*iim+i
-   
-          CALL compute_wee(n,right,w)
-          Wee(n+u_right,:,1)=w(1:5)
-
-          CALL compute_wee(n+t_right,left,w)
-          Wee(n+u_right,:,2)=w(1:5)
-
-
-          CALL compute_wee(n,lup,w)
-          Wee(n+u_lup,:,1)=w(1:5)
-
-          CALL compute_wee(n+t_lup,rdown,w)
-          Wee(n+u_lup,:,2)=w(1:5)
-
-
-          CALL compute_wee(n,ldown,w)
-          Wee(n+u_ldown,:,1)=w(1:5)
-
-          CALL compute_wee(n+t_ldown,rup,w)
-          Wee(n+u_ldown,:,2)=w(1:5)
-
-        ENDDO
-      ENDDO
-      
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          n=(j-1)*iim+i
-          ii_glo=d%ii_begin_glo-d%ii_begin+i
-          jj_glo=d%jj_begin_glo-d%jj_begin+j
-          
-          IF (ii_glo==1 .AND. jj_glo==1) THEN
-            le(n+u_ldown)=0
-            xyz_v(n+z_ldown,:)=xyz_v(n+z_down,:)
-                       
-          ENDIF
-
-          IF (ii_glo==iim_glo .AND. jj_glo==1) THEN
-            le(n+u_right)=0
-            xyz_v(n+z_rdown,:)=xyz_v(n+z_rup,:)
-          ENDIF
-
-          IF (ii_glo==iim_glo .AND. jj_glo==jjm_glo) THEN
-            le(n+u_rup)=0
-            xyz_v(n+z_rup,:)=xyz_v(n+z_up,:)
-          ENDIF
-
-          IF (ii_glo==1 .AND. jj_glo==jjm_glo) THEN
-            le(n+u_lup)=0
-            xyz_v(n+z_up,:)=xyz_v(n+z_lup,:)
-          ENDIF
-          
-        ENDDO
-      ENDDO
-
-      DO j=jj_begin-1,jj_end+1
-        DO i=ii_begin-1,ii_end+1
-          n=(j-1)*iim+i
-          xyz_i(n,:)=xyz_i(n,:) * radius
-          xyz_v(n+z_up,:)=xyz_v(n+z_up,:) * radius
-          xyz_v(n+z_down,:)=xyz_v(n+z_down,:) *radius
-          de(n+u_right)=de(n+u_right) * radius
-          de(n+u_lup)=de(n+u_lup)*radius
-          de(n+u_ldown)=de(n+u_ldown)*radius
-          xyz_e(n+u_right,:)=xyz_e(n+u_right,:)*radius
-          xyz_e(n+u_lup,:)=xyz_e(n+u_lup,:)*radius
-          xyz_e(n+u_ldown,:)=xyz_e(n+u_ldown,:)*radius
-          le(n+u_right)=le(n+u_right)*radius
-          le(n+u_lup)=le(n+u_lup)*radius
-          le(n+u_ldown)=le(n+u_ldown)*radius
-          Ai(n)=Ai(n)*radius**2
-          Av(n+z_up)=Av(n+z_up)*radius**2
-          Av(n+z_down)=Av(n+z_down)*radius**2
-        ENDDO
-      ENDDO
-                 
-    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)
- 
-  END SUBROUTINE set_geometry
-  
-  SUBROUTINE compute_wee(n,pos,w)
-  IMPLICIT NONE
-    INTEGER,INTENT(IN) :: n
-    INTEGER,INTENT(IN) :: pos
-    REAL(rstd),INTENT(OUT) ::w(6)
-
-    REAL(rstd) :: ne_(0:5)
-    REAL(rstd) :: Riv_(6)
-    INTEGER    :: k
-    
-    
-    DO k=0,5
-      ne_(k)=ne(n,MOD(pos-1+k+6,6)+1)  
-      Riv_(k+1)=Riv(n,MOD(pos-1+k+6,6)+1)
-    ENDDO
-          
-    w(1)=-ne_(0)*ne_(1)*(Riv_(1)-0.5)
-    w(2)=-ne_(2)*(ne_(0)*Riv_(2)-w(1)*ne_(1))
-    w(3)=-ne_(3)*(ne_(0)*Riv_(3)-w(2)*ne_(2))
-    w(4)=-ne_(4)*(ne_(0)*Riv_(4)-w(3)*ne_(3))
-    w(5)=-ne_(5)*(ne_(0)*Riv_(5)-w(4)*ne_(4))
-    w(6)=ne_(0)*ne_(5)*(Riv_(6)-0.5)
-    
-!    IF ( ABS(w(5)-w(6))>1e-20) PRINT *, "pb pour wee : w(5)!=w(6)",sum(Riv_(:))
-
-   END SUBROUTINE compute_wee
-            
-
-  
-  SUBROUTINE compute_geometry
-  IMPLICIT NONE
-    CALL allocate_geometry
-    CALL set_geometry
-    
-  END SUBROUTINE compute_geometry
-  
-END MODULE geometry
Index: codes/icosagcm/devel/src/geopotential_mod.f90
===================================================================
--- codes/icosagcm/devel/src/geopotential_mod.f90	(revision 531)
+++ 	(revision )
@@ -1,87 +1,0 @@
-MODULE geopotential_mod
-  IMPLICIT NONE
-  PRIVATE
-  
-  PUBLIC :: compute_geopotential
-CONTAINS
-  
-  SUBROUTINE thetarhodz2geopot(f_ps,f_phis,f_theta_rhodz, f_p,f_theta,f_phi) ! FIXME : never called, dry only
-    USE icosa
-    USE omp_para
-    USE pression_mod
-    USE theta2theta_rhodz_mod
-    TYPE(t_field), POINTER :: f_ps(:), f_phis(:), f_theta_rhodz(:), &  ! IN                                       
-         f_p(:), f_theta(:), f_phi(:)               ! OUT                                                         
-    REAL(rstd),POINTER :: pk(:,:), p(:,:), theta(:,:,:), theta_rhodz(:,:,:), &
-         phi(:,:), phis(:), ps(:)
-    INTEGER :: ind
-    
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       ps = f_ps(ind)
-       p  = f_p(ind)
-!$OMP BARRIER                                                                                                     
-       CALL compute_pression(ps,p,0)
-!$OMP BARRIER                                                                                                     
-       theta_rhodz = f_theta_rhodz(ind)
-       theta = f_theta(ind)
-       CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0)
-       phis = f_phis(ind)
-       phi = f_phi(ind)
-       CALL compute_geopotential(phis,p,theta,phi,0)
-    END DO
-
-  END SUBROUTINE thetarhodz2geopot
-
-
-  SUBROUTINE compute_geopotential(phis,p,theta,phi,offset)
-    USE icosa
-    USE omp_para
-    REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
-    REAL(rstd),INTENT(IN) :: phis(iim*jjm)
-    REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm,nqdyn)
-    REAL(rstd),INTENT(OUT) :: phi(iim*jjm,llm)
-    INTEGER,INTENT(IN) :: offset
-    INTEGER :: i,j,ij,l
-    REAL(rstd) :: mg_ij, p_ij, exner_ij
-
-!!! Compute geopotential
-  ! LMD-Z : dh=pi.dtheta-vdp  => (1/rho) dp = pi.dtheta - d(h=pi.theta) = -dtheta.gradpi
-  ! g.dz =  -(1/rho)dp =  theta.gradpi
-  ! direct (variational)
-  ! dz = -(1/rho.g)dp, rho = RT/p = (R/C_p).theta.pi/p
-   
-  ! for first layer
-
-! flush pks, pk thetha, phis
-!$OMP BARRIER
-    IF(is_omp_level_master) THEN
-       DO j=jj_begin-offset,jj_end+offset
-          DO i=ii_begin-offset,ii_end+offset
-             ij=(j-1)*iim+i
-             phi( ij,1 ) = phis( ij )
-          END DO
-       END DO
-          
-    ! for other layers
-     DO l = 1, llm-1
-       DO j=jj_begin-offset,jj_end+offset
-         DO i=ii_begin-offset,ii_end+offset
-           ij=(j-1)*iim+i
-           mg_ij = p(ij,l+1)-p(ij,l)
-           ! v=RT/p=(kappa.cpp).Theta.(p/preff)**kappa /p
-           p_ij=.5*(p(ij,l+1)+p(ij,l))
-           exner_ij = (p_ij/preff)**kappa ! NB : no cpp factor
-           phi(ij,l+1) = phi(ij,l) + (kappa*cpp)*mg_ij*theta(ij,l,1)*exner_ij/p_ij
-         ENDDO
-       ENDDO
-     ENDDO
-   ENDIF
-! flush phi
-!$OMP BARRIER
-   
-  END SUBROUTINE compute_geopotential
-
-END MODULE geopotential_mod
Index: codes/icosagcm/devel/src/getin.f90
===================================================================
--- codes/icosagcm/devel/src/getin.f90	(revision 531)
+++ 	(revision )
@@ -1,78 +1,0 @@
-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
-  USE mpipara
-  IMPLICIT NONE
-    CHARACTER(LEN=*) :: name
-    CHARACTER(LEN=*) :: value
-
-!$OMP MASTER    
-    CALL getin_(name,value)
-    IF(is_mpi_root) PRINT *,'GETIN ',TRIM(name),' = ', TRIM(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
-  USE mpipara
-  IMPLICIT NONE
-    CHARACTER(LEN=*) :: name
-    LOGICAL          :: value
-
-!$OMP MASTER    
-    CALL getin_(name,value)
-    IF(is_mpi_root) PRINT *,'GETIN ',TRIM(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
-  USE mpipara
-  IMPLICIT NONE
-    CHARACTER(LEN=*) :: name
-    INTEGER          :: value
-
-!$OMP MASTER    
-    CALL getin_(name,value)
-    IF(is_mpi_root) PRINT *,'GETIN ',TRIM(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 mpipara
-  USE transfert_omp_mod
-  IMPLICIT NONE
-    CHARACTER(LEN=*) :: name
-    REAL             :: value
-
-!$OMP MASTER    
-    CALL getin_(name,value)
-    IF(is_mpi_root) PRINT *,'GETIN ',TRIM(name), ' = ', value
-!$OMP END MASTER
-    IF (omp_in_parallel()) CALL bcast_omp(value)
-  END SUBROUTINE getin_r
- 
-END MODULE getin_mod
Index: codes/icosagcm/devel/src/grid_param.f90
===================================================================
--- codes/icosagcm/devel/src/grid_param.f90	(revision 531)
+++ 	(revision )
@@ -1,29 +1,0 @@
-MODULE grid_param
-  INTEGER  :: iim_glo=40
-  INTEGER  :: jjm_glo
-  INTEGER,PARAMETER  :: nb_face=10
-  INTEGER  :: llm=19
-  INTEGER  :: nqtot ! number of tracers handled by advection scheme
-  INTEGER  :: nqdyn ! number of dynamical tracers : 1 if dry, more if moist
-
-CONTAINS
-
-  SUBROUTINE init_grid_param(is_mpi_root)
-    USE ioipsl
-    IMPLICIT NONE
-    LOGICAL :: is_mpi_root
-    CALL getin('nbp',iim_glo)
-    jjm_glo=iim_glo
-    CALL getin('llm',llm)
-    nqtot=1
-    CALL getin('nqtot',nqtot)
-    IF(is_mpi_root) THEN
-       PRINT *, 'GETIN nbp = ',iim_glo
-       PRINT *, 'GETIN llm = ',llm
-       PRINT *, 'GETIN nqtot = ',nqtot
-    END IF
-    
-  END SUBROUTINE  init_grid_param
-
-END MODULE grid_param
-    
Index: codes/icosagcm/devel/src/guided_mod.f90
===================================================================
--- codes/icosagcm/devel/src/guided_mod.f90	(revision 531)
+++ 	(revision )
@@ -1,54 +1,0 @@
-MODULE guided_mod
-
-  CHARACTER(LEN=255),SAVE :: guided_type
-!$OMP THREADPRIVATE(guided_type)
-
-CONTAINS
-
-
-  SUBROUTINE init_guided
-  USE icosa
-  USE guided_ncar_mod, ONLY : init_guided_ncar => init_guided
-  IMPLICIT NONE
-    
-    guided_type='none'
-    CALL getin("guided_type",guided_type)
-    
-    SELECT CASE(TRIM(guided_type))
-      CASE ('none')
-      
-      CASE ('dcmip1')
-        CALL init_guided_ncar
-        
-      CASE DEFAULT
-         PRINT*,"Bad selector for varaible guided_type >",TRIM(guided_type),"> option are <none>, <dcmip1>"
-         STOP
-    END SELECT 
-    
-  END SUBROUTINE init_guided
-
-  
-  SUBROUTINE guided(tt, f_ps, f_theta_rhodz, f_u, f_q)
-  USE icosa
-  USE guided_ncar_mod, ONLY : guided_ncar => guided
-  IMPLICIT NONE
-    REAL(rstd), INTENT(IN):: tt
-    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(:)  
-
-    SELECT CASE(TRIM(guided_type))
-      CASE ('none')
-      CASE ('dcmip1')
-        CALL guided_ncar(tt, f_ps, f_theta_rhodz, f_u, f_q)
-      CASE DEFAULT
-         PRINT*,"Bad selector for varaible guided_type >",TRIM(guided_type),"> option are <none>, <dcmip1>"
-         STOP
-    END SELECT 
-  
-  END SUBROUTINE guided
-  
-END MODULE guided_mod
-  
Index: codes/icosagcm/devel/src/guided_ncar_mod.f90
===================================================================
--- codes/icosagcm/devel/src/guided_ncar_mod.f90	(revision 531)
+++ 	(revision )
@@ -1,164 +1,0 @@
-MODULE guided_ncar_mod
-  USE icosa
-  PRIVATE
-  
-  INTEGER,SAVE :: case_wind
-!$OMP THREADPRIVATE(case_wind)
-  
-  REAL(rstd), PARAMETER :: alpha=0.0 ! tilt of solid-body rotation
-  REAL(rstd), PARAMETER :: tau_hadley=daysec, tau = 12*daysec ! 12 days               ! see p. 16
-  REAL(rstd), PARAMETER :: w0_deform = 23000*pi/tau, b=0.2, ptop=25494.4  ! see p. 16 
-  REAL(rstd), PARAMETER :: u0_hadley=40.,w0_hadley=0.15 ,ztop= 12000. 
-  INTEGER, PARAMETER    :: K_hadley=5
-
-  PUBLIC init_guided, guided
-
-CONTAINS
-
-  SUBROUTINE init_guided
-    IMPLICIT NONE
-    CHARACTER(LEN=255) :: wind
-    wind='deform'
-    CALL getin('dcmip1_wind',wind)
-    SELECT CASE(TRIM(wind))
-    CASE('solid')
-       case_wind=0
-    CASE('deform')
-       case_wind=1
-    CASE('hadley')
-       case_wind=2
-    CASE DEFAULT
-       PRINT*,'Bad selector for variable ncar_adv_wind : <', TRIM(wind),'> options are <solid>, <deform>, <hadley>'
-       END SELECT
-  END SUBROUTINE init_guided
-  
-  SUBROUTINE guided(tt, f_ps, f_theta_rhodz, f_u, f_q)
-  USE icosa
-    IMPLICIT NONE
-    REAL(rstd), INTENT(IN):: tt
-    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(:)  
-    
-    REAL(rstd),POINTER :: ue(:,:)
-    INTEGER :: ind
-    
-    DO ind = 1 , ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind) 
-      ue = f_u(ind)  
-      CALL wind_profile(tt,ue)
-    END DO    
-
-  END SUBROUTINE guided
-  
-
-  SUBROUTINE wind_profile(tt,ue)
-    USE icosa
-    USE disvert_mod
-    IMPLICIT NONE
-    REAL(rstd),INTENT(IN)  :: tt ! current time 
-    REAL(rstd),INTENT(OUT) :: ue(iim*3*jjm,llm)
-    REAL(rstd) :: lon, lat
-    REAL(rstd) :: nx(3),n_norm,Velocity(3,llm)
-    REAL(rstd) :: rr1,rr2,bb,cc,aa,hmx
-    REAL(rstd) :: v1(3),v2(3),ny(3)
-    INTEGER :: i,j,n,l
-    REAL(rstd) :: pitbytau,kk, pr, zr, u0, u1, v0
-
-    pitbytau = pi*tt/tau
-    kk = 10*radius/tau
-    u0 = 2*pi*radius/tau ! for solid-body rotation
-!---------------------------------------------------------
-    DO l = 1,llm 
-       pr = presnivs(l)
-       zr = -kappa*cpp*ncar_T0/g*log(pr/ncar_p0)  ! reciprocal of (1) p. 13, isothermal atmosphere
-       u1 = w0_deform*radius/b/ptop*cos(2*pitbytau)*(exp((ptop-pr)/b/ptop)-exp((pr-ncar_p0)/b/ptop))
-       v0 = -radius*w0_hadley*pi/(5.0*ztop)*(ncar_p0/pr)*cos(pi*zr/ztop)*cos(pi*tt/tau_hadley) ! for Hadley cell
-
-       DO j=jj_begin-1,jj_end+1
-          DO i=ii_begin-1,ii_end+1
-             n=(j-1)*iim+i
-             CALL compute_velocity(xyz_e(n+u_right,:),l,velocity(:,l))
-             CALL cross_product2(xyz_v(n+z_rdown,:)/radius,xyz_v(n+z_rup,:)/radius,nx)       
-             ue(n+u_right,l)=1e-10
-             n_norm=sqrt(sum(nx(:)**2))
-             IF (n_norm>1e-30) THEN
-                nx=-nx/n_norm*ne(n,right)
-                ue(n+u_right,l)=sum(nx(:)*velocity(:,l))
-                IF (ABS(ue(n+u_right,l))<1e-100) PRINT *,"ue(n+u_right)==0",i,j,velocity(:,1)
-             ENDIF
-             
-             CALL compute_velocity(xyz_e(n+u_lup,:),l,velocity(:,l))
-             CALL cross_product2(xyz_v(n+z_up,:)/radius,xyz_v(n+z_lup,:)/radius,nx)
-             
-             ue(n+u_lup,l)=1e-10
-             n_norm=sqrt(sum(nx(:)**2))
-             IF (n_norm>1e-30) THEN
-                nx=-nx/n_norm*ne(n,lup)
-                ue(n+u_lup,l)=sum(nx(:)*velocity(:,l))
-             ENDIF
-             
-             CALL compute_velocity(xyz_e(n+u_ldown,:),l,velocity(:,l))
-             CALL cross_product2(xyz_v(n+z_ldown,:)/radius,xyz_v(n+z_down,:)/radius,nx)
-             
-             ue(n+u_ldown,l)=1e-10
-             n_norm=sqrt(sum(nx(:)**2))
-             IF (n_norm>1e-30) THEN
-                nx=-nx/n_norm*ne(n,ldown)
-                ue(n+u_ldown,l)=sum(nx(:)*velocity(:,l))
-                IF (ABS(ue(n+u_ldown,l))<1e-100) PRINT *,"ue(n+u_ldown)==0",i,j
-             ENDIF
-          ENDDO
-       ENDDO
-    END DO
-    
-  CONTAINS
-	   
-    SUBROUTINE compute_velocity(x,l,velocity)
-      IMPLICIT NONE
-      REAL(rstd),INTENT(IN)  :: x(3)
-      INTEGER,INTENT(IN)::l
-      REAL(rstd),INTENT(OUT) :: velocity(3)
-      REAL(rstd) :: e_lat(3), e_lon(3)
-      REAL(rstd) :: lon,lat
-      REAL(rstd) :: u,v
-	      
-      CALL xyz2lonlat(x/radius,lon,lat)
-      e_lat(1) = -cos(lon)*sin(lat)
-      e_lat(2) = -sin(lon)*sin(lat)
-      e_lat(3) = cos(lat)
-        
-      e_lon(1) = -sin(lon)
-      e_lon(2) = cos(lon)
-      e_lon(3) = 0
-
-      u = 0.0 ; v = 0.0
-    
-      SELECT CASE(case_wind) 
-      CASE(0)  ! Solid-body rotation
-         u=u0*(cos(lat)*cos(alpha)+sin(lat)*sin(alpha)*cos(lon))
-         v=-u0*sin(lon)*sin(alpha)
-      CASE(1)  ! 3D Deformational flow - 
-         lon = lon-2*pitbytau
-         u = kk*sin(lon)*sin(lon)*sin(2*lat)*cos(pitbytau)+ u0*cos(lat)
-         u = u + u1*cos(lon)*cos(lat)**2
-         v = kk*sin(2*lon)*cos(lat)*cos(pitbytau) 
-      CASE(2) ! Hadley-like flow
-         u = u0_hadley*cos(lat)
-         v = v0*cos(lat)*sin(5.*lat)    ! Eq. 37 p. 19
-      CASE DEFAULT 
-         PRINT*,"not valid choice of wind" 
-      END SELECT
-      
-      Velocity(:)=(u*e_lon(:)+v*e_lat(:)+1e-50)
-      
-    END SUBROUTINE compute_velocity
-    
-  END SUBROUTINE  wind_profile
-
-
-END MODULE guided_ncar_mod
Index: codes/icosagcm/devel/src/hevi_scheme.f90
===================================================================
--- codes/icosagcm/devel/src/hevi_scheme.f90	(revision 531)
+++ 	(revision )
@@ -1,169 +1,0 @@
-MODULE hevi_scheme_mod
-  USE prec
-  USE domain_mod
-  USE field_mod
-  USE euler_scheme_mod
-  IMPLICIT NONE
-  PRIVATE
-
-  REAL(rstd), SAVE :: wj(3), bjl(3,3), cjl(3,3), taujj(3)
-  REAL(rstd), PARAMETER, DIMENSION(3) :: zero = (/0.,0.,0./)
-
-  PUBLIC :: set_coefs_ark23, set_coefs_ark33, hevi_scheme
-
-CONTAINS
-
-  SUBROUTINE set_coefs_ark23(dt)
-    ! ARK2 scheme by Giraldo, Kelly, Constantinescu 2013
-    ! See Weller et al., 2013 - ARK2 scheme Fig. 2
-    REAL(rstd) :: dt
-    REAL(rstd), PARAMETER :: delta=.5/SQRT(2.), gamma=1.-2.*delta
-!    REAL(rstd), PARAMETER :: alpha=(3.+SQRT(8.))/6. ! original value in GKC2013
-    REAL(rstd), PARAMETER :: alpha=0.7
-    REAL(rstd), PARAMETER, DIMENSION(3) :: wj = (/delta,delta,gamma/)
-    CALL set_coefs_hevi(dt, &
-         (/ zero, (/2.*gamma,0.,0./), (/1-alpha,alpha,0./), wj /), &
-         (/ zero, (/gamma,gamma,0./), wj, wj /) )
-  END SUBROUTINE set_coefs_ark23
-
-  SUBROUTINE set_coefs_ark33(dt)
-    ! Fully-explicit RK3 scheme disguised as ARK
-    REAL(rstd) :: dt
-    CALL set_coefs_rk(dt, (/ zero, (/.5,0.,0./), (/-1.,2.,0./), (/1./6.,2./3.,1./6./) /) )
-  END SUBROUTINE set_coefs_ark33
-    
-  SUBROUTINE set_coefs_rk(dt, ajl)
-    REAL(rstd) :: dt, ajl(3,4)
-    CALL set_coefs_hevi(dt,ajl,ajl)
-  END SUBROUTINE set_coefs_rk
-
-  SUBROUTINE set_coefs_hevi(dt, ajl_slow, ajl_fast)
-    REAL(rstd) :: dt, ajl_slow(3,4), ajl_fast(3,4) ! fast/slow Butcher tableaus
-    INTEGER :: j
-    DO j=1,3
-       bjl(:,j) = dt*(ajl_slow(:,j+1)-ajl_slow(:,j))
-       cjl(:,j) = dt*(ajl_fast(:,j+1)-ajl_fast(:,j))
-       taujj(j) = dt*ajl_fast(j,j)
-    END DO
-    wj=dt*ajl_slow(:,4)
-  END SUBROUTINE set_coefs_hevi
-
-  SUBROUTINE HEVI_scheme(it, fluxt_zero)
-    USE time_mod
-    USE disvert_mod
-    USE caldyn_hevi_mod
-    USE omp_para
-    USE checksum_mod
-    LOGICAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating fluxes in time
-    INTEGER :: it,j,l, ind
-    REAL(rstd),POINTER :: hflux(:,:),wflux(:,:),hfluxt(:,:),wfluxt(:,:)
-
-    CALL legacy_to_DEC(f_ps, f_u)
-    DO j=1,nb_stage
-       CALL caldyn_hevi((j==1) .AND. (MOD(it,itau_out)==0), taujj(j), &
-            f_phis, f_ps,f_mass,f_theta_rhodz,f_u,f_q, &
-            f_W, f_geopot, f_hflux, f_wflux, &
-            f_dps_slow(:,j), f_dmass_slow(:,j), f_dtheta_rhodz_slow(:,j), &
-            f_du_slow(:,j), f_du_fast(:,j), &
-            f_dPhi_slow(:,j), f_dPhi_fast(:,j), &
-            f_dW_slow(:,j), f_dW_fast(:,j) )
-       ! accumulate mass fluxes for transport scheme
-       
-       DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind)) CYCLE
-          CALL swap_dimensions(ind)
-          hflux=f_hflux(ind);     hfluxt=f_hfluxt(ind)
-          wflux=f_wflux(ind);     wfluxt=f_wfluxt(ind)
-          CALL accumulate_fluxes(hflux,wflux, hfluxt,wfluxt, wj(j), fluxt_zero(ind))
-       END DO
-       ! update model state
-       DO l=1,j
-          IF(caldyn_eta==eta_mass) THEN
-             CALL update_2D(bjl(l,j), f_ps, f_dps_slow(:,l))
-          ELSE
-             CALL update_3D(bjl(l,j), f_mass, f_dmass_slow(:,l))
-          END IF
-          CALL update_4D(bjl(l,j), f_theta_rhodz, f_dtheta_rhodz_slow(:,l))
-          CALL update_3D(bjl(l,j), f_u, f_du_slow(:,l))
-          CALL update_3D(cjl(l,j), f_u, f_du_fast(:,l))
-          IF(.NOT. hydrostatic) THEN
-             CALL update_3D(bjl(l,j), f_W, f_dW_slow(:,l))
-             CALL update_3D(cjl(l,j), f_W, f_dW_fast(:,l))
-             CALL update_3D(bjl(l,j), f_geopot, f_dPhi_slow(:,l))
-             CALL update_3D(cjl(l,j), f_geopot, f_dPhi_fast(:,l))
-          END IF
-!$OMP BARRIER       
-       END DO
-    END DO
-    CALL DEC_to_legacy(f_ps, f_u)
-  END SUBROUTINE HEVI_scheme
-  
-  SUBROUTINE update_4D(w, f_y, f_dy)
-    USE dimensions
-    USE grid_param, ONLY : nqdyn
-    REAL(rstd) :: w
-    TYPE(t_field) :: f_y(:), f_dy(:)
-    REAL(rstd), POINTER :: y(:,:,:), dy(:,:,:)
-    INTEGER :: ind, iq
-    IF(w /= 0.) THEN
-       DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind)) CYCLE
-          CALL swap_dimensions(ind)
-          dy=f_dy(ind); y=f_y(ind)
-          DO iq=1,nqdyn
-             CALL compute_update_3D(w,y(:,:,iq),dy(:,:,iq))
-          END DO
-       ENDDO
-    END IF
-  END SUBROUTINE update_4D
-    
-  SUBROUTINE update_3D(w, f_y, f_dy)
-    USE dimensions
-    REAL(rstd) :: w
-    TYPE(t_field) :: f_y(:), f_dy(:)
-    REAL(rstd), POINTER :: y(:,:), dy(:,:)
-    INTEGER :: ind
-    IF(w /= 0.) THEN
-       DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind)) CYCLE
-          CALL swap_dimensions(ind)
-          dy=f_dy(ind); y=f_y(ind)
-          CALL compute_update_3D(w,y,dy)
-       ENDDO
-    END IF
-  END SUBROUTINE update_3D
-    
-  SUBROUTINE compute_update_3D(w, y, dy)
-    USE omp_para
-    USE disvert_mod
-    REAL(rstd) :: w
-    REAL(rstd) :: y(:,:), dy(:,:)
-    INTENT(INOUT) :: y
-    INTENT(IN) :: dy
-    INTEGER :: l
-    DO l=ll_begin,ll_end
-       y(:,l)=y(:,l)+w*dy(:,l)
-    ENDDO
-  END SUBROUTINE compute_update_3D
-  
-  SUBROUTINE update_2D(w, f_y, f_dy)
-  USE omp_para
-    REAL(rstd) :: w
-    TYPE(t_field) :: f_y(:), f_dy(:)
-    REAL(rstd), POINTER :: y(:), dy(:)
-    INTEGER :: ind
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       dy=f_dy(ind); y=f_y(ind)
-       IF (is_omp_level_master) CALL compute_update_2D(w,y,dy)
-    ENDDO
-  END SUBROUTINE update_2D
-    
-  SUBROUTINE compute_update_2D(w, y, dy)
-    REAL(rstd) :: w, y(:), dy(:)
-    INTENT(INOUT) :: y
-    INTENT(IN) :: dy
-    y(:)=y(:)+w*dy(:)
-  END SUBROUTINE compute_update_2D
-  
-END MODULE hevi_scheme_mod
Index: codes/icosagcm/devel/src/icosa_init.f90
===================================================================
--- codes/icosagcm/devel/src/icosa_init.f90	(revision 533)
+++ codes/icosagcm/devel/src/icosa_init.f90	(revision 533)
@@ -0,0 +1,109 @@
+MODULE icosa_init_mod
+
+
+
+CONTAINS
+
+  SUBROUTINE icosa_init
+  USE icosa
+  USE timeloop_gcm_mod
+  USE disvert_mod
+  USE etat0_mod
+  USE wind_mod
+  USE mpipara
+  USE omp_para
+  USE vertical_interp_mod
+  USE trace
+  USE output_field_mod
+  USE xios_mod
+  USE write_field_mod
+  USE physics_mod
+  USE tracer_mod
+  USE restart_mod
+  USE etat0_mod
+  IMPLICIT NONE
+  
+    CALL init_mpipara
+    CALL trace_off
+    CALL xios_init
+    CALL init_earth_const 
+    CALL init_grid_param(is_mpi_master)
+    CALL init_omp_para(is_mpi_master)
+    CALL compute_metric
+    CALL compute_domain
+    CALL init_transfert
+    CALL init_writefield
+    CALL init_trace
+
+  !$OMP PARALLEL  
+    CALL switch_omp_no_distrib_level
+    CALL compute_geometry
+    CALL check_total_area
+  
+    CALL init_disvert 
+    CALL init_vertical_interp
+    CALL init_tracer
+    
+    CALL WriteField("Ai",geom%Ai)
+  
+    IF (is_mpi_root) CALL write_apbp
+    CALL init_time
+    CALL init_restart
+    CALL init_etat0
+
+    CALL output_field_init
+    CALL init_timeloop
+    CALL init_physics
+   
+    CALL timeloop
+    CALL switch_omp_no_distrib_level
+  !$OMP END PARALLEL
+
+    CALL output_field_finalize
+    CALL close_files
+    CALL close_time_counter
+    CALL finalize_mpipara
+
+  CONTAINS
+  
+    SUBROUTINE check_total_area
+    IMPLICIT NONE
+    TYPE(t_field),POINTER,SAVE :: sum_ne(:)
+    TYPE(t_field),POINTER,SAVE :: sum_ne_glo(:)
+    REAL(rstd),POINTER :: pt_sum_ne(:)
+    INTEGER :: ind,i,j,k,n
+    REAL(rstd) :: vect(3,6)
+    REAL(rstd) :: centr(3),dist    
+    REAL(rstd) :: tot_sum=0
+
+      CALL allocate_field(sum_ne,field_T,type_real)
+    
+    !$OMP BARRIER
+    !$OMP MASTER
+      DO ind=1,ndomain
+       
+        pt_sum_ne=sum_ne(ind)
+        
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+       
+        DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+            n=(j-1)*iim+i
+            pt_sum_ne(n)=0
+            DO k=1,6
+              pt_sum_ne(n)=pt_sum_ne(n)+ne(n,k)
+            ENDDO
+            IF (domain(ind)%own(i,j)) tot_sum=tot_sum+Ai(n)
+          ENDDO
+        ENDDO
+      ENDDO
+    
+      IF (is_mpi_root) PRINT *," Diff surf",1-tot_sum/(4*Pi*radius*radius)
+    !$OMP END MASTER
+    
+    END SUBROUTINE check_total_area
+  
+  END SUBROUTINE icosa_init
+
+END MODULE icosa_init_mod
Index: codes/icosagcm/devel/src/icosagcm.f90
===================================================================
--- codes/icosagcm/devel/src/icosagcm.f90	(revision 531)
+++ 	(revision )
@@ -1,109 +1,0 @@
-MODULE icosa_init_mod
-
-
-
-CONTAINS
-
-  SUBROUTINE icosa_init
-  USE icosa
-  USE timeloop_gcm_mod
-  USE disvert_mod
-  USE etat0_mod
-  USE wind_mod
-  USE mpipara
-  USE omp_para
-  USE vertical_interp_mod
-  USE trace
-  USE output_field_mod
-  USE xios_mod
-  USE write_field_mod
-  USE physics_mod
-  USE tracer_mod
-  USE restart_mod
-  USE etat0_mod
-  IMPLICIT NONE
-  
-    CALL init_mpipara
-    CALL trace_off
-    CALL xios_init
-    CALL init_earth_const 
-    CALL init_grid_param(is_mpi_master)
-    CALL init_omp_para(is_mpi_master)
-    CALL compute_metric
-    CALL compute_domain
-    CALL init_transfert
-    CALL init_writefield
-    CALL init_trace
-
-  !$OMP PARALLEL  
-    CALL switch_omp_no_distrib_level
-    CALL compute_geometry
-    CALL check_total_area
-  
-    CALL init_disvert 
-    CALL init_vertical_interp
-    CALL init_tracer
-    
-    CALL WriteField("Ai",geom%Ai)
-  
-    IF (is_mpi_root) CALL write_apbp
-    CALL init_time
-    CALL init_restart
-    CALL init_etat0
-
-    CALL output_field_init
-    CALL init_timeloop
-    CALL init_physics
-   
-    CALL timeloop
-    CALL switch_omp_no_distrib_level
-  !$OMP END PARALLEL
-
-    CALL output_field_finalize
-    CALL close_files
-    CALL close_time_counter
-    CALL finalize_mpipara
-
-  CONTAINS
-  
-    SUBROUTINE check_total_area
-    IMPLICIT NONE
-    TYPE(t_field),POINTER,SAVE :: sum_ne(:)
-    TYPE(t_field),POINTER,SAVE :: sum_ne_glo(:)
-    REAL(rstd),POINTER :: pt_sum_ne(:)
-    INTEGER :: ind,i,j,k,n
-    REAL(rstd) :: vect(3,6)
-    REAL(rstd) :: centr(3),dist    
-    REAL(rstd) :: tot_sum=0
-
-      CALL allocate_field(sum_ne,field_T,type_real)
-    
-    !$OMP BARRIER
-    !$OMP MASTER
-      DO ind=1,ndomain
-       
-        pt_sum_ne=sum_ne(ind)
-        
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-       
-        DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-            n=(j-1)*iim+i
-            pt_sum_ne(n)=0
-            DO k=1,6
-              pt_sum_ne(n)=pt_sum_ne(n)+ne(n,k)
-            ENDDO
-            IF (domain(ind)%own(i,j)) tot_sum=tot_sum+Ai(n)
-          ENDDO
-        ENDDO
-      ENDDO
-    
-      IF (is_mpi_root) PRINT *," Diff surf",1-tot_sum/(4*Pi*radius*radius)
-    !$OMP END MASTER
-    
-    END SUBROUTINE check_total_area
-  
-  END SUBROUTINE icosa_init
-
-END MODULE icosa_init_mod
Index: codes/icosagcm/devel/src/initial/q_sat.f90
===================================================================
--- codes/icosagcm/devel/src/initial/q_sat.f90	(revision 533)
+++ codes/icosagcm/devel/src/initial/q_sat.f90	(revision 533)
@@ -0,0 +1,98 @@
+MODULE qsat_mod
+
+
+
+
+CONTAINS
+
+  SUBROUTINE qsat(f_temp,f_p,f_qs)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_temp(:)  ! IN    : temperature
+    TYPE(t_field), POINTER :: f_p(:)     ! IN    : pressure at mid-levels
+    TYPE(t_field), POINTER :: f_qs(:)    ! OUT   : vapeur d'eau saturante en kg/kg
+    
+    REAL(rstd),POINTER :: temp(:,:),  p(:,:), qs(:,:)
+    INTEGER :: ind
+
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       temp=f_temp(ind)
+       p=f_p(ind)
+       qs=f_qs(ind)
+       CALL compute_qsat(temp,p,qs)
+    END DO
+  
+  END SUBROUTINE qsat
+
+  
+  SUBROUTINE compute_qsat(temp,p,qsat)
+  USE icosa
+  USE omp_para
+  IMPLICIT NONE
+  
+!======================================================================
+! Autheur(s): Z.X. Li (LMD/CNRS)
+!  reecriture vectorisee par F. Hourdin.
+! Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
+!======================================================================
+! Arguments:
+! kelvin---input-R: temperature en Kelvin
+! millibar--input-R: pression en mb
+!
+! q_sat----output-R: vapeur d'eau saturante en kg/kg
+!======================================================================
+!
+      REAL,INTENT(IN)  :: temp(iim*jjm,llm)
+      REAL,INTENT(IN)  :: p   (iim*jjm,llm+1)
+      REAL,INTENT(OUT) :: qsat(iim*jjm,llm)
+
+      REAL, PARAMETER  ::  r2es=611.14 *18.0153/28.9644
+
+      REAL :: r3es
+      REAL, PARAMETER ::  r3les=17.269
+      REAL, PARAMETER ::  r3ies=21.875
+
+      REAL :: r4es
+      REAL, PARAMETER :: r4les=35.86
+      REAL, PARAMETER :: r4ies=7.66
+
+      REAL, PARAMETER :: rtt=273.16
+      REAL, PARAMETER :: retv=28.9644/18.0153 - 1.0
+
+      REAL :: zqsat, pmid
+      INTEGER :: l,i,j,ij
+!
+!     ------------------------------------------------------------------
+!
+!
+
+    DO l=ll_begin,ll_end
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+
+          IF (temp(ij,l) .LE. rtt) THEN
+            r3es = r3ies
+            r4es = r4ies
+          ELSE
+            r3es = r3les
+            r4es = r4les
+          ENDIF
+          pmid=0.5*(p(ij,l)+p(ij,l+1))
+          zqsat=r2es/pmid*EXP(r3es*(temp(ij,l)-rtt)/(temp(ij,l)-r4es))
+          zqsat=MIN(0.5,zqsat)
+          zqsat=zqsat/(1.-retv *zqsat)
+
+          qsat(ij,l)= zqsat
+
+        ENDDO
+      ENDDO
+    ENDDO
+  
+  
+  END SUBROUTINE compute_qsat
+
+END MODULE qsat_mod
Index: codes/icosagcm/devel/src/kinetic.f90
===================================================================
--- codes/icosagcm/devel/src/kinetic.f90	(revision 531)
+++ 	(revision )
@@ -1,198 +1,0 @@
-MODULE kinetic_mod
-IMPLICIT NONE
-PRIVATE
-
-PUBLIC :: kinetic, kinetic_v, kinetic_new, gradient
-
-CONTAINS
-  
-  SUBROUTINE kinetic(f_ue,f_Ki)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ue(:)
-    TYPE(t_field), POINTER :: f_Ki(:)
-  
-    REAL(rstd), POINTER :: ue(:,:)
-    REAL(rstd), POINTER :: Ki(:,:)
-    INTEGER :: ind
-  
-    CALL transfert_request(f_ue,req_e1_vect)
-    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)
-      ue=f_ue(ind)
-      Ki=f_Ki(ind)
-      CALL compute_kinetic(ue, Ki)
-    ENDDO  
-  END SUBROUTINE kinetic
-  
-  SUBROUTINE kinetic_new(f_ue,f_Ki)
-    USE icosa
-    IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ue(:)
-    TYPE(t_field), POINTER :: f_Ki(:)
-    
-    REAL(rstd), POINTER :: ue(:,:)
-    REAL(rstd), POINTER :: Ki(:,:)
-    INTEGER :: ind
-    
-    CALL transfert_request(f_ue,req_e1_vect)
-    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)
-       ue=f_ue(ind)
-       Ki=f_Ki(ind)
-       CALL compute_Ki_new(ue, Ki)
-    ENDDO
-  END SUBROUTINE kinetic_new
-  
-  SUBROUTINE kinetic_v(f_ue,f_Kv)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ue(:)
-    TYPE(t_field), POINTER :: f_Kv(:)
-  
-    REAL(rstd), POINTER :: ue(:,:)
-    REAL(rstd), POINTER :: Kv(:,:)
-    INTEGER :: ind
-  
-    CALL transfert_request(f_ue,req_e1_vect)
-    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)
-      ue=f_ue(ind)
-      Kv=f_Kv(ind)
-      CALL compute_kv(ue, Kv)
-    ENDDO  
-  END SUBROUTINE kinetic_v
-  
-  SUBROUTINE compute_kinetic(ue, Ki)
-  USE icosa
-  USE omp_para
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: ue(3*iim*jjm,llm)
-    REAL(rstd),INTENT(OUT) :: Ki(iim*jjm,llm)
-    INTEGER :: i,j,ij,l
-    
-    DO l=ll_begin,ll_end
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-
-          Ki(ij,l)=1/(4*Ai(ij))*(le(ij+u_right)*de(ij+u_right)*ue(ij+u_right,l)**2 +  &
-                               le(ij+u_rup)*de(ij+u_rup)*ue(ij+u_rup,l)**2 +        &
-                               le(ij+u_lup)*de(ij+u_lup)*ue(ij+u_lup,l)**2 +        &
-                               le(ij+u_left)*de(ij+u_left)*ue(ij+u_left,l)**2 +     &
-                               le(ij+u_ldown)*de(ij+u_ldown)*ue(ij+u_ldown,l)**2 +  &
-                               le(ij+u_rdown)*de(ij+u_rdown)*ue(ij+u_rdown,l)**2 )  
-       
-        ENDDO
-      ENDDO
-    ENDDO
-  END SUBROUTINE compute_kinetic
-  
-  SUBROUTINE compute_kv(ue, Kv)
-  USE icosa
-  USE omp_para
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: ue(3*iim*jjm,llm)
-    REAL(rstd),INTENT(OUT) :: Kv(2*iim*jjm,llm)
-    INTEGER :: ij,l, u_up, u_down
-
-    u_up    = t_lup + u_right
-    u_down  = t_rdown + u_left
-    
-    DO l=ll_begin,ll_end
-      DO ij=ij_begin,ij_end
-          Kv(ij+z_up,l) = (radius**2/Av(ij+z_up))*(                         &
-                               S1(ij,vup)*ue(ij+u_rup,l)**2 +        &
-                               S2(ij,vup)*ue(ij+u_lup,l)**2 +        &
-                               S2(ij+t_lup,vrdown)*ue(ij+u_up,l)**2)
-
-          Kv(ij+z_down,l) = (radius**2/Av(ij+z_down))*(                         &
-                               S1(ij,vdown)*ue(ij+u_ldown,l)**2 +       &
-                               S2(ij,vdown)*ue(ij+u_rdown,l)**2 +       &
-                               S2(ij+t_rdown,vlup)*ue(ij+u_down,l)**2 )
-       ENDDO
-    ENDDO
-  END SUBROUTINE compute_kv
-  
-  SUBROUTINE compute_Ki_new(ue, Ki)
-    USE icosa
-    USE omp_para
-    IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: ue(3*iim*jjm,llm)
-    REAL(rstd),INTENT(OUT):: Ki(iim*jjm,llm)
-    REAL(rstd) :: Kv(2*iim*jjm,llm)
-    INTEGER :: ij,l, u_up, u_down
-    
-    CALL compute_kv(ue,Kv)
-    
-    DO l=ll_begin,ll_end
-       DO ij=ij_begin,ij_end
-          Ki(ij,l) = Riv(ij,vup)*Kv(ij+z_up,l) + &
-               Riv(ij,vlup)  *Kv(ij+z_lup,l) + &
-               Riv(ij,vldown)*Kv(ij+z_ldown,l) + &
-               Riv(ij,vdown) *Kv(ij+z_down,l) + &
-               Riv(ij,vrdown)*Kv(ij+z_rdown,l) + &
-               Riv(ij,vrup)  *Kv(ij+z_rup,l)
-       END DO
-    END DO
-  END SUBROUTINE compute_Ki_new
-  
-  SUBROUTINE gradient(f_berni, f_du)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_berni(:)
-    TYPE(t_field), POINTER :: f_du(:)
-  
-    REAL(rstd), POINTER :: du(:,:)
-    REAL(rstd), POINTER :: berni(:,:)
-    INTEGER :: ind
-  
-    CALL transfert_request(f_du,req_e1_vect)
-    CALL transfert_request(f_du,req_e1_vect)
-
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      berni=f_berni(ind)
-      du=f_du(ind)
-      CALL compute_grad(berni, du)
-    ENDDO
-  
-  END SUBROUTINE gradient
-  
-  SUBROUTINE compute_grad(berni, du)
-  USE icosa
-  USE omp_para
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: berni(iim*jjm,llm)
-    REAL(rstd),INTENT(OUT) :: du(3*iim*jjm,llm)
-    INTEGER :: i,j,ij,l
-    
-    DO l=ll_begin,ll_end
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-            du(ij+u_right,l) = ne_right*(berni(ij,l)-berni(ij+t_right,l))/de(ij+u_right)
-            du(ij+u_lup,l)   = ne_lup*(berni(ij,l)-berni(ij+t_lup,l))/de(ij+u_right)
-            du(ij+u_ldown,l) = ne_ldown*(berni(ij,l)-berni(ij+t_ldown,l))/de(ij+u_right)
-         ENDDO
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE compute_grad
-
-
-END MODULE kinetic_mod
Index: codes/icosagcm/devel/src/math_const.f90
===================================================================
--- codes/icosagcm/devel/src/math_const.f90	(revision 531)
+++ 	(revision )
@@ -1,7 +1,0 @@
-MODULE math_const
-  USE PREC
-  
-  REAL(rstd),PARAMETER :: Pi=acos(-1._rstd)
-  COMPLEX(cstd), PARAMETER :: Imag=(0,1)
-  
-END MODULE math_const
Index: codes/icosagcm/devel/src/metric.f90
===================================================================
--- codes/icosagcm/devel/src/metric.f90	(revision 531)
+++ 	(revision )
@@ -1,870 +1,0 @@
-MODULE metric
-  USE genmod
-  USE grid_param
-  USE domain_param
-  
-  TYPE t_cell_glo
-    INTEGER :: neighbour(0:5)
-    INTEGER :: edge(0:5)
-    INTEGER :: assign_face
-    INTEGER :: assign_i
-    INTEGER :: assign_j
-    INTEGER :: assign_domain
-    REAL(rstd) :: xyz(3)
-  END TYPE t_cell_glo
-  
-  TYPE t_vertex_glo
-    REAL(rstd) :: xyz(3)
-    INTEGER    :: neighbour(0:5)
-    INTEGER    :: ne(0:5)
-    INTEGER    :: ind
-    INTEGER    :: delta
-  END TYPE t_vertex_glo
-  
-  TYPE t_edge_glo
-   INTEGER :: e1
-   INTEGER :: e2
-   INTEGER :: assign_domain
-   INTEGER :: assign_i
-   INTEGER :: assign_j
-   INTEGER :: assign_pos
-   INTEGER :: assign_delta
-  END TYPE t_edge_glo
-    
- 
-  TYPE(t_vertex_glo),ALLOCATABLE,SAVE :: vertex_glo(:,:,:)
-  TYPE(t_cell_glo),ALLOCATABLE,SAVE :: cell_glo(:)
-  TYPE(t_edge_glo),ALLOCATABLE,SAVE :: edge_glo(:)
-  INTEGER :: ncell_glo
-  
-  INTEGER,ALLOCATABLE,SAVE :: Tab_index(:,:,:)  
-  INTEGER,PARAMETER :: right=1
-  INTEGER,PARAMETER :: rup=2
-  INTEGER,PARAMETER :: lup=3
-  INTEGER,PARAMETER :: left=4
-  INTEGER,PARAMETER :: ldown=5
-  INTEGER,PARAMETER :: rdown=6
-  
-  INTEGER,PARAMETER :: vrup=1
-  INTEGER,PARAMETER :: vup=2
-  INTEGER,PARAMETER :: vlup=3
-  INTEGER,PARAMETER :: vldown=4
-  INTEGER,PARAMETER :: vdown=5
-  INTEGER,PARAMETER :: vrdown=6
-  
-CONTAINS
-
-  SUBROUTINE remap_schmidt_glo ! FIXME : not called any more
-    USE spherical_geom_mod
-    USE getin_mod
-    IMPLICIT NONE
-    INTEGER :: nf,i,j
-    REAL(rstd) :: schmidt_factor, schmidt_lon, schmidt_lat
-
-    ! Schmidt transform parameters
-    schmidt_factor = 1.
-    CALL getin('schmidt_factor', schmidt_factor)
-    schmidt_factor =  schmidt_factor**2.
-    
-    schmidt_lon = 0.
-    CALL getin('schmidt_lon', schmidt_lon)
-    schmidt_lon = schmidt_lon * pi/180.
-
-    schmidt_lat = 45.
-    CALL getin('schmidt_lat', schmidt_lat)
-    schmidt_lat = schmidt_lat * pi/180.
-
-    DO nf=1,nb_face
-       DO j=1,jjm_glo
-          DO i=1,iim_glo
-             CALL schmidt_transform(vertex_glo(i,j,nf)%xyz, schmidt_factor, schmidt_lon, schmidt_lat)
-          END DO
-       END DO
-    END DO
-  END SUBROUTINE remap_schmidt_glo
-
-  SUBROUTINE allocate_metric
-  IMPLICIT NONE
-    INTEGER :: ind
-    
-    ALLOCATE(vertex_glo(1-halo:iim_glo+halo,1-halo:jjm_glo+halo,nb_face))
-    ncell_glo=10*(iim_glo-2)*(jjm_glo-2)+(iim_glo-2)*20+12
-    ALLOCATE(cell_glo(ncell_glo))
-    ALLOCATE(tab_index(nb_face,nb_face,0:5))
-    ALLOCATE(edge_glo(ncell_glo*3))
-    
-    DO ind=1,ncell_glo
-      cell_glo(ind)%neighbour(:)=0
-    ENDDO
-    
-  END SUBROUTINE allocate_metric
-  
-  SUBROUTINE Compute_face
-  USE spherical_geom_mod
-  IMPLICIT NONE
-    
-    REAL(rstd) :: len_edge
-    REAL(rstd) :: rot=0.
-    INTEGER :: nf,i,j
-    REAL(rstd),DIMENSION(3) :: p1,p2,p3
-    REAL(rstd) :: d1,d2,d3
-  
-  
-   len_edge=acos(cos(Pi/5)*cos(2*Pi/5)/(sin(Pi/5)*sin(2*Pi/5)))
-   
-   DO nf=1,nb_face/2
-     CALL lonlat2xyz(0.,Pi/2,vertex_glo(1,1,nf)%xyz)
-     CALL lonlat2xyz(rot+(nf-1)*2*Pi/5,Pi/2-len_edge,vertex_glo(iim_glo,1,nf)%xyz)
-     CALL lonlat2xyz(rot+2*Pi/5+(nf-1)*2*Pi/5,Pi/2-len_edge,vertex_glo(1,jjm_glo,nf)%xyz)
-     CALL lonlat2xyz(rot+Pi/5+(nf-1)*2*Pi/5,-Pi/2+len_edge,vertex_glo(iim_glo,jjm_glo,nf)%xyz)
-
-     CALL lonlat2xyz(0.,-Pi/2,vertex_glo(1,1,nf+nb_face/2)%xyz)
-     CALL lonlat2xyz(rot+Pi/5+(nf-1)*2*Pi/5,-(Pi/2-len_edge),vertex_glo(1,jjm_glo,nf+nb_face/2)%xyz)
-     CALL lonlat2xyz(rot+Pi/5+2*Pi/5+(nf-1)*2*Pi/5,-(Pi/2-len_edge),vertex_glo(iim_glo,1,nf+nb_face/2)%xyz)
-     CALL lonlat2xyz(rot+Pi/5+Pi/5+(nf-1)*2*Pi/5,-(-Pi/2+len_edge),vertex_glo(iim_glo,jjm_glo,nf+nb_face/2)%xyz)
-   ENDDO
-
-   DO nf=1,nb_face
-     DO i=2,iim_glo-1
-       CALL div_arc(vertex_glo(1,1,nf)%xyz,vertex_glo(iim_glo,1,nf)%xyz,(i-1)*1./(iim_glo-1),vertex_glo(i,1,nf)%xyz)
-       CALL div_arc(vertex_glo(1,jjm_glo,nf)%xyz,vertex_glo(iim_glo,jjm_glo,nf)%xyz,                                 &
-                               (i-1)*1./(iim_glo-1),vertex_glo(i,jjm_glo,nf)%xyz)
-     ENDDO
-      DO j=2,jjm_glo-1
-       CALL div_arc(vertex_glo(1,1,nf)%xyz,vertex_glo(1,jjm_glo,nf)%xyz,(j-1)*1./(jjm_glo-1),vertex_glo(1,j,nf)%xyz)
-       CALL div_arc(vertex_glo(iim_glo,1,nf)%xyz,vertex_glo(iim_glo,jjm_glo,nf)%xyz,(j-1)*1./(jjm_glo-1),            &
-                    vertex_glo(iim_glo,j,nf)%xyz)
-     ENDDO
-    
-     DO j=2,jjm_glo-1
-       DO i=2,iim_glo-1
-         IF (i+j-1 > iim_glo) THEN
-           CALL div_arc(vertex_glo(iim_glo,i+j-iim_glo,nf)%xyz,vertex_glo(i+j-jjm_glo,jjm_glo,nf)%xyz,    &
-                        (iim_glo-i)*1./(2*iim_glo-(i+j)),vertex_glo(i,j,nf)%xyz) 
-         ELSE
-           CALL div_arc(vertex_glo(i+j-1,1,nf)%xyz,vertex_glo(1,i+j-1,nf)%xyz,(j-1)*1./(i+j-2),vertex_glo(i,j,nf)%xyz)
-         ENDIF
-       ENDDO
-     ENDDO
-   ENDDO
-
-  CALL dist_cart(vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,d1) 
-  CALL dist_cart(vertex_glo(2,1,1)%xyz,vertex_glo(3,1,1)%xyz,d2) 
-  CALL dist_cart(vertex_glo(3,1,1)%xyz,vertex_glo(4,1,1)%xyz,d3) 
-  CALL div_arc(vertex_glo(1,1,1)%xyz,vertex_glo(3,1,1)%xyz,0.5,p1)
-
-  CALL circumcenter(vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,vertex_glo(1,2,1)%xyz,p1)
-!  CALL Centroide(vertex_glo(1,2,1)%xyz,vertex_glo(2,1,1)%xyz,vertex_glo(1,1,1)%xyz,p1)
-!  CALL Centroide(vertex_glo(1,2,1)%xyz,vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,p1)
-  CALL dist_cart(vertex_glo(1,1,1)%xyz,p1,d1) 
-  CALL dist_cart(vertex_glo(2,1,1)%xyz,p1,d2) 
-  CALL dist_cart(vertex_glo(1,2,1)%xyz,p1,d3) 
-
-  END SUBROUTINE compute_face
-
-  SUBROUTINE Compute_face_projection
-  USE spherical_geom_mod
-  IMPLICIT NONE
-    
-    REAL(rstd) :: len_edge
-    REAL(rstd) :: rot=0.
-    INTEGER :: nf,i,j
-    REAL(rstd),DIMENSION(3) :: p1,p2,p3
-    REAL(rstd) :: d1,d2,d3
-  
-   len_edge=acos(cos(Pi/5)*cos(2*Pi/5)/(sin(Pi/5)*sin(2*Pi/5)))
-   
-   DO nf=1,nb_face/2
-     CALL lonlat2xyz(0.,Pi/2,vertex_glo(1,1,nf)%xyz)
-     CALL lonlat2xyz(rot+(nf-1)*2*Pi/5,Pi/2-len_edge,vertex_glo(iim_glo,1,nf)%xyz)
-     CALL lonlat2xyz(rot+2*Pi/5+(nf-1)*2*Pi/5,Pi/2-len_edge,vertex_glo(1,jjm_glo,nf)%xyz)
-     CALL lonlat2xyz(rot+Pi/5+(nf-1)*2*Pi/5,-Pi/2+len_edge,vertex_glo(iim_glo,jjm_glo,nf)%xyz)
-
-     CALL lonlat2xyz(0.,-Pi/2,vertex_glo(1,1,nf+nb_face/2)%xyz)
-     CALL lonlat2xyz(rot+Pi/5+(nf-1)*2*Pi/5,-(Pi/2-len_edge),vertex_glo(1,jjm_glo,nf+nb_face/2)%xyz)
-     CALL lonlat2xyz(rot+Pi/5+2*Pi/5+(nf-1)*2*Pi/5,-(Pi/2-len_edge),vertex_glo(iim_glo,1,nf+nb_face/2)%xyz)
-     CALL lonlat2xyz(rot+Pi/5+Pi/5+(nf-1)*2*Pi/5,-(-Pi/2+len_edge),vertex_glo(iim_glo,jjm_glo,nf+nb_face/2)%xyz)
-   ENDDO
-
-   DO nf=1,nb_face
-     DO i=2,iim_glo-1
-       CALL div_arc_bis(vertex_glo(1,1,nf)%xyz,vertex_glo(iim_glo,1,nf)%xyz,(i-1)*1./(iim_glo-1),vertex_glo(i,1,nf)%xyz)
-       CALL div_arc_bis(vertex_glo(1,jjm_glo,nf)%xyz,vertex_glo(iim_glo,jjm_glo,nf)%xyz,                                 &
-                               (i-1)*1./(iim_glo-1),vertex_glo(i,jjm_glo,nf)%xyz)
-     ENDDO
-      DO j=2,jjm_glo-1
-       CALL div_arc_bis(vertex_glo(1,1,nf)%xyz,vertex_glo(1,jjm_glo,nf)%xyz,(j-1)*1./(jjm_glo-1),vertex_glo(1,j,nf)%xyz)
-       CALL div_arc_bis(vertex_glo(iim_glo,1,nf)%xyz,vertex_glo(iim_glo,jjm_glo,nf)%xyz,(j-1)*1./(jjm_glo-1),            &
-                    vertex_glo(iim_glo,j,nf)%xyz)
-     ENDDO
-    
-     DO j=2,jjm_glo-1
-       DO i=2,iim_glo-1
-         IF (i+j-1 > iim_glo) THEN
-           CALL div_arc_bis(vertex_glo(iim_glo,i+j-iim_glo,nf)%xyz,vertex_glo(i+j-jjm_glo,jjm_glo,nf)%xyz,    &
-                        (iim_glo-i)*1./(2*iim_glo-(i+j)),vertex_glo(i,j,nf)%xyz) 
-         ELSE
-           CALL div_arc_bis(vertex_glo(i+j-1,1,nf)%xyz,vertex_glo(1,i+j-1,nf)%xyz,(j-1)*1./(i+j-2),vertex_glo(i,j,nf)%xyz)
-         ENDIF
-       ENDDO
-     ENDDO
-     
-!     DO j=1,jjm_glo
-!       DO i=1,iim_glo
-!         vertex_glo(i,j,nf)%xyz=vertex_glo(i,j,nf)%xyz/sqrt(sum(vertex_glo(i,j,nf)%xyz**2))
-!       ENDDO
-!     ENDDO
-   ENDDO
-
-!  CALL dist_cart(vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,d1) 
-!  CALL dist_cart(vertex_glo(2,1,1)%xyz,vertex_glo(3,1,1)%xyz,d2) 
-!  CALL dist_cart(vertex_glo(3,1,1)%xyz,vertex_glo(4,1,1)%xyz,d3) 
-!  CALL div_arc(vertex_glo(1,1,1)%xyz,vertex_glo(3,1,1)%xyz,0.5,p1)
-!  CALL div_arc(vertex_glo(2,1,1)%xyz,vertex_glo(1,3,1)%xyz,1./3,p1)
-!  CALL div_arc(vertex_glo(1,2,1)%xyz,vertex_glo(3,1,1)%xyz,1./3,p2)
-!  CALL div_arc(vertex_glo(2,2,1)%xyz,vertex_glo(1,1,1)%xyz,1./3,p3)
-!  PRINT *, "dist",d1
-!  PRINT *, "dist",d2
-!  PRINT *, "dist",d3
-!  PRINT *,"dist",vertex_glo(2,1,1)%xyz
-!  PRINT *,"dist",p1/sqrt(sum(p1**2))
-!  CALL Centroide(vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,vertex_glo(1,2,1)%xyz,p1)
-!  CALL Centroide(vertex_glo(1,2,1)%xyz,vertex_glo(2,1,1)%xyz,vertex_glo(1,1,1)%xyz,p1)
-!  CALL Centroide(vertex_glo(1,2,1)%xyz,vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,p1)
-!  CALL dist_cart(vertex_glo(1,1,1)%xyz,p1,d1) 
-!  CALL dist_cart(vertex_glo(2,1,1)%xyz,p1,d2) 
-!  CALL dist_cart(vertex_glo(1,2,1)%xyz,p1,d3) 
-!  PRINT *, "dist",d1
-!  PRINT *, "dist",d2
-!  PRINT *, "dist",d3
-
-  END SUBROUTINE compute_face_projection
-
-
-  SUBROUTINE compute_extended_face_bis
-  IMPLICIT NONE
-  
-    INTEGER :: nf
-    INTEGER :: i,j
-    INTEGER :: delta
-    INTEGER :: ind
-    INTEGER :: k,ng
-
-    DO nf=1,nb_face
-      DO i=2,iim_glo-1
-
-        CALL set_neighbour(i,1,nf,ldown-1)
-        CALL set_neighbour(i,1,nf,rdown-1)
-
-        CALL set_neighbour(i,jjm_glo,nf,lup-1)
-        CALL set_neighbour(i,jjm_glo,nf,rup-1)
-      
-      ENDDO    
-     
-      DO j=2,jjm_glo-1
-        
-        CALL set_neighbour(1,j,nf,left-1)
-        CALL set_neighbour(1,j,nf,lup-1)
-
-        CALL set_neighbour(iim_glo,j,nf,rdown-1)
-        CALL set_neighbour(iim_glo,j,nf,right-1)
-
-      ENDDO
-      
-      CALL set_neighbour(2,0,nf,left-1)
-      CALL set_neighbour(iim_glo,0,nf,right-1)
-      CALL set_neighbour(iim_glo+1,jjm_glo-1,nf,rup-1)
-      CALL set_neighbour(iim_glo-1,jjm_glo+1,nf,right-1)
-      CALL set_neighbour(1,jjm_glo+1,nf,left-1)
-      CALL set_neighbour(0,2,nf,ldown-1)
-      
-      CALL set_neighbour(1,0,nf,left-1)
-      CALL set_neighbour(iim_glo,0,nf,right-1)
-      CALL set_neighbour(0,jjm_glo,nf,rup-1)
-      CALL set_neighbour(iim_glo+1,jjm_glo,nf,rup-1)
-    ENDDO
-
-    DO nf=1,nb_face
-      DO j=0,jjm_glo+1
-        DO i=0,iim_glo+1
-          ind=vertex_glo(i,j,nf)%ind
-          delta=vertex_glo(i,j,nf)%delta
-          DO k=0,5
-            ng=MOD(delta+k+6,6)
-            vertex_glo(i,j,nf)%neighbour(k)=cell_glo(ind)%neighbour(ng)
-          ENDDO
-        ENDDO
-      ENDDO
- 
-      i=1 ; j=1
-      vertex_glo(i,j,nf)%neighbour(0)=vertex_glo(i+1,j,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(1)=vertex_glo(i,j+1,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(2)=vertex_glo(i-1,j+1,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(3)=vertex_glo(i-1,j,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(4)=vertex_glo(i,j-1,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(5)=vertex_glo(i+1,j-1,nf)%ind
-
-      i=iim_glo ; j=1
-      vertex_glo(i,j,nf)%neighbour(0)=vertex_glo(i+1,j,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(1)=vertex_glo(i,j+1,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(2)=vertex_glo(i-1,j+1,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(3)=vertex_glo(i-1,j,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(4)=vertex_glo(i,j-1,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(5)=vertex_glo(i+1,j-1,nf)%ind
-
-      i=1 ; j=jjm_glo
-      vertex_glo(i,j,nf)%neighbour(0)=vertex_glo(i+1,j,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(1)=vertex_glo(i,j+1,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(2)=vertex_glo(i-1,j+1,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(3)=vertex_glo(i-1,j,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(4)=vertex_glo(i,j-1,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(5)=vertex_glo(i+1,j-1,nf)%ind
-
-      i=iim_glo ; j=jjm_glo
-      vertex_glo(i,j,nf)%neighbour(0)=vertex_glo(i+1,j,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(1)=vertex_glo(i,j+1,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(2)=vertex_glo(i-1,j+1,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(3)=vertex_glo(i-1,j,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(4)=vertex_glo(i,j-1,nf)%ind
-      vertex_glo(i,j,nf)%neighbour(5)=vertex_glo(i+1,j-1,nf)%ind
-   ENDDO      
-  
-  CONTAINS
-  
-    SUBROUTINE set_neighbour(i,j,nf,neighbour)
-    IMPLICIT NONE
-      INTEGER :: i,j,nf,neighbour
-      INTEGER :: in,jn
-      INTEGER :: k,ng
-      INTEGER :: delta
-      INTEGER :: ind,ind2
-    
-       SELECT CASE (neighbour)
-         CASE(right-1)
-           in=i+1 ; jn=j
-         CASE(rup-1)
-           in=i ; jn=j+1
-         CASE(lup-1)
-           in=i-1 ; jn=j+1
-         CASE(left-1)
-           in=i-1 ; jn=j
-         CASE(ldown-1)
-           in=i ; jn=j-1
-         CASE(rdown-1)
-           in=i+1; jn=j-1
-        END SELECT
-         
-        ind=vertex_glo(i,j,nf)%ind
-        delta=MOD(vertex_glo(i,j,nf)%delta+neighbour+6,6)
-        ind2=cell_glo(ind)%neighbour(delta)
-        DO k=0,5
-          IF (cell_glo(ind2)%neighbour(k)==ind) ng=k
-        ENDDO
-        vertex_glo(in,jn,nf)%ind=ind2
-        vertex_glo(in,jn,nf)%delta=MOD(ng-neighbour+3+6,6)    
-      END SUBROUTINE set_neighbour    
-  
-  END SUBROUTINE compute_extended_face_bis
-    
-    
-  SUBROUTINE compute_extended_face
-  IMPLICIT NONE
-  
-    INTEGER :: nf,nf2
-    INTEGER :: ind,ind2
-    INTEGER :: i,j,h
-    
-
-    DO h=1,halo
-      DO nf=1,nb_face
-        DO i=1-h+1,iim_glo+h-1
-          j=1-h+1
-          ind=vertex_glo(i,j,nf)%ind
-          nf2=cell_glo(ind)%assign_face
-          ind2=cell_glo(ind)%neighbour(tab_index(nf,nf2,ldown-1))
-          vertex_glo(i,j-1,nf)%ind=ind2
-          vertex_glo(i,j-1,nf)%xyz=cell_glo(ind2)%xyz
-        ENDDO
-      
-        DO j=1-h,jjm_glo+h-1
-          i=iim_glo+h-1
-          ind=vertex_glo(i,j,nf)%ind
-          nf2=cell_glo(ind)%assign_face
-          ind2=cell_glo(ind)%neighbour(tab_index(nf,nf2,right-1))
-          vertex_glo(i+1,j,nf)%ind=ind2
-          vertex_glo(i+1,j,nf)%xyz=cell_glo(ind2)%xyz
-        ENDDO
-      
-        DO i=iim_glo+h,1-h+1,-1
-          j=jjm_glo+h-1
-          ind=vertex_glo(i,j,nf)%ind
-          nf2=cell_glo(ind)%assign_face
-          ind2=cell_glo(ind)%neighbour(tab_index(nf,nf2,rup-1))
-          vertex_glo(i,j+1,nf)%ind=ind2
-          vertex_glo(i,j+1,nf)%xyz=cell_glo(ind2)%xyz
-        ENDDO
-
-         DO j=jjm_glo+h,1-h,-1
-          i=1-h+1
-          ind=vertex_glo(i,j,nf)%ind
-          nf2=cell_glo(ind)%assign_face
-          ind2=cell_glo(ind)%neighbour(tab_index(nf,nf2,left-1))
-          vertex_glo(i-1,j,nf)%ind=ind2
-          vertex_glo(i-1,j,nf)%xyz=cell_glo(ind2)%xyz
-        ENDDO
-      ENDDO
-    ENDDO
-    
-    
-  END SUBROUTINE compute_extended_face
-  
-  SUBROUTINE Set_index
-  IMPLICIT NONE
-    INTEGER :: delta
-    INTEGER :: n1,n2,i
-   
-    DO n1=1,5
-     DO delta=-2,2
-        DO i=0,5
-          n2=MOD(n1-1-delta+5,5)+1
-          tab_index(n1,n2,i)=MOD(delta+i+6,6)
-          n2=MOD(n1-1+delta+5,5)+1
-          tab_index(n1+5,n2+5,i)=MOD(delta+i+6,6)
-        ENDDO
-      ENDDO
-    ENDDO
-    
-    DO n1=1,5
-      DO i=0,5
-        delta=3
-
-        n2=5+n1
-        Tab_index(n1,n2,i)=MOD(delta+i+6,6)
-        Tab_index(n2,n1,i)=MOD(delta+i+6,6)
-      
-        n2=5+n1-1
-        IF (n2==5) n2=10
-        Tab_index(n1,n2,i)=MOD(delta+i+6,6)
-        Tab_index(n2,n1,i)=MOD(delta+i+6,6)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE set_index
-  
-  
-  SUBROUTINE set_cell
-  IMPLICIT NONE
-    INTEGER :: ind,ind2
-    INTEGER :: nf,nf2,nfm1,nfp1
-    INTEGER :: i,j,k
-    INTEGER :: delta
-    
-    ind=0
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Association des cellules !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! interieur des faces
-    DO nf=1,nb_face     
-      DO i=2,iim_glo-1
-        DO j=2,jjm_glo-1
-          ind=ind+1
-          vertex_glo(i,j,nf)%ind=ind
-          cell_glo(ind)%assign_face=nf
-          cell_glo(ind)%assign_i=i
-          cell_glo(ind)%assign_j=j
-        ENDDO
-      ENDDO
-    ENDDO
-
-! frontieres faces nord
-    DO nf=1,nb_face/2
-
-      nfm1=nf-1
-      IF (nfm1==0) nfm1=nb_face/2
-      
-      nf2=nf+nb_face/2
-
-      DO i=2,iim_glo-1
-        ind=ind+1
-        vertex_glo(i,1,nf)%ind=ind
-        vertex_glo(1,i,nfm1)%ind=ind
-        cell_glo(ind)%assign_face=nf
-        cell_glo(ind)%assign_i=i
-        cell_glo(ind)%assign_j=1
-      ENDDO
-
-      DO i=2,iim_glo-1
-        ind=ind+1
-        vertex_glo(i,jjm_glo,nf)%ind=ind
-        vertex_glo(iim_glo-i+1,jjm_glo,nf2)%ind=ind
-        
-        cell_glo(ind)%assign_face=nf
-        cell_glo(ind)%assign_i=i
-        cell_glo(ind)%assign_j=jjm_glo
-      ENDDO
-     ENDDO
-
-! frontieres faces sud
-
-    DO nf=nb_face/2+1,nb_face
-      
-      nfp1=nf+1
-      IF (nfp1==nb_face+1) nfp1=nb_face/2+1
-      
-      nf2=nf-nb_face/2+1
-      IF (nf2==nb_face/2+1) nf2=1
-      
-      DO i=2,iim_glo-1
-        ind=ind+1
-        vertex_glo(i,1,nf)%ind=ind
-        vertex_glo(1,i,nfp1)%ind=ind
-        cell_glo(ind)%assign_face=nf
-        cell_glo(ind)%assign_i=i
-        cell_glo(ind)%assign_j=1
-      ENDDO
-
-      DO j=2,jjm_glo-1
-        ind=ind+1
-        vertex_glo(iim_glo,j,nf)%ind=ind
-        vertex_glo(iim_glo,jjm_glo-j+1,nf2)%ind=ind
-        
-        cell_glo(ind)%assign_face=nf
-        cell_glo(ind)%assign_i=iim_glo
-        cell_glo(ind)%assign_j=j
-      ENDDO
-    ENDDO
-
-! vertex nord (sur 3 faces)
-
-    DO nf=1,nb_face/2
-
-      nfp1=nf+1
-      IF (nfp1==nb_face/2+1) nfp1=1
-      
-      nf2=nf+nb_face/2
-
-      ind=ind+1
-      vertex_glo(1,jjm_glo,nf)%ind=ind
-      vertex_glo(iim_glo,1,nfp1)%ind=ind
-      vertex_glo(iim_glo,jjm_glo,nf2)%ind=ind
-      cell_glo(ind)%assign_face=nf
-      cell_glo(ind)%assign_i=1
-      cell_glo(ind)%assign_j=jjm_glo
-     ENDDO
-
-! vertex sud (sur 3 faces)
-
-    DO nf=nb_face/2+1,nb_face
-
-      nfp1=nf+1
-      IF (nfp1==nb_face+1) nfp1=nb_face/2+1
-      
-      nf2=nf-nb_face/2+1
-      IF (nf2==nb_face/2+1) nf2=1
-
-      ind=ind+1
-      vertex_glo(iim_glo,1,nf)%ind=ind
-      vertex_glo(1,jjm_glo,nfp1)%ind=ind
-      vertex_glo(iim_glo,jjm_glo,nf2)%ind=ind
-      cell_glo(ind)%assign_face=nf
-      cell_glo(ind)%assign_i=iim_glo
-      cell_glo(ind)%assign_j=1
-    ENDDO
-
-
-! vertex nord (sur 5 faces)
-
-    ind=ind+1
-    vertex_glo(1,1,1)%ind=ind
-    vertex_glo(1,1,2)%ind=ind
-    vertex_glo(1,1,3)%ind=ind
-    vertex_glo(1,1,4)%ind=ind
-    vertex_glo(1,1,5)%ind=ind
-    cell_glo(ind)%assign_face=1
-    cell_glo(ind)%assign_i=1
-    cell_glo(ind)%assign_j=1
-      
-! vertex sud (sur 5 faces)
-
-    ind=ind+1    
-    vertex_glo(1,1,6)%ind=ind
-    vertex_glo(1,1,7)%ind=ind
-    vertex_glo(1,1,8)%ind=ind
-    vertex_glo(1,1,9)%ind=ind
-    vertex_glo(1,1,10)%ind=ind
-    cell_glo(ind)%assign_face=6
-    cell_glo(ind)%assign_i=1
-    cell_glo(ind)%assign_j=1
-
-! assignation des coordonnees xyz
-
-  DO ind=1,ncell_glo
-    nf=cell_glo(ind)%assign_face
-    i=cell_glo(ind)%assign_i
-    j=cell_glo(ind)%assign_j
-    cell_glo(ind)%xyz=vertex_glo(i,j,nf)%xyz
-  ENDDO
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Association des voisins !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! interieur des faces
-  
-    DO nf=1,nb_face
-      DO j=2,jjm_glo-1
-        DO i=2,iim_glo-1
-          ind=vertex_glo(i,j,nf)%ind
-! right          
-          ind2=vertex_glo(i+1,j,nf)%ind   
-          nf2=cell_glo(ind2)%assign_face
-          cell_glo(ind)%neighbour(right-1)=ind2
-          cell_glo(ind2)%neighbour(tab_index(nf,nf2,left-1))=ind
-          
-! rup          
-          ind2=vertex_glo(i,j+1,nf)%ind   
-          nf2=cell_glo(ind2)%assign_face
-          cell_glo(ind)%neighbour(rup-1)=ind2
-          cell_glo(ind2)%neighbour(tab_index(nf,nf2,ldown-1))=ind
-              
-! lup          
-          ind2=vertex_glo(i-1,j+1,nf)%ind  
-          nf2=cell_glo(ind2)%assign_face
-          cell_glo(ind)%neighbour(lup-1)=ind2
-          cell_glo(ind2)%neighbour(tab_index(nf,nf2,rdown-1))=ind
-          
-! left          
-          ind2=vertex_glo(i-1,j,nf)%ind   
-          nf2=cell_glo(ind2)%assign_face
-          cell_glo(ind)%neighbour(left-1)=ind2
-          cell_glo(ind2)%neighbour(tab_index(nf,nf2,right-1))=ind
-! ldown          
-          ind2=vertex_glo(i,j-1,nf)%ind   
-          nf2=cell_glo(ind2)%assign_face
-          cell_glo(ind)%neighbour(ldown-1)=ind2
-          cell_glo(ind2)%neighbour(tab_index(nf,nf2,rup-1))=ind
-          
-! rdown          
-          ind2=vertex_glo(i+1,j-1,nf)%ind   
-          nf2=cell_glo(ind2)%assign_face
-          cell_glo(ind)%neighbour(rdown-1)=ind2
-          cell_glo(ind2)%neighbour(tab_index(nf,nf2,lup-1))=ind
-        ENDDO
-      ENDDO
-    ENDDO
-
-! frontiere face nord
-    
-    DO nf=1,nb_face/2
-      DO i=2,iim_glo-1
-        j=1
-        ind=vertex_glo(i,j,nf)%ind
-! right          
-        ind2=vertex_glo(i+1,j,nf)%ind   
-        nf2=cell_glo(ind2)%assign_face
-        cell_glo(ind)%neighbour(right-1)=ind2
-        cell_glo(ind2)%neighbour(tab_index(nf,nf2,left-1))=ind
-! left          
-        ind2=vertex_glo(i-1,j,nf)%ind   
-        nf2=cell_glo(ind2)%assign_face
-        cell_glo(ind)%neighbour(left-1)=ind2
-        cell_glo(ind2)%neighbour(tab_index(nf,nf2,right-1))=ind
-! lup          
-          ind2=vertex_glo(i-1,j+1,nf)%ind  
-          nf2=cell_glo(ind2)%assign_face
-          cell_glo(ind)%neighbour(lup-1)=ind2
-          cell_glo(ind2)%neighbour(tab_index(nf,nf2,rdown-1))=ind
-
-      ENDDO
-
-      DO i=2,iim_glo-1
-        j=jjm_glo
-        ind=vertex_glo(i,j,nf)%ind
-! right          
-        ind2=vertex_glo(i+1,j,nf)%ind   
-        nf2=cell_glo(ind2)%assign_face
-        cell_glo(ind)%neighbour(right-1)=ind2
-        cell_glo(ind2)%neighbour(tab_index(nf,nf2,left-1))=ind
-! left          
-        ind2=vertex_glo(i-1,j,nf)%ind   
-        nf2=cell_glo(ind2)%assign_face
-        cell_glo(ind)%neighbour(left-1)=ind2
-        cell_glo(ind2)%neighbour(tab_index(nf,nf2,right-1))=ind
-! rdown          
-          ind2=vertex_glo(i+1,j-1,nf)%ind   
-          nf2=cell_glo(ind2)%assign_face
-          cell_glo(ind)%neighbour(rdown-1)=ind2
-          cell_glo(ind2)%neighbour(tab_index(nf,nf2,lup-1))=ind
-      ENDDO
-    ENDDO
-    
-
-! frontiere face sud
-
-    DO nf=nb_face/2+1,nb_face
-      DO i=2,iim_glo-1
-        j=1
-        ind=vertex_glo(i,j,nf)%ind
-! right          
-        ind2=vertex_glo(i+1,j,nf)%ind   
-        nf2=cell_glo(ind2)%assign_face
-        cell_glo(ind)%neighbour(right-1)=ind2
-        cell_glo(ind2)%neighbour(tab_index(nf,nf2,left-1))=ind
-! left          
-        ind2=vertex_glo(i-1,j,nf)%ind   
-        nf2=cell_glo(ind2)%assign_face
-        cell_glo(ind)%neighbour(left-1)=ind2
-        cell_glo(ind2)%neighbour(tab_index(nf,nf2,right-1))=ind
-! lup          
-          ind2=vertex_glo(i-1,j+1,nf)%ind  
-          nf2=cell_glo(ind2)%assign_face
-          cell_glo(ind)%neighbour(lup-1)=ind2
-          cell_glo(ind2)%neighbour(tab_index(nf,nf2,rdown-1))=ind
-      ENDDO
-
-      DO j=2,jjm_glo-1
-        i=iim_glo
-        ind=vertex_glo(i,j,nf)%ind
-! rup          
-        ind2=vertex_glo(i,j+1,nf)%ind   
-        nf2=cell_glo(ind2)%assign_face
-        cell_glo(ind)%neighbour(rup-1)=ind2
-        cell_glo(ind2)%neighbour(tab_index(nf,nf2,ldown-1))=ind
-! ldown          
-        ind2=vertex_glo(i,j-1,nf)%ind   
-        nf2=cell_glo(ind2)%assign_face
-        cell_glo(ind)%neighbour(ldown-1)=ind2
-        cell_glo(ind2)%neighbour(tab_index(nf,nf2,rup-1))=ind
-! lup          
-          ind2=vertex_glo(i-1,j+1,nf)%ind  
-          nf2=cell_glo(ind2)%assign_face
-          cell_glo(ind)%neighbour(lup-1)=ind2
-          cell_glo(ind2)%neighbour(tab_index(nf,nf2,rdown-1))=ind
-
-      ENDDO
-    ENDDO          
-
-   
-! vertex nord (sur 3 faces)
-
-    DO nf=1,nb_face/2
-      ind=vertex_glo(1,jjm_glo,nf)%ind
-      cell_glo(ind)%neighbour(2)=cell_glo(ind)%neighbour(1)
-    ENDDO
-
-! vertex sud (sur 3 faces)
-
-    DO nf=nb_face/2+1,nb_face
-
-      ind=vertex_glo(iim_glo,1,nf)%ind
-      cell_glo(ind)%neighbour(5)=cell_glo(ind)%neighbour(0)
-    ENDDO
-
-
-! vertex nord (sur 5 faces)
-
-    ind=vertex_glo(1,1,1)%ind
-    cell_glo(ind)%neighbour(3)=cell_glo(ind)%neighbour(4)
-      
-! vertex sud (sur 5 faces)
-
-    ind=vertex_glo(1,1,6)%ind
-    cell_glo(ind)%neighbour(3)=cell_glo(ind)%neighbour(2)
-      
-    
- !! assignation des delta 
-    DO nf=1,nb_face
-      DO j=1,jjm_glo
-        DO i=1,iim_glo 
-          ind=vertex_glo(i,j,nf)%ind
-          nf2=cell_glo(ind)%assign_face
-          vertex_glo(i,j,nf)%delta=tab_index(nf,nf2,0)
-        ENDDO
-      ENDDO
-    ENDDO    
-
-     
-  END SUBROUTINE set_cell
-      
-          
-  SUBROUTINE set_cell_edge
-  IMPLICIT NONE
-    INTEGER :: ind,k,ind2,ng,ne
-    
-    DO ind=1,ncell_glo
-      cell_glo(ind)%edge(:)=0
-    ENDDO
-    
-    ne=0
-    DO ind=1,ncell_glo
-      DO k=0,5
-        IF (cell_glo(ind)%edge(k)==0) THEN
-          ind2=cell_glo(ind)%neighbour(k)
-          DO ng=0,5
-            IF (cell_glo(ind2)%neighbour(ng)==ind) THEN
-              IF (cell_glo(ind2)%edge(ng)==0) THEN
-                ne=ne+1
-                cell_glo(ind)%edge(k)=ne
-                edge_glo(ne)%e1=ind
-                edge_glo(ne)%e2=ind2
-                cell_glo(ind2)%edge(ng)=ne
-              ELSE 
-                ne=cell_glo(ind2)%edge(ng)
-                cell_glo(ind)%edge(k)=ne
-              ENDIF    
-              EXIT            
-            ENDIF
-          ENDDO
-        ENDIF
-      ENDDO
-    ENDDO
-    
-  END SUBROUTINE  set_cell_edge    
-        
-  SUBROUTINE set_vertex_edge
-  IMPLICIT NONE
-    INTEGER :: nf
-    INTEGER :: i,j
-    INTEGER :: ind,ind2
-    INTEGER :: ne
-    INTEGER :: k,l     
-  
-    DO nf=1,nb_face
-      DO j=0,jjm_glo+1
-        DO i=0,iim_glo+1
-          ind=vertex_glo(i,j,nf)%ind
-          DO k=0,5
-            ind2=vertex_glo(i,j,nf)%neighbour(k)
-            DO l=0,5
-              ne=cell_glo(ind)%edge(l)
-              IF (edge_glo(ne)%e1==ind .AND. edge_glo(ne)%e2==ind2) THEN
-                vertex_glo(i,j,nf)%ne(k)=1
-              ELSE IF (edge_glo(ne)%e1==ind2 .AND. edge_glo(ne)%e2==ind) THEN
-                vertex_glo(i,j,nf)%ne(k)=-1
-              ENDIF
-            ENDDO
-          ENDDO
-        ENDDO
-      ENDDO
-    ENDDO
-  END SUBROUTINE set_vertex_edge 
-     
-  SUBROUTINE compute_metric
-  IMPLICIT NONE
-  
-    CALL allocate_metric
-!    CALL compute_face
-    CALL compute_face_projection
-!    CALL remap_schmidt_glo ! replaced by call to remap_schmidt_loc in set_geometry
-
-    CALL set_index
-    CALL set_cell
-    CALL compute_extended_face_bis
-    CALL set_cell_edge
-    CALL set_vertex_edge
-    
-  END SUBROUTINE compute_metric
-
-END MODULE metric
Index: codes/icosagcm/devel/src/mpi_mod.F90
===================================================================
--- codes/icosagcm/devel/src/mpi_mod.F90	(revision 531)
+++ 	(revision )
@@ -1,83 +1,0 @@
-MODULE mpi_mod
-
-#ifdef CPP_USING_MPI
-  INCLUDE 'mpif.h'
-#else
-  INTEGER :: MPI_COMM_WORLD
-  INTEGER :: MPI_REAL8
-  INTEGER :: MPI_INTEGER
-  INTEGER :: MPI_CHARACTER
-  INTEGER :: MPI_LOGICAL
-  INTEGER :: MPI_ANY_SOURCE
-  INTEGER :: MPI_MAX
-  INTEGER :: MPI_INFO_NULL
-  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
-
-END MODULE mpi_mod
-
-
-#ifndef CPP_USING_MPI
-
- SUBROUTINE  MPI_INIT
-   PRINT *, 'Compiled without MPI'
- END
-
- SUBROUTINE  MPI_INIT_THREAD
-   PRINT *, 'Compiled without MPI'
- END
- 
- SUBROUTINE  MPI_COMM_SIZE
- END
-
- SUBROUTINE  MPI_COMM_RANK
- END
- 
- SUBROUTINE MPI_FINALIZE
- END
- 
- SUBROUTINE MPI_ALLREDUCE
- END
-
- SUBROUTINE MPI_REDUCE
- END
-
- SUBROUTINE MPI_ALLTOALL
- END
-
- SUBROUTINE MPI_ISEND
- END
-
- SUBROUTINE MPI_ISSEND
- END
-
- SUBROUTINE MPI_IRECV
- END
-
- SUBROUTINE MPI_WAITALL
- END
-
- SUBROUTINE MPI_TESTALL
- END
-
- SUBROUTINE MPI_BARRIER
- END
-
- SUBROUTINE MPI_ALLGATHER
- END
- 
- SUBROUTINE MPI_TYPE_EXTENT
- END
- 
- SUBROUTINE MPI_ALLOC_MEM
- END
-
- SUBROUTINE MPI_FREE_MEM
- END
-
-#endif
Index: codes/icosagcm/devel/src/mpipara.F90
===================================================================
--- codes/icosagcm/devel/src/mpipara.F90	(revision 531)
+++ 	(revision )
@@ -1,235 +1,0 @@
-MODULE mpipara
-
-  INTEGER,SAVE :: mpi_rank
-  INTEGER,SAVE :: mpi_size
-  INTEGER,SAVE :: mpi_threading_mode
-  
-  INTEGER,SAVE :: comm_icosa
-  INTEGER,SAVE :: ierr
-  LOGICAL,SAVE :: using_mpi
-  LOGICAL,SAVE :: is_mpi_root
-  LOGICAL,SAVE :: is_mpi_master
-  INTEGER,SAVE :: mpi_master
-  
-  
-  INTERFACE allocate_mpi_buffer
-    MODULE PROCEDURE allocate_mpi_buffer_r2, allocate_mpi_buffer_r3,allocate_mpi_buffer_r4
-  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
-
-  PRIVATE :: getin
-
-CONTAINS
-
-  SUBROUTINE getin(name,value) ! Copied from getin.f90 to avoid circular dependency
-  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)
-    IF(is_mpi_root) PRINT *,'GETIN ',TRIM(name),' = ', TRIM(value)
-!$OMP END MASTER
-    IF (omp_in_parallel()) CALL bcast_omp(value)
-  END SUBROUTINE getin
-
-  SUBROUTINE init_mpipara
-  USE mpi_mod
-#ifdef CPP_USING_XIOS
-  USE xios
-#endif
-  IMPLICIT NONE
-    CHARACTER(LEN=256) :: required_mode_str
-    INTEGER :: required_mode
-
-    using_mpi=.FALSE.
-#ifdef CPP_USING_MPI
-    using_mpi=.TRUE. 
-#endif 
-    
-    IF (using_mpi) THEN
-    
-      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) THEN
-         PRINT*,'MPI_INIT_THREAD : MPI_SINGLE_THREAD used : Warning : openMP is not garanted to work'
-      ENDIF
-      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)
-#else
-     comm_icosa=MPI_COMM_WORLD
-#endif
-      CALL MPI_COMM_SIZE(comm_icosa,mpi_size,ierr)
-      CALL MPI_COMM_RANK(comm_icosa,mpi_rank,ierr)
-      PRINT *, 'MPI Process ', mpi_rank, '/', mpi_size
-    ELSE
-      comm_icosa=-1
-      mpi_size=1
-      mpi_rank=0
-    ENDIF
-    
-    mpi_master=0
-    IF (mpi_rank==0) THEN 
-      is_mpi_root=.TRUE.
-      is_mpi_master=.TRUE.
-    ELSE
-      is_mpi_root=.FALSE.
-      is_mpi_master=.FALSE.
-    ENDIF
-    
-  END SUBROUTINE  init_mpipara
-
-  SUBROUTINE finalize_mpipara
-  USE mpi_mod
-#ifdef CPP_USING_XIOS
-  USE xios
-#endif
-  IMPLICIT NONE
-    
-#ifdef CPP_USING_XIOS
-      CALL xios_finalize
-#endif
-    IF (using_mpi) CALL MPI_FINALIZE(ierr)
-    
-   END SUBROUTINE  finalize_mpipara
-   
-
-  SUBROUTINE allocate_mpi_buffer_r2(buffer,length)
-  USE ISO_C_BINDING
-  USE mpi_mod
-  USE prec
-  IMPLICIT NONE
-    REAL(rstd), POINTER :: buffer(:)
-    INTEGER,INTENT(IN)  :: length
-
-    TYPE(C_PTR)         :: base_ptr
-    INTEGER(KIND=MPI_ADDRESS_KIND) :: size
-    INTEGER :: real_size,ierr
-    
-    CALL MPI_TYPE_EXTENT(MPI_REAL8, real_size, ierr)
-    size=length*real_size
-    
-    CALL MPI_ALLOC_MEM(size,MPI_INFO_NULL,base_ptr,ierr)
-    CALL C_F_POINTER(base_ptr, buffer, (/ length /))
-
-  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)
-  USE ISO_C_BINDING
-  USE mpi_mod
-  USE prec
-    IMPLICIT NONE
-    REAL(rstd), POINTER :: buffer(:,:)
-    INTEGER,INTENT(IN)  :: length
-    INTEGER,INTENT(IN)  :: dim3
-
-    TYPE(C_PTR)         :: base_ptr
-    INTEGER(KIND=MPI_ADDRESS_KIND) :: size
-    INTEGER :: real_size,ierr
-    
-    CALL MPI_TYPE_EXTENT(MPI_REAL8, real_size, ierr)
-    size=length*real_size*dim3
-    
-    CALL MPI_ALLOC_MEM(size,MPI_INFO_NULL,base_ptr,ierr)
-    CALL C_F_POINTER(base_ptr, buffer, (/ length,dim3 /))
-    
-  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)
-  USE ISO_C_BINDING
-  USE mpi_mod
-  USE prec
-  IMPLICIT NONE
-    REAL(rstd), POINTER :: buffer(:,:,:)
-    INTEGER,INTENT(IN)  :: length
-    INTEGER,INTENT(IN)  :: dim3
-    INTEGER,INTENT(IN)  :: dim4
-
-    TYPE(C_PTR)         :: base_ptr
-    INTEGER(KIND=MPI_ADDRESS_KIND) :: size
-    INTEGER :: real_size,ierr
-    
-    CALL MPI_TYPE_EXTENT(MPI_REAL8, real_size, ierr)
-    size=length*real_size*dim3*dim4
-    
-    CALL MPI_ALLOC_MEM(size,MPI_INFO_NULL,base_ptr,ierr)
-    CALL C_F_POINTER(base_ptr, buffer, (/ length, dim3, dim4 /))
-    
-   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/devel/src/netcdf_mod.F90
===================================================================
--- codes/icosagcm/devel/src/netcdf_mod.F90	(revision 531)
+++ 	(revision )
@@ -1,235 +1,0 @@
-MODULE netcdf_mod
-
-#ifndef CPP_NO_IO
-
-  USE netcdf
-  LOGICAL,PARAMETER :: no_io = .FALSE.
-
-#ifndef CPP_NETCDF4
-  INTEGER ::  NF90_NETCDF4
-  INTEGER ::  NF90_MPIIO
-  INTEGER ::  NF90_CHUNKED
-  
-  INTEGER,EXTERNAL :: NF90_CREATE_PAR
-  INTEGER,EXTERNAL :: NF90_DEF_VAR_CHUNKING 
-#endif
-
-#ifdef CPP_NF90_DEF_VAR_CHUNKING
-  INTEGER,EXTERNAL :: NF90_DEF_VAR_CHUNKING 
-#endif
-
-END MODULE netcdf_mod
-
-#ifndef CPP_NETCDF4
-   SUBROUTINE NF90_CREATE_PAR
-   END
-   
-   SUBROUTINE NF90_DEF_VAR_CHUNKING
-   END
-#endif
-
-#ifdef CPP_NF90_DEF_VAR_CHUNKING
-   SUBROUTINE NF90_DEF_VAR_CHUNKING
-   END
-#endif
-
-
-#else
-
-  LOGICAL,PARAMETER :: no_io = .TRUE.
-
-  INTEGER ::  NF90_NETCDF4
-  INTEGER ::  NF90_MPIIO
-  INTEGER ::  NF90_CHUNKED
-  
-  INTEGER,EXTERNAL :: NF90_CREATE_PAR
-  INTEGER,EXTERNAL :: NF90_DEF_VAR_CHUNKING 
-  INTEGER,EXTERNAL :: NF90_CREATE
-  INTEGER,EXTERNAL ::  NF90_DEF_DIM
-  INTEGER,EXTERNAL :: NF90_PUT_ATT
-  INTEGER,EXTERNAL :: NF90_ENDDEF  
-  INTEGER,EXTERNAL :: NF90_CLOSE
-  INTEGER,EXTERNAL :: NF90_SYNC
-  INTEGER,EXTERNAL :: NF90_OPEN
-  INTEGER,EXTERNAL :: NF90_INQ_VARID
-  INTEGER,EXTERNAL :: NF90_GET_ATT
-  
-  INTEGER ::  NF90_NOWRITE  
-  INTEGER :: NF90_CLOBBER
-  INTEGER ::  NF90_UNLIMITED
-  INTEGER :: NF90_DOUBLE
-  INTEGER :: NF90_FLOAT
-  INTEGER :: NF90_GLOBAL
-  
-  INTERFACE nf90_put_var
-    MODULE PROCEDURE   nf90_put_var_int0, nf90_put_var_int1, nf90_put_var_int2, nf90_put_var_int3,&
-                                                 nf90_put_var_real0, nf90_put_var_real1, nf90_put_var_real2, nf90_put_var_real3
-  END INTERFACE nf90_put_var
-
-  INTERFACE nf90_get_var
-    MODULE PROCEDURE   nf90_get_var_int0, nf90_get_var_int1, nf90_get_var_int2, nf90_get_var_int3,&
-                                                 nf90_get_var_real0, nf90_get_var_real1, nf90_get_var_real2, nf90_get_var_real3
-  END INTERFACE nf90_get_var
-  
- CONTAINS
-   
-   function nf90_def_var(ncid, name, xtype, dimids, varid)
-        integer,                         intent( in) :: ncid
-        character (len = *),             intent( in) :: name
-        integer,                         intent( in) :: xtype
-        integer, dimension(:), optional, intent( in) :: dimids
-        integer,                         intent(out) :: varid
-        integer                                      :: nf90_def_var
-    end function nf90_def_var
-    
-    
-    function nf90_put_var_int0(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        integer,                          intent( in) :: values
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_put_var_int0
-    end function nf90_put_var_int0
-
-    function nf90_put_var_int1(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        integer,                          intent( in) :: values(:)
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_put_var_int1
-    end function nf90_put_var_int1
-
-    function nf90_put_var_int2(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        integer,                          intent( in) :: values(:,:)
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_put_var_int2
-    end function nf90_put_var_int2
-
-    function nf90_put_var_int3(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        integer,                          intent( in) :: values(:,:,:)
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_put_var_int3
-    end function nf90_put_var_int3
-    
-    function nf90_put_var_real0(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        real,                              intent( in) :: values
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_put_var_real0   
-   end function nf90_put_var_real0
-
-    function nf90_put_var_real1(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        real,                              intent( in) :: values(:)
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_put_var_real1   
-   end function nf90_put_var_real1
-
-    function nf90_put_var_real2(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        real,                              intent( in) :: values(:,:)
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_put_var_real2   
-   end function nf90_put_var_real2
-
-    function nf90_put_var_real3(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        real,                              intent( in) :: values(:,:,:)
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_put_var_real3   
-   end function nf90_put_var_real3
- 
- 
-     function nf90_get_var_int0(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        integer,                          intent( out) :: values
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_get_var_int0
-    end function nf90_get_var_int0
-
-    function nf90_get_var_int1(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        integer,                          intent( out) :: values(:)
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_get_var_int1
-    end function nf90_get_var_int1
-
-    function nf90_get_var_int2(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        integer,                          intent( out) :: values(:,:)
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_get_var_int2
-    end function nf90_get_var_int2
-
-    function nf90_get_var_int3(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        integer,                          intent( out) :: values(:,:,:)
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_get_var_int3
-    end function nf90_get_var_int3
-    
-    function nf90_get_var_real0(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        real,                              intent( out) :: values
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_get_var_real0   
-   end function nf90_get_var_real0
-
-    function nf90_get_var_real1(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        real,                              intent( out) :: values(:)
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_get_var_real1   
-   end function nf90_get_var_real1
-
-    function nf90_get_var_real2(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        real,                              intent( out) :: values(:,:)
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_get_var_real2   
-   end function nf90_get_var_real2
-
-    function nf90_get_var_real3(ncid, varid, values, start, count, stride, map)
-        integer,                         intent( in) :: ncid, varid
-        real,                              intent( out) :: values(:,:,:)
-        integer, dimension(:), optional, intent( in) :: start, count, stride, map
-        integer                                      :: nf90_get_var_real3   
-   end function nf90_get_var_real3
-  
-END MODULE netcdf_mod
-
-  SUBROUTINE NF90_CREATE_PAR
-  END
-  
- SUBROUTINE NF90_DEF_VAR_CHUNKING 
- END
- 
- SUBROUTINE NF90_CREATE
- END
- 
- SUBROUTINE  NF90_DEF_DIM
- END
- 
- SUBROUTINE NF90_PUT_ATT
- END
- 
- SUBROUTINE NF90_ENDDEF 
- END
-  
- SUBROUTINE NF90_CLOSE
- END
- 
- SUBROUTINE NF90_SYNC
- END
- 
- SUBROUTINE NF90_OPEN
- END
- 
- SUBROUTINE NF90_INQ_VARID
- END
- 
- SUBROUTINE NF90_GET_ATT
- END
-
-#endif
-
Index: codes/icosagcm/devel/src/observable.f90
===================================================================
--- codes/icosagcm/devel/src/observable.f90	(revision 531)
+++ 	(revision )
@@ -1,332 +1,0 @@
-MODULE observable_mod
-  USE icosa
-  IMPLICIT NONE
-  PRIVATE
-
-  TYPE(t_field),POINTER, SAVE :: f_buf_i(:), &
-       f_buf_uh(:), & ! horizontal velocity, different from prognostic velocity if NH
-       f_buf_ulon(:), f_buf_ulat(:), &
-       f_buf_u3d(:) ! unused, remove ?
-  TYPE(t_field),POINTER, SAVE :: f_buf1_i(:), f_buf2_i(:)
-  TYPE(t_field),POINTER, SAVE :: f_buf_v(:), f_buf_s(:), f_buf_p(:)
-  TYPE(t_field),POINTER, SAVE :: f_pmid(:)
-
-! temporary shared variable for caldyn
-  TYPE(t_field),POINTER, SAVE :: f_theta(:)
-
-  PUBLIC init_observable, write_output_fields_basic, f_theta
-
-CONTAINS
-  
-  SUBROUTINE init_observable
-    CALL allocate_field(f_buf_i,   field_t,type_real,llm,name="buffer_i")
-    CALL allocate_field(f_buf1_i,   field_t,type_real,llm,name="buffer1_i")
-    CALL allocate_field(f_buf2_i,   field_t,type_real,llm,name="buffer2_i")
-    CALL allocate_field(f_buf_p,   field_t,type_real,llm+1) 
-    CALL allocate_field(f_buf_u3d, field_t,type_real,3,llm)  ! 3D vel at cell centers
-    CALL allocate_field(f_buf_ulon,field_t,type_real,llm, name="buf_ulon")
-    CALL allocate_field(f_buf_ulat,field_t,type_real,llm, name="buf_ulat")
-    CALL allocate_field(f_buf_uh,  field_u,type_real,llm, name="buf_uh")
-    CALL allocate_field(f_buf_v,   field_z,type_real,llm, name="buf_v")
-    CALL allocate_field(f_buf_s,   field_t,type_real, name="buf_s")
-
-    CALL allocate_field(f_theta, field_t,type_real,llm,nqdyn,  name='theta') ! potential temperature
-    CALL allocate_field(f_pmid,  field_t,type_real,llm,  name='pmid')       ! mid layer pressure
-  END SUBROUTINE init_observable
-
-  SUBROUTINE write_output_fields_basic(init, f_phis, f_ps, f_mass, f_geopot, f_theta_rhodz, f_u, f_W, f_q)
-    USE xios_mod
-    USE disvert_mod
-    USE wind_mod
-    USE output_field_mod
-    USE omp_para
-    USE time_mod
-    USE xios_mod
-    USE earth_const
-    USE pression_mod
-    USE vertical_interp_mod
-    USE theta2theta_rhodz_mod
-    USE omega_mod
-    LOGICAL, INTENT(IN) :: init
-    INTEGER :: l
-    REAL :: scalar(1)
-    REAL :: mid_ap(llm)
-    REAL :: mid_bp(llm)
-
-    TYPE(t_field),POINTER :: f_phis(:), f_ps(:), f_mass(:), f_geopot(:), f_theta_rhodz(:), f_u(:), f_W(:), f_q(:)
-!    IF (is_master) PRINT *,'CALL write_output_fields_basic'
-
-    CALL transfert_request(f_ps,req_i1)
-    
-    IF(init) THEN
-       scalar(1)=dt
-       IF (is_omp_master) CALL xios_send_field("timestep", scalar)
-       scalar(1)=preff
-       IF (is_omp_master) CALL xios_send_field("preff", scalar)
-       IF (is_omp_master) CALL xios_send_field("ap",ap)
-       IF (is_omp_master) CALL xios_send_field("bp",bp)
-       DO l=1,llm
-          mid_ap(l)=(ap(l)+ap(l+1))/2
-          mid_bp(l)=(bp(l)+bp(l+1))/2
-       ENDDO
-       IF (is_omp_master) CALL xios_send_field("mid_ap",mid_ap)
-       IF (is_omp_master) CALL xios_send_field("mid_bp",mid_bp)
-
-       CALL output_field("phis",f_phis)
-       CALL output_field("Ai",geom%Ai)       
-    END IF
-
-    IF(nqdyn>1) THEN
-       CALL divide_by_mass(2, f_mass, f_theta_rhodz, f_buf_i)
-       IF(init) THEN
-          CALL output_field("dyn_q_init",f_buf_i)
-       ELSE
-          CALL output_field("dyn_q",f_buf_i)
-       END IF
-    END IF
-
-    CALL divide_by_mass(1, f_mass, f_theta_rhodz, f_buf_i)
-    IF(init) THEN
-       CALL output_field("theta_init",f_buf_i)
-    ELSE
-       CALL output_field("theta",f_buf_i)
-    END IF
-
-    CALL pression_mid(f_ps, f_pmid)
-    CALL diagnose_temperature(f_pmid, f_q, f_buf_i) ! f_buf_i : IN = theta, out = T
-
-    IF(init) THEN
-       CALL output_field("temp_init",f_buf_i)
-    ELSE
-       CALL output_field("temp",f_buf_i)
-       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,85000.)
-       CALL output_field("t850",f_buf_s)
-       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,50000.)
-       CALL output_field("t500",f_buf_s)
-       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,preff)
-       CALL output_field("SST",f_buf_s)       
-    END IF
-    
-    CALL progonostic_vel_to_horiz(f_geopot, f_ps, f_mass, f_u, f_W, f_buf_uh, f_buf_i)
-    CALL transfert_request(f_buf_uh,req_e1_vect) 
-    CALL un2ulonlat(f_buf_uh, f_buf_ulon, f_buf_ulat)
-    IF(init) THEN
-       CALL output_field("uz_init",f_buf_i)
-       CALL output_field("ulon_init",f_buf_ulon)
-       CALL output_field("ulat_init",f_buf_ulat)
-       CALL output_field("p_init",f_pmid)
-       CALL output_field("ps_init",f_ps)
-       CALL output_field("mass_init",f_mass)
-       CALL output_field("geopot_init",f_geopot)
-       CALL output_field("q_init",f_q)
-    ELSE
-       CALL output_field("uz",f_buf_i)
-       CALL output_field("ulon",f_buf_ulon)
-       CALL output_field("ulat",f_buf_ulat)
-       CALL output_field("p",f_pmid)
-       CALL output_field("ps",f_ps)
-       CALL output_field("mass",f_mass)
-       CALL output_field("geopot",f_geopot)
-       CALL output_field("q",f_q)
-
-       !       CALL output_field("exner",f_pk)
-       !       CALL output_field("pv",f_qv)
-       
-       CALL vertical_interp(f_pmid,f_buf_ulon,f_buf_s,85000.)
-       CALL output_field("u850",f_buf_s)
-       CALL vertical_interp(f_pmid,f_buf_ulon,f_buf_s,50000.)
-       CALL output_field("u500",f_buf_s)
-       
-       CALL vertical_interp(f_pmid,f_buf_ulat,f_buf_s,85000.)
-       CALL output_field("v850",f_buf_s)
-       CALL vertical_interp(f_pmid,f_buf_ulat,f_buf_s,50000.)
-       CALL output_field("v500",f_buf_s)
-
-       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,85000.)
-       CALL output_field("w850",f_buf_s)
-       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,50000.)
-       CALL output_field("w500",f_buf_s)    
-
-       CALL w_omega(f_ps, f_u, f_buf_i)
-       CALL output_field("omega",f_buf_i)
-       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,85000.)
-       CALL output_field("omega850",f_buf_s)
-       CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,50000.)
-       CALL output_field("omega500",f_buf_s)
-    END IF
-
-  END SUBROUTINE write_output_fields_basic
-  
- !------------------- Conversion from prognostic to observable variables ------------------
-
-  SUBROUTINE progonostic_vel_to_horiz(f_geopot, f_ps, f_rhodz, f_u, f_W, f_uh, f_uz)
-    USE disvert_mod
-    TYPE(t_field), POINTER :: f_geopot(:), f_ps(:), f_rhodz(:), &
-         f_u(:), f_W(:), f_uz(:), &  ! IN
-         f_uh(:)                         ! OUT
-    REAL(rstd),POINTER :: geopot(:,:), ps(:), rhodz(:,:), u(:,:), W(:,:), uh(:,:), uz(:,:)
-    INTEGER :: ind
-    
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       geopot = f_geopot(ind)
-       rhodz = f_rhodz(ind)
-       u = f_u(ind)
-       W = f_W(ind)
-       uh  = f_uh(ind)
-       IF(caldyn_eta==eta_mass) THEN
-          ps=f_ps(ind)
-          CALL compute_rhodz(.TRUE., ps, rhodz)
-       END IF
-       uz = f_uz(ind)
-       CALL compute_prognostic_vel_to_horiz(geopot,rhodz,u,W,uh,uz)
-    END DO
-  END SUBROUTINE progonostic_vel_to_horiz
-  
-  SUBROUTINE compute_prognostic_vel_to_horiz(Phi, rhodz, u, W, uh, uz)
-    USE omp_para
-    REAL(rstd), INTENT(IN) :: Phi(iim*jjm,llm+1)
-    REAL(rstd), INTENT(IN) :: rhodz(iim*jjm,llm)
-    REAL(rstd), INTENT(IN) :: u(3*iim*jjm,llm)
-    REAL(rstd), INTENT(IN) :: W(iim*jjm,llm+1)
-    REAL(rstd), INTENT(OUT) :: uh(3*iim*jjm,llm)
-    REAL(rstd), INTENT(OUT) :: uz(iim*jjm,llm)
-    INTEGER :: ij,l
-    REAL(rstd) :: F_el(3*iim*jjm,llm+1)
-    REAL(rstd) :: uu_right, uu_lup, uu_ldown, W_el, DePhil
-    ! NB : u and uh are not in DEC form, they are normal components    
-    ! => we must divide by de
-    IF(hydrostatic) THEN
-       uh(:,:)=u(:,:)
-       uz(:,:)=0.
-    ELSE
-       DO l=ll_begin, ll_endp1 ! compute on l levels (interfaces)
-          DO ij=ij_begin_ext, ij_end_ext
-             ! Compute on edge 'right'
-             W_el   = .5*( W(ij,l)+W(ij+t_right,l) )
-             DePhil = ne_right*(Phi(ij+t_right,l)-Phi(ij,l))
-             F_el(ij+u_right,l)   = DePhil*W_el/de(ij+u_right)
-             ! Compute on edge 'lup'
-             W_el   = .5*( W(ij,l)+W(ij+t_lup,l) )
-             DePhil = ne_lup*(Phi(ij+t_lup,l)-Phi(ij,l))
-             F_el(ij+u_lup,l)   = DePhil*W_el/de(ij+u_lup)
-             ! Compute on edge 'ldown'
-             W_el   = .5*( W(ij,l)+W(ij+t_ldown,l) )
-             DePhil = ne_ldown*(Phi(ij+t_ldown,l)-Phi(ij,l))
-             F_el(ij+u_ldown,l) = DePhil*W_el/de(ij+u_ldown)
-          END DO
-       END DO
-
-       DO l=ll_begin, ll_end ! compute on k levels (full levels)
-          DO ij=ij_begin_ext, ij_end_ext
-             ! w = vertical momentum = g^-2*dPhi/dt = uz/g
-             uz(ij,l) = (.5*g)*(W(ij,l)+W(ij,l+1))/rhodz(ij,l)
-             ! uh = u-w.grad(Phi) = u - uz.grad(z)
-             uh(ij+u_right,l) = u(ij+u_right,l) - (F_el(ij+u_right,l)+F_el(ij+u_right,l+1)) / (rhodz(ij,l)+rhodz(ij+t_right,l))
-             uh(ij+u_lup,l)   = u(ij+u_lup,l)   - (F_el(ij+u_lup,l)+F_el(ij+u_lup,l+1))     / (rhodz(ij,l)+rhodz(ij+t_lup,l))
-             uh(ij+u_ldown,l) = u(ij+u_ldown,l) - (F_el(ij+u_ldown,l)+F_el(ij+u_ldown,l+1)) / (rhodz(ij,l)+rhodz(ij+t_ldown,l))
-          END DO
-       END DO
-
-    END IF
-  END SUBROUTINE compute_prognostic_vel_to_horiz
-
-  SUBROUTINE diagnose_temperature(f_pmid,f_q,f_temp)
-    USE icosa
-    USE pression_mod
-    IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_pmid(:)           ! IN
-    TYPE(t_field), POINTER :: f_q(:)            ! IN
-    TYPE(t_field), POINTER :: f_temp(:)         ! INOUT
-    
-    REAL(rstd), POINTER :: pmid(:,:)
-    REAL(rstd), POINTER :: q(:,:,:)
-    REAL(rstd), POINTER :: temp(:,:)
-    INTEGER :: ind
-    
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       pmid=f_pmid(ind)
-       q=f_q(ind)
-       temp=f_temp(ind)
-       CALL compute_diagnose_temp(pmid,q,temp)
-    END DO
-  END SUBROUTINE diagnose_temperature
-  
-  SUBROUTINE compute_diagnose_temp(pmid,q,temp)
-    USE omp_para
-    USE pression_mod
-    REAL(rstd),INTENT(IN)    :: pmid(iim*jjm,llm)
-    REAL(rstd),INTENT(IN)    :: q(iim*jjm,llm,nqtot)
-    REAL(rstd),INTENT(INOUT) :: temp(iim*jjm,llm)
-
-    REAL(rstd) :: Rd, p_ik, theta_ik, temp_ik, qv, chi, Rmix
-    INTEGER :: ij,l
-
-    Rd = kappa*cpp
-    DO l=ll_begin,ll_end
-       DO ij=ij_begin,ij_end
-          p_ik = pmid(ij,l)
-          theta_ik = temp(ij,l)
-          qv = q(ij,l,1) ! water vaper mixing ratio = mv/md
-          SELECT CASE(caldyn_thermo)
-          CASE(thermo_theta)
-             temp_ik = theta_ik*((p_ik/preff)**kappa)
-          CASE(thermo_entropy)
-             temp_ik = Treff*exp((theta_ik + Rd*log(p_ik/preff))/cpp)
-          CASE(thermo_moist)
-             Rmix = Rd+qv*Rv
-             chi = ( theta_ik + Rmix*log(p_ik/preff) ) / (cpp + qv*cppv) ! log(T/Treff)
-             temp_ik = Treff*exp(chi)
-          END SELECT
-          IF(physics_thermo==thermo_fake_moist) temp_ik=temp_ik/(1+0.608*qv)
-          temp(ij,l)=temp_ik
-       END DO
-    END DO
-  END SUBROUTINE compute_diagnose_temp
-
-  SUBROUTINE Tv2T(f_Tv, f_q, f_T)
-    TYPE(t_field), POINTER :: f_TV(:)
-    TYPE(t_field), POINTER :: f_q(:)
-    TYPE(t_field), POINTER :: f_T(:)
-    
-    REAL(rstd),POINTER :: Tv(:,:), q(:,:,:), T(:,:)
-    INTEGER :: ind
-    
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       Tv=f_Tv(ind)
-       T=f_T(ind)
-       SELECT CASE(physics_thermo)
-       CASE(thermo_dry)
-          T=Tv
-       CASE(thermo_fake_moist)
-          q=f_q(ind)
-          T=Tv/(1+0.608*q(:,:,1))
-       END SELECT
-    END DO
-  END SUBROUTINE Tv2T
-
-  SUBROUTINE divide_by_mass(iq, f_mass, f_theta_rhodz, f_theta)
-    INTEGER, INTENT(IN) :: iq
-    TYPE(t_field), POINTER :: f_mass(:), f_theta_rhodz(:), f_theta(:)
-    REAL(rstd), POINTER :: mass(:,:), theta_rhodz(:,:,:), theta(:,:)
-    INTEGER :: ind
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       mass=f_mass(ind)
-       theta_rhodz=f_theta_rhodz(ind)
-       theta=f_theta(ind)
-       theta(:,:) = theta_rhodz(:,:,iq) / mass(:,:)
-    END DO
-  END SUBROUTINE divide_by_mass
-    
-END MODULE observable_mod
Index: codes/icosagcm/devel/src/omega.f90
===================================================================
--- codes/icosagcm/devel/src/omega.f90	(revision 531)
+++ 	(revision )
@@ -1,157 +1,0 @@
-MODULE omega_mod
-
-  USE icosa
-  PRIVATE
-
-  PUBLIC :: w_omega, compute_omega
-
-CONTAINS
-
-  SUBROUTINE w_omega(f_ps, f_u, f_omega) ! Compute omega = Dp/Dt
-    TYPE(t_field),POINTER :: f_ps(:), f_u(:), f_omega(:)
-    INTEGER :: ind
-    REAL(rstd),POINTER :: ps(:), u(:,:), om(:,:)
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       ps=f_ps(ind)
-       u=f_u(ind)
-       om=f_omega(ind)
-       CALL compute_omega(ps,u,om)
-    END DO
-  END SUBROUTINE W_omega
-
-
-
-  SUBROUTINE compute_omega(ps,u, w)
-    USE disvert_mod, ONLY : ap,bp
-    USE omp_para
-    IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: u(iim*3*jjm,llm), ps(iim*jjm)
-    REAL(rstd),INTENT(OUT):: w(iim*jjm,llm)
-    REAL(rstd):: convm(iim*jjm,llm+1)
-    REAL(rstd):: p(iim*jjm,llm+1), rhodz(iim*jjm,llm), Fe(iim*3*jjm,llm)
-    REAL(rstd):: ugradps
-    
-    INTEGER :: i,j,l,ij
-
-!$OMP BARRIER    
-    IF (is_omp_level_master) THEN
-      DO    l    = 1, llm+1
-         DO j=jj_begin-1,jj_end+1
-           DO i=ii_begin-1,ii_end+1
-               ij=(j-1)*iim+i
-               p(ij,l) = ap(l) + bp(l) * ps(ij)
-            ENDDO
-         ENDDO
-      ENDDO
-    
-!!! Compute mass
-      DO l = 1, llm
-         DO j=jj_begin-1,jj_end+1
-            DO i=ii_begin-1,ii_end+1
-               ij=(j-1)*iim+i
-               rhodz(ij,l) = ( p(ij,l) - p(ij,l+1) ) / g
-            ENDDO
-         ENDDO
-      ENDDO
-    
-!!!  Compute mass flux
-      DO l = 1, llm
-         DO j=jj_begin-1,jj_end+1
-            DO i=ii_begin-1,ii_end+1
-               ij=(j-1)*iim+i
-               Fe(ij+u_right,l)=0.5*(rhodz(ij,l)+rhodz(ij+t_right,l))*u(ij+u_right,l)*le(ij+u_right)
-               Fe(ij+u_lup,l)=0.5*(rhodz(ij,l)+rhodz(ij+t_lup,l))*u(ij+u_lup,l)*le(ij+u_lup)
-               Fe(ij+u_ldown,l)=0.5*(rhodz(ij,l)+rhodz(ij+t_ldown,l))*u(ij+u_ldown,l)*le(ij+u_ldown)
-            ENDDO
-         ENDDO
-      ENDDO
-    
-!!! mass flux convergence computation  
-    
-    ! horizontal convergence
-      DO l = 1, llm
-         DO j=jj_begin,jj_end
-            DO i=ii_begin,ii_end
-               ij=(j-1)*iim+i
-               ! convm = +div(mass flux), sign convention as in Ringler et al. 2012, eq. 21
-               convm(ij,l)= 1./Ai(ij)*(ne(ij,right)*Fe(ij+u_right,l)   +  &
-                    ne(ij,rup)*Fe(ij+u_rup,l)       +  &  
-                    ne(ij,lup)*Fe(ij+u_lup,l)       +  &  
-                    ne(ij,left)*Fe(ij+u_left,l)     +  &  
-                    ne(ij,ldown)*Fe(ij+u_ldown,l)   +  &  
-                    ne(ij,rdown)*Fe(ij+u_rdown,l))
-            ENDDO
-         ENDDO
-      ENDDO
-    
-      ! vertical integration from up to down
-      DO  l = llm-1, 1, -1
-         DO j=jj_begin,jj_end
-            DO i=ii_begin,ii_end
-               ij=(j-1)*iim+i
-               convm(ij,l) = convm(ij,l) + convm(ij,l+1)
-            ENDDO
-         ENDDO
-      ENDDO
-      convm(:,llm+1)=0.
-
-!!! Compute dps
-    !  DO j=jj_begin,jj_end
-    !    DO i=ii_begin,ii_end
-    !      ij=(j-1)*iim+i
-    !      ! dps/dt = -int(div flux)dz
-    !      dps(ij)=-convm(ij,1) * g 
-    !      convm(ij,llm+1)=0.
-    !    ENDDO
-    !  ENDDO
-    
-    ! Compute Omega = Dp/Dt
-    ! with p = A(eta)+B(eta)ps
-    !      Dp/Dt = dp/deta.Deta/Dt + B(eta)Dps/Dt
-    !            = -mg.Deta/Dt + B.Dps/Dt
-    ! By definition the mass flux through model levels is W=m.Deta/Dt with m=-1/g dp/deta
-    ! therefore 
-    !  Dp/Dt = -g.W + B.dps/dt + Bu.grad ps
-    !        = B.u.grad ps - g*convm
-    
-!!! Compute vertical flux through model layers
-    !  DO l = 1,llm-1
-    !    DO j=jj_begin,jj_end
-    !      DO i=ii_begin,ii_end
-    !        ij=(j-1)*iim+i
-    !        ! w = int(z,ztop,div(flux)dz) + B(eta)dps/dt
-    !        ! => w>0 for upward transport
-    !        w( ij, l+1 ) = convm( ij, l+1 ) - bp(l+1) * convm( ij, 1 ) ! g.W = g.convm + B dps/dt
-    !      ENDDO
-    !    ENDDO
-    !  ENDDO
-    
-    
-!!! Compute omega
-    ! -grad ps : ( ne(ij,ldown)*ps(ij,l) + ne(ij+t_ldown,rup)*ps(ij+t_ldown,l) ) ) / de(ij+u_ldown)
-
-       DO l = 1,llm
-         DO j=jj_begin,jj_end 
-           DO i=ii_begin,ii_end
-             ij=(j-1)*iim+i
-             ugradps = &
-                  le(ij+u_right)*u(ij+u_right,l)*( ne(ij,right)*ps(ij) + ne(ij+t_right,left)*ps(ij+t_right) )  &
-                  + le(ij+u_rup)*u(ij+u_rup,l)*( ne(ij,rup)*ps(ij) + ne(ij+t_rup,ldown)*ps(ij+t_rup) )  &
-                  + le(ij+u_lup)*u(ij+u_lup,l)*( ne(ij,lup)*ps(ij) + ne(ij+t_lup,rdown)*ps(ij+t_lup) )         &
-                  + le(ij+u_left)*u(ij+u_left,l)*( ne(ij,left)*ps(ij) + ne(ij+t_left,right)*ps(ij+t_left) )    &
-                  + le(ij+u_ldown)*u(ij+u_ldown,l)*( ne(ij,ldown)*ps(ij) + ne(ij+t_ldown,rup)*ps(ij+t_ldown) ) &
-                  + le(ij+u_rdown)*u(ij+u_rdown,l)*( ne(ij,rdown)*ps(ij) + ne(ij+t_rdown,lup)*ps(ij+t_rdown) )
-             ugradps = .5*(bp(l)+bp(l+1)) *ugradps/(-4*Ai(ij))  ! sign convention as in Ringler et al. 2010, Eq. 22 p.3072
-             w( ij, l) =  ugradps - g*.5*(convm( ij,l+1)+convm(ij,l)) 
-          ENDDO
-        ENDDO
-      ENDDO
-    ENDIF
-!$OMP BARRIER
-    
-  END SUBROUTINE compute_omega
-  
-END MODULE omega_mod
Index: codes/icosagcm/devel/src/omp_para.F90
===================================================================
--- codes/icosagcm/devel/src/omp_para.F90	(revision 531)
+++ 	(revision )
@@ -1,273 +1,0 @@
-MODULE omp_para
-
-  INTEGER,SAVE :: omp_size
-  INTEGER,SAVE :: omp_rank
-!$OMP THREADPRIVATE(omp_rank)
-
-  LOGICAL,SAVE :: is_omp_first_level
-  LOGICAL,SAVE :: is_omp_last_level
-  LOGICAL,SAVE :: is_omp_master
-!$OMP THREADPRIVATE(is_omp_first_level, is_omp_last_level,is_omp_master)
-
-  INTEGER,SAVE :: ll_begin
-  INTEGER,SAVE :: ll_beginp1
-  INTEGER,SAVE :: ll_end
-  INTEGER,SAVE :: ll_endm1
-  INTEGER,SAVE :: ll_endp1
-!$OMP THREADPRIVATE(ll_begin,ll_beginp1,ll_end,ll_endm1,ll_endp1)
-  LOGICAL,SAVE :: using_openmp
-  
-  INTEGER,SAVE :: omp_domain_size
-  INTEGER,SAVE :: omp_domain_rank
-  INTEGER,SAVE :: omp_level_size
-  INTEGER,SAVE :: omp_level_rank
-!$OMP THREADPRIVATE( omp_domain_size, omp_level_size,omp_domain_rank,omp_level_rank)
-  LOGICAL,SAVE :: is_omp_domain_master
-  LOGICAL,SAVE :: is_omp_level_master
-!$OMP THREADPRIVATE(is_omp_domain_master,is_omp_level_master )
-  
-  LOGICAL,PARAMETER :: omp_by_domain=.TRUE. 
-  LOGICAL,SAVE :: is_master
-!$OMP THREADPRIVATE(is_master)
-
-
-   LOGICAL,SAVE :: is_omp_first_level_full
-   LOGICAL,SAVE :: is_omp_last_level_full
-   INTEGER,SAVE :: ll_begin_full
-   INTEGER,SAVE :: ll_beginp1_full
-   INTEGER,SAVE :: ll_end_full
-   INTEGER,SAVE :: ll_endm1_full
-   INTEGER,SAVE :: ll_endp1_full
-!$OMP THREADPRIVATE(is_omp_first_level_full,is_omp_last_level_full)   
-!$OMP THREADPRIVATE( ll_begin_full, ll_beginp1_full, ll_end_full, ll_endm1_full, ll_endp1_full)
-  PRIVATE :: is_omp_first_level_full,is_omp_last_level_full
-  PRIVATE :: ll_begin_full, ll_beginp1_full, ll_end_full, ll_endm1_full, ll_endp1_full 
-  
-
-   LOGICAL,SAVE :: is_omp_first_level_distrib
-   LOGICAL,SAVE :: is_omp_last_level_distrib
-   INTEGER,SAVE :: ll_begin_distrib
-   INTEGER,SAVE :: ll_beginp1_distrib
-   INTEGER,SAVE :: ll_end_distrib
-   INTEGER,SAVE :: ll_endm1_distrib
-   INTEGER,SAVE :: ll_endp1_distrib
-!$OMP THREADPRIVATE(is_omp_first_level_distrib,is_omp_last_level_distrib)   
-!$OMP THREADPRIVATE( ll_begin_distrib, ll_beginp1_distrib, ll_end_distrib, ll_endm1_distrib, ll_endp1_distrib)
-
-  PRIVATE :: is_omp_first_level_distrib,is_omp_last_level_distrib
-  PRIVATE :: ll_begin_distrib, ll_beginp1_distrib, ll_end_distrib, ll_endm1_distrib, ll_endp1_distrib 
-
-CONTAINS
-
-  SUBROUTINE init_omp_para(is_mpi_master)
-  USE grid_param
-  USE ioipsl, ONLY : getin
-#ifdef CPP_USING_OMP
-  USE omp_lib
-#endif
-  IMPLICIT NONE
-  LOGICAL, INTENT(IN) :: is_mpi_master
-  INTEGER :: ll_nb,i,llb,lle
-
-#ifdef CPP_USING_OMP
-  using_openmp=.TRUE.
-#else
-  using_openmp=.FALSE.
-#endif
-
-  IF (using_openmp) THEN    
-!$OMP PARALLEL PRIVATE(ll_nb,i,llb,lle)
-  
-!$OMP MASTER
-#ifdef CPP_USING_OMP
-    omp_size=OMP_GET_NUM_THREADS()
-#endif
-!$OMP END MASTER
-!$OMP BARRIER
-#ifdef CPP_USING_OMP
-    omp_rank=OMP_GET_THREAD_NUM()
-#endif
-    
-    is_omp_master=.FALSE.
-    is_master=.FALSE.
-      
-    IF (omp_rank==0) THEN
-      is_omp_master=.TRUE.
-      IF (is_mpi_master) is_master=.TRUE.
-    ENDIF
-
-    !$OMP CRITICAL
-    omp_level_size=1
-    CALL getin("omp_level_size",omp_level_size)
-    !$OMP END CRITICAL
-
-    IF(is_mpi_master) PRINT *,'GETIN omp_level_size', ' = ', omp_level_size
-
-    IF (MOD(omp_size,omp_level_size)/=0) THEN
-      IF (is_mpi_master) PRINT*,"omp_size /= omp_level_size x omp_domain_size  => disable omp threads on vertical layers"
-      omp_level_size=1
-    ENDIF
-    omp_domain_size=omp_size/omp_level_size
-    omp_domain_rank = omp_rank / omp_level_size    
-    omp_level_rank = MOD(omp_rank, omp_level_size)    
-    
-    IF (is_mpi_master) PRINT*,"omp_domain_size",omp_domain_size,"omp_domain_rank", omp_domain_rank
-    IF (is_mpi_master) PRINT*,"omp_level_size",omp_level_size,"omp_level_rank", omp_level_rank
-    
-    is_omp_first_level=.FALSE.
-    is_omp_last_level= .FALSE.
-    is_omp_domain_master=.FALSE.
-    is_omp_level_master=.FALSE.
-
-    IF (omp_domain_rank==0) is_omp_domain_master = .TRUE.
-    IF (omp_level_rank==0) is_omp_level_master = .TRUE.
-    IF (omp_level_rank==0) is_omp_first_level=.TRUE.
-    
-    IF (omp_level_rank==omp_level_size-1) is_omp_last_level=.TRUE.
-    
-    lle=0
-    
-    DO i=0,omp_level_rank
-      llb=lle+1
-      ll_nb=llm/omp_level_size
-      IF (MOD(llm,omp_level_size)>i) ll_nb=ll_nb+1
-      lle=llb+ll_nb-1
-    ENDDO
-    ll_begin=llb
-    ll_end=lle
-    
-    ll_beginp1=ll_begin
-    ll_endp1=ll_end
-    ll_endm1=ll_end
-
-    IF (is_omp_first_level) ll_beginp1=ll_begin+1
-    IF (is_omp_last_level) ll_endp1=ll_endp1+1
-    IF (is_omp_last_level) ll_endm1=ll_endm1-1
-    
-    
-    
-    is_omp_first_level_distrib = is_omp_first_level
-    is_omp_last_level_distrib  = is_omp_last_level
-    ll_begin_distrib           = ll_begin
-    ll_beginp1_distrib         = ll_beginp1
-    ll_end_distrib             = ll_end
-    ll_endm1_distrib           = ll_endm1
-    ll_endp1_distrib           = ll_endp1
-    
-    is_omp_first_level_full = .TRUE.
-    is_omp_last_level_full  = .TRUE.
-    ll_begin_full           = 1
-    ll_beginp1_full         = 2
-    ll_end_full             = llm
-    ll_endm1_full           = llm-1
-    ll_endp1_full           = llm+1    
-
-!$OMP END PARALLEL
-
-   ELSE
-     omp_size=1
-     omp_level_size=1
-     omp_domain_size=1
-     omp_rank=0
-     omp_level_rank=0
-     omp_domain_rank=0
-     is_master=is_mpi_master
-     is_omp_first_level=.TRUE.
-     is_omp_last_level=.TRUE.
-     is_omp_master=.TRUE.
-     is_omp_domain_master=.TRUE.
-     is_omp_level_master=.TRUE.
-     ll_begin=1
-     ll_beginp1=2
-     ll_end=llm
-     ll_endm1=llm-1
-     ll_endp1=llm+1
-     
-     is_omp_first_level_distrib = is_omp_first_level
-     is_omp_last_level_distrib  = is_omp_last_level
-     ll_begin_distrib           = ll_begin
-     ll_beginp1_distrib         = ll_beginp1
-     ll_end_distrib             = ll_end
-     ll_endm1_distrib           = ll_endm1
-     ll_endp1_distrib           = ll_endp1
-    
-     is_omp_first_level_full = .TRUE.
-     is_omp_last_level_full  = .TRUE.
-     ll_begin_full           = 1
-     ll_beginp1_full         = 2
-     ll_end_full             = llm
-     ll_endm1_full           = llm-1
-     ll_endp1_full           = llm+1    
-
-   ENDIF
-   
-  END SUBROUTINE init_omp_para
-
-  SUBROUTINE distrib_level(size,lbegin,lend)
-  IMPLICIT NONE
-    INTEGER,INTENT(IN)  :: size  
-    INTEGER,INTENT(OUT) :: lbegin  
-    INTEGER,INTENT(OUT) :: lend  
-    INTEGER :: div,rest
-    
-    div=size/omp_level_size
-    rest=MOD(size,omp_level_size)
-    IF (omp_level_rank<rest) THEN
-      lbegin=(div+1)*omp_level_rank+1
-      lend=lbegin+div
-    ELSE
-      lbegin=(div+1)*rest + (omp_level_rank-rest)*div+1
-      lend=lbegin+div-1
-    ENDIF
-  END SUBROUTINE distrib_level
-
-
-  SUBROUTINE switch_omp_distrib_level
-  IMPLICIT NONE
-     is_omp_first_level = is_omp_first_level_distrib 
-     is_omp_last_level  = is_omp_last_level_distrib 
-     ll_begin           = ll_begin_distrib 
-     ll_beginp1         = ll_beginp1_distrib 
-     ll_end             = ll_end_distrib 
-     ll_endm1           = ll_endm1_distrib 
-     ll_endp1           = ll_endp1_distrib 
-  
-  END SUBROUTINE switch_omp_distrib_level
-  
-
-  SUBROUTINE switch_omp_no_distrib_level
-  IMPLICIT NONE
-
-     is_omp_first_level = is_omp_first_level_full 
-     is_omp_last_level  = is_omp_last_level_full 
-     ll_begin           = ll_begin_full 
-     ll_beginp1         = ll_beginp1_full 
-     ll_end             = ll_end_full 
-     ll_endm1           = ll_endm1_full 
-     ll_endp1           = ll_endp1_full 
-  
-  END SUBROUTINE switch_omp_no_distrib_level
-  
-
-  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/devel/src/output/free_unit_mod.f90
===================================================================
--- codes/icosagcm/devel/src/output/free_unit_mod.f90	(revision 533)
+++ codes/icosagcm/devel/src/output/free_unit_mod.f90	(revision 533)
@@ -0,0 +1,26 @@
+MODULE free_unit_mod
+
+  PRIVATE 
+
+  INTEGER, PARAMETER :: start_unit=1000
+
+  PUBLIC :: free_unit
+
+CONTAINS
+
+  FUNCTION free_unit()
+    INTEGER :: free_unit
+    LOGICAL :: out
+    
+    out=.FALSE.
+    free_unit=start_unit
+    
+    DO WHILE (.NOT. out)
+      free_unit=free_unit+1
+      INQUIRE(unit=free_unit, exist=out)
+    END DO
+    
+  END FUNCTION free_unit
+  
+END MODULE free_unit_mod
+  
Index: codes/icosagcm/devel/src/output/netcdf_mod.F90
===================================================================
--- codes/icosagcm/devel/src/output/netcdf_mod.F90	(revision 533)
+++ codes/icosagcm/devel/src/output/netcdf_mod.F90	(revision 533)
@@ -0,0 +1,235 @@
+MODULE netcdf_mod
+
+#ifndef CPP_NO_IO
+
+  USE netcdf
+  LOGICAL,PARAMETER :: no_io = .FALSE.
+
+#ifndef CPP_NETCDF4
+  INTEGER ::  NF90_NETCDF4
+  INTEGER ::  NF90_MPIIO
+  INTEGER ::  NF90_CHUNKED
+  
+  INTEGER,EXTERNAL :: NF90_CREATE_PAR
+  INTEGER,EXTERNAL :: NF90_DEF_VAR_CHUNKING 
+#endif
+
+#ifdef CPP_NF90_DEF_VAR_CHUNKING
+  INTEGER,EXTERNAL :: NF90_DEF_VAR_CHUNKING 
+#endif
+
+END MODULE netcdf_mod
+
+#ifndef CPP_NETCDF4
+   SUBROUTINE NF90_CREATE_PAR
+   END
+   
+   SUBROUTINE NF90_DEF_VAR_CHUNKING
+   END
+#endif
+
+#ifdef CPP_NF90_DEF_VAR_CHUNKING
+   SUBROUTINE NF90_DEF_VAR_CHUNKING
+   END
+#endif
+
+
+#else
+
+  LOGICAL,PARAMETER :: no_io = .TRUE.
+
+  INTEGER ::  NF90_NETCDF4
+  INTEGER ::  NF90_MPIIO
+  INTEGER ::  NF90_CHUNKED
+  
+  INTEGER,EXTERNAL :: NF90_CREATE_PAR
+  INTEGER,EXTERNAL :: NF90_DEF_VAR_CHUNKING 
+  INTEGER,EXTERNAL :: NF90_CREATE
+  INTEGER,EXTERNAL ::  NF90_DEF_DIM
+  INTEGER,EXTERNAL :: NF90_PUT_ATT
+  INTEGER,EXTERNAL :: NF90_ENDDEF  
+  INTEGER,EXTERNAL :: NF90_CLOSE
+  INTEGER,EXTERNAL :: NF90_SYNC
+  INTEGER,EXTERNAL :: NF90_OPEN
+  INTEGER,EXTERNAL :: NF90_INQ_VARID
+  INTEGER,EXTERNAL :: NF90_GET_ATT
+  
+  INTEGER ::  NF90_NOWRITE  
+  INTEGER :: NF90_CLOBBER
+  INTEGER ::  NF90_UNLIMITED
+  INTEGER :: NF90_DOUBLE
+  INTEGER :: NF90_FLOAT
+  INTEGER :: NF90_GLOBAL
+  
+  INTERFACE nf90_put_var
+    MODULE PROCEDURE   nf90_put_var_int0, nf90_put_var_int1, nf90_put_var_int2, nf90_put_var_int3,&
+                                                 nf90_put_var_real0, nf90_put_var_real1, nf90_put_var_real2, nf90_put_var_real3
+  END INTERFACE nf90_put_var
+
+  INTERFACE nf90_get_var
+    MODULE PROCEDURE   nf90_get_var_int0, nf90_get_var_int1, nf90_get_var_int2, nf90_get_var_int3,&
+                                                 nf90_get_var_real0, nf90_get_var_real1, nf90_get_var_real2, nf90_get_var_real3
+  END INTERFACE nf90_get_var
+  
+ CONTAINS
+   
+   function nf90_def_var(ncid, name, xtype, dimids, varid)
+        integer,                         intent( in) :: ncid
+        character (len = *),             intent( in) :: name
+        integer,                         intent( in) :: xtype
+        integer, dimension(:), optional, intent( in) :: dimids
+        integer,                         intent(out) :: varid
+        integer                                      :: nf90_def_var
+    end function nf90_def_var
+    
+    
+    function nf90_put_var_int0(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        integer,                          intent( in) :: values
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_put_var_int0
+    end function nf90_put_var_int0
+
+    function nf90_put_var_int1(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        integer,                          intent( in) :: values(:)
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_put_var_int1
+    end function nf90_put_var_int1
+
+    function nf90_put_var_int2(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        integer,                          intent( in) :: values(:,:)
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_put_var_int2
+    end function nf90_put_var_int2
+
+    function nf90_put_var_int3(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        integer,                          intent( in) :: values(:,:,:)
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_put_var_int3
+    end function nf90_put_var_int3
+    
+    function nf90_put_var_real0(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        real,                              intent( in) :: values
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_put_var_real0   
+   end function nf90_put_var_real0
+
+    function nf90_put_var_real1(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        real,                              intent( in) :: values(:)
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_put_var_real1   
+   end function nf90_put_var_real1
+
+    function nf90_put_var_real2(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        real,                              intent( in) :: values(:,:)
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_put_var_real2   
+   end function nf90_put_var_real2
+
+    function nf90_put_var_real3(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        real,                              intent( in) :: values(:,:,:)
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_put_var_real3   
+   end function nf90_put_var_real3
+ 
+ 
+     function nf90_get_var_int0(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        integer,                          intent( out) :: values
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_get_var_int0
+    end function nf90_get_var_int0
+
+    function nf90_get_var_int1(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        integer,                          intent( out) :: values(:)
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_get_var_int1
+    end function nf90_get_var_int1
+
+    function nf90_get_var_int2(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        integer,                          intent( out) :: values(:,:)
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_get_var_int2
+    end function nf90_get_var_int2
+
+    function nf90_get_var_int3(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        integer,                          intent( out) :: values(:,:,:)
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_get_var_int3
+    end function nf90_get_var_int3
+    
+    function nf90_get_var_real0(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        real,                              intent( out) :: values
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_get_var_real0   
+   end function nf90_get_var_real0
+
+    function nf90_get_var_real1(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        real,                              intent( out) :: values(:)
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_get_var_real1   
+   end function nf90_get_var_real1
+
+    function nf90_get_var_real2(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        real,                              intent( out) :: values(:,:)
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_get_var_real2   
+   end function nf90_get_var_real2
+
+    function nf90_get_var_real3(ncid, varid, values, start, count, stride, map)
+        integer,                         intent( in) :: ncid, varid
+        real,                              intent( out) :: values(:,:,:)
+        integer, dimension(:), optional, intent( in) :: start, count, stride, map
+        integer                                      :: nf90_get_var_real3   
+   end function nf90_get_var_real3
+  
+END MODULE netcdf_mod
+
+  SUBROUTINE NF90_CREATE_PAR
+  END
+  
+ SUBROUTINE NF90_DEF_VAR_CHUNKING 
+ END
+ 
+ SUBROUTINE NF90_CREATE
+ END
+ 
+ SUBROUTINE  NF90_DEF_DIM
+ END
+ 
+ SUBROUTINE NF90_PUT_ATT
+ END
+ 
+ SUBROUTINE NF90_ENDDEF 
+ END
+  
+ SUBROUTINE NF90_CLOSE
+ END
+ 
+ SUBROUTINE NF90_SYNC
+ END
+ 
+ SUBROUTINE NF90_OPEN
+ END
+ 
+ SUBROUTINE NF90_INQ_VARID
+ END
+ 
+ SUBROUTINE NF90_GET_ATT
+ END
+
+#endif
+
Index: codes/icosagcm/devel/src/output/output_field.f90
===================================================================
--- codes/icosagcm/devel/src/output/output_field.f90	(revision 533)
+++ codes/icosagcm/devel/src/output/output_field.f90	(revision 533)
@@ -0,0 +1,64 @@
+MODULE output_field_mod
+USE genmod
+  PRIVATE
+  LOGICAL,SAVE :: xios_output 
+!$OMP THREADPRIVATE(xios_output)     
+  LOGICAL,SAVE :: enable_io    
+!$OMP THREADPRIVATE(enable_io)     
+
+  PUBLIC enable_io,xios_output,output_field_init,output_field,output_field_finalize
+
+CONTAINS 
+  
+  SUBROUTINE output_field_init
+  USE getin_mod
+  USE xios_mod
+  USE write_field_mod
+  IMPLICIT NONE
+
+    enable_io=.TRUE.
+    CALL getin('enable_io',enable_io)
+
+    IF (using_xios) THEN
+      xios_output=.TRUE.
+      CALL getin('xios_output',xios_output)
+    ELSE
+      xios_output=.FALSE.
+    ENDIF
+    
+    IF (xios_output) THEN
+      CALL xios_init_write_field
+    ENDIF
+
+    
+  END SUBROUTINE output_field_init
+
+  SUBROUTINE output_field(name_in,field)
+    USE field_mod
+    USE xios_mod
+    USE write_field_mod
+    IMPLICIT NONE  
+     CHARACTER(LEN=*),INTENT(IN) :: name_in
+      TYPE(t_field),POINTER :: field(:)
+
+      IF (xios_output) THEN
+        CALL xios_write_field(name_in,field)
+      ELSE
+       CALL writeField(name_in,field)
+      ENDIF
+
+  END SUBROUTINE output_field
+
+  SUBROUTINE output_field_finalize
+  USE ioipsl
+  USE xios_mod
+  IMPLICIT NONE
+    
+    IF (xios_output) THEN
+      CALL xios_write_field_finalize
+    ENDIF
+    
+  END SUBROUTINE output_field_finalize
+
+END MODULE output_field_mod
+  
Index: codes/icosagcm/devel/src/output/restart.f90
===================================================================
--- codes/icosagcm/devel/src/output/restart.f90	(revision 533)
+++ codes/icosagcm/devel/src/output/restart.f90	(revision 533)
@@ -0,0 +1,664 @@
+MODULE restart_mod
+  USE field_mod
+
+  TYPE t_field_array
+    TYPE(t_field),POINTER :: field(:)
+  END TYPE t_field_array
+
+  LOGICAL,SAVE :: write_start=.TRUE.
+
+CONTAINS
+  
+  SUBROUTINE init_restart
+  USE xios_mod
+  USE icosa
+  USE time_mod
+  USE omp_para
+  IMPLICIT NONE
+  CHARACTER(LEN=255) :: start_file_name
+  CHARACTER(LEN=255) :: restart_file_name
+    
+    IF (using_xios) THEN
+      start_file_name="start"
+      CALL getin("start_file_name",start_file_name)
+      restart_file_name="restart"
+      CALL getin("restart_file_name",restart_file_name)
+      IF (is_omp_master) THEN
+!        CALL xios_set_file_attr("start",name=TRIM(ADJUSTL(start_file_name)),output_freq=(itaumax+1)*xios_timestep)
+        CALL xios_set_file_attr("start",name=TRIM(ADJUSTL(start_file_name)),output_freq=1*xios_timestep)
+        CALL xios_set_file_attr("restart",name=TRIM(ADJUSTL(restart_file_name)),output_freq=itaumax*xios_timestep)
+        CALL xios_set_fieldgroup_attr("group_restart", freq_op=itaumax*xios_timestep)
+      ENDIF
+    ENDIF
+    
+  END SUBROUTINE init_restart
+  
+  
+  SUBROUTINE write_restart(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9,   &
+                           field10,field11,field12,field13,field14,field15,field16,field17,field18,field19 )
+  USE prec
+  USE metric
+  USE field_mod
+  USE domain_mod
+  USE netcdf_mod
+  USE mpipara
+  USE omp_para
+  USE getin_mod
+  USE spherical_geom_mod
+  USE transfert_mod
+  USE disvert_mod
+  USE xios_mod
+  IMPLICIT NONE 
+  INTEGER,INTENT(IN)     :: it
+
+  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9
+  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field10,field11,field12,field13,field14,field15,field16,field17,field18,field19
+
+  TYPE(t_field_array) :: field_array(20)
+  INTEGER             :: nfield
+  INTEGER             :: fieldId(20)
+   
+  TYPE(t_domain),POINTER :: d
+  TYPE(t_field),POINTER :: field_glo(:)
+  TYPE(t_field),POINTER :: field(:)
+  
+  CHARACTER(LEN=255) :: file_name
+  CHARACTER(LEN=255) :: suffix
+  INTEGER,PARAMETER  :: nvert=6
+  INTEGER    ::  ncid, cellId, levId, edgeId,  vertid, lonId, latId, bounds_lonId, bounds_latId, nqId, levAxisId
+  INTEGER    :: ind,ind_glo,i,j,k,nf
+  INTEGER    :: status
+  REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
+   
+    IF (no_io) RETURN
+    
+    IF (it==0) THEN
+      file_name="start"
+      CALL getin("start_file_name",file_name)
+      suffix="_start"
+    ELSE
+      file_name="restart"
+      CALL getin("restart_file_name",file_name)
+      suffix="_restart"
+    ENDIF  
+     
+    IF (using_xios) THEN
+      IF (PRESENT(field0))  THEN ; CALL  xios_write_field(TRIM(field0(1)%name)//TRIM(suffix),field0)  ; ENDIF
+      IF (PRESENT(field1))  THEN ; CALL  xios_write_field(TRIM(field1(1)%name)//TRIM(suffix),field1)  ; ENDIF
+      IF (PRESENT(field2))  THEN ; CALL  xios_write_field(TRIM(field2(1)%name)//TRIM(suffix),field2)  ; ENDIF
+      IF (PRESENT(field3))  THEN ; CALL  xios_write_field(TRIM(field3(1)%name)//TRIM(suffix),field3)  ; ENDIF
+      IF (PRESENT(field4))  THEN ; CALL  xios_write_field(TRIM(field4(1)%name)//TRIM(suffix),field4)  ; ENDIF
+      IF (PRESENT(field5))  THEN ; CALL  xios_write_field(TRIM(field5(1)%name)//TRIM(suffix),field5)  ; ENDIF
+      IF (PRESENT(field6))  THEN ; CALL  xios_write_field(TRIM(field6(1)%name)//TRIM(suffix),field6)  ; ENDIF
+      IF (PRESENT(field7))  THEN ; CALL  xios_write_field(TRIM(field7(1)%name)//TRIM(suffix),field7)  ; ENDIF
+      IF (PRESENT(field8))  THEN ; CALL  xios_write_field(TRIM(field8(1)%name)//TRIM(suffix),field8)  ; ENDIF
+      IF (PRESENT(field9))  THEN ; CALL  xios_write_field(TRIM(field9(1)%name)//TRIM(suffix),field9)  ; ENDIF
+      IF (PRESENT(field10))  THEN ; CALL  xios_write_field(TRIM(field10(1)%name)//TRIM(suffix),field10)  ; ENDIF
+      IF (PRESENT(field11))  THEN ; CALL  xios_write_field(TRIM(field11(1)%name)//TRIM(suffix),field11)  ; ENDIF
+      IF (PRESENT(field12))  THEN ; CALL  xios_write_field(TRIM(field12(1)%name)//TRIM(suffix),field12)  ; ENDIF
+      IF (PRESENT(field13))  THEN ; CALL  xios_write_field(TRIM(field13(1)%name)//TRIM(suffix),field13)  ; ENDIF
+      IF (PRESENT(field14))  THEN ; CALL  xios_write_field(TRIM(field14(1)%name)//TRIM(suffix),field14)  ; ENDIF
+      IF (PRESENT(field15))  THEN ; CALL  xios_write_field(TRIM(field15(1)%name)//TRIM(suffix),field15)  ; ENDIF
+      IF (PRESENT(field16))  THEN ; CALL  xios_write_field(TRIM(field16(1)%name)//TRIM(suffix),field16)  ; ENDIF
+      IF (PRESENT(field17))  THEN ; CALL  xios_write_field(TRIM(field17(1)%name)//TRIM(suffix),field17)  ; ENDIF
+      IF (PRESENT(field18))  THEN ; CALL  xios_write_field(TRIM(field18(1)%name)//TRIM(suffix),field18)  ; ENDIF
+      IF (PRESENT(field19))  THEN ; CALL  xios_write_field(TRIM(field19(1)%name)//TRIM(suffix),field19)  ; ENDIF
+      IF (is_omp_master) CALL xios_send_field('it'//TRIM(suffix),it*1.0)
+
+    ELSE
+
+    !$OMP MASTER
+      
+      nfield=0
+      IF (PRESENT(field0))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0  ; ENDIF
+      IF (PRESENT(field1))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1  ; ENDIF
+      IF (PRESENT(field2))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2  ; ENDIF
+      IF (PRESENT(field3))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3  ; ENDIF
+      IF (PRESENT(field4))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4  ; ENDIF
+      IF (PRESENT(field5))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5  ; ENDIF
+      IF (PRESENT(field6))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6  ; ENDIF
+      IF (PRESENT(field7))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7  ; ENDIF
+      IF (PRESENT(field8))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8  ; ENDIF
+      IF (PRESENT(field9))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9  ; ENDIF
+      IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF
+      IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF
+      IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF
+      IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF
+      IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF
+      IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF
+      IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF
+      IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF
+      IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF
+      IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF
+      
+        
+
+      IF (is_mpi_root) THEN
+        status = NF90_CREATE(TRIM(ADJUSTL(file_name))//'.nc', NF90_CLOBBER, ncid)
+        status = NF90_DEF_DIM(ncid,'cell',ncell_glo,cellId)
+        status = NF90_DEF_DIM(ncid,'edge',3*ncell_glo,edgeId)
+        status = NF90_DEF_DIM(ncid,'lev',llm,levId)
+        status = NF90_DEF_DIM(ncid,'nvert',nvert,vertId)
+        status = NF90_DEF_DIM(ncid,'nq',nqtot,nqId)
+        status = NF90_PUT_ATT(ncid,NF90_GLOBAL,"iteration",it)
+        
+        status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ cellId /),lonId)
+        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
+        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
+        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
+        status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ cellId /),latId)
+        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
+        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
+        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
+        status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ vertId,cellId /),bounds_lonId)
+        status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ vertId,cellId /),bounds_latId)
+        status = NF90_DEF_VAR(ncid,'lev',NF90_DOUBLE,(/ levId /),levAxisId)
+        status = NF90_PUT_ATT(ncid,levAxisId,"axis","Z")
+        status = NF90_PUT_ATT(ncid,levAxisId,"units","Pa")
+        status = NF90_PUT_ATT(ncid,levAxisId,"positive","down")
+        
+        DO nf=1,nfield
+          field=>field_array(nf)%field
+          IF (field(1)%field_type==field_T) THEN
+            IF (field(1)%ndim==2) THEN
+              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId /),fieldId(nf))
+              status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lon lat")
+            ELSE IF (field(1)%ndim==3) THEN
+              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId /),fieldId(nf))
+              status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lev lon lat")
+            ELSE IF (field(1)%ndim==4) THEN
+              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId,nqId /),fieldId(nf))
+              status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","nq lev lon lat")
+            ENDIF
+          ELSE IF (field(1)%field_type==field_U) THEN
+            IF (field(1)%ndim==2) THEN
+              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId /),fieldId(nf))
+            ELSE IF (field(1)%ndim==3) THEN
+              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId, levId /),fieldId(nf))
+            ELSE IF (field(1)%ndim==4) THEN
+              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId, levId, nqId /),fieldId(nf))
+            ENDIF
+          ENDIF
+        ENDDO
+            
+        
+        status = NF90_ENDDEF(ncid)
+        
+        ALLOCATE(lon(ncell_glo),lat(ncell_glo),bounds_lon(0:nvert-1,ncell_glo),bounds_lat(0:nvert-1,ncell_glo))
+        DO ind=1,ndomain_glo
+          d=>domain_glo(ind)
+          DO j=d%jj_begin,d%jj_end
+            DO i=d%ii_begin,d%ii_end
+               ind_glo=d%assign_cell_glo(i,j)
+               CALL xyz2lonlat(d%xyz(:,i,j),lon(ind_glo),lat(ind_glo))
+               lon(ind_glo)=lon(ind_glo)*180/Pi
+               lat(ind_glo)=lat(ind_glo)*180/Pi
+               DO k=0,5
+                   CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,ind_glo), bounds_lat(k,ind_glo))
+                   bounds_lat(k,ind_glo)=bounds_lat(k,ind_glo)*180/Pi
+                   bounds_lon(k,ind_glo)=bounds_lon(k,ind_glo)*180/Pi
+               ENDDO
+            ENDDO
+          ENDDO
+        ENDDO
+
+        status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell_glo /))
+        status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell_glo /))
+        status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /))
+        status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /))
+        status=NF90_PUT_VAR(ncid,levAxisId,REAL(presnivs,r8),start=(/ 1 /),count=(/ llm /))
+      ENDIF
+
+      DO nf=1,nfield
+        field=>field_array(nf)%field
+        CALL write_restart_field(field,fieldId(nf),ncid)
+      ENDDO
+            
+    !          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name),NF90_DOUBLE,(/ ncellId /),fieldId(nf))
+    !        ELSE IF (field(1)%ndim==3) THEN
+    !          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name),NF90_DOUBLE,(/ ncellId, levId /),fieldId(nf))
+    !        ENDIF
+    !      ENDDO
+
+
+      IF (is_mpi_root) THEN
+        status = NF90_CLOSE(ncid)      
+      ENDIF
+    
+    !$OMP END MASTER
+    
+    ENDIF
+  
+  END SUBROUTINE write_restart
+  
+  SUBROUTINE write_restart_field(field,fieldId,ncid)
+  USE prec
+  USE metric
+  USE field_mod
+  USE domain_mod
+  USE netcdf_mod
+  USE mpipara
+  USE getin_mod
+  USE spherical_geom_mod
+  USE transfert_mod
+  USE xios_mod
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    INTEGER,INTENT(IN)     :: fieldId
+    INTEGER,INTENT(IN)     :: ncid
+
+    TYPE(t_domain),POINTER :: d
+    TYPE(t_field),POINTER :: field_glo(:)
+    REAL(rstd),ALLOCATABLE :: global_field2d(:)
+    REAL(rstd),ALLOCATABLE :: global_field3d(:,:)
+    REAL(rstd),ALLOCATABLE :: global_field4d(:,:,:)
+    INTEGER :: i,j,ij,k,e,ind,ind_glo
+    INTEGER :: ndim, field_type
+    INTEGER :: status
+    
+      ndim=field(1)%ndim
+      field_Type= field(1)%field_type
+      
+      IF (is_mpi_root) THEN
+ 
+        IF (ndim==2) THEN
+          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,name=field(1)%name)
+        ELSE IF (ndim==3) THEN
+          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,name=field(1)%name)
+        ELSE IF (ndim==4) THEN
+          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4,name=field(1)%name)
+        ENDIF
+      ENDIF
+      
+      CALL gather_field(field,field_glo)
+      
+
+      IF (is_mpi_root) THEN
+
+        IF (field_type==field_T) THEN
+          IF (ndim==2) THEN
+            ALLOCATE(global_field2d(ncell_glo))
+            DO ind=1,ndomain_glo
+              d=>domain_glo(ind)
+              DO j=d%jj_begin,d%jj_end
+                DO i=d%ii_begin,d%ii_end
+                  IF (d%own(i,j)) THEN 
+                    ij=(j-1)*d%iim+i
+                    ind_glo=d%assign_cell_glo(i,j)
+                    global_field2d(ind_glo)=field_glo(ind)%rval2d(ij)
+                  ENDIF 
+                ENDDO
+              ENDDO
+            ENDDO
+            status=NF90_PUT_VAR(ncid,fieldid,global_field2d,start=(/ 1 /),count=(/ ncell_glo /))
+          
+          ELSE IF (ndim==3) THEN
+            ALLOCATE(global_field3d(ncell_glo,llm))
+            DO ind=1,ndomain_glo
+              d=>domain_glo(ind)
+              DO j=d%jj_begin,d%jj_end
+                DO i=d%ii_begin,d%ii_end
+                  IF (d%own(i,j)) THEN 
+                    ij=(j-1)*d%iim+i
+                    ind_glo=d%assign_cell_glo(i,j)
+                    global_field3d(ind_glo,:)=field_glo(ind)%rval3d(ij,:)
+                  ENDIF
+                ENDDO
+              ENDDO
+            ENDDO
+            status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ ncell_glo,llm /))
+          ELSE IF (ndim==4) THEN
+            ALLOCATE(global_field4d(ncell_glo,llm,nqtot))
+            DO ind=1,ndomain_glo
+              d=>domain_glo(ind)
+              DO j=d%jj_begin,d%jj_end
+                DO i=d%ii_begin,d%ii_end
+                  IF (d%own(i,j)) THEN 
+                    ij=(j-1)*d%iim+i
+                    ind_glo=d%assign_cell_glo(i,j)
+                    global_field4d(ind_glo,:,:)=field_glo(ind)%rval4d(ij,:,:)
+                  ENDIF
+                ENDDO
+              ENDDO
+            ENDDO
+            status=NF90_PUT_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ ncell_glo,llm,nqtot /))
+          ENDIF
+        
+        ELSE IF (field_type==field_U) THEN
+        
+          IF (ndim==2) THEN
+            ALLOCATE(global_field2d(3*ncell_glo))
+            DO ind=1,ndomain_glo
+              d=>domain_glo(ind)
+              DO j=d%jj_begin,d%jj_end
+                DO i=d%ii_begin,d%ii_end
+                  DO k=0,5
+                   IF (d%edge_assign_domain(k,i,j)==ind .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
+                     .AND. d%edge_assign_pos(k,i,j)==k) THEN
+                       ij=(j-1)*d%iim+i
+                      ind_glo=d%assign_cell_glo(i,j)
+                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))  
+                      global_field2d(e)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval2d(ij+d%u_pos(k))
+                    ENDIF
+                  ENDDO
+                ENDDO
+              ENDDO
+            ENDDO
+            status=NF90_PUT_VAR(ncid,fieldid,REAL(global_field2d,r8),start=(/ 1 /),count=(/ 3*ncell_glo /))
+          ELSE IF (ndim==3) THEN
+            ALLOCATE(global_field3d(3*ncell_glo,llm))
+            DO ind=1,ndomain_glo
+              d=>domain_glo(ind)
+              DO j=d%jj_begin,d%jj_end
+                DO i=d%ii_begin,d%ii_end
+                  DO k=0,5
+                   IF (d%edge_assign_domain(k,i,j)==ind .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
+                     .AND. d%edge_assign_pos(k,i,j)==k) THEN
+                       ij=(j-1)*d%iim+i
+                      ind_glo=d%assign_cell_glo(i,j)
+                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))  
+                      global_field3d(e,:)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)
+                    ENDIF
+                  ENDDO
+                ENDDO
+              ENDDO
+            ENDDO
+            status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
+          ELSE IF (ndim==4) THEN
+            ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
+            DO ind=1,ndomain_glo
+              d=>domain_glo(ind)
+              DO j=d%jj_begin,d%jj_end
+                DO i=d%ii_begin,d%ii_end
+                  DO k=0,5
+                    IF (d%edge_assign_domain(k,i,j)==ind .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j&
+                      .AND. d%edge_assign_pos(k,i,j)==k) THEN
+                      ij=(j-1)*d%iim+i
+                      ind_glo=d%assign_cell_glo(i,j)
+                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))  
+                      global_field4d(e,:,:)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)
+                    ENDIF
+                  ENDDO
+                ENDDO
+              ENDDO
+            ENDDO
+            status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
+          ENDIF
+
+        ENDIF
+        
+        CALL deallocate_field_glo(field_glo)
+      
+      ENDIF
+      
+      
+  END SUBROUTINE write_restart_field
+
+
+  SUBROUTINE read_start(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9,   &
+                           field10,field11,field12,field13,field14,field15,field16,field17,field18,field19 )
+  USE prec
+  USE metric
+  USE field_mod
+  USE domain_mod
+  USE netcdf_mod
+  USE mpipara
+  USE getin_mod
+  USE spherical_geom_mod
+  USE transfert_mod
+  USE xios_mod
+ 
+  IMPLICIT NONE
+  INTEGER, INTENT(OUT)  :: it
+  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9
+  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field10,field11,field12,field13,field14,field15,field16,field17,field18,field19
+
+  TYPE(t_field_array) :: field_array(20)
+  INTEGER             :: nfield
+  INTEGER             :: fieldId(20)
+   
+  TYPE(t_domain),POINTER :: d
+  TYPE(t_field),POINTER :: field_glo(:)
+  TYPE(t_field),POINTER :: field(:)
+  
+  CHARACTER(LEN=255) :: start_file_name
+  INTEGER,PARAMETER  :: nvert=6
+  INTEGER    ::  ncid, cellId, levId, edgeId,  vertid, lonId, latId, bounds_lonId, bounds_latId
+  INTEGER    :: ind,ind_glo,i,j,k,nf
+  INTEGER    :: status
+  REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
+  REAL(rstd) :: it_real
+  
+    IF (no_io) RETURN
+    
+    start_file_name="start"
+    CALL getin("start_file_name",start_file_name)
+
+
+
+    IF (using_xios) THEN
+      IF (PRESENT(field0))  THEN ; CALL  xios_read_field(TRIM(field0(1)%name)//'_start',field0)  ; ENDIF
+      IF (PRESENT(field1))  THEN ; CALL  xios_read_field(TRIM(field1(1)%name)//'_start',field1)  ; ENDIF
+      IF (PRESENT(field2))  THEN ; CALL  xios_read_field(TRIM(field2(1)%name)//'_start',field2)  ; ENDIF
+      IF (PRESENT(field3))  THEN ; CALL  xios_read_field(TRIM(field3(1)%name)//'_start',field3)  ; ENDIF
+      IF (PRESENT(field4))  THEN ; CALL  xios_read_field(TRIM(field4(1)%name)//'_start',field4)  ; ENDIF
+      IF (PRESENT(field5))  THEN ; CALL  xios_read_field(TRIM(field5(1)%name)//'_start',field5)  ; ENDIF
+      IF (PRESENT(field6))  THEN ; CALL  xios_read_field(TRIM(field6(1)%name)//'_start',field6)  ; ENDIF
+      IF (PRESENT(field7))  THEN ; CALL  xios_read_field(TRIM(field7(1)%name)//'_start',field7)  ; ENDIF
+      IF (PRESENT(field8))  THEN ; CALL  xios_read_field(TRIM(field8(1)%name)//'_start',field8)  ; ENDIF
+      IF (PRESENT(field9))  THEN ; CALL  xios_read_field(TRIM(field9(1)%name)//'_start',field9)  ; ENDIF
+      IF (PRESENT(field10))  THEN ; CALL  xios_read_field(TRIM(field10(1)%name)//'_start',field10)  ; ENDIF
+      IF (PRESENT(field11))  THEN ; CALL  xios_read_field(TRIM(field11(1)%name)//'_start',field11)  ; ENDIF
+      IF (PRESENT(field12))  THEN ; CALL  xios_read_field(TRIM(field12(1)%name)//'_start',field12)  ; ENDIF
+      IF (PRESENT(field13))  THEN ; CALL  xios_read_field(TRIM(field13(1)%name)//'_start',field13)  ; ENDIF
+      IF (PRESENT(field14))  THEN ; CALL  xios_read_field(TRIM(field14(1)%name)//'_start',field14)  ; ENDIF
+      IF (PRESENT(field15))  THEN ; CALL  xios_read_field(TRIM(field15(1)%name)//'_start',field15)  ; ENDIF
+      IF (PRESENT(field16))  THEN ; CALL  xios_read_field(TRIM(field16(1)%name)//'_start',field16)  ; ENDIF
+      IF (PRESENT(field17))  THEN ; CALL  xios_read_field(TRIM(field17(1)%name)//'_start',field17)  ; ENDIF
+      IF (PRESENT(field18))  THEN ; CALL  xios_read_field(TRIM(field18(1)%name)//'_start',field18)  ; ENDIF
+      IF (PRESENT(field19))  THEN ; CALL  xios_read_field(TRIM(field19(1)%name)//'_start',field19)  ; ENDIF
+
+!      CALL xios_recv_field("it_start",it_real)
+      CALL xios_read_var("it_start",it_real)
+      it=it_real
+    ELSE
+
+    !$OMP MASTER
+
+      nfield=0
+      IF (PRESENT(field0))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0  ; ENDIF
+      IF (PRESENT(field1))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1  ; ENDIF
+      IF (PRESENT(field2))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2  ; ENDIF
+      IF (PRESENT(field3))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3  ; ENDIF
+      IF (PRESENT(field4))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4  ; ENDIF
+      IF (PRESENT(field5))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5  ; ENDIF
+      IF (PRESENT(field6))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6  ; ENDIF
+      IF (PRESENT(field7))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7  ; ENDIF
+      IF (PRESENT(field8))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8  ; ENDIF
+      IF (PRESENT(field9))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9  ; ENDIF
+      IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF
+      IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF
+      IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF
+      IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF
+      IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF
+      IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF
+      IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF
+      IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF
+      IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF
+      IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF
+      
+        
+
+      IF (is_mpi_root) THEN
+        status = NF90_OPEN(TRIM(ADJUSTL(start_file_name))//'.nc', NF90_NOWRITE, ncid)
+      ENDIF
+     
+      DO nf=1,nfield
+        field=>field_array(nf)%field
+        status = nf90_inq_varid(ncid, TRIM(ADJUSTL(field(1)%name)), fieldId(nf))
+        status = nf90_get_att(ncid, NF90_GLOBAL, "iteration", it)
+        CALL read_start_field(field,fieldId(nf),ncid)
+      ENDDO
+
+
+      IF (is_mpi_root) THEN
+        status = NF90_CLOSE(ncid)      
+      ENDIF
+     
+     !$OMP END MASTER
+    
+    ENDIF
+  
+  END SUBROUTINE read_start
+
+
+  SUBROUTINE read_start_field(field,fieldId,ncid)
+  USE prec
+  USE metric
+  USE field_mod
+  USE domain_mod
+  USE netcdf_mod
+  USE mpipara
+  USE getin_mod
+  USE spherical_geom_mod
+  USE transfert_mod
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    INTEGER,INTENT(IN)     :: fieldId
+    INTEGER,INTENT(IN)     :: ncid
+
+    TYPE(t_domain),POINTER :: d
+    TYPE(t_field),POINTER :: field_glo(:)
+    REAL(rstd),ALLOCATABLE :: global_field2d(:)
+    REAL(rstd),ALLOCATABLE :: global_field3d(:,:)
+    REAL(rstd),ALLOCATABLE :: global_field4d(:,:,:)
+    INTEGER :: i,j,ij,k,e,ind,ind_glo
+    INTEGER :: ndim, field_type
+    INTEGER :: status
+    
+      ndim=field(1)%ndim
+      field_Type= field(1)%field_type
+      
+      IF (is_mpi_root) THEN
+ 
+        IF (ndim==2) THEN
+          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,name=field(1)%name)
+        ELSE IF (ndim==3) THEN
+          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,name=field(1)%name)
+        ELSE IF (ndim==4) THEN
+          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4,name=field(1)%name)
+        ENDIF
+      ENDIF
+      
+      IF (is_mpi_root) THEN
+
+        IF (field_type==field_T) THEN
+          IF (ndim==2) THEN
+            ALLOCATE(global_field2d(ncell_glo))
+            status=NF90_GET_VAR(ncid,fieldid, global_field2d, start=(/ 1 /), count=(/ ncell_glo /))
+            DO ind=1,ndomain_glo
+              d=>domain_glo(ind)
+              DO j=d%jj_begin,d%jj_end
+                DO i=d%ii_begin,d%ii_end
+                    ij=(j-1)*d%iim+i
+                    ind_glo=d%assign_cell_glo(i,j)
+                    field_glo(ind)%rval2d(ij)=global_field2d(ind_glo)
+                ENDDO
+              ENDDO
+            ENDDO
+          
+          ELSE IF (ndim==3) THEN
+            ALLOCATE(global_field3d(ncell_glo,llm))
+            status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ ncell_glo,llm /))
+            DO ind=1,ndomain_glo
+              d=>domain_glo(ind)
+              DO j=d%jj_begin,d%jj_end
+                DO i=d%ii_begin,d%ii_end
+                  ij=(j-1)*d%iim+i
+                  ind_glo=d%assign_cell_glo(i,j)
+                  field_glo(ind)%rval3d(ij,:) = global_field3d(ind_glo,:)
+                ENDDO
+              ENDDO
+            ENDDO
+          ELSE IF (ndim==4) THEN
+            ALLOCATE(global_field4d(ncell_glo,llm,nqtot))
+            status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ ncell_glo,llm,nqtot /))
+            DO ind=1,ndomain_glo
+              d=>domain_glo(ind)
+              DO j=d%jj_begin,d%jj_end
+                DO i=d%ii_begin,d%ii_end
+                  ij=(j-1)*d%iim+i
+                  ind_glo=d%assign_cell_glo(i,j)
+                  field_glo(ind)%rval4d(ij,:,:) = global_field4d(ind_glo,:,:)
+                ENDDO
+              ENDDO
+            ENDDO
+          ENDIF
+        
+        ELSE IF (field_type==field_U) THEN
+        
+          IF (ndim==2) THEN
+            ALLOCATE(global_field2d(3*ncell_glo))
+            status=NF90_GET_VAR(ncid,fieldid,global_field2d,start=(/ 1 /),count=(/ 3*ncell_glo /))
+
+            DO ind=1,ndomain_glo
+              d=>domain_glo(ind)
+              DO j=d%jj_begin,d%jj_end
+                DO i=d%ii_begin,d%ii_end
+                  DO k=0,5
+                    ij=(j-1)*d%iim+i
+                    ind_glo=d%assign_cell_glo(i,j)
+                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))  
+                    field_glo(ind)%rval2d(ij+d%u_pos(k))= global_field2d(ind_glo)*d%edge_assign_sign(k,i,j)
+                  ENDDO
+                ENDDO
+              ENDDO
+            ENDDO
+          ELSE IF (ndim==3) THEN
+            ALLOCATE(global_field3d(3*ncell_glo,llm))
+            status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
+            DO ind=1,ndomain_glo
+              d=>domain_glo(ind)
+              DO j=d%jj_begin,d%jj_end
+                DO i=d%ii_begin,d%ii_end
+                  DO k=0,5
+                    ij=(j-1)*d%iim+i
+                    ind_glo=d%assign_cell_glo(i,j)
+                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))  
+                    field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)=global_field3d(e,:)*d%edge_assign_sign(k,i,j)
+                  ENDDO
+                ENDDO
+              ENDDO
+            ENDDO
+          ELSE IF (ndim==4) THEN
+            ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
+            status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
+            DO ind=1,ndomain_glo
+              d=>domain_glo(ind)
+              DO j=d%jj_begin,d%jj_end
+                DO i=d%ii_begin,d%ii_end
+                  DO k=0,5
+                    ij=(j-1)*d%iim+i
+                    ind_glo=d%assign_cell_glo(i,j)
+                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))  
+                    field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)=global_field4d(e,:,:)*d%edge_assign_sign(k,i,j)
+                  ENDDO
+                ENDDO
+              ENDDO
+            ENDDO
+          ENDIF
+
+        ENDIF
+      ENDIF
+      
+      CALL scatter_field(field_glo,field)
+        
+      IF (is_mpi_root) THEN
+        CALL deallocate_field_glo(field_glo)
+      ENDIF
+      
+      
+  END SUBROUTINE read_start_field      
+    
+END MODULE restart_mod
+  
Index: codes/icosagcm/devel/src/output/write_etat0.f90
===================================================================
--- codes/icosagcm/devel/src/output/write_etat0.f90	(revision 533)
+++ codes/icosagcm/devel/src/output/write_etat0.f90	(revision 533)
@@ -0,0 +1,51 @@
+MODULE write_etat0_mod
+
+
+
+CONTAINS
+
+  SUBROUTINE write_etat0(it,f_ps,f_phis,f_theta_rhodz,f_u, f_q)
+  USE icosa
+  USE restart_mod
+  USE wind_mod
+  USE write_field_mod
+  USE domain_mod
+  USE omp_para
+  USE xios_mod
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)    :: it
+    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,SAVE :: f_ulon(:)
+    TYPE(t_field),POINTER,SAVE :: f_ulat(:)
+    TYPE(t_field),POINTER,SAVE :: f_theta_rhodz_1d(:)
+    REAL(rstd), POINTER :: theta_rhodz(:,:,:),theta_rhodz_1d(:,:)
+    INTEGER :: ind
+    
+    
+    CALL allocate_field(f_ulon,field_t,type_real,llm,name='ulon')
+    CALL allocate_field(f_ulat,field_t,type_real,llm,name='ulat')
+    CALL allocate_field(f_theta_rhodz_1d,field_t,type_real,llm,name='theta_rhodz')
+
+!$OMP BARRIER    
+    DO ind=1, ndomain
+       IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+       theta_rhodz=f_theta_rhodz(ind) ; theta_rhodz_1d=f_theta_rhodz_1d(ind)
+       theta_rhodz_1d(:,:)=theta_rhodz(:,:,1)
+    ENDDO
+    
+    CALL transfert_request(f_u,req_e1_vect)
+    CALL un2ulonlat(f_u, f_ulon, f_ulat)
+    
+    CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q)
+
+    CALL deallocate_field(f_ulon)
+    CALL deallocate_field(f_ulat)
+    
+  END SUBROUTINE write_etat0
+    
+END MODULE write_etat0_mod
Index: codes/icosagcm/devel/src/output/write_field.f90
===================================================================
--- codes/icosagcm/devel/src/output/write_field.f90	(revision 533)
+++ codes/icosagcm/devel/src/output/write_field.f90	(revision 533)
@@ -0,0 +1,1814 @@
+module write_field_mod
+  USE genmod
+  IMPLICIT NONE
+  PRIVATE  
+  INTEGER,SAVE :: ncprec
+  
+  TYPE ncvar
+    INTEGER :: size
+    INTEGER,POINTER :: nc_id(:)
+    INTEGER :: displ
+  END TYPE ncvar
+
+  INTEGER, PARAMETER :: MaxWriteField = 1000
+  INTEGER, DIMENSION(MaxWriteField),SAVE :: FieldId
+  TYPE(ncvar), dimension(MaxWriteField),SAVE :: FieldVarId
+  INTEGER, DIMENSION(MaxWriteField),SAVE :: FieldIndex
+  CHARACTER(len=255), DIMENSION(MaxWriteField) ::  FieldName 
+   
+  INTEGER,SAVE :: NbField = 0
+  
+  PUBLIC init_writeField, writefield, close_files
+  
+  CONTAINS
+  
+    SUBROUTINE init_writeField
+      USE ioipsl
+      use netcdf_mod
+      CHARACTER(LEN=255) :: netcdf_prec
+      
+      !$OMP CRITICAL
+      netcdf_prec='float'
+      CALL getin("netcdf_prec",netcdf_prec)
+      SELECT CASE(TRIM(netcdf_prec))
+        CASE('float')
+          ncprec=NF90_FLOAT
+        CASE('double')
+          ncprec=NF90_DOUBLE
+        CASE default
+        PRINT*,'Bad selector for variable netcdf_prec : <', TRIM(netcdf_prec),"> options are <float>, <double>" 
+        STOP   
+      END SELECT
+      !$OMP END CRITICAL
+    END SUBROUTINE init_writeField
+    
+    function GetFieldIndex(name)
+    implicit none
+      integer          :: GetFieldindex
+      character(len=*) :: name
+    
+      character(len=255) :: TrueName
+      integer            :: i
+       
+      
+      TrueName=TRIM(ADJUSTL(name))
+    
+      GetFieldIndex=-1
+      do i=1,NbField
+        if (TrueName==FieldName(i)) then
+          GetFieldIndex=i
+          exit
+        endif
+      enddo
+    end function GetFieldIndex
+    
+    SUBROUTINE Writefield(name_in,field,nind,once)
+    USE domain_mod
+    USE field_mod
+    USE transfert_mpi_mod
+    USE dimensions
+    USE mpipara
+    USE netcdf_mod
+    IMPLICIT NONE  
+     CHARACTER(LEN=*),INTENT(IN) :: name_in
+      TYPE(t_field),POINTER :: field(:)
+      INTEGER,OPTIONAL,INTENT(IN) :: nind
+      LOGICAL,OPTIONAL,INTENT(IN) :: once
+      LOGICAL                     :: once_
+      
+      TYPE(t_field),POINTER :: field_glo(:)
+      
+      IF (no_io) RETURN
+      
+!$OMP BARRIER
+!$OMP MASTER      
+      IF(PRESENT(once)) THEN
+         once_=once
+      ELSE
+         once_=.FALSE.
+      END IF
+
+      IF (field(1)%ndim==2) THEN
+        CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type)
+      ELSE IF (field(1)%ndim==3) THEN
+        CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3) 
+      ELSE IF (field(1)%ndim==4) THEN
+        CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4)
+      ENDIF
+      
+      CALL gather_field(field,field_glo)
+      
+      IF (mpi_rank==0) THEN
+        IF (PRESENT(nind)) THEN
+         CALL writefield_gen(name_in,field_glo,domain_glo,nind,once=once_)
+        ELSE
+         CALL writefield_gen(name_in,field_glo,domain_glo,1,ndomain_glo,once=once_)
+        ENDIF
+      ENDIF
+      
+      CALL deallocate_field_glo(field_glo)
+!$OMP END MASTER
+!$OMP BARRIER
+      
+   END SUBROUTINE writefield
+   
+!   SUBROUTINE Writefield(name_in,field,nind)
+!   USE netcdf
+!   USE domain_mod
+!   use field_mod
+!   USE dimensions
+!   USE geometry
+!   IMPLICIT NONE
+!     CHARACTER(LEN=*),INTENT(IN) :: name_in
+!     TYPE(t_field),POINTER :: field(:)
+!     INTEGER,OPTIONAL,INTENT(IN) :: nind
+!     REAL(r8),ALLOCATABLE :: field_val2d(:)
+!     REAL(r8),ALLOCATABLE :: field_val3d(:,:)
+!     REAL(r8),ALLOCATABLE :: field_val4d(:,:,:)
+!     TYPE(t_domain),POINTER :: d
+!     INTEGER :: Index
+!     INTEGER :: ind,i,j,k,n,ncell,q
+!     INTEGER :: iie,jje,iin,jjn
+!     INTEGER :: status
+!     CHARACTER(len=255) :: name
+!     CHARACTER(len=255) :: str_ind
+!     INTEGER :: ind_b,ind_e
+!     INTEGER :: halo_size
+!     LOGICAL :: single
+!     
+!     
+!     name=TRIM(ADJUSTL(name_in))
+
+!     IF (PRESENT(nind)) THEN
+!       name=TRIM(name)//"_"//TRIM(int2str(nind))
+!       PRINT *,"NAME",nind,int2str(nind),name
+!       ind_b=nind
+!       ind_e=nind
+!       halo_size=1
+!       single=.TRUE.
+!     ELSE
+!       ind_b=1
+!       ind_e=ndomain
+!       halo_size=0
+!       single=.FALSE.
+!     ENDIF      
+
+!     Index=GetFieldIndex(name)
+!     if (Index==-1) then
+!       call create_header(name,field,nind)
+!	Index=GetFieldIndex(name)
+!     else
+!       FieldIndex(Index)=FieldIndex(Index)+1.
+!     endif
+!     
+!     IF (Field(ind_b)%field_type==field_T) THEN
+!       ncell=1
+!       DO ind=ind_b,ind_e
+!         d=>domain(ind)
+!         IF (Field(ind)%field_type/=field_T) THEN
+!           PRINT *,"Writefield, grille non geree"
+!           RETURN
+!         ENDIF
+
+!       n=0
+!       DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+!         DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+!           IF (d%own(i,j) .OR. single) n=n+1
+!         ENDDO
+!       ENDDO
+
+!       IF (field(ind)%ndim==2) THEN
+!         ALLOCATE(Field_val2d(n))
+!         n=0
+!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+!             k=d%iim*(j-1)+i
+!             IF (d%own(i,j) .OR. single) THEN
+!               n=n+1
+!               Field_val2d(n)=field(ind)%rval2d(k)
+!             ENDIF
+!           ENDDO
+!         ENDDO
+!         status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,  &
+!                             start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /))
+!         DEALLOCATE(field_val2d)
+!       ELSE IF (field(ind)%ndim==3) THEN
+!         ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
+!         n=0
+!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+!             k=d%iim*(j-1)+i
+!             IF (d%own(i,j) .OR. single) THEN
+!               n=n+1
+!               Field_val3d(n,:)=field(ind)%rval3d(k,:)
+!             ENDIF
+!           ENDDO
+!         ENDDO
+!          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /),   &
+!                              count=(/n,size(field(1)%rval3d,2),1 /))
+!         DEALLOCATE(field_val3d)
+!       ELSE IF (field(1)%ndim==4) THEN
+
+!         DO q=1,FieldVarId(index)%size
+!         
+!           ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
+!           n=0
+!           DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+!             DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+!               k=d%iim*(j-1)+i
+!               IF (d%own(i,j) .OR. single) THEN
+!                 n=n+1
+!                 Field_val3d(n,:)=field(ind)%rval4d(k,:,q)
+!               ENDIF
+!             ENDDO
+!           ENDDO
+!           status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /),   &
+!                              count=(/n,size(field(1)%rval4d,2),1 /))
+!           DEALLOCATE(field_val3d)
+!         ENDDO         
+!       ENDIF
+!       
+!        PRINT *,NF90_STRERROR(status)
+!       ncell=ncell+n
+
+!    ENDDO
+!    
+!    ELSE IF (Field(ind_b)%field_type==field_Z) THEN
+!       ncell=1
+!       n=0
+!       DO ind=ind_b,ind_e
+!         d=>domain(ind)
+!         CALL swap_geometry(ind)
+!         CALL swap_dimensions(ind)
+! 
+!         n=0
+!         DO j=jj_begin+1,jj_end
+!           DO i=ii_begin,ii_end-1
+!             n=n+1
+!           ENDDO
+!         ENDDO
+
+!         DO j=jj_begin,jj_end-1
+!           DO i=ii_begin+1,ii_end
+!             n=n+1
+!           ENDDO
+!         ENDDO
+
+!       IF (field(ind)%ndim==2) THEN
+!         ALLOCATE(Field_val2d(n))
+
+!         n=0
+!         DO j=jj_begin+1,jj_end
+!           DO i=ii_begin,ii_end-1
+!             n=n+1
+!             k=iim*(j-1)+i
+!             Field_val2d(n)=field(ind)%rval2d(k+z_down)
+!           ENDDO
+!         ENDDO
+
+!         DO j=jj_begin,jj_end-1
+!           DO i=ii_begin+1,ii_end
+!             n=n+1
+!             k=iim*(j-1)+i
+!             Field_val2d(n)=field(ind)%rval2d(k+z_up)
+!           ENDDO
+!         ENDDO
+
+!         status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),                       &
+!                             Field_val2d,start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /))
+!         DEALLOCATE(field_val2d)
+
+!       ELSE IF (field(ind)%ndim==3) THEN
+!         ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
+!         n=0
+!         DO j=jj_begin+1,jj_end
+!           DO i=ii_begin,ii_end-1
+!             n=n+1
+!             k=iim*(j-1)+i
+!             Field_val3d(n,:)=field(ind)%rval3d(k+z_down,:)
+!           ENDDO
+!         ENDDO
+
+!         DO j=jj_begin,jj_end-1
+!           DO i=ii_begin+1,ii_end
+!             n=n+1
+!             k=iim*(j-1)+i
+!             Field_val3d(n,:)=field(ind)%rval3d(k+z_up,:)
+!           ENDDO
+!         ENDDO
+!          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /),   &
+!                              count=(/n,size(field(1)%rval3d,2),1 /))
+!         DEALLOCATE(field_val3d)
+!       ELSE IF (field(1)%ndim==4) THEN
+
+!         DO q=1,FieldVarId(index)%size
+!           ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
+!           n=0
+!           DO j=jj_begin+1,jj_end
+!             DO i=ii_begin,ii_end-1
+!               n=n+1
+!               k=iim*(j-1)+i
+!               Field_val3d(n,:)=field(ind)%rval4d(k+z_down,:,q)
+!             ENDDO
+!           ENDDO
+
+!           DO j=jj_begin,jj_end-1
+!             DO i=ii_begin+1,ii_end
+!               n=n+1
+!               k=iim*(j-1)+i
+!               Field_val3d(n,:)=field(ind)%rval4d(k+z_up,:,q)
+!             ENDDO
+!           ENDDO
+
+!           status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ ncell,1,1,FieldIndex(Index) /),   &
+!                               count=(/n,size(field(1)%rval4d,2),1 /))
+!           DEALLOCATE(field_val3d)
+!         ENDDO
+!       ENDIF
+!       
+!        PRINT *,NF90_STRERROR(status)
+!       ncell=ncell+n
+
+!    ENDDO
+!    
+!    ENDIF
+!    status=NF90_SYNC(FieldId(Index))
+!     
+!   END SUBROUTINE Writefield
+
+
+    SUBROUTINE Writefield_gen(name_in, field, domain_type, ind_b_in, ind_e_in,once )
+    USE netcdf_mod
+    USE domain_mod
+    USE field_mod
+    IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN) :: name_in
+      TYPE(t_field), POINTER :: field(:)
+      TYPE(t_domain),INTENT(IN),TARGET :: domain_type(:)
+      INTEGER,OPTIONAL,INTENT(IN) :: ind_b_in
+      INTEGER,OPTIONAL,INTENT(IN) :: ind_e_in
+      REAL(r8),ALLOCATABLE :: field_val2d(:)
+      REAL(r8),ALLOCATABLE :: field_val3d(:,:)
+      REAL(r8),ALLOCATABLE :: field_val4d(:,:,:)
+      LOGICAL, INTENT(IN) :: once
+      TYPE(t_domain),POINTER :: d
+      INTEGER :: Index
+      INTEGER :: ind,i,j,k,n,ncell,q
+      INTEGER :: iie,jje,iin,jjn
+      INTEGER :: status
+      CHARACTER(len=255) :: name
+      CHARACTER(len=255) :: str_ind
+      INTEGER :: ind_b,ind_e
+      INTEGER :: halo_size
+      LOGICAL :: single
+      
+      name=TRIM(ADJUSTL(name_in))
+
+      IF (PRESENT(ind_b_in) .AND. .NOT. PRESENT(ind_e_in)) THEN
+        name=TRIM(name)//"_"//TRIM(int2str(ind_b))
+        ind_b=ind_b_in
+        ind_e=ind_b_in
+        halo_size=1
+        single=.TRUE.
+      ELSE IF (.NOT. PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN
+        name=TRIM(name)//"_"//TRIM(int2str(ind_e))
+        ind_b=ind_e_in
+        ind_e=ind_e_in
+        halo_size=1
+        single=.TRUE.
+      ELSE IF ( PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN
+        ind_b=ind_b_in
+        ind_e=ind_e_in
+        halo_size=0
+        single=.FALSE.
+      ELSE
+        halo_size=0
+        ind_b=1
+        ind_e=ndomain
+        single=.FALSE.
+      ENDIF      
+      
+      Index=GetFieldIndex(name)
+      if (Index==-1) then
+        call create_header_gen(name_in,field,domain_type,ind_b_in,ind_e_in,once)
+	Index=GetFieldIndex(name)
+      else
+        FieldIndex(Index)=FieldIndex(Index)+1.
+      endif
+      
+      IF (Field(ind_b)%field_type==field_T) THEN
+
+        ncell=0
+        DO ind=ind_b,ind_e
+          d=>domain_type(ind)
+          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+              IF (d%assign_domain(i,j)==ind .OR. single) ncell=ncell+1
+            ENDDO
+          ENDDO
+        ENDDO
+        
+        IF (field(1)%ndim==2) THEN
+          ALLOCATE(Field_val2d(ncell))
+          n=0
+          DO ind=ind_b,ind_e
+            d=>domain_type(ind)
+            DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+              DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+                k=d%iim*(j-1)+i
+                IF (d%assign_domain(i,j)==ind .OR. single) THEN
+                  n=n+1
+                  Field_val2d(n)=field(ind)%rval2d(k)
+                ENDIF
+              ENDDO
+            ENDDO
+          ENDDO
+
+          IF (once) THEN 
+            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,  &
+                               start=(/ 1 /),count=(/ncell /))
+          ELSE
+            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,  &
+                               start=(/ 1,FieldIndex(Index) /),count=(/ncell,1 /))
+          ENDIF
+          
+          DEALLOCATE(field_val2d)
+        ELSE IF (field(1)%ndim==3) THEN
+          ALLOCATE(Field_val3d(ncell,size(field(1)%rval3d,2)))
+          n=0
+          DO ind=ind_b,ind_e
+            d=>domain_type(ind)
+            DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+              DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+                k=d%iim*(j-1)+i
+                IF (d%assign_domain(i,j)==ind .OR. single) THEN
+                  n=n+1
+                  Field_val3d(n,:)=field(ind)%rval3d(k,:)
+                ENDIF
+              ENDDO
+            ENDDO
+          ENDDO
+
+          PRINT *, 'Writefield ', TRIM(name), MAXVAL(Field_val3d(:,1)), MINVAL(Field_val3d(:,1)) ! FIXME
+
+          IF (once) THEN 
+            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ 1,1 /),   &
+                                 count=(/ncell,size(field(1)%rval3d,2) /))
+          ELSE
+             status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ 1,1,FieldIndex(Index) /),   &
+                                 count=(/ncell,size(field(1)%rval3d,2),1 /))
+          ENDIF
+                                
+          DEALLOCATE(field_val3d)
+        ELSE IF (field(1)%ndim==4) THEN
+
+          DO q=1,FieldVarId(index)%size
+          
+            ALLOCATE(Field_val3d(ncell,size(field(1)%rval4d,2)))
+            n=0
+            DO ind=ind_b,ind_e
+              d=>domain_type(ind)
+              DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+                DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+                  k=d%iim*(j-1)+i
+                  IF (d%assign_domain(i,j)==ind .OR. single) THEN
+                    n=n+1
+                    Field_val3d(n,:)=field(ind)%rval4d(k,:,q)
+                  ENDIF
+                ENDDO
+              ENDDO
+            ENDDO
+            
+            IF (once) THEN 
+              status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ 1,1 /),   &
+                                 count=(/ncell,size(field(1)%rval4d,2),1 /))
+            ELSE
+              status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ 1,1,FieldIndex(Index) /),   &
+                                 count=(/ncell,size(field(1)%rval4d,2),1 /))
+            ENDIF
+            DEALLOCATE(field_val3d)
+          ENDDO         
+        ENDIF
+        
+     
+     ELSE IF (Field(ind_b)%field_type==field_Z) THEN
+
+        ncell=0
+        DO ind=ind_b,ind_e
+          d=>domain_type(ind)
+  
+          DO j=d%jj_begin+1,d%jj_end
+            DO i=d%ii_begin,d%ii_end-1
+              ncell=ncell+1
+            ENDDO
+          ENDDO
+
+          DO j=d%jj_begin,d%jj_end-1
+            DO i=d%ii_begin+1,d%ii_end
+              ncell=ncell+1
+            ENDDO
+          ENDDO
+        ENDDO
+
+        IF (field(1)%ndim==2) THEN
+          ALLOCATE(Field_val2d(ncell))
+
+          n=0
+          
+          DO ind=ind_b,ind_e
+            d=>domain_type(ind)
+            DO j=d%jj_begin+1,d%jj_end
+              DO i=d%ii_begin,d%ii_end-1
+                n=n+1
+                k=d%iim*(j-1)+i
+                Field_val2d(n)=field(ind)%rval2d(k+d%z_down)
+              ENDDO
+            ENDDO
+
+            DO j=d%jj_begin,d%jj_end-1
+              DO i=d%ii_begin+1,d%ii_end
+                n=n+1
+                k=d%iim*(j-1)+i
+                Field_val2d(n)=field(ind)%rval2d(k+d%z_up)
+              ENDDO
+            ENDDO
+          ENDDO
+          
+          IF (once) THEN 
+            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),                       &
+                                Field_val2d,start=(/ 1 /),count=(/ncell /))
+           ELSE
+            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),                       &
+                                Field_val2d,start=(/ 1,FieldIndex(Index) /),count=(/ncell,1 /))
+          ENDIF
+          DEALLOCATE(field_val2d)
+
+        ELSE IF (field(1)%ndim==3) THEN
+          ALLOCATE(Field_val3d(ncell,size(field(1)%rval3d,2)))
+          n=0
+          DO ind=ind_b,ind_e
+            d=>domain_type(ind)
+            DO j=d%jj_begin+1,d%jj_end
+              DO i=d%ii_begin,d%ii_end-1
+                n=n+1
+                k=d%iim*(j-1)+i
+                Field_val3d(n,:)=field(ind)%rval3d(k+d%z_down,:)
+              ENDDO
+            ENDDO
+
+            DO j=d%jj_begin,d%jj_end-1
+              DO i=d%ii_begin+1,d%ii_end
+                n=n+1
+                k=d%iim*(j-1)+i
+                Field_val3d(n,:)=field(ind)%rval3d(k+d%z_up,:)
+              ENDDO
+            ENDDO
+          ENDDO
+          
+          IF (once) THEN 
+            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ 1,1 /),   &
+                                count=(/ncell,size(field(1)%rval3d,2) /))
+          ELSE
+            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ 1,1,FieldIndex(Index) /),   &
+                                count=(/ncell,size(field(1)%rval3d,2),1 /))
+          ENDIF
+          DEALLOCATE(field_val3d)
+        
+        ELSE IF (field(1)%ndim==4) THEN
+
+          DO q=1,FieldVarId(index)%size
+            ALLOCATE(Field_val3d(ncell,size(field(1)%rval4d,2)))
+            n=0
+            DO ind=ind_b,ind_e
+              d=>domain_type(ind)
+              DO j=d%jj_begin+1,d%jj_end
+                DO i=d%ii_begin,d%ii_end-1
+                  n=n+1
+                  k=d%iim*(j-1)+i
+                  Field_val3d(n,:)=field(ind)%rval4d(k+d%z_down,:,q)
+                ENDDO
+              ENDDO
+
+              DO j=d%jj_begin,d%jj_end-1
+                DO i=d%ii_begin+1,d%ii_end
+                  n=n+1
+                  k=d%iim*(j-1)+i
+                  Field_val3d(n,:)=field(ind)%rval4d(k+d%z_up,:,q)
+                ENDDO
+              ENDDO
+            ENDDO
+
+            IF (once) THEN 
+              status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ 1,1,1 /),   &
+                                  count=(/ncell,size(field(1)%rval4d,2) /))
+            ELSE
+              status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ 1,1,1,FieldIndex(Index) /),   &
+                                  count=(/ncell,size(field(1)%rval4d,2),1 /))
+            ENDIF
+            DEALLOCATE(field_val3d)
+          ENDDO
+        ENDIF
+     
+     ENDIF
+     status=NF90_SYNC(FieldId(Index))
+      
+    END SUBROUTINE Writefield_gen
+
+      
+
+    SUBROUTINE Writefield_mpi(name_in,field,nind)
+    USE netcdf_mod
+    USE domain_mod
+    use field_mod
+    USE dimensions
+    USE geometry
+    IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN) :: name_in
+      TYPE(t_field),POINTER :: field(:)
+      INTEGER,OPTIONAL,INTENT(IN) :: nind
+      REAL(r8),ALLOCATABLE :: field_val2d(:)
+      REAL(r8),ALLOCATABLE :: field_val3d(:,:)
+      REAL(r8),ALLOCATABLE :: field_val4d(:,:,:)
+      TYPE(t_domain),POINTER :: d
+      INTEGER :: Index
+      INTEGER :: ind,i,j,l,k,n,ncell,q
+      INTEGER :: iie,jje,iin,jjn
+      INTEGER :: status
+      CHARACTER(len=255) :: name
+      CHARACTER(len=255) :: str_ind
+      INTEGER :: ind_b,ind_e
+      INTEGER :: halo_size
+      LOGICAL :: single
+      INTEGER :: displ
+      
+      
+      name=TRIM(ADJUSTL(name_in))
+
+      IF (PRESENT(nind)) THEN
+        name=TRIM(name)//"_"//TRIM(int2str(nind))
+        PRINT *,"NAME",nind,int2str(nind),name
+        ind_b=nind
+        ind_e=nind
+        halo_size=1
+        single=.TRUE.
+      ELSE
+        ind_b=1
+        ind_e=ndomain
+        halo_size=0
+        single=.FALSE.
+      ENDIF      
+
+      Index=GetFieldIndex(name)
+      if (Index==-1) then
+        call create_header_mpi(name,field,nind)
+	Index=GetFieldIndex(name)
+      else
+        FieldIndex(Index)=FieldIndex(Index)+1.
+      endif
+      
+      IF (Field(ind_b)%field_type==field_T) THEN
+        ncell=1
+        DO ind=ind_b,ind_e
+          d=>domain(ind)
+          IF (Field(ind)%field_type/=field_T) THEN
+            PRINT *,"Writefield, grille non geree"
+            RETURN
+          ENDIF
+
+        n=0
+        DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+          DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+            IF (d%own(i,j) .OR. single) n=n+1
+          ENDDO
+        ENDDO
+
+        displ=FieldVarId(index)%displ
+        
+        IF (field(ind)%ndim==2) THEN
+          ALLOCATE(Field_val2d(n))
+          n=0
+          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+              k=d%iim*(j-1)+i
+              IF (d%own(i,j) .OR. single) THEN
+                n=n+1
+                Field_val2d(n)=field(ind)%rval2d(k)
+              ENDIF
+            ENDDO
+          ENDDO
+          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,  &
+                              start=(/ displ+ncell,FieldIndex(Index) /),count=(/n,1 /))
+          DEALLOCATE(field_val2d)
+        ELSE IF (field(ind)%ndim==3) THEN
+          ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
+          n=0
+          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+              k=d%iim*(j-1)+i
+              IF (d%own(i,j) .OR. single) THEN
+                n=n+1
+                Field_val3d(n,:)=field(ind)%rval3d(k,:)
+              ENDIF
+            ENDDO
+          ENDDO
+          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,  &
+                                start=(/ displ+ncell,1,FieldIndex(Index) /), count=(/n,size(field(ind)%rval3d,2),1 /))
+          DEALLOCATE(field_val3d)
+
+        ELSE IF (field(1)%ndim==4) THEN
+
+          DO q=1,FieldVarId(index)%size
+          
+            ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
+            n=0
+            DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+              DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+                k=d%iim*(j-1)+i
+                IF (d%own(i,j) .OR. single) THEN
+                  n=n+1
+                  Field_val3d(n,:)=field(ind)%rval4d(k,:,q)
+                ENDIF
+              ENDDO
+             ENDDO
+
+            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d(:,l), &
+                                start=(/ displ+ncell,l,FieldIndex(Index) /), count=(/n,size(field(ind)%rval4d,2),1 /))
+            DEALLOCATE(field_val3d)
+          ENDDO         
+        ENDIF
+        
+        ncell=ncell+n
+
+     ENDDO
+     
+     ELSE IF (Field(ind_b)%field_type==field_Z) THEN
+        ncell=1
+        n=0
+        DO ind=ind_b,ind_e
+          d=>domain(ind)
+          CALL swap_geometry(ind)
+          CALL swap_dimensions(ind)
+  
+          n=0
+          DO j=jj_begin+1,jj_end
+            DO i=ii_begin,ii_end-1
+              n=n+1
+            ENDDO
+          ENDDO
+
+          DO j=jj_begin,jj_end-1
+            DO i=ii_begin+1,ii_end
+              n=n+1
+            ENDDO
+          ENDDO
+
+        displ=FieldVarId(index)%displ
+
+        IF (field(ind)%ndim==2) THEN
+          ALLOCATE(Field_val2d(n))
+
+          n=0
+          DO j=jj_begin+1,jj_end
+            DO i=ii_begin,ii_end-1
+              n=n+1
+              k=iim*(j-1)+i
+              Field_val2d(n)=field(ind)%rval2d(k+z_down)
+            ENDDO
+          ENDDO
+
+          DO j=jj_begin,jj_end-1
+            DO i=ii_begin+1,ii_end
+              n=n+1
+              k=iim*(j-1)+i
+              Field_val2d(n)=field(ind)%rval2d(k+z_up)
+            ENDDO
+          ENDDO
+
+          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),                       &
+                              Field_val2d,start=(/ displ+ncell,FieldIndex(Index) /),count=(/n,1 /))
+          DEALLOCATE(field_val2d)
+
+        ELSE IF (field(ind)%ndim==3) THEN
+          ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
+          n=0
+          DO j=jj_begin+1,jj_end
+            DO i=ii_begin,ii_end-1
+              n=n+1
+              k=iim*(j-1)+i
+              Field_val3d(n,:)=field(ind)%rval3d(k+z_down,:)
+            ENDDO
+          ENDDO
+
+          DO j=jj_begin,jj_end-1
+            DO i=ii_begin+1,ii_end
+              n=n+1
+              k=iim*(j-1)+i
+              Field_val3d(n,:)=field(ind)%rval3d(k+z_up,:)
+            ENDDO
+          ENDDO
+
+           status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,    &
+                               start=(/ displ+ncell,1,FieldIndex(Index) /), count=(/n,size(field(ind)%rval3d,2),1 /))
+          DEALLOCATE(field_val3d)
+
+        ELSE IF (field(1)%ndim==4) THEN
+
+          DO q=1,FieldVarId(index)%size
+            ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
+            n=0
+            DO j=jj_begin+1,jj_end
+              DO i=ii_begin,ii_end-1
+                n=n+1
+                k=iim*(j-1)+i
+                Field_val3d(n,:)=field(ind)%rval4d(k+z_down,:,q)
+              ENDDO
+            ENDDO
+
+            DO j=jj_begin,jj_end-1
+              DO i=ii_begin+1,ii_end
+                n=n+1
+                k=iim*(j-1)+i
+                Field_val3d(n,:)=field(ind)%rval4d(k+z_up,:,q)
+              ENDDO
+            ENDDO
+
+            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,  &
+                                start=(/ displ+ncell,1,FieldIndex(Index) /), count=(/n,size(field(ind)%rval4d,2),1 /))
+            DEALLOCATE(field_val3d)
+          ENDDO
+        ENDIF
+        
+        ncell=ncell+n
+
+     ENDDO
+     
+     ENDIF
+     status=NF90_SYNC(FieldId(Index))
+      
+    END SUBROUTINE Writefield_mpi
+    
+    
+           
+!   SUBROUTINE Create_header(name,field,nind)
+!   USE netcdf
+!   USE field_mod
+!   USE domain_mod
+!   USE spherical_geom_mod
+!   USE dimensions
+!   USE geometry
+!   IMPLICIT NONE
+!     CHARACTER(LEN=*) :: name
+!     TYPE(t_field),POINTER :: field(:)
+!     INTEGER,OPTIONAL,INTENT(IN) :: nind
+!     INTEGER :: ncell
+!     INTEGER :: nvert
+!     REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
+!     TYPE(t_domain),POINTER :: d
+!     INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId
+!     INTEGER :: dim3id,dim4id
+!     INTEGER :: status
+!     INTEGER :: ind,i,j,k,n,q
+!     INTEGER :: iie,jje,iin,jjn
+!     INTEGER :: ind_b,ind_e
+!     INTEGER :: halo_size
+!     LOGICAL :: single 
+!     INTEGER :: nij
+!         
+!     NbField=NbField+1
+!     FieldName(NbField)=TRIM(ADJUSTL(name))
+!     FieldIndex(NbField)=1
+!     
+!     IF (PRESENT(nind)) THEN
+!       ind_b=nind
+!       ind_e=nind
+!       halo_size=1
+!       single=.TRUE.
+!     ELSE
+!       ind_b=1
+!       ind_e=ndomain
+!       halo_size=0
+!       single=.FALSE.
+!     ENDIF
+!     
+!     ncell=0
+!     
+!     IF (Field(ind_b)%field_type==field_T) THEN
+!       nvert=6
+!       
+!       DO ind=ind_b,ind_e
+!         d=>domain(ind)
+!       
+!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+!             IF (single .OR. domain(ind)%own(i,j)) ncell=ncell+1
+!           ENDDO
+!         ENDDO
+
+!       END DO
+!     
+!       status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
+!       FieldId(NbField)=ncid
+!       status = NF90_DEF_DIM(ncid,'cell',ncell,ncellId)
+!       status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
+
+!       IF (Field(ind_b)%ndim==2)  THEN
+!         FieldVarId(NbField)%size=1
+!         ALLOCATE(FieldVarId(NbField)%nc_id(1))
+!       ELSE IF (Field(ind_b)%ndim==3)  THEN
+!         FieldVarId(NbField)%size=1
+!         ALLOCATE(FieldVarId(NbField)%nc_id(1))
+!         status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval3d,2),dim3id)
+!       ELSE IF (Field(1)%ndim==4) THEN
+!         FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
+!         ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
+!         status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval4d,2),dim3id)
+!          status = NF90_DEF_DIM(ncid,'Q',size(field(ind_b)%rval4d,3),dim4id)
+!       ENDIF
+!     
+!       status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
+!     
+!       status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
+!       status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
+!       status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
+!       status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
+!       status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
+!       status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
+!       status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
+!       status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
+!       status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
+!       status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
+
+!       IF (Field(ind_b)%ndim==2) THEN
+!         status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
+!         status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
+!       ELSE IF (Field(ind_b)%ndim==3) THEN
+!         status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
+!         status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
+!       ELSE IF (Field(ind_b)%ndim==4) THEN
+!         DO i=1,FieldVarId(NbField)%size
+!           status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),  &
+!                                 FieldVarId(NbField)%nc_id(i))
+!           status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon lat")
+!         ENDDO        
+!       ENDIF 
+! 
+!     
+!       status = NF90_ENDDEF(ncid)      
+
+!       ncell=1
+!       DO ind=ind_b,ind_e
+!         d=>domain(ind)
+! 
+!         n=0
+!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+!             IF (single .OR. d%own(i,j)) n=n+1
+!           ENDDO
+!         ENDDO
+!         
+!        ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
+!         
+!         n=0  
+!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+!               IF (d%own(i,j) .OR. single) THEN
+!               n=n+1
+!               CALL xyz2lonlat(d%xyz(:,i,j),lon(n),lat(n))
+!               lon(n)=lon(n)*180/Pi
+!               lat(n)=lat(n)*180/Pi
+!               DO k=0,5
+!                 CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,n), bounds_lat(k,n))
+!                 bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
+!                 bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
+!               ENDDO
+!             ENDIF
+!           ENDDO
+!         ENDDO
+!         status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ ncell /),count=(/ n /))
+!         status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ ncell /),count=(/ n /))
+!         status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,ncell /),count=(/ nvert,n /))
+!         status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,ncell /),count=(/ nvert,n /))
+! 
+!         ncell=ncell+n
+!         DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
+!     END DO 
+
+!   ELSE IF (Field(ind_b)%field_type==field_Z) THEN
+!       nvert=3
+!       DO ind=ind_b,ind_e
+!         d=>domain(ind)
+!       
+!         DO j=d%jj_begin+1,d%jj_end
+!           DO i=d%ii_begin,d%ii_end-1
+!             ncell=ncell+1
+!           ENDDO
+!         ENDDO
+
+!         DO j=d%jj_begin,d%jj_end-1
+!           DO i=d%ii_begin+1,d%ii_end
+!             ncell=ncell+1
+!           ENDDO
+!         ENDDO
+
+!       END DO
+!     
+!       status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
+!       FieldId(NbField)=ncid
+!       status = NF90_DEF_DIM(ncid,'cell',ncell,ncellId)
+!       status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
+
+!       IF (Field(ind_b)%ndim==2)  THEN
+!         FieldVarId(NbField)%size=1
+!         ALLOCATE(FieldVarId(NbField)%nc_id(1))
+!       ELSE IF (Field(ind_b)%ndim==3)  THEN
+!         FieldVarId(NbField)%size=1
+!         ALLOCATE(FieldVarId(NbField)%nc_id(1))
+!         status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval3d,2),dim3id)
+!       ELSE IF (Field(1)%ndim==4) THEN
+!         FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
+!         ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
+!         status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval4d,2),dim3id)
+!       ENDIF
+
+
+!     
+!       status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
+!     
+!       status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
+!       status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
+!       status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
+!       status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
+!       status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
+!       status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
+!       status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
+!       status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
+!       status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
+!       status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
+
+
+!       IF (Field(ind_b)%ndim==2) THEN
+!         status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
+!         status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
+!       ELSE IF (Field(ind_b)%ndim==3) THEN
+!         status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
+!         status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
+!       ELSE IF (Field(ind_b)%ndim==4) THEN
+!         DO q=1,FieldVarId(NbField)%size
+!           status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),NF90_DOUBLE,             &
+!                                 (/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q))
+!           status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon lat")
+!         ENDDO        
+!       ENDIF 
+!       
+!       status = NF90_ENDDEF(ncid)      
+
+!       ncell=1
+!       DO ind=ind_b,ind_e
+!         d=>domain(ind)
+!         CALL swap_geometry(ind)
+!         CALL swap_dimensions(ind)
+! 
+!         n=0
+!         DO j=jj_begin+1,jj_end
+!           DO i=ii_begin,ii_end-1
+!             n=n+1
+!           ENDDO
+!         ENDDO
+
+!         DO j=jj_begin,jj_end-1
+!           DO i=ii_begin+1,ii_end
+!             n=n+1
+!           ENDDO
+!         ENDDO
+
+!        ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
+!         
+!         n=0  
+!      
+!         DO j=jj_begin+1,jj_end
+!           DO i=ii_begin,ii_end-1
+!             nij=(j-1)*iim+i
+!             n=n+1
+!             CALL xyz2lonlat(xyz_v(nij+z_down,:)/radius,lon(n),lat(n))
+!             lon(n)=lon(n)*180/Pi
+!!             IF (lon(n)<0) lon(n)=lon(n)+360
+!             lat(n)=lat(n)*180/Pi
+!             CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
+!             CALL xyz2lonlat(xyz_i(nij+t_ldown,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
+!             CALL xyz2lonlat(xyz_i(nij+t_rdown,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
+
+!             DO k=0,2
+!               bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
+!               bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
+!                IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360
+!             ENDDO
+!           ENDDO
+!         ENDDO
+
+!         DO j=jj_begin,jj_end-1
+!           DO i=ii_begin+1,ii_end
+!             nij=(j-1)*iim+i
+!             n=n+1
+!             CALL xyz2lonlat(xyz_v(nij+z_up,:)/radius,lon(n),lat(n))
+!             lon(n)=lon(n)*180/Pi
+!              IF (lon(n)<0) lon(n)=lon(n)+360
+!             lat(n)=lat(n)*180/Pi
+!             CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
+!             CALL xyz2lonlat(xyz_i(nij+t_rup,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
+!             CALL xyz2lonlat(xyz_i(nij+t_lup,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
+
+!             DO k=0,2
+!               bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
+!               bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
+!                IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360
+!             ENDDO
+!           ENDDO
+!         ENDDO
+!         
+!         
+!         status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ ncell /),count=(/ n /))
+!         status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ ncell /),count=(/ n /))
+!         status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,ncell /),count=(/ nvert,n /))
+!         status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,ncell /),count=(/ nvert,n /))
+! 
+!         ncell=ncell+n
+!         DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
+!     END DO          
+!   ENDIF
+
+
+!     
+!      status = NF90_CLOSE(ncid)
+
+!   END SUBROUTINE Create_Header
+
+
+
+   
+    SUBROUTINE Create_header_gen(name_in,field,domain_type,ind_b_in,ind_e_in,once)
+    USE netcdf_mod
+    USE field_mod
+    USE domain_mod
+    USE metric
+    USE spherical_geom_mod
+    IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN) :: name_in
+      TYPE(t_field),POINTER :: field(:)
+      TYPE(t_domain),INTENT(IN),TARGET :: domain_type(:)
+      INTEGER,OPTIONAL,INTENT(IN) :: ind_b_in
+      INTEGER,OPTIONAL,INTENT(IN) :: ind_e_in
+      LOGICAL,INTENT(IN) :: once
+      
+      INTEGER :: ncell
+      INTEGER :: nvert
+      REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
+      TYPE(t_domain),POINTER :: d
+      INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId
+      INTEGER :: dim3id,dim4id
+      INTEGER :: status
+      INTEGER :: ind,i,j,k,n,q
+      INTEGER :: iie,jje,iin,jjn
+      INTEGER :: ind_b,ind_e
+      INTEGER :: halo_size
+      LOGICAL :: single 
+      INTEGER :: nij
+      CHARACTER(LEN=255) :: name
+      INTEGER :: l,level_size, levId, dimlevId
+            
+      name=TRIM(ADJUSTL(name_in))
+
+      IF (PRESENT(ind_b_in) .AND. .NOT. PRESENT(ind_e_in)) THEN
+        name=TRIM(name)//"_"//TRIM(int2str(ind_b))
+        ind_b=ind_b_in
+        ind_e=ind_b_in
+        halo_size=1
+        single=.TRUE.
+      ELSE IF (.NOT. PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN
+        name=TRIM(name)//"_"//TRIM(int2str(ind_e))
+        ind_b=ind_e_in
+        ind_e=ind_e_in
+        halo_size=1
+        single=.TRUE.
+      ELSE IF ( PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN
+        ind_b=ind_b_in
+        ind_e=ind_e_in
+        halo_size=0
+        single=.FALSE.
+      ELSE
+        halo_size=0
+        ind_b=1
+        ind_e=ndomain
+        single=.FALSE.
+      ENDIF      
+                
+      NbField=NbField+1
+      FieldName(NbField)=TRIM(ADJUSTL(name))
+      FieldIndex(NbField)=1
+      
+      ncell=0
+      
+      IF (Field(ind_b)%field_type==field_T) THEN
+        nvert=6
+        
+        DO ind=ind_b,ind_e
+          d=>domain_type(ind)
+        
+          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+              IF (single .OR. d%assign_domain(i,j)==ind) ncell=ncell+1
+            ENDDO
+          ENDDO
+
+        END DO
+      
+        status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
+        FieldId(NbField)=ncid
+        status = NF90_DEF_DIM(ncid,'cell_i',ncell,ncellId)
+        status = NF90_DEF_DIM(ncid,'nvert_i',nvert,nvertid)
+        level_size=0
+        IF (Field(ind_b)%ndim==2)  THEN
+          FieldVarId(NbField)%size=1
+          ALLOCATE(FieldVarId(NbField)%nc_id(1))
+        ELSE IF (Field(ind_b)%ndim==3)  THEN
+          FieldVarId(NbField)%size=1
+          ALLOCATE(FieldVarId(NbField)%nc_id(1))
+          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
+          level_size=size(field(ind_b)%rval3d,2)
+        ELSE IF (Field(1)%ndim==4) THEN
+          FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
+          ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
+          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
+          level_size=size(field(ind_b)%rval4d,2)
+!          status = NF90_DEF_DIM(ncid,'Q',size(field(ind_b)%rval4d,3),dim4id)
+        ENDIF
+        PRINT*,"LEVEL_SIZE=",level_size
+
+        status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
+        IF (level_size>0) THEN
+          status = NF90_DEF_VAR(ncid,'lev',NF90_DOUBLE,(/ dim3id /),levId)
+          status = NF90_PUT_ATT(ncid,levId,"axis","Z")
+        ENDIF
+        
+        status = NF90_DEF_VAR(ncid,'lon_i',NF90_DOUBLE,(/ ncellId /),lonId)
+        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
+        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
+        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon_i")
+        status = NF90_DEF_VAR(ncid,'lat_i',NF90_DOUBLE,(/ ncellId /),latId)
+        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
+        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
+        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat_i")
+        status = NF90_DEF_VAR(ncid,'bounds_lon_i',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
+        status = NF90_DEF_VAR(ncid,'bounds_lat_i',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
+
+        IF (Field(ind_b)%ndim==2) THEN
+          IF (once) THEN 
+            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId /),FieldVarId(NbField)%nc_id(1))
+          ELSE
+             status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
+          ENDIF
+          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon_i lat_i")
+        ELSE IF (Field(ind_b)%ndim==3) THEN
+          IF (once) THEN 
+            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id /),FieldVarId(NbField)%nc_id(1))
+          ELSE
+            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
+          ENDIF
+          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon_i lat_i")
+        ELSE IF (Field(ind_b)%ndim==4) THEN
+          DO i=1,FieldVarId(NbField)%size
+            IF (once) THEN 
+              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),ncprec,(/ ncellId,dim3id /),  &
+                                    FieldVarId(NbField)%nc_id(i))
+            ELSE
+              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),ncprec,(/ ncellId,dim3id,timeId /),  &
+                                   FieldVarId(NbField)%nc_id(i))
+            ENDIF
+            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon_i lat_i")
+          ENDDO        
+        ENDIF 
+  
+      
+        status = NF90_ENDDEF(ncid)      
+
+        if (level_size>0) status = NF90_PUT_VAR(ncid,levId,(/ (l,l=1,level_size) /))
+         
+         ALLOCATE(lon(ncell),lat(ncell),bounds_lon(0:nvert-1,ncell),bounds_lat(0:nvert-1,ncell))
+          
+         n=0  
+         DO ind=ind_b,ind_e
+           d=>domain_type(ind)
+           DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+             DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+               IF (d%assign_domain(i,j)==ind .OR. single) THEN
+                 n=n+1
+                 CALL xyz2lonlat(d%xyz(:,i,j),lon(n),lat(n))
+                 lon(n)=lon(n)*180/Pi
+                 lat(n)=lat(n)*180/Pi
+                 DO k=0,5
+                   CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,n), bounds_lat(k,n))
+                   bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
+                   bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
+                 ENDDO
+               ENDIF
+             ENDDO
+           ENDDO
+         ENDDO
+         status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell /))
+         status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell /))
+         status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell /))
+         status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell /))
+  
+         DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
+
+    ELSE IF (Field(ind_b)%field_type==field_Z) THEN
+        nvert=3
+        DO ind=ind_b,ind_e
+          d=>domain_type(ind)
+        
+          DO j=d%jj_begin+1,d%jj_end
+            DO i=d%ii_begin,d%ii_end-1
+              ncell=ncell+1
+            ENDDO
+          ENDDO
+
+          DO j=d%jj_begin,d%jj_end-1
+            DO i=d%ii_begin+1,d%ii_end
+              ncell=ncell+1
+            ENDDO
+          ENDDO
+
+        END DO
+      
+        status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
+        FieldId(NbField)=ncid
+        status = NF90_DEF_DIM(ncid,'cell_v',ncell,ncellId)
+        status = NF90_DEF_DIM(ncid,'nvert_v',nvert,nvertid)
+
+        IF (Field(ind_b)%ndim==2)  THEN
+          FieldVarId(NbField)%size=1
+          ALLOCATE(FieldVarId(NbField)%nc_id(1))
+        ELSE IF (Field(ind_b)%ndim==3)  THEN
+          FieldVarId(NbField)%size=1
+          ALLOCATE(FieldVarId(NbField)%nc_id(1))
+          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
+        ELSE IF (Field(1)%ndim==4) THEN
+          FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
+          ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
+          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
+        ENDIF
+
+
+      
+        status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
+      
+        status = NF90_DEF_VAR(ncid,'lon_v',NF90_DOUBLE,(/ ncellId /),lonId)
+        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
+        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
+        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon_v")
+        status = NF90_DEF_VAR(ncid,'lat_v',NF90_DOUBLE,(/ ncellId /),latId)
+        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
+        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
+        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat_v")
+        status = NF90_DEF_VAR(ncid,'bounds_lon_v',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
+        status = NF90_DEF_VAR(ncid,'bounds_lat_v',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
+
+
+        IF (Field(ind_b)%ndim==2) THEN
+          IF (once) THEN 
+            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId /),FieldVarId(NbField)%nc_id(1))
+          ELSE
+            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
+          ENDIF
+          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon_v lat_v")
+        ELSE IF (Field(ind_b)%ndim==3) THEN
+          IF (once) THEN 
+            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id /),FieldVarId(NbField)%nc_id(1))
+          ELSE
+            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
+          ENDIF
+          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon_v lat_v")
+        ELSE IF (Field(ind_b)%ndim==4) THEN
+          DO q=1,FieldVarId(NbField)%size
+            IF (once) THEN 
+              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),ncprec,             &
+                                    (/ ncellId,dim3id /),FieldVarId(NbField)%nc_id(q))
+            ELSE
+              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),ncprec,             &
+                                    (/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q))
+            ENDIF
+            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon_v lat_v")
+          ENDDO        
+        ENDIF 
+        
+        status = NF90_ENDDEF(ncid)      
+
+         ALLOCATE(lon(ncell),lat(ncell),bounds_lon(0:nvert-1,ncell),bounds_lat(0:nvert-1,ncell))
+          
+         n=0  
+       
+         DO ind=ind_b,ind_e
+           d=>domain_type(ind)
+           DO j=d%jj_begin+1,d%jj_end
+             DO i=d%ii_begin,d%ii_end-1
+               nij=(j-1)*d%iim+i
+               n=n+1
+               CALL xyz2lonlat(d%vertex(:,vdown,i,j),lon(n),lat(n))
+               lon(n)=lon(n)*180/Pi
+               lat(n)=lat(n)*180/Pi
+
+               CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,n), bounds_lat(0,n))
+               CALL xyz2lonlat(d%xyz(:,i,j-1),bounds_lon(1,n), bounds_lat(1,n))
+               CALL xyz2lonlat(d%xyz(:,i+1,j-1),bounds_lon(2,n), bounds_lat(2,n))
+
+               DO k=0,2
+                 bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
+                 bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
+               ENDDO
+             ENDDO
+           ENDDO
+
+           DO j=d%jj_begin,d%jj_end-1
+             DO i=d%ii_begin+1,d%ii_end
+               nij=(j-1)*d%iim+i
+               n=n+1
+               CALL xyz2lonlat(d%vertex(:,vup,i,j),lon(n),lat(n))
+               lon(n)=lon(n)*180/Pi
+               lat(n)=lat(n)*180/Pi
+               CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,n), bounds_lat(0,n))
+               CALL xyz2lonlat(d%xyz(:,i,j+1),bounds_lon(1,n), bounds_lat(1,n))
+               CALL xyz2lonlat(d%xyz(:,i-1,j+1),bounds_lon(2,n), bounds_lat(2,n))
+
+               DO k=0,2
+                 bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
+                 bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
+               ENDDO
+             ENDDO
+           ENDDO
+         ENDDO 
+          
+         status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell /))
+         status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell /))
+         status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell /))
+         status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell /))
+  
+          DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
+      ENDIF
+
+
+    END SUBROUTINE Create_Header_gen
+
+    SUBROUTINE Create_header_mpi(name,field,nind)
+    USE netcdf_mod
+    USE field_mod
+    USE domain_mod
+    USE spherical_geom_mod
+    USE dimensions
+    USE geometry
+    USE mpi_mod
+    USE mpipara
+    IMPLICIT NONE
+      CHARACTER(LEN=*) :: name
+      CHARACTER(LEN=LEN_TRIM(ADJUSTL(name))) :: name_adj
+      TYPE(t_field),POINTER :: field(:)
+      INTEGER,OPTIONAL,INTENT(IN) :: nind
+      INTEGER :: ncell
+      INTEGER :: nvert
+      REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
+      TYPE(t_domain),POINTER :: d
+      INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId
+      INTEGER :: dim3id,dim4id
+      INTEGER :: status
+      INTEGER :: ind,i,j,k,n,q
+      INTEGER :: iie,jje,iin,jjn
+      INTEGER :: ind_b,ind_e
+      INTEGER :: halo_size
+      LOGICAL :: single 
+      INTEGER :: nij
+      INTEGER :: ncell_glo(0:mpi_size-1)
+      INTEGER :: displ, ncell_tot
+      
+          
+      NbField=NbField+1
+      name_adj=TRIM(ADJUSTL(name))  ! work around ICE with pgf90
+      FieldName(NbField)=name_adj
+      FieldIndex(NbField)=1
+      
+      IF (PRESENT(nind)) THEN
+        ind_b=nind
+        ind_e=nind
+        halo_size=1
+        single=.TRUE.
+      ELSE
+        ind_b=1
+        ind_e=ndomain
+        halo_size=0
+        single=.FALSE.
+      ENDIF
+      
+      ncell=0
+      
+      IF (Field(ind_b)%field_type==field_T) THEN
+        nvert=6
+        
+        DO ind=ind_b,ind_e
+          d=>domain(ind)
+        
+          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+              IF (single .OR. domain(ind)%own(i,j)) ncell=ncell+1
+            ENDDO
+          ENDDO
+
+        END DO
+      
+        CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
+
+        displ=0
+        DO i=1,mpi_rank
+          displ=displ+ncell_glo(i-1)
+        ENDDO
+        FieldVarId(NbField)%displ=displ
+        ncell_tot=sum(ncell_glo(:))
+        
+!        status = NF90_CREATE_PAR(TRIM(ADJUSTL(name))//'.nc', IOR(NF90_NETCDF4, NF90_MPIIO), comm_icosa, MPI_INFO_NULL, ncid)
+        FieldId(NbField)=ncid
+        status = NF90_DEF_DIM(ncid,'cell',ncell_tot,ncellId)
+        status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
+
+        IF (Field(ind_b)%ndim==2)  THEN
+          FieldVarId(NbField)%size=1
+          ALLOCATE(FieldVarId(NbField)%nc_id(1))
+        ELSE IF (Field(ind_b)%ndim==3)  THEN
+          FieldVarId(NbField)%size=1
+          ALLOCATE(FieldVarId(NbField)%nc_id(1))
+          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
+        ELSE IF (Field(1)%ndim==4) THEN
+          FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
+          ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
+          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
+!          status = NF90_DEF_DIM(ncid,'Q',size(field(ind_b)%rval4d,3),dim4id)
+        ENDIF
+      
+        status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
+      
+        status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
+        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
+        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
+        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
+        status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
+        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
+        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
+        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
+        status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
+        status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
+
+        IF (Field(ind_b)%ndim==2) THEN
+          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
+          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
+          status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, (/ncell_tot,1/))
+        ELSE IF (Field(ind_b)%ndim==3) THEN
+          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
+          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
+          status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED,   &
+                                         (/ncell_tot,size(field(ind_b)%rval3d,2),1/))
+        ELSE IF (Field(ind_b)%ndim==4) THEN
+          DO i=1,FieldVarId(NbField)%size
+            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),ncprec,(/ ncellId,dim3id,timeId /),  &
+                                  FieldVarId(NbField)%nc_id(i))
+            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon lat")
+            status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(q), NF90_CHUNKED,   &
+                                           (/ncell_tot,size(field(ind_b)%rval4d,2),1/))
+          ENDDO        
+        ENDIF 
+  
+      
+        status = NF90_ENDDEF(ncid)      
+
+        ncell=1
+        DO ind=ind_b,ind_e
+          d=>domain(ind)
+  
+          n=0
+          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+              IF (single .OR. d%own(i,j)) n=n+1
+            ENDDO
+          ENDDO
+          
+         ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
+          
+          n=0  
+          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
+            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
+                IF (d%own(i,j) .OR. single) THEN
+                n=n+1
+                CALL xyz2lonlat(d%xyz(:,i,j),lon(n),lat(n))
+                lon(n)=lon(n)*180/Pi
+                lat(n)=lat(n)*180/Pi
+                DO k=0,5
+                  CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,n), bounds_lat(k,n))
+                  bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
+                  bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
+                ENDDO
+              ENDIF
+            ENDDO
+          ENDDO
+          status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ displ+ncell /),count=(/ n /))
+          status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ displ+ncell /),count=(/ n /))
+          status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
+          status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
+  
+          ncell=ncell+n
+          DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
+      END DO 
+
+    ELSE IF (Field(ind_b)%field_type==field_Z) THEN
+        nvert=3
+        DO ind=ind_b,ind_e
+          d=>domain(ind)
+        
+          DO j=d%jj_begin+1,d%jj_end
+            DO i=d%ii_begin,d%ii_end-1
+              ncell=ncell+1
+            ENDDO
+          ENDDO
+
+          DO j=d%jj_begin,d%jj_end-1
+            DO i=d%ii_begin+1,d%ii_end
+              ncell=ncell+1
+            ENDDO
+          ENDDO
+
+        END DO
+        
+        CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
+
+        displ=0
+        DO i=1,mpi_rank
+          displ=displ+ncell_glo(i-1)
+        ENDDO
+        FieldVarId(NbField)%displ=displ
+        ncell_tot=sum(ncell_glo(:))
+              
+!        status = NF90_CREATE_PAR(TRIM(ADJUSTL(name))//'.nc',IOR(NF90_NETCDF4, NF90_MPIIO), comm_icosa, MPI_INFO_NULL, ncid)
+!        status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
+        FieldId(NbField)=ncid
+        status = NF90_DEF_DIM(ncid,'cell',ncell_tot,ncellId)
+        status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
+
+        IF (Field(ind_b)%ndim==2)  THEN
+          FieldVarId(NbField)%size=1
+          ALLOCATE(FieldVarId(NbField)%nc_id(1))
+        ELSE IF (Field(ind_b)%ndim==3)  THEN
+          FieldVarId(NbField)%size=1
+          ALLOCATE(FieldVarId(NbField)%nc_id(1))
+          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
+        ELSE IF (Field(1)%ndim==4) THEN
+          FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
+          ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
+          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
+        ENDIF
+
+
+      
+        status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
+      
+        status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
+        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
+        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
+        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
+        status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
+        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
+        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
+        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
+        status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
+        status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
+
+
+        IF (Field(ind_b)%ndim==2) THEN
+          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
+          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
+          status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, (/ncell_tot,1/))
+        ELSE IF (Field(ind_b)%ndim==3) THEN
+          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
+          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
+          status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED,   &
+                                         (/ncell_tot,size(field(ind_b)%rval3d,2),1/))
+        ELSE IF (Field(ind_b)%ndim==4) THEN
+          DO q=1,FieldVarId(NbField)%size
+            status = NF90_DEF_VAR(ncid,name_adj//int2str(q),ncprec,             &
+                                  (/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q))
+            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon lat")
+           status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(q), NF90_CHUNKED, &
+                                          (/ncell_tot,size(field(ind_b)%rval4d,2),1/))
+          ENDDO        
+        ENDIF 
+        
+        status = NF90_ENDDEF(ncid)      
+
+        ncell=1
+        DO ind=ind_b,ind_e
+          d=>domain(ind)
+          CALL swap_geometry(ind)
+          CALL swap_dimensions(ind)
+  
+          n=0
+          DO j=jj_begin+1,jj_end
+            DO i=ii_begin,ii_end-1
+              n=n+1
+            ENDDO
+          ENDDO
+
+          DO j=jj_begin,jj_end-1
+            DO i=ii_begin+1,ii_end
+              n=n+1
+            ENDDO
+          ENDDO
+
+         ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
+          
+          n=0  
+       
+          DO j=jj_begin+1,jj_end
+            DO i=ii_begin,ii_end-1
+              nij=(j-1)*iim+i
+              n=n+1
+              CALL xyz2lonlat(xyz_v(nij+z_down,:)/radius,lon(n),lat(n))
+              lon(n)=lon(n)*180/Pi
+              lat(n)=lat(n)*180/Pi
+              CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
+              CALL xyz2lonlat(xyz_i(nij+t_ldown,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
+              CALL xyz2lonlat(xyz_i(nij+t_rdown,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
+
+              DO k=0,2
+                bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
+                bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
+              ENDDO
+            ENDDO
+          ENDDO
+
+          DO j=jj_begin,jj_end-1
+            DO i=ii_begin+1,ii_end
+              nij=(j-1)*iim+i
+              n=n+1
+              CALL xyz2lonlat(xyz_v(nij+z_up,:)/radius,lon(n),lat(n))
+              lon(n)=lon(n)*180/Pi
+              lat(n)=lat(n)*180/Pi
+              CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
+              CALL xyz2lonlat(xyz_i(nij+t_rup,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
+              CALL xyz2lonlat(xyz_i(nij+t_lup,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
+
+              DO k=0,2
+                bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
+                bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
+              ENDDO
+            ENDDO
+          ENDDO
+          
+          
+          status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ displ+ncell /),count=(/ n /))
+          status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ displ+ncell /),count=(/ n /))
+          status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
+          status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
+  
+          ncell=ncell+n
+          DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
+      END DO          
+    ENDIF
+
+
+   END SUBROUTINE Create_Header_mpi  
+   
+   SUBROUTINE Close_files
+   USE netcdf_mod
+   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
+     
+     
+  function int2str(int)
+    implicit none
+    integer, parameter :: MaxLen=10
+    integer,intent(in) :: int
+    character(len=MaxLen) :: int2str
+    logical :: flag
+    integer :: i
+    flag=.true.
+    
+    i=int
+    
+    int2str=''
+    do while (flag)
+      int2str=CHAR(MOD(i,10)+48)//int2str
+      i=i/10
+      if (i==0) flag=.false.
+    enddo
+  end function int2str
+
+end module write_field_mod
+  
Index: codes/icosagcm/devel/src/output/xios_mod.F90
===================================================================
--- codes/icosagcm/devel/src/output/xios_mod.F90	(revision 533)
+++ codes/icosagcm/devel/src/output/xios_mod.F90	(revision 533)
@@ -0,0 +1,1051 @@
+MODULE xios_mod
+
+#ifdef CPP_USING_XIOS
+   USE xios
+#endif
+   IMPLICIT NONE 
+
+  PUBLIC
+  LOGICAL,SAVE :: using_xios
+
+  INTEGER,SAVE :: ncell_i
+!$OMP THREADPRIVATE(ncell_i)
+  INTEGER,SAVE :: ncell_v
+!$OMP THREADPRIVATE(ncell_v)
+  INTEGER,SAVE :: ncell_e
+!$OMP THREADPRIVATE(ncell_e)
+
+  PRIVATE ncell_i,ncell_v,ncell_e
+
+#ifdef CPP_USING_XIOS
+  
+CONTAINS
+ 
+ SUBROUTINE xios_init
+   USE getin_mod
+   USE xios
+   USE mpipara
+   IMPLICIT NONE
+    TYPE(xios_context) :: ctx_hdl
+
+     using_xios=.TRUE.
+     CALL xios_context_initialize("icosagcm",comm_icosa)
+     CALL xios_get_handle("icosagcm",ctx_hdl)
+     CALL xios_set_current_context(ctx_hdl)
+   
+ END SUBROUTINE xios_init  
+ 
+ SUBROUTINE xios_init_write_field
+ USE genmod
+ USE mpipara
+ USE xios
+ USE grid_param
+ USE domain_mod
+ USE dimensions
+ USE spherical_geom_mod
+ USE geometry
+ USE mpi_mod
+ USE time_mod
+ USE metric, ONLY : vup,vdown, cell_glo
+ IMPLICIT NONE
+  TYPE(xios_context) :: ctx_hdl
+  TYPE(xios_duration)      :: dtime
+  REAL(rstd) :: lev_value(llm)
+  REAL(rstd) :: lev_valuep1(llm+1)
+  REAL(rstd) :: nq_value(nqtot)
+  INTEGER :: ncell, ncell_tot, ncell_glo(0:mpi_size-1), displ
+  INTEGER :: ind, i,j,k,l,ij
+  REAL(rstd),ALLOCATABLE    :: lon(:), lat(:), bounds_lon(:,:), bounds_lat(:,:)
+  INTEGER, ALLOCATABLE      :: ind_glo(:)
+  TYPE(t_domain),POINTER :: d
+
+!$OMP BARRIER
+!$OMP MASTER
+!   CALL xios_context_initialize("icosagcm",comm_icosa)
+   CALL xios_get_handle("icosagcm",ctx_hdl)
+   CALL xios_set_current_context(ctx_hdl)
+   lev_value(:) = (/ (l,l=1,llm) /)     
+   lev_valuep1(:) = (/ (l,l=1,llm+1) /)     
+   nq_value(:) = (/ (l,l=1,nqtot) /)     
+   CALL xios_set_axis_attr("lev",n_glo=llm ,value=lev_value) ;
+   CALL xios_set_axis_attr("levp1",n_glo=llm+1 ,value=lev_valuep1) ;
+   CALL xios_set_axis_attr("nq",n_glo=nqtot, value=nq_value) ;
+   
+   ncell=0
+   DO ind=1,ndomain
+     d=>domain(ind)
+        
+     DO j=d%jj_begin,d%jj_end
+       DO i=d%ii_begin,d%ii_end
+         IF (domain(ind)%own(i,j)) ncell=ncell+1
+       ENDDO
+     ENDDO
+   ENDDO      
+   ncell_i=ncell
+   
+   CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
+
+   displ=0
+   DO i=1,mpi_rank
+     displ=displ+ncell_glo(i-1)
+   ENDDO
+
+   ncell_tot=sum(ncell_glo(:))
+   
+   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:5,ncell), bounds_lat(0:5,ncell), ind_glo(ncell)) 
+   
+   ncell=0
+   DO ind=1,ndomain
+     d=>domain(ind)
+        
+     DO j=d%jj_begin,d%jj_end
+       DO i=d%ii_begin,d%ii_end
+         IF (domain(ind)%own(i,j)) THEN 
+           ncell=ncell+1
+           CALL xyz2lonlat(d%xyz(:,i,j),lon(ncell),lat(ncell))
+           lon(ncell)=lon(ncell)*180/Pi
+           lat(ncell)=lat(ncell)*180/Pi
+           DO k=0,5
+             CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,ncell), bounds_lat(k,ncell))
+             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
+             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
+           ENDDO
+           ind_glo(ncell)=domain(ind)%assign_cell_glo(i,j)-1 
+         ENDIF
+       ENDDO
+     ENDDO
+   ENDDO         
+
+   CALL xios_set_domaingroup_attr("i",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
+   CALL xios_set_domaingroup_attr("i", data_dim=1, type='unstructured' , nvertex=6, i_index=ind_glo)
+   CALL xios_set_domaingroup_attr("i",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
+   
+   DEALLOCATE(lon, lat, bounds_lon, bounds_lat,ind_glo) 
+    
+
+
+   ncell=0
+   DO ind=1,ndomain
+     d=>domain(ind)
+
+     DO j=d%jj_begin,d%jj_end
+       DO i=d%ii_begin,d%ii_end
+         DO k=0,5
+            IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
+                                                                                 .AND. d%edge_assign_pos(k,i,j)==k) THEN
+               ncell=ncell+1
+            ENDIF
+         ENDDO
+       ENDDO
+     ENDDO
+   ENDDO
+   ncell_e=ncell
+   
+   CALL MPI_ALLGATHER(ncell_e,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
+   displ=0
+   DO i=1,mpi_rank
+     displ=displ+ncell_glo(i-1)
+   ENDDO
+   ncell_tot=sum(ncell_glo(:))
+   
+   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:1,ncell), bounds_lat(0:1,ncell),ind_glo(ncell)) 
+
+
+   ncell=0
+   DO ind=1,ndomain
+     d=>domain(ind)
+     CALL swap_dimensions(ind)
+     CALL swap_geometry(ind)
+
+     DO j=d%jj_begin,d%jj_end
+       DO i=d%ii_begin,d%ii_end
+         DO k=0,5
+           IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
+                                                                                 .AND. d%edge_assign_pos(k,i,j)==k) THEN
+              ncell=ncell+1
+              ij=(j-1)*iim+i
+
+              lon(ncell)=lon_e(ij+u_pos(k+1))*180/Pi
+              lat(ncell)=lat_e(ij+u_pos(k+1))*180/Pi
+               
+              CALL xyz2lonlat(d%vertex(:,MOD((k-1)+6,6),i,j),bounds_lon(0,ncell), bounds_lat(0,ncell))
+              CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(1,ncell), bounds_lat(1,ncell))
+              bounds_lon(:,ncell)=bounds_lon(:,ncell)*180/Pi
+              bounds_lat(:,ncell)=bounds_lat(:,ncell)*180/Pi
+              ind_glo(ncell)=cell_glo(d%assign_cell_glo(i,j))%edge(MOD(k+d%delta(i,j)+6,6))-1 
+           ENDIF               
+         ENDDO
+       ENDDO
+     ENDDO
+   ENDDO
+   CALL xios_set_domain_attr("u",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
+   CALL xios_set_domain_attr("u", data_dim=1, type='unstructured' , nvertex=2, i_index=ind_glo)
+   CALL xios_set_domain_attr("u",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
+
+   DEALLOCATE(lon, lat, bounds_lon, bounds_lat,ind_glo) 
+
+
+   ncell=0
+   DO ind=1,ndomain
+     d=>domain(ind)
+        
+     DO j=d%jj_begin+1,d%jj_end
+       DO i=d%ii_begin,d%ii_end-1
+         ncell=ncell+1
+       ENDDO
+     ENDDO
+
+     DO j=d%jj_begin,d%jj_end-1
+       DO i=d%ii_begin+1,d%ii_end
+          ncell=ncell+1
+        ENDDO
+     ENDDO
+
+   ENDDO      
+   
+   ncell_v=ncell
+   
+   CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
+
+   displ=0
+   DO i=1,mpi_rank
+     displ=displ+ncell_glo(i-1)
+   ENDDO
+
+   ncell_tot=sum(ncell_glo(:))
+   
+   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:2,ncell), bounds_lat(0:2,ncell)) 
+   
+   ncell=0
+   DO ind=1,ndomain
+     d=>domain(ind)
+ 
+     DO j=d%jj_begin+1,d%jj_end
+       DO i=d%ii_begin,d%ii_end-1
+           ncell=ncell+1
+           CALL xyz2lonlat(d%vertex(:,vdown,i,j),lon(ncell),lat(ncell))
+           lon(ncell)=lon(ncell)*180/Pi
+           lat(ncell)=lat(ncell)*180/Pi
+
+           CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,ncell), bounds_lat(0,ncell))
+           CALL xyz2lonlat(d%xyz(:,i,j-1),bounds_lon(1,ncell), bounds_lat(1,ncell))
+           CALL xyz2lonlat(d%xyz(:,i+1,j-1),bounds_lon(2,ncell), bounds_lat(2,ncell))
+
+           DO k=0,2
+             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
+             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
+           ENDDO
+         ENDDO
+       ENDDO 
+ 
+       DO j=d%jj_begin,d%jj_end-1
+         DO i=d%ii_begin+1,d%ii_end
+           ncell=ncell+1
+           CALL xyz2lonlat(d%vertex(:,vup,i,j),lon(ncell),lat(ncell))
+           lon(ncell)=lon(ncell)*180/Pi
+           lat(ncell)=lat(ncell)*180/Pi
+           CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,ncell), bounds_lat(0,ncell))
+           CALL xyz2lonlat(d%xyz(:,i,j+1),bounds_lon(1,ncell), bounds_lat(1,ncell))
+           CALL xyz2lonlat(d%xyz(:,i-1,j+1),bounds_lon(2,ncell), bounds_lat(2,ncell))
+
+           DO k=0,2
+             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
+             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
+           ENDDO
+         ENDDO
+       ENDDO 
+        
+   ENDDO         
+
+  
+   CALL xios_set_domain_attr("v",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
+   CALL xios_set_domain_attr("v", data_dim=1, type='unstructured' , nvertex=3)
+   CALL xios_set_domain_attr("v",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
+
+
+   dtime%second=dt
+   CALL xios_set_timestep(dtime)
+   
+   CALL xios_set_fieldgroup_attr("standard_output", freq_op=itau_out*xios_timestep, freq_offset=(itau_out-1)*xios_timestep)
+    
+   CALL xios_close_context_definition()
+!$OMP END MASTER
+!$OMP BARRIER
+   
+ END SUBROUTINE xios_init_write_field
+  
+  
+ SUBROUTINE xios_write_field(name,field)
+ USE field_mod
+ IMPLICIT NONE 
+   CHARACTER(LEN=*),INTENT(IN) :: name
+   TYPE(t_field), POINTER :: field(:)
+   CHARACTER(LEN=10) :: str_number
+   INTEGER :: iq
+
+!$OMP BARRIER
+!$OMP MASTER
+   
+   IF (Field(1)%field_type==field_T) THEN
+     IF (field(1)%ndim==2) THEN
+        CALL xios_write_field_scalar(name,field,1,1)
+     ELSE IF (field(1)%ndim==3) THEN
+        CALL xios_write_field_scalar(name,field,size(field(1)%rval3d,2),1)
+     ELSE IF (field(1)%ndim==4) THEN
+!        DO iq=1,size(field(1)%rval4d,3)
+!          WRITE(str_number,'(i10)') iq
+!          CALL xios_write_field_scalar(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
+          CALL xios_write_field_scalar(name,field,size(field(1)%rval4d,2),size(field(1)%rval4d,3))
+!        ENDDO
+     ELSE
+        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
+     ENDIF
+
+   ELSE IF (Field(1)%field_type==field_U) THEN
+      IF (field(1)%ndim==2) THEN
+        CALL xios_write_field_U(name,field,1,1)
+      ELSE IF (field(1)%ndim==3) THEN
+        CALL xios_write_field_U(name,field,size(field(1)%rval3d,2),1)
+      ELSE IF (field(1)%ndim==4) THEN
+        CALL xios_write_field_U(name,field,size(field(1)%rval4d,2),size(field(1)%rval4d,3))
+      ELSE
+        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
+      ENDIF
+
+    ELSE IF (Field(1)%field_type==field_Z) THEN
+     IF (field(1)%ndim==2) THEN
+        CALL xios_write_field_vort(name,field,1)
+      ELSE IF (field(1)%ndim==3) THEN
+        CALL xios_write_field_vort(name,field,size(field(1)%rval3d,2))
+      ELSE IF (field(1)%ndim==4) THEN
+        DO iq=1,size(field(1)%rval4d,3)
+          WRITE(str_number,'(i10)') iq
+          CALL xios_write_field_vort(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
+        ENDDO
+      ELSE
+        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
+      ENDIF
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+      
+ END SUBROUTINE xios_write_field
+
+ SUBROUTINE xios_read_field(name,field)
+ USE field_mod
+ IMPLICIT NONE 
+   CHARACTER(LEN=*),INTENT(IN) :: name
+   TYPE(t_field), POINTER :: field(:)
+   CHARACTER(LEN=10) :: str_number
+   INTEGER :: iq
+
+!$OMP BARRIER
+!$OMP MASTER
+   
+   IF (Field(1)%field_type==field_T) THEN
+     IF (field(1)%ndim==2) THEN
+        CALL xios_read_field_scalar(name,field,1,1)
+      ELSE IF (field(1)%ndim==3) THEN
+        CALL xios_read_field_scalar(name,field,size(field(1)%rval3d,2),1)
+      ELSE IF (field(1)%ndim==4) THEN
+!        DO iq=1,size(field(1)%rval4d,3)
+!          WRITE(str_number,'(i10)') iq
+!          CALL xios_read_field_scalar(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
+!        ENDDO
+          CALL xios_read_field_scalar(name,field,size(field(1)%rval4d,2),size(field(1)%rval4d,3))
+      ELSE
+        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
+      ENDIF
+   ELSE IF (Field(1)%field_type==field_U) THEN
+     IF (field(1)%ndim==2) THEN
+        CALL xios_read_field_u(name,field,1,1)
+      ELSE IF (field(1)%ndim==3) THEN
+        CALL xios_read_field_u(name,field,size(field(1)%rval3d,2),1)
+      ELSE IF (field(1)%ndim==4) THEN
+          CALL xios_read_field_u(name,field,size(field(1)%rval4d,2),size(field(1)%rval4d,3))
+      ELSE
+        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
+      ENDIF
+    ELSE IF (Field(1)%field_type==field_Z) THEN
+     IF (field(1)%ndim==2) THEN
+        CALL xios_read_field_vort(name,field,1)
+      ELSE IF (field(1)%ndim==3) THEN
+        CALL xios_read_field_vort(name,field,size(field(1)%rval3d,2))
+      ELSE IF (field(1)%ndim==4) THEN
+        DO iq=1,size(field(1)%rval4d,3)
+          WRITE(str_number,'(i10)') iq
+          CALL xios_read_field_vort(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
+        ENDDO
+      ELSE
+        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
+      ENDIF
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+      
+ END SUBROUTINE xios_read_field
+
+
+ 
+ SUBROUTINE xios_write_field_scalar(name,field,nlev,nq)
+ USE genmod
+ USE mpipara
+ USE xios
+ USE grid_param
+ USE domain_mod
+ USE dimensions
+ USE spherical_geom_mod
+ USE geometry
+ USE mpi_mod
+ IMPLICIT NONE 
+   CHARACTER(LEN=*),INTENT(IN) :: name
+   TYPE(t_field), POINTER :: field(:)
+   INTEGER,INTENT(IN) :: nlev
+   INTEGER,INTENT(IN) :: nq
+   
+   REAL(rstd) :: field_tmp(ncell_i,nlev,nq)
+   TYPE(t_domain),POINTER :: d
+   INTEGER :: n,i,j,ij,ind
+   
+   IF (field(1)%ndim==2) THEN
+     n=0
+     DO ind=1,ndomain
+       
+       d=>domain(ind)
+        
+       DO j=d%jj_begin,d%jj_end
+         DO i=d%ii_begin,d%ii_end
+           IF (d%own(i,j)) THEN
+             n=n+1
+             ij=d%iim*(j-1)+i
+             field_tmp(n,1,1)=field(ind)%rval2d(ij)
+           ENDIF
+         ENDDO
+       ENDDO
+     ENDDO
+   ELSE IF (field(1)%ndim==3) THEN
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+        
+       DO j=d%jj_begin,d%jj_end
+         DO i=d%ii_begin,d%ii_end
+           IF (d%own(i,j)) THEN
+             n=n+1
+             ij=d%iim*(j-1)+i
+             field_tmp(n,:,1)=field(ind)%rval3d(ij,:)
+           ENDIF
+         ENDDO
+       ENDDO
+     ENDDO
+   ELSE IF (field(1)%ndim==4) THEN
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+        
+       DO j=d%jj_begin,d%jj_end
+         DO i=d%ii_begin,d%ii_end
+           IF (d%own(i,j)) THEN
+             n=n+1
+             ij=d%iim*(j-1)+i
+             field_tmp(n,:,:)=field(ind)%rval4d(ij,:,:)
+           ENDIF
+         ENDDO
+       ENDDO
+     ENDDO     
+   ENDIF
+   
+   CALL xios_send_field(name,field_tmp)
+ 
+ END SUBROUTINE xios_write_field_scalar  
+
+
+ SUBROUTINE xios_read_var(name,field)
+   USE prec
+   CHARACTER(LEN=*),INTENT(IN) :: name
+   REAL(rstd), INTENT(OUT) :: field
+   CALL xios_recv_field(name,field)
+ END SUBROUTINE
+
+ SUBROUTINE xios_read_field_scalar(name,field,nlev,nq)
+ USE genmod
+ USE mpipara
+ USE xios
+ USE grid_param
+ USE domain_mod
+ USE dimensions
+ USE spherical_geom_mod
+ USE geometry
+ USE mpi_mod
+ IMPLICIT NONE 
+   CHARACTER(LEN=*),INTENT(IN) :: name
+   TYPE(t_field), POINTER :: field(:)
+   INTEGER,INTENT(IN) :: nlev
+   INTEGER,INTENT(IN) :: nq
+   
+   REAL(rstd) :: field_tmp(ncell_i,nlev,nq)
+   TYPE(t_domain),POINTER :: d
+   INTEGER :: n,i,j,ij,ind
+
+   CALL xios_recv_field(name,field_tmp)
+   
+   IF (field(1)%ndim==2) THEN
+     n=0
+     DO ind=1,ndomain
+       
+       d=>domain(ind)
+        
+       DO j=d%jj_begin,d%jj_end
+         DO i=d%ii_begin,d%ii_end
+           IF (d%own(i,j)) THEN
+             n=n+1
+             ij=d%iim*(j-1)+i
+             field(ind)%rval2d(ij)=field_tmp(n,1,1)
+           ENDIF
+         ENDDO
+       ENDDO
+     ENDDO
+   ELSE IF (field(1)%ndim==3) THEN
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+        
+       DO j=d%jj_begin,d%jj_end
+         DO i=d%ii_begin,d%ii_end
+           IF (d%own(i,j)) THEN
+             n=n+1
+             ij=d%iim*(j-1)+i
+             field(ind)%rval3d(ij,:)=field_tmp(n,:,1)
+           ENDIF
+         ENDDO
+       ENDDO
+     ENDDO
+   ELSE IF (field(1)%ndim==4) THEN
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+        
+       DO j=d%jj_begin,d%jj_end
+         DO i=d%ii_begin,d%ii_end
+           IF (d%own(i,j)) THEN
+             n=n+1
+             ij=d%iim*(j-1)+i
+             field(ind)%rval4d(ij,:,:)=field_tmp(n,:,:)
+           ENDIF
+         ENDDO
+       ENDDO
+     ENDDO     
+   ENDIF
+ 
+ END SUBROUTINE xios_read_field_scalar
+
+ SUBROUTINE xios_write_field_U(name,field,nlev,nq)
+ USE genmod
+ USE mpipara
+ USE xios
+ USE grid_param
+ USE domain_mod
+ USE dimensions
+ USE spherical_geom_mod
+ USE geometry
+ USE mpi_mod
+ IMPLICIT NONE 
+   CHARACTER(LEN=*),INTENT(IN) :: name
+   TYPE(t_field), POINTER :: field(:)
+   INTEGER,INTENT(IN) :: nlev
+   INTEGER,INTENT(IN) :: nq
+   
+   REAL(rstd) :: field_tmp(ncell_e,nlev,nq)
+   TYPE(t_domain),POINTER :: d
+   INTEGER :: n,i,j,k,ij,ind
+   
+   IF (field(1)%ndim==2) THEN
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+
+       DO j=d%jj_begin,d%jj_end
+         DO i=d%ii_begin,d%ii_end
+           DO k=0,5
+             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
+                                                                                 .AND. d%edge_assign_pos(k,i,j)==k) THEN
+               n=n+1
+               ij=iim*(j-1)+i
+               Field_tmp(n,1,1)=d%edge_assign_sign(k,i,j)*field(ind)%rval2d(ij+d%u_pos(k+1))
+             ENDIF
+           ENDDO
+         ENDDO
+       ENDDO
+     ENDDO       
+  
+   ELSE IF (field(1)%ndim==3) THEN
+
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+
+       DO j=d%jj_begin,d%jj_end
+         DO i=d%ii_begin,d%ii_end
+           DO k=0,5
+             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
+                                                                                  .AND. d%edge_assign_pos(k,i,j)==k) THEN
+               n=n+1
+               ij=iim*(j-1)+i
+               Field_tmp(n,:,1)=d%edge_assign_sign(k,i,j)*field(ind)%rval3d(ij+d%u_pos(k+1),:)
+             ENDIF
+           ENDDO
+         ENDDO
+       ENDDO
+     ENDDO       
+
+   ELSE IF (field(1)%ndim==4) THEN
+
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+
+       DO j=d%jj_begin,d%jj_end
+         DO i=d%ii_begin,d%ii_end
+           DO k=0,5
+             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
+                                                                                  .AND. d%edge_assign_pos(k,i,j)==k) THEN
+               n=n+1
+               ij=iim*(j-1)+i
+               Field_tmp(n,:,:)=d%edge_assign_sign(k,i,j)*field(ind)%rval4d(ij+d%u_pos(k+1),:,:)
+             ENDIF
+           ENDDO
+         ENDDO
+       ENDDO
+     ENDDO       
+
+   ENDIF
+   
+   CALL xios_send_field(name,field_tmp)
+ 
+ END SUBROUTINE xios_write_field_u 
+
+
+ SUBROUTINE xios_read_field_u(name,field,nlev,nq)
+ USE genmod
+ USE mpipara
+ USE xios
+ USE grid_param
+ USE domain_mod
+ USE dimensions
+ USE spherical_geom_mod
+ USE geometry
+ USE mpi_mod
+ IMPLICIT NONE 
+   CHARACTER(LEN=*),INTENT(IN) :: name
+   TYPE(t_field), POINTER :: field(:)
+   INTEGER,INTENT(IN) :: nlev
+   INTEGER,INTENT(IN) :: nq
+   
+   REAL(rstd) :: field_tmp(ncell_e,nlev,nq)
+   TYPE(t_domain),POINTER :: d
+   INTEGER :: n,i,j,k,ij,ind
+
+   CALL xios_recv_field(name,field_tmp)
+   
+   IF (field(1)%ndim==2) THEN
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+
+       DO j=d%jj_begin,d%jj_end
+         DO i=d%ii_begin,d%ii_end
+           DO k=0,5
+             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
+                                                                                 .AND. d%edge_assign_pos(k,i,j)==k) THEN
+               n=n+1
+               ij=iim*(j-1)+i
+               field(ind)%rval2d(ij+d%u_pos(k+1))=Field_tmp(n,1,1)*d%edge_assign_sign(k,i,j)
+             ENDIF
+           ENDDO
+         ENDDO
+       ENDDO
+     ENDDO       
+  
+   ELSE IF (field(1)%ndim==3) THEN
+
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+
+       DO j=d%jj_begin,d%jj_end
+         DO i=d%ii_begin,d%ii_end
+           DO k=0,5
+             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
+                                                                                  .AND. d%edge_assign_pos(k,i,j)==k) THEN
+               n=n+1
+               ij=iim*(j-1)+i
+               field(ind)%rval3d(ij+d%u_pos(k+1),:)=Field_tmp(n,:,1)*d%edge_assign_sign(k,i,j)
+             ENDIF
+           ENDDO
+         ENDDO
+       ENDDO
+     ENDDO       
+
+   ELSE IF (field(1)%ndim==4) THEN
+
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+
+       DO j=d%jj_begin,d%jj_end
+         DO i=d%ii_begin,d%ii_end
+           DO k=0,5
+             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
+                                                                                  .AND. d%edge_assign_pos(k,i,j)==k) THEN
+               n=n+1
+               ij=iim*(j-1)+i
+               field(ind)%rval4d(ij+d%u_pos(k+1),:,:)=Field_tmp(n,:,:)*d%edge_assign_sign(k,i,j)
+             ENDIF
+           ENDDO
+         ENDDO
+       ENDDO
+     ENDDO       
+
+   ENDIF
+   
+ 
+ END SUBROUTINE xios_read_field_u 
+
+
+
+      
+ SUBROUTINE xios_write_field_vort(name,field,nlev,iq)
+ USE genmod
+ USE mpipara
+ USE xios
+ USE grid_param
+ USE domain_mod
+ USE dimensions
+ USE spherical_geom_mod
+ USE geometry
+ USE mpi_mod
+ IMPLICIT NONE 
+   CHARACTER(LEN=*),INTENT(IN) :: name
+   TYPE(t_field), POINTER :: field(:)
+   INTEGER,INTENT(IN) :: nlev
+   INTEGER,INTENT(IN),OPTIONAL :: iq
+   
+   REAL(rstd) :: field_tmp(ncell_v,nlev)
+   TYPE(t_domain),POINTER :: d
+   INTEGER :: n,i,j,ij,ind
+   
+   IF (field(1)%ndim==2) THEN
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+       CALL swap_dimensions(ind)  
+       
+       DO j=d%jj_begin+1,d%jj_end
+         DO i=d%ii_begin,d%ii_end-1
+           n=n+1
+           ij=iim*(j-1)+i
+           Field_tmp(n,1)=field(ind)%rval2d(ij+z_down)
+         ENDDO
+       ENDDO
+
+       DO j=d%jj_begin,d%jj_end-1
+         DO i=d%ii_begin+1,d%ii_end
+           n=n+1
+           ij=iim*(j-1)+i
+           Field_tmp(n,1)=field(ind)%rval2d(ij+z_up)
+          ENDDO
+       ENDDO
+          
+     ENDDO
+
+   ELSE IF (field(1)%ndim==3) THEN
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+       CALL swap_dimensions(ind)    
+             
+       DO j=d%jj_begin+1,d%jj_end
+         DO i=d%ii_begin,d%ii_end-1
+           n=n+1
+           ij=iim*(j-1)+i
+           Field_tmp(n,:)=field(ind)%rval3d(ij+z_down,:)
+         ENDDO
+       ENDDO
+
+       DO j=d%jj_begin,d%jj_end-1
+         DO i=d%ii_begin+1,d%ii_end
+           n=n+1
+           ij=iim*(j-1)+i
+           Field_tmp(n,:)=field(ind)%rval3d(ij+z_up,:)
+          ENDDO
+       ENDDO
+          
+     ENDDO
+
+   ELSE IF (field(1)%ndim==4) THEN
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+       CALL swap_dimensions(ind) 
+               
+       DO j=d%jj_begin+1,d%jj_end
+         DO i=d%ii_begin,d%ii_end-1
+           n=n+1
+           ij=iim*(j-1)+i
+           Field_tmp(n,:)=field(ind)%rval4d(ij+z_down,:,iq)
+         ENDDO
+       ENDDO
+
+       DO j=d%jj_begin,d%jj_end-1
+         DO i=d%ii_begin+1,d%ii_end
+           n=n+1
+           ij=iim*(j-1)+i
+           Field_tmp(n,:)=field(ind)%rval4d(ij+z_up,:,iq)
+          ENDDO
+       ENDDO
+          
+     ENDDO
+
+   ENDIF
+   
+   CALL xios_send_field(name,field_tmp)
+ 
+ END SUBROUTINE xios_write_field_vort 
+
+ SUBROUTINE xios_read_field_vort(name,field,nlev,iq)
+ USE genmod
+ USE mpipara
+ USE xios
+ USE grid_param
+ USE domain_mod
+ USE dimensions
+ USE spherical_geom_mod
+ USE geometry
+ USE mpi_mod
+ IMPLICIT NONE 
+   CHARACTER(LEN=*),INTENT(IN) :: name
+   TYPE(t_field), POINTER :: field(:)
+   INTEGER,INTENT(IN) :: nlev
+   INTEGER,INTENT(IN),OPTIONAL :: iq
+   
+   REAL(rstd) :: field_tmp(ncell_v,nlev)
+   TYPE(t_domain),POINTER :: d
+   INTEGER :: n,i,j,ij,ind
+
+   CALL xios_recv_field(name,field_tmp)
+
+   
+   IF (field(1)%ndim==2) THEN
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+       CALL swap_dimensions(ind)  
+       
+       DO j=d%jj_begin+1,d%jj_end
+         DO i=d%ii_begin,d%ii_end-1
+           n=n+1
+           ij=iim*(j-1)+i
+           field(ind)%rval2d(ij+z_down)=Field_tmp(n,1)
+         ENDDO
+       ENDDO
+
+       DO j=d%jj_begin,d%jj_end-1
+         DO i=d%ii_begin+1,d%ii_end
+           n=n+1
+           ij=iim*(j-1)+i
+           Field_tmp(n,1)=field(ind)%rval2d(ij+z_up)
+           field(ind)%rval2d(ij+z_up)=Field_tmp(n,1)
+          ENDDO
+       ENDDO
+          
+     ENDDO
+
+   ELSE IF (field(1)%ndim==3) THEN
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+       CALL swap_dimensions(ind)    
+             
+       DO j=d%jj_begin+1,d%jj_end
+         DO i=d%ii_begin,d%ii_end-1
+           n=n+1
+           ij=iim*(j-1)+i
+           field(ind)%rval3d(ij+z_down,:)=Field_tmp(n,:)
+         ENDDO
+       ENDDO
+
+       DO j=d%jj_begin,d%jj_end-1
+         DO i=d%ii_begin+1,d%ii_end
+           n=n+1
+           ij=iim*(j-1)+i
+           field(ind)%rval3d(ij+z_up,:)=Field_tmp(n,:)
+          ENDDO
+       ENDDO
+          
+     ENDDO
+
+   ELSE IF (field(1)%ndim==4) THEN
+     n=0
+     DO ind=1,ndomain
+       d=>domain(ind)
+       CALL swap_dimensions(ind) 
+               
+       DO j=d%jj_begin+1,d%jj_end
+         DO i=d%ii_begin,d%ii_end-1
+           n=n+1
+           ij=iim*(j-1)+i
+           field(ind)%rval4d(ij+z_down,:,iq)=Field_tmp(n,:)
+         ENDDO
+       ENDDO
+
+       DO j=d%jj_begin,d%jj_end-1
+         DO i=d%ii_begin+1,d%ii_end
+           n=n+1
+           ij=iim*(j-1)+i
+           field(ind)%rval4d(ij+z_up,:,iq)=Field_tmp(n,:)
+          ENDDO
+       ENDDO
+          
+     ENDDO
+
+   ENDIF
+ 
+ END SUBROUTINE xios_read_field_vort 
+
+
+
+
+  
+ 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
+
+ SUBROUTINE xios_set_context
+ IMPLICIT NONE   
+  TYPE(xios_context) :: ctx_hdl
+
+!$OMP MASTER 
+   CALL xios_get_handle("icosagcm",ctx_hdl)
+   CALL xios_set_current_context(ctx_hdl)
+!$OMP END MASTER
+
+  END SUBROUTINE xios_set_context
+
+
+#else
+  
+
+INTERFACE xios_send_field
+  MODULE PROCEDURE xios_send_field_scalar, xios_send_field_1d
+END INTERFACE  xios_send_field
+
+INTEGER,PARAMETER :: xios_timestep=1
+
+CONTAINS  
+  
+  
+  SUBROUTINE xios_init
+   IMPLICIT NONE
+         
+    using_xios=.FALSE.
+    
+  END SUBROUTINE xios_init
+  
+  SUBROUTINE xios_send_field_scalar(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(IN) :: field
+  END SUBROUTINE xios_send_field_scalar  
+
+  SUBROUTINE xios_send_field_1d(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(IN) :: field(:)
+  END SUBROUTINE xios_send_field_1d  
+ 
+  SUBROUTINE xios_write_field(name,field)
+  USE field_mod
+  IMPLICIT NONE 
+   CHARACTER(LEN=*),INTENT(IN) :: name
+   TYPE(t_field), POINTER :: field(:)
+  END SUBROUTINE xios_write_field
+
+  SUBROUTINE xios_read_field(name,field)
+  USE field_mod
+  IMPLICIT NONE 
+   CHARACTER(LEN=*),INTENT(IN) :: name
+   TYPE(t_field), POINTER :: field(:)
+  END SUBROUTINE xios_read_field
+
+ SUBROUTINE xios_read_var(name,field)
+   USE prec
+   CHARACTER(LEN=*),INTENT(IN) :: name
+   REAL(rstd), INTENT(OUT) :: field
+ END SUBROUTINE
+ 
+  SUBROUTINE xios_update_calendar(step)
+  IMPLICIT NONE
+   INTEGER, INTENT(IN):: step  
+  END SUBROUTINE xios_update_calendar
+
+  SUBROUTINE xios_write_field_finalize
+  END SUBROUTINE xios_write_field_finalize
+  
+  SUBROUTINE xios_init_write_field
+  END SUBROUTINE xios_init_write_field  
+  
+  SUBROUTINE xios_set_context
+  END SUBROUTINE xios_set_context
+  
+  SUBROUTINE xios_set_fieldgroup_attr(name,enabled,freq_op)
+    CHARACTER(LEN=*) :: name
+    LOGICAL,OPTIONAL          :: enabled
+    INTEGER,OPTIONAL          :: freq_op
+  END SUBROUTINE xios_set_fieldgroup_attr
+
+  SUBROUTINE xios_set_filegroup_attr(name,enabled)
+    CHARACTER(LEN=*) :: name
+    LOGICAL,OPTIONAL          :: enabled
+  END SUBROUTINE xios_set_filegroup_attr
+
+  SUBROUTINE xios_set_file_attr(id,name,enabled, output_freq)
+    CHARACTER(LEN=*) :: id
+    CHARACTER(LEN=*),OPTIONAL :: name
+    LOGICAL,OPTIONAL          :: enabled
+    INTEGER,OPTIONAL          :: output_freq
+  END SUBROUTINE xios_set_file_attr
+
+  SUBROUTINE xios_get_axis_attr(name,n_glo,value)
+    CHARACTER(LEN=*) :: name
+    INTEGER,OPTIONAL          :: n_glo
+    REAL,OPTIONAL             :: value(:)
+  END SUBROUTINE xios_get_axis_attr
+
+  SUBROUTINE xios_set_axis_attr(id,n_glo,value)
+    CHARACTER(LEN=*) :: id
+    INTEGER,OPTIONAL          :: n_glo
+    REAL,OPTIONAL             :: value(:)
+  END SUBROUTINE xios_set_axis_attr
+
+#endif  
+
+END MODULE xios_mod
Index: codes/icosagcm/devel/src/output_field.f90
===================================================================
--- codes/icosagcm/devel/src/output_field.f90	(revision 531)
+++ 	(revision )
@@ -1,64 +1,0 @@
-MODULE output_field_mod
-USE genmod
-  PRIVATE
-  LOGICAL,SAVE :: xios_output 
-!$OMP THREADPRIVATE(xios_output)     
-  LOGICAL,SAVE :: enable_io    
-!$OMP THREADPRIVATE(enable_io)     
-
-  PUBLIC enable_io,xios_output,output_field_init,output_field,output_field_finalize
-
-CONTAINS 
-  
-  SUBROUTINE output_field_init
-  USE getin_mod
-  USE xios_mod
-  USE write_field_mod
-  IMPLICIT NONE
-
-    enable_io=.TRUE.
-    CALL getin('enable_io',enable_io)
-
-    IF (using_xios) THEN
-      xios_output=.TRUE.
-      CALL getin('xios_output',xios_output)
-    ELSE
-      xios_output=.FALSE.
-    ENDIF
-    
-    IF (xios_output) THEN
-      CALL xios_init_write_field
-    ENDIF
-
-    
-  END SUBROUTINE output_field_init
-
-  SUBROUTINE output_field(name_in,field)
-    USE field_mod
-    USE xios_mod
-    USE write_field_mod
-    IMPLICIT NONE  
-     CHARACTER(LEN=*),INTENT(IN) :: name_in
-      TYPE(t_field),POINTER :: field(:)
-
-      IF (xios_output) THEN
-        CALL xios_write_field(name_in,field)
-      ELSE
-       CALL writeField(name_in,field)
-      ENDIF
-
-  END SUBROUTINE output_field
-
-  SUBROUTINE output_field_finalize
-  USE ioipsl
-  USE xios_mod
-  IMPLICIT NONE
-    
-    IF (xios_output) THEN
-      CALL xios_write_field_finalize
-    ENDIF
-    
-  END SUBROUTINE output_field_finalize
-
-END MODULE output_field_mod
-  
Index: codes/icosagcm/devel/src/parallel/checksum.f90
===================================================================
--- codes/icosagcm/devel/src/parallel/checksum.f90	(revision 533)
+++ codes/icosagcm/devel/src/parallel/checksum.f90	(revision 533)
@@ -0,0 +1,150 @@
+MODULE checksum_mod
+
+
+! simple function to perform checksum on T field
+! works only on 1 process
+! usefull to check openMP synchronisation problem
+! need to be enhanced...
+
+CONTAINS
+
+  SUBROUTINE checksum(field)
+  USE icosa
+  USE mpi_mod
+  USE mpipara
+  IMPLICIT NONE
+    TYPE(t_field) :: field(:)
+
+    INTEGER :: intval(2)
+    INTEGER :: ind,i,j,ij,l,k
+    INTEGER :: tot_sum
+    INTEGER :: tot_sum_mpi(mpi_size)
+        
+
+!$OMP BARRIER
+!$OMP MASTER
+    tot_sum=0
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+       
+      IF (field(ind)%field_type==field_T) THEN
+
+        IF (field(ind)%ndim==2) THEN
+          DO j=jj_begin,jj_end
+             DO i=ii_begin,ii_end
+                ij=(j-1)*iim+i
+                IF (domain(ind)%own(i,j)) THEN
+                  intval=transfer(field(ind)%rval2d(ij),intval,2)  
+                  tot_sum=tot_sum+intval(1)+intval(2)
+                ENDIF
+             ENDDO
+          ENDDO
+     
+        ELSE IF (field(ind)%ndim==3) THEN
+          
+          DO l=1,size(field(ind)%rval3d,2)
+            DO j=jj_begin,jj_end
+               DO i=ii_begin,ii_end
+                  ij=(j-1)*iim+i
+                  IF (domain(ind)%own(i,j)) THEN
+                    intval=transfer(field(ind)%rval3d(ij,l),intval,2)  
+                    tot_sum=tot_sum+intval(1)+intval(2)
+                  ENDIF
+               ENDDO
+            ENDDO
+          ENDDO
+
+        ELSE IF (field(ind)%ndim==4) THEN
+          
+          DO k=1,size(field(ind)%rval4d,3)
+            DO l=1,size(field(ind)%rval4d,2)
+              DO j=jj_begin,jj_end
+                 DO i=ii_begin,ii_end
+                    ij=(j-1)*iim+i
+                    IF (domain(ind)%own(i,j)) THEN
+                      intval=transfer(field(ind)%rval4d(ij,l,k),intval,2)  
+                      tot_sum=tot_sum+intval(1)+intval(2)
+                    ENDIF
+                 ENDDO
+              ENDDO
+            ENDDO
+          ENDDO
+       
+        ENDIF
+
+      ELSE IF (field(ind)%field_type==field_U) THEN
+
+        IF (field(ind)%ndim==2) THEN
+          DO j=jj_begin,jj_end
+             DO i=ii_begin,ii_end-1
+                ij=(j-1)*iim+i
+                intval=transfer(field(ind)%rval2d(ij+u_right),intval,2)  
+                tot_sum=tot_sum+intval(1)+intval(2)
+             ENDDO
+          ENDDO
+
+          DO j=jj_begin,jj_end-1
+             DO i=ii_begin+1,ii_end
+                ij=(j-1)*iim+i
+                intval=transfer(field(ind)%rval2d(ij+u_lup),intval,2)  
+                tot_sum=tot_sum+intval(1)+intval(2)
+             ENDDO
+          ENDDO
+    
+          DO j=jj_begin+1,jj_end
+             DO i=ii_begin,ii_end
+                ij=(j-1)*iim+i
+                intval=transfer(field(ind)%rval2d(ij+u_ldown),intval,2)  
+                tot_sum=tot_sum+intval(1)+intval(2)
+             ENDDO
+          ENDDO
+
+        ELSE IF (field(ind)%ndim==3) THEN
+          
+          DO l=1,size(field(ind)%rval3d,2)
+          DO j=jj_begin,jj_end
+             DO i=ii_begin,ii_end-1
+                ij=(j-1)*iim+i
+                intval=transfer(field(ind)%rval3d(ij+u_right,l),intval,2)  
+                tot_sum=tot_sum+intval(1)+intval(2)
+             ENDDO
+          ENDDO
+
+          DO j=jj_begin,jj_end-1
+             DO i=ii_begin+1,ii_end
+                ij=(j-1)*iim+i
+                intval=transfer(field(ind)%rval3d(ij+u_lup,l),intval,2)  
+                tot_sum=tot_sum+intval(1)+intval(2)
+             ENDDO
+          ENDDO
+    
+          DO j=jj_begin+1,jj_end
+             DO i=ii_begin,ii_end
+                ij=(j-1)*iim+i
+                intval=transfer(field(ind)%rval3d(ij+u_ldown,l),intval,2)  
+                tot_sum=tot_sum+intval(1)+intval(2)
+             ENDDO
+          ENDDO
+          ENDDO
+
+        
+        ENDIF
+     ENDIF
+
+    ENDDO
+!$OMP END MASTER
+!$OMP BARRIER    
+    
+!$OMP MASTER
+    CALL MPI_Gather(tot_sum,1,MPI_INTEGER,tot_sum_mpi,1,MPI_INTEGER,0,comm_icosa,ierr)
+    IF (mpi_rank==0) PRINT*,"CheckSum Field : ",field(1)%name,sum(tot_sum_mpi), tot_sum_mpi
+    
+!$OMP END MASTER
+  
+  
+  
+  END SUBROUTINE checksum
+  
+END MODULE checksum_mod
+  
Index: codes/icosagcm/devel/src/parallel/domain.f90
===================================================================
--- codes/icosagcm/devel/src/parallel/domain.f90	(revision 533)
+++ codes/icosagcm/devel/src/parallel/domain.f90	(revision 533)
@@ -0,0 +1,590 @@
+MODULE domain_mod
+  USE domain_param
+
+  TYPE t_domain
+    INTEGER :: face
+    INTEGER :: iim
+    INTEGER :: jjm
+    INTEGER :: ii_begin
+    INTEGER :: jj_begin
+    INTEGER :: ii_end
+    INTEGER :: jj_end
+    INTEGER :: ii_nb
+    INTEGER :: jj_nb
+    INTEGER :: ii_begin_glo
+    INTEGER :: jj_begin_glo
+    INTEGER :: ii_end_glo
+    INTEGER :: jj_end_glo
+    INTEGER,POINTER  :: assign_domain(:,:)
+    INTEGER,POINTER  :: assign_cell_glo(:,:)
+    INTEGER,POINTER  :: assign_i(:,:)
+    INTEGER,POINTER  :: assign_j(:,:)
+    INTEGER,POINTER  :: edge_assign_domain(:,:,:)
+    INTEGER,POINTER  :: edge_assign_i(:,:,:)
+    INTEGER,POINTER  :: edge_assign_j(:,:,:)
+    INTEGER,POINTER  :: edge_assign_pos(:,:,:)
+    INTEGER,POINTER  :: edge_assign_sign(:,:,:)
+    REAL,POINTER     :: xyz(:,:,:)
+    REAL,POINTER     :: neighbour(:,:,:,:)
+    INTEGER,POINTER  :: delta(:,:)
+    REAL,POINTER     :: vertex(:,:,:,:)
+    LOGICAL,POINTER  :: own(:,:)
+    INTEGER,POINTER  :: ne(:,:,:)
+    
+    INTEGER :: t_right
+    INTEGER :: t_rup
+    INTEGER :: t_lup
+    INTEGER :: t_left
+    INTEGER :: t_ldown
+    INTEGER :: t_rdown
+
+    INTEGER :: u_right
+    INTEGER :: u_rup
+    INTEGER :: u_lup
+    INTEGER :: u_left
+    INTEGER :: u_ldown
+    INTEGER :: u_rdown
+
+    INTEGER :: z_rup
+    INTEGER :: z_up
+    INTEGER :: z_lup
+    INTEGER :: z_ldown
+    INTEGER :: z_down
+    INTEGER :: z_rdown
+   
+    INTEGER :: t_pos(6)
+    INTEGER :: u_pos(6)
+    INTEGER :: z_pos(6)
+     
+  END TYPE t_domain
+
+  INTEGER,SAVE :: ndomain
+  INTEGER,SAVE :: ndomain_glo
+
+  TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain(:)
+  TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain_glo(:)
+
+  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
+
+  SUBROUTINE create_domain
+  USE grid_param
+  USE mpipara
+  USE ioipsl
+  IMPLICIT NONE
+  INTEGER :: ind,nf,ni,nj,i,j
+  INTEGER :: quotient, rest
+  INTEGER :: halo_i,halo_j
+  
+  TYPE(t_domain),POINTER :: d
+ 
+    ndomain_glo=nsplit_i*nsplit_j*nb_face
+    ALLOCATE(domain_glo(ndomain_glo))
+    ALLOCATE(domglo_rank(ndomain_glo))
+    ALLOCATE(domglo_loc_ind(ndomain_glo))
+   
+    halo_i=0
+    CALL getin("halo_i",halo_i)
+    halo_j=1
+    CALL getin("halo_j",halo_j)
+
+    ind=0
+    DO nf=1,nb_face
+      DO nj=1,nsplit_j
+        DO ni=1,nsplit_i
+          ind=ind+1
+          d=>domain_glo(ind)
+          quotient=(iim_glo/nsplit_i)
+          rest=MOD(iim_glo,nsplit_i)
+          IF (ni-1 < rest) THEN
+            d%ii_nb=quotient+1
+            d%ii_begin_glo=(quotient+1)*(ni-1)+1
+          ELSE 
+            d%ii_nb=quotient
+            d%ii_begin_glo=(quotient+1)*rest+(ni-1-rest) * quotient+1
+          ENDIF
+          d%ii_end_glo=d%ii_begin_glo+d%ii_nb-1
+ 
+          IF (ni/=1) THEN 
+            d%ii_nb=d%ii_nb+1
+            d%ii_begin_glo=d%ii_begin_glo-1
+          ENDIF
+         
+        
+          quotient=(jjm_glo/nsplit_j)
+          rest=MOD(jjm_glo,nsplit_j)
+          IF (nj-1 < rest) THEN
+            d%jj_nb=quotient+1
+            d%jj_begin_glo=(quotient+1)*(nj-1)+1
+          ELSE
+            d%jj_nb=quotient
+            d%jj_begin_glo=(quotient+1)*rest+(nj-1-rest) * quotient+1
+          ENDIF
+          d%jj_end_glo=d%jj_begin_glo+d%jj_nb-1
+
+          IF (nj/=1) THEN 
+            d%jj_nb=d%jj_nb+1
+            d%jj_begin_glo=d%jj_begin_glo-1
+          ENDIF
+
+
+          d%iim=d%ii_nb+2*halo  + halo_i*2
+          d%jjm=d%jj_nb+2*halo  + halo_j*2
+          d%ii_begin=halo+1  + halo_i
+          d%jj_begin=halo+1  + halo_j
+          d%ii_end=d%ii_begin+d%ii_nb-1
+          d%jj_end=d%jj_begin+d%jj_nb-1
+          d%face=nf        
+          ALLOCATE(d%assign_domain(d%iim,d%jjm))
+          ALLOCATE(d%assign_cell_glo(d%iim,d%jjm))
+          ALLOCATE(d%assign_i(d%iim,d%jjm))
+          ALLOCATE(d%assign_j(d%iim,d%jjm))
+          ALLOCATE(d%edge_assign_domain(0:5,d%iim,d%jjm))
+          ALLOCATE(d%edge_assign_i(0:5,d%iim,d%jjm))
+          ALLOCATE(d%edge_assign_j(0:5,d%iim,d%jjm))
+          ALLOCATE(d%edge_assign_pos(0:5,d%iim,d%jjm))
+          ALLOCATE(d%edge_assign_sign(0:5,d%iim,d%jjm))
+          ALLOCATE(d%delta(d%iim,d%jjm))
+          ALLOCATE(d%xyz(3,d%iim,d%jjm))
+          ALLOCATE(d%vertex(3,0:5,d%iim,d%jjm))
+          ALLOCATE(d%neighbour(3,0:5,d%iim,d%jjm))
+          ALLOCATE(d%own(d%iim,d%jjm))
+          ALLOCATE(d%ne(0:5,d%iim,d%jjm))
+          
+          IF (is_mpi_root) PRINT *,"Domain ",ind," : size ",d%ii_nb,"x",d%jj_nb
+          
+        END DO
+      END DO
+    END DO
+    
+  END SUBROUTINE create_domain
+  
+  SUBROUTINE copy_domain(d1,d2)
+  IMPLICIT NONE
+  INTEGER :: face
+  TYPE(t_domain),TARGET,INTENT(IN) :: d1
+  TYPE(t_domain), INTENT(OUT) :: d2
+  
+    d2%iim = d1%iim
+    d2%jjm = d1%jjm
+    d2%ii_begin = d1%ii_begin
+    d2%jj_begin = d1%jj_begin
+    d2%ii_end = d1%ii_end
+    d2%jj_end = d1%jj_end
+    d2%ii_nb =  d1%ii_nb
+    d2%jj_nb = d1%jj_nb
+    d2%ii_begin_glo = d1%ii_begin_glo
+    d2%jj_begin_glo = d1%jj_begin_glo
+    d2%ii_end_glo = d1%ii_end_glo
+    d2%jj_end_glo = d1%jj_end_glo
+    d2%assign_domain => d1%assign_domain
+    d2%assign_cell_glo => d1%assign_cell_glo
+    d2%assign_i => d1%assign_i
+    d2%assign_j => d1%assign_j
+    d2%edge_assign_domain => d1%edge_assign_domain
+    d2%edge_assign_i => d1%edge_assign_i
+    d2%edge_assign_j => d1%edge_assign_j
+    d2%edge_assign_pos => d1%edge_assign_pos
+    d2%edge_assign_sign => d1%edge_assign_sign
+    d2%xyz => d1%xyz
+    d2%neighbour => d1%neighbour
+    d2%delta => d1%delta
+    d2%vertex => d1%vertex
+    d2%own => d1%own
+    d2%ne => d1%ne
+    
+    d2%t_right = d1%t_right
+    d2%t_rup = d1%t_rup
+    d2%t_lup = d1%t_lup
+    d2%t_left = d1%t_left
+    d2%t_ldown = d1%t_ldown
+    d2%t_rdown = d1%t_rdown
+
+    d2%u_right = d1%u_right
+    d2%u_rup = d1%u_rup
+    d2%u_lup = d1%u_lup
+    d2%u_left = d1%u_left
+    d2%u_ldown = d1%u_ldown
+    d2%u_rdown = d1%u_rdown
+
+    d2%z_rup = d1%z_rup
+    d2%z_up = d1%z_up
+    d2%z_lup = d1%z_lup
+    d2%z_ldown = d1%z_ldown
+    d2%z_down = d1%z_down
+    d2%z_rdown = d1%z_rdown
+   
+    d2%t_pos = d1%t_pos
+    d2%u_pos = d1%u_pos
+    d2%z_pos = d1%z_pos
+    
+  END SUBROUTINE copy_domain
+  
+  
+  SUBROUTINE assign_cell
+  USE metric
+  IMPLICIT NONE
+    INTEGER :: ind_d,ind,ind2,e
+    INTEGER :: nf,nf2
+    INTEGER :: i,j,k,ii,jj
+    TYPE(t_domain),POINTER :: d
+    INTEGER :: delta
+     
+    
+    DO ind_d=1,ndomain_glo
+      d=>domain_glo(ind_d)
+      nf=d%face
+      DO j=d%jj_begin,d%jj_end
+        DO i=d%ii_begin,d%ii_end
+          ii=d%ii_begin_glo-d%ii_begin+i
+          jj=d%jj_begin_glo-d%jj_begin+j
+          ind=vertex_glo(ii,jj,nf)%ind
+          delta=vertex_glo(ii,jj,nf)%delta
+          IF (cell_glo(ind)%assign_face==nf) THEN 
+            cell_glo(ind)%assign_domain=ind_d
+            cell_glo(ind)%assign_i=i
+            cell_glo(ind)%assign_j=j
+          ENDIF
+          IF ( i+1 <= d%ii_end ) CALL assign_edge(ind_d,ind,i,j,delta,0)
+          IF ( j+1 <= d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,1)
+          IF ( i-1 >= d%ii_begin .AND. j+1<=d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,2)
+          IF ( i-1 >= d%ii_begin ) CALL assign_edge(ind_d,ind,i,j,delta,3)
+          IF ( j-1 >= d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,4)
+          IF ( i+1 <= d%ii_end .AND. j-1 >=d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,5)
+        ENDDO
+      ENDDO
+    ENDDO
+    
+    
+    DO ind_d=1,ndomain_glo
+      d=>domain_glo(ind_d)
+      nf=d%face
+      DO j=d%jj_begin-1,d%jj_end+1
+        DO i=d%ii_begin-1,d%ii_end+1
+          ii=d%ii_begin_glo-d%ii_begin+i
+          jj=d%jj_begin_glo-d%jj_begin+j
+          ind=vertex_glo(ii,jj,nf)%ind
+          d%assign_cell_glo(i,j) = ind  
+          d%assign_domain(i,j)=cell_glo(ind)%assign_domain
+          d%assign_i(i,j)=cell_glo(ind)%assign_i
+          d%assign_j(i,j)=cell_glo(ind)%assign_j
+          delta=vertex_glo(ii,jj,nf)%delta
+          d%delta(i,j)=vertex_glo(ii,jj,nf)%delta
+          DO k=0,5
+            ind2=vertex_glo(ii,jj,nf)%neighbour(k)
+            d%neighbour(:,k,i,j)=cell_glo(ind2)%xyz(:)
+
+            d%ne(k,i,j)=1-2*MOD(k,2)
+
+            e=cell_glo(ind)%edge(MOD(k+delta+6,6))
+            d%edge_assign_domain(k,i,j)=edge_glo(e)%assign_domain
+            d%edge_assign_i(k,i,j)=edge_glo(e)%assign_i
+            d%edge_assign_j(k,i,j)=edge_glo(e)%assign_j
+            d%edge_assign_pos(k,i,j)=edge_glo(e)%assign_pos
+            nf2=domain_glo(edge_glo(e)%assign_domain)%face
+            d%edge_assign_sign(k,i,j)=1-2*MOD(12+tab_index(nf,nf2,0),2)
+            IF (MOD(6+k+tab_index(nf,nf2,0),6)/=edge_glo(e)%assign_pos .AND. MOD(6+k+tab_index(nf,nf2,0),6) & 
+                /= MOD(edge_glo(e)%assign_pos+3,6)) THEN
+              d%edge_assign_sign(k,i,j)=-d%edge_assign_sign(k,i,j)
+            ENDIF
+             
+          ENDDO
+          d%xyz(:,i,j)=cell_glo(ind)%xyz(:)
+          IF (d%assign_domain(i,j)==ind_d) THEN
+           d%own(i,j)=.TRUE.
+          ELSE
+           d%own(i,j)=.FALSE.
+          ENDIF
+        ENDDO
+      ENDDO
+    ENDDO
+
+  CONTAINS
+
+    SUBROUTINE assign_edge(ind_d,ind,i,j,delta,k)
+      INTEGER :: ind_d,ind,i,j,delta,k
+      INTEGER :: e
+      e=cell_glo(ind)%edge(MOD(k+delta+6,6))
+      edge_glo(e)%assign_domain=ind_d
+      edge_glo(e)%assign_i=i
+      edge_glo(e)%assign_j=j
+      edge_glo(e)%assign_pos=k
+      edge_glo(e)%assign_delta=delta
+
+     END  SUBROUTINE assign_edge
+         
+  END SUBROUTINE assign_cell
+
+  SUBROUTINE compute_boundary
+  USE spherical_geom_mod
+  IMPLICIT NONE
+    INTEGER :: ind_d
+    INTEGER :: i,j,k
+    TYPE(t_domain),POINTER :: d 
+    REAL(rstd) :: ng1(3),ng2(3) 
+
+    DO ind_d=1,ndomain_glo
+      d=>domain_glo(ind_d)
+      DO j=d%jj_begin-1,d%jj_end+1
+        DO i=d%ii_begin-1,d%ii_end+1
+          DO k=0,5
+            ng1=d%neighbour(:,MOD(k,6),i,j)
+            ng2=d%neighbour(:,MOD(k+1,6),i,j)
+            IF (sqrt(sum((ng1-ng2)**2))<1e-16) ng2=d%neighbour(:,MOD(k+2,6),i,j)
+            CALL circumcenter(d%xyz(:,i,j),ng1,ng2,d%vertex(:,k,i,j))
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO        
+  END SUBROUTINE compute_boundary
+
+  SUBROUTINE set_neighbour_indice
+  USE metric
+  IMPLICIT NONE
+    INTEGER :: ind_d
+    TYPE(t_domain),POINTER :: d 
+    
+    DO ind_d=1,ndomain_glo
+      d=>domain_glo(ind_d)
+      d%t_right=1
+      d%t_left=-1
+      d%t_rup=d%iim
+      d%t_lup=d%iim-1
+      d%t_ldown=-d%iim
+      d%t_rdown=-d%iim+1
+      
+      d%u_right=0
+      d%u_lup=d%iim*d%jjm
+      d%u_ldown=2*d%iim*d%jjm
+      
+      d%u_rup=d%t_rup+d%u_ldown
+      d%u_left=d%t_left+d%u_right
+      d%u_rdown=d%t_rdown+d%u_lup
+      
+      d%z_up=0
+      d%z_down=d%iim*d%jjm
+      d%z_rup=d%t_rup+d%z_down
+      d%z_lup=d%t_lup+d%z_down
+      d%z_ldown=d%t_ldown+d%z_up
+      d%z_rdown=d%t_rdown+d%z_up
+      
+      d%t_pos(right)=d%t_right
+      d%t_pos(rup)=d%t_rup
+      d%t_pos(lup)=d%t_lup
+      d%t_pos(left)=d%t_left
+      d%t_pos(ldown)=d%t_ldown
+      d%t_pos(rdown)=d%t_rdown
+
+      d%u_pos(right)=d%u_right
+      d%u_pos(rup)=d%u_rup
+      d%u_pos(lup)=d%u_lup
+      d%u_pos(left)=d%u_left
+      d%u_pos(ldown)=d%u_ldown
+      d%u_pos(rdown)=d%u_rdown
+      
+      d%z_pos(vrup)=d%z_rup
+      d%z_pos(vup)=d%z_up
+      d%z_pos(vlup)=d%z_lup
+      d%z_pos(vldown)=d%z_ldown
+      d%z_pos(vdown)=d%z_down
+      d%z_pos(vrdown)=d%z_rdown
+      
+    ENDDO  
+  
+  END SUBROUTINE set_neighbour_indice
+      
+  SUBROUTINE assign_domain
+  USE mpipara
+  USE grid_param
+  IMPLICIT NONE
+    INTEGER :: nb_domain(0:mpi_size-1)
+    INTEGER :: rank, ind,ind_glo
+    INTEGER :: block_j,jb,i,j,nd_glo,n,nf
+    LOGICAL :: exit
+    
+    DO rank=0,mpi_size-1
+      nb_domain(rank)=ndomain_glo/mpi_size
+      IF ( rank < MOD(ndomain_glo,mpi_size) ) nb_domain(rank)=nb_domain(rank)+1
+    ENDDO
+    
+    ndomain=nb_domain(mpi_rank)
+    ALLOCATE(domain(ndomain))
+    ALLOCATE(domloc_glo_ind(ndomain))
+    
+    
+    block_j=sqrt(nsplit_i*nsplit_j*nb_face*1./mpi_size)
+    exit=.FALSE.
+    jb=1
+    i=1
+    j=1
+    ind=1
+    nd_glo=0
+    rank=0
+    DO WHILE (.NOT. exit)
+
+      IF (j==MIN(jb+block_j,nsplit_j*nb_face+1)) THEN
+        j=jb
+        i=i+1
+      ENDIF
+
+      IF (i>nsplit_i) THEN 
+        i=1
+        jb=jb+block_j
+        j=jb
+      ENDIF
+      
+      IF (ind>nb_domain(rank)) THEN
+        rank=rank+1
+        ind=1
+      ENDIF 
+      ind_glo=(j-1)*nsplit_i+i
+
+      nd_glo=nd_glo+1
+      IF (nd_glo==ndomain_glo) THEN
+
+        exit=.TRUE.
+        IF (.NOT. (rank==mpi_size-1 .AND. ind==nb_domain(rank) )) THEN
+          PRINT *, "Distribution problem in assign_domain"
+          STOP
+        ENDIF
+
+      ENDIF
+
+      domglo_rank(ind_glo)=rank
+      domglo_loc_ind(ind_glo)=ind
+      IF (rank==mpi_rank) THEN 
+        CALL copy_domain(domain_glo(ind_glo),domain(ind))
+        domloc_glo_ind(ind)=ind_glo
+      ENDIF
+      
+      j=j+1
+      ind=ind+1
+      
+    ENDDO
+
+    IF (is_mpi_master) THEN
+   
+      ind_glo=0
+      PRINT *,''
+      PRINT*, '      MPI PROCESS DISTRIBUTION'
+      PRINT *,''
+      
+      WRITE(*,"(' ')", ADVANCE='NO')
+      DO n=1,nsplit_i*7-1
+        WRITE(*,"('=')", ADVANCE='NO')
+      ENDDO
+      PRINT *,''
+
+      DO nf=1,nb_face
+        DO j=1,nsplit_j
+          IF (j>1) THEN
+            WRITE(*,"(' ')", ADVANCE='NO')
+            DO n=1,nsplit_i*7-1
+              WRITE(*,"('-')", ADVANCE='NO')
+            ENDDO
+            PRINT *,''
+          ENDIF
+
+          WRITE(*,"('|')", ADVANCE='NO')
+          DO i=1,nsplit_i
+            WRITE(*,"(' ','    ',' |')",ADVANCE='NO')         
+          ENDDO
+          PRINT *,''
+
+          WRITE(*,"('|')", ADVANCE='NO')
+          DO i=1,nsplit_i
+            ind_glo=ind_glo+1
+            WRITE(*,"(' ',i4.4  ,' |')",ADVANCE='NO'),domglo_rank(ind_glo)           
+          END DO
+          PRINT *,''
+
+          WRITE(*,"('|')", ADVANCE='NO')
+          DO i=1,nsplit_i
+            WRITE(*,"(' ','    ',' |')",ADVANCE='NO')         
+          ENDDO
+          PRINT *,''
+
+        ENDDO
+          
+        WRITE(*,"(' ')", ADVANCE='NO')
+        DO n=1,nsplit_i*7-1
+          WRITE(*,"('=')", ADVANCE='NO')
+        ENDDO
+        PRINT *,''
+      ENDDO
+    ENDIF
+              
+!    rank=0
+!    ind=0
+!    DO ind_glo=1,ndomain_glo
+!      ind=ind+1
+!      domglo_rank(ind_glo)=rank
+!      domglo_loc_ind(ind_glo)=ind
+!      IF (rank==mpi_rank) THEN 
+!        CALL copy_domain(domain_glo(ind_glo),domain(ind))
+!        domloc_glo_ind(ind)=ind_glo
+!      ENDIF
+!      
+!      IF (ind==nb_domain(rank)) THEN
+!        rank=rank+1
+!        ind=0
+!      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_domain_size-1
+      nb_domain=ndomain/omp_domain_size
+      IF ( rank < MOD(ndomain,omp_domain_size) ) nb_domain=nb_domain+1
+    
+      DO i=1,nb_domain
+       ind=ind+1
+       IF (rank==omp_domain_rank) THEN 
+         assigned_domain(ind)=.TRUE.
+         WRITE(*,'(A,I6.6,A,I4.4,A,I4.4,A,I8.8)') "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
+  IMPLICIT NONE
+    CALL init_domain_param
+    CALL create_domain
+    CALL assign_cell
+    CALL compute_boundary
+    CALL set_neighbour_indice
+    CALL assign_domain
+      
+  END SUBROUTINE compute_domain
+          
+END MODULE domain_mod 
+  
Index: codes/icosagcm/devel/src/parallel/domain_param.f90
===================================================================
--- codes/icosagcm/devel/src/parallel/domain_param.f90	(revision 533)
+++ codes/icosagcm/devel/src/parallel/domain_param.f90	(revision 533)
@@ -0,0 +1,25 @@
+MODULE domain_param
+  IMPLICIT NONE
+  PRIVATE
+  INTEGER :: nsplit_i
+  INTEGER :: nsplit_j
+  INTEGER :: halo=1
+
+  INTEGER, PARAMETER :: default_nsplit_i=1
+  INTEGER, PARAMETER :: default_nsplit_j=1
+
+  PUBLIC nsplit_i, nsplit_j, halo, init_domain_param
+
+CONTAINS
+  
+  SUBROUTINE init_domain_param
+    USE ioipsl
+    !$OMP CRITICAL
+    nsplit_i=default_nsplit_i
+    nsplit_j=default_nsplit_j
+    CALL getin('nsplit_i',nsplit_i)
+    CALL getin('nsplit_j',nsplit_j)
+    !$OMP END CRITICAL
+  END SUBROUTINE init_domain_param
+  
+END MODULE domain_param
Index: codes/icosagcm/devel/src/parallel/mpi_mod.F90
===================================================================
--- codes/icosagcm/devel/src/parallel/mpi_mod.F90	(revision 533)
+++ codes/icosagcm/devel/src/parallel/mpi_mod.F90	(revision 533)
@@ -0,0 +1,83 @@
+MODULE mpi_mod
+
+#ifdef CPP_USING_MPI
+  INCLUDE 'mpif.h'
+#else
+  INTEGER :: MPI_COMM_WORLD
+  INTEGER :: MPI_REAL8
+  INTEGER :: MPI_INTEGER
+  INTEGER :: MPI_CHARACTER
+  INTEGER :: MPI_LOGICAL
+  INTEGER :: MPI_ANY_SOURCE
+  INTEGER :: MPI_MAX
+  INTEGER :: MPI_INFO_NULL
+  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
+
+END MODULE mpi_mod
+
+
+#ifndef CPP_USING_MPI
+
+ SUBROUTINE  MPI_INIT
+   PRINT *, 'Compiled without MPI'
+ END
+
+ SUBROUTINE  MPI_INIT_THREAD
+   PRINT *, 'Compiled without MPI'
+ END
+ 
+ SUBROUTINE  MPI_COMM_SIZE
+ END
+
+ SUBROUTINE  MPI_COMM_RANK
+ END
+ 
+ SUBROUTINE MPI_FINALIZE
+ END
+ 
+ SUBROUTINE MPI_ALLREDUCE
+ END
+
+ SUBROUTINE MPI_REDUCE
+ END
+
+ SUBROUTINE MPI_ALLTOALL
+ END
+
+ SUBROUTINE MPI_ISEND
+ END
+
+ SUBROUTINE MPI_ISSEND
+ END
+
+ SUBROUTINE MPI_IRECV
+ END
+
+ SUBROUTINE MPI_WAITALL
+ END
+
+ SUBROUTINE MPI_TESTALL
+ END
+
+ SUBROUTINE MPI_BARRIER
+ END
+
+ SUBROUTINE MPI_ALLGATHER
+ END
+ 
+ SUBROUTINE MPI_TYPE_EXTENT
+ END
+ 
+ SUBROUTINE MPI_ALLOC_MEM
+ END
+
+ SUBROUTINE MPI_FREE_MEM
+ END
+
+#endif
Index: codes/icosagcm/devel/src/parallel/mpipara.F90
===================================================================
--- codes/icosagcm/devel/src/parallel/mpipara.F90	(revision 533)
+++ codes/icosagcm/devel/src/parallel/mpipara.F90	(revision 533)
@@ -0,0 +1,235 @@
+MODULE mpipara
+
+  INTEGER,SAVE :: mpi_rank
+  INTEGER,SAVE :: mpi_size
+  INTEGER,SAVE :: mpi_threading_mode
+  
+  INTEGER,SAVE :: comm_icosa
+  INTEGER,SAVE :: ierr
+  LOGICAL,SAVE :: using_mpi
+  LOGICAL,SAVE :: is_mpi_root
+  LOGICAL,SAVE :: is_mpi_master
+  INTEGER,SAVE :: mpi_master
+  
+  
+  INTERFACE allocate_mpi_buffer
+    MODULE PROCEDURE allocate_mpi_buffer_r2, allocate_mpi_buffer_r3,allocate_mpi_buffer_r4
+  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
+
+  PRIVATE :: getin
+
+CONTAINS
+
+  SUBROUTINE getin(name,value) ! Copied from getin.f90 to avoid circular dependency
+  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)
+    IF(is_mpi_root) PRINT *,'GETIN ',TRIM(name),' = ', TRIM(value)
+!$OMP END MASTER
+    IF (omp_in_parallel()) CALL bcast_omp(value)
+  END SUBROUTINE getin
+
+  SUBROUTINE init_mpipara
+  USE mpi_mod
+#ifdef CPP_USING_XIOS
+  USE xios
+#endif
+  IMPLICIT NONE
+    CHARACTER(LEN=256) :: required_mode_str
+    INTEGER :: required_mode
+
+    using_mpi=.FALSE.
+#ifdef CPP_USING_MPI
+    using_mpi=.TRUE. 
+#endif 
+    
+    IF (using_mpi) THEN
+    
+      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) THEN
+         PRINT*,'MPI_INIT_THREAD : MPI_SINGLE_THREAD used : Warning : openMP is not garanted to work'
+      ENDIF
+      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)
+#else
+     comm_icosa=MPI_COMM_WORLD
+#endif
+      CALL MPI_COMM_SIZE(comm_icosa,mpi_size,ierr)
+      CALL MPI_COMM_RANK(comm_icosa,mpi_rank,ierr)
+      PRINT *, 'MPI Process ', mpi_rank, '/', mpi_size
+    ELSE
+      comm_icosa=-1
+      mpi_size=1
+      mpi_rank=0
+    ENDIF
+    
+    mpi_master=0
+    IF (mpi_rank==0) THEN 
+      is_mpi_root=.TRUE.
+      is_mpi_master=.TRUE.
+    ELSE
+      is_mpi_root=.FALSE.
+      is_mpi_master=.FALSE.
+    ENDIF
+    
+  END SUBROUTINE  init_mpipara
+
+  SUBROUTINE finalize_mpipara
+  USE mpi_mod
+#ifdef CPP_USING_XIOS
+  USE xios
+#endif
+  IMPLICIT NONE
+    
+#ifdef CPP_USING_XIOS
+      CALL xios_finalize
+#endif
+    IF (using_mpi) CALL MPI_FINALIZE(ierr)
+    
+   END SUBROUTINE  finalize_mpipara
+   
+
+  SUBROUTINE allocate_mpi_buffer_r2(buffer,length)
+  USE ISO_C_BINDING
+  USE mpi_mod
+  USE prec
+  IMPLICIT NONE
+    REAL(rstd), POINTER :: buffer(:)
+    INTEGER,INTENT(IN)  :: length
+
+    TYPE(C_PTR)         :: base_ptr
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: size
+    INTEGER :: real_size,ierr
+    
+    CALL MPI_TYPE_EXTENT(MPI_REAL8, real_size, ierr)
+    size=length*real_size
+    
+    CALL MPI_ALLOC_MEM(size,MPI_INFO_NULL,base_ptr,ierr)
+    CALL C_F_POINTER(base_ptr, buffer, (/ length /))
+
+  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)
+  USE ISO_C_BINDING
+  USE mpi_mod
+  USE prec
+    IMPLICIT NONE
+    REAL(rstd), POINTER :: buffer(:,:)
+    INTEGER,INTENT(IN)  :: length
+    INTEGER,INTENT(IN)  :: dim3
+
+    TYPE(C_PTR)         :: base_ptr
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: size
+    INTEGER :: real_size,ierr
+    
+    CALL MPI_TYPE_EXTENT(MPI_REAL8, real_size, ierr)
+    size=length*real_size*dim3
+    
+    CALL MPI_ALLOC_MEM(size,MPI_INFO_NULL,base_ptr,ierr)
+    CALL C_F_POINTER(base_ptr, buffer, (/ length,dim3 /))
+    
+  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)
+  USE ISO_C_BINDING
+  USE mpi_mod
+  USE prec
+  IMPLICIT NONE
+    REAL(rstd), POINTER :: buffer(:,:,:)
+    INTEGER,INTENT(IN)  :: length
+    INTEGER,INTENT(IN)  :: dim3
+    INTEGER,INTENT(IN)  :: dim4
+
+    TYPE(C_PTR)         :: base_ptr
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: size
+    INTEGER :: real_size,ierr
+    
+    CALL MPI_TYPE_EXTENT(MPI_REAL8, real_size, ierr)
+    size=length*real_size*dim3*dim4
+    
+    CALL MPI_ALLOC_MEM(size,MPI_INFO_NULL,base_ptr,ierr)
+    CALL C_F_POINTER(base_ptr, buffer, (/ length, dim3, dim4 /))
+    
+   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/devel/src/parallel/omp_para.F90
===================================================================
--- codes/icosagcm/devel/src/parallel/omp_para.F90	(revision 533)
+++ codes/icosagcm/devel/src/parallel/omp_para.F90	(revision 533)
@@ -0,0 +1,273 @@
+MODULE omp_para
+
+  INTEGER,SAVE :: omp_size
+  INTEGER,SAVE :: omp_rank
+!$OMP THREADPRIVATE(omp_rank)
+
+  LOGICAL,SAVE :: is_omp_first_level
+  LOGICAL,SAVE :: is_omp_last_level
+  LOGICAL,SAVE :: is_omp_master
+!$OMP THREADPRIVATE(is_omp_first_level, is_omp_last_level,is_omp_master)
+
+  INTEGER,SAVE :: ll_begin
+  INTEGER,SAVE :: ll_beginp1
+  INTEGER,SAVE :: ll_end
+  INTEGER,SAVE :: ll_endm1
+  INTEGER,SAVE :: ll_endp1
+!$OMP THREADPRIVATE(ll_begin,ll_beginp1,ll_end,ll_endm1,ll_endp1)
+  LOGICAL,SAVE :: using_openmp
+  
+  INTEGER,SAVE :: omp_domain_size
+  INTEGER,SAVE :: omp_domain_rank
+  INTEGER,SAVE :: omp_level_size
+  INTEGER,SAVE :: omp_level_rank
+!$OMP THREADPRIVATE( omp_domain_size, omp_level_size,omp_domain_rank,omp_level_rank)
+  LOGICAL,SAVE :: is_omp_domain_master
+  LOGICAL,SAVE :: is_omp_level_master
+!$OMP THREADPRIVATE(is_omp_domain_master,is_omp_level_master )
+  
+  LOGICAL,PARAMETER :: omp_by_domain=.TRUE. 
+  LOGICAL,SAVE :: is_master
+!$OMP THREADPRIVATE(is_master)
+
+
+   LOGICAL,SAVE :: is_omp_first_level_full
+   LOGICAL,SAVE :: is_omp_last_level_full
+   INTEGER,SAVE :: ll_begin_full
+   INTEGER,SAVE :: ll_beginp1_full
+   INTEGER,SAVE :: ll_end_full
+   INTEGER,SAVE :: ll_endm1_full
+   INTEGER,SAVE :: ll_endp1_full
+!$OMP THREADPRIVATE(is_omp_first_level_full,is_omp_last_level_full)   
+!$OMP THREADPRIVATE( ll_begin_full, ll_beginp1_full, ll_end_full, ll_endm1_full, ll_endp1_full)
+  PRIVATE :: is_omp_first_level_full,is_omp_last_level_full
+  PRIVATE :: ll_begin_full, ll_beginp1_full, ll_end_full, ll_endm1_full, ll_endp1_full 
+  
+
+   LOGICAL,SAVE :: is_omp_first_level_distrib
+   LOGICAL,SAVE :: is_omp_last_level_distrib
+   INTEGER,SAVE :: ll_begin_distrib
+   INTEGER,SAVE :: ll_beginp1_distrib
+   INTEGER,SAVE :: ll_end_distrib
+   INTEGER,SAVE :: ll_endm1_distrib
+   INTEGER,SAVE :: ll_endp1_distrib
+!$OMP THREADPRIVATE(is_omp_first_level_distrib,is_omp_last_level_distrib)   
+!$OMP THREADPRIVATE( ll_begin_distrib, ll_beginp1_distrib, ll_end_distrib, ll_endm1_distrib, ll_endp1_distrib)
+
+  PRIVATE :: is_omp_first_level_distrib,is_omp_last_level_distrib
+  PRIVATE :: ll_begin_distrib, ll_beginp1_distrib, ll_end_distrib, ll_endm1_distrib, ll_endp1_distrib 
+
+CONTAINS
+
+  SUBROUTINE init_omp_para(is_mpi_master)
+  USE grid_param
+  USE ioipsl, ONLY : getin
+#ifdef CPP_USING_OMP
+  USE omp_lib
+#endif
+  IMPLICIT NONE
+  LOGICAL, INTENT(IN) :: is_mpi_master
+  INTEGER :: ll_nb,i,llb,lle
+
+#ifdef CPP_USING_OMP
+  using_openmp=.TRUE.
+#else
+  using_openmp=.FALSE.
+#endif
+
+  IF (using_openmp) THEN    
+!$OMP PARALLEL PRIVATE(ll_nb,i,llb,lle)
+  
+!$OMP MASTER
+#ifdef CPP_USING_OMP
+    omp_size=OMP_GET_NUM_THREADS()
+#endif
+!$OMP END MASTER
+!$OMP BARRIER
+#ifdef CPP_USING_OMP
+    omp_rank=OMP_GET_THREAD_NUM()
+#endif
+    
+    is_omp_master=.FALSE.
+    is_master=.FALSE.
+      
+    IF (omp_rank==0) THEN
+      is_omp_master=.TRUE.
+      IF (is_mpi_master) is_master=.TRUE.
+    ENDIF
+
+    !$OMP CRITICAL
+    omp_level_size=1
+    CALL getin("omp_level_size",omp_level_size)
+    !$OMP END CRITICAL
+
+    IF(is_mpi_master) PRINT *,'GETIN omp_level_size', ' = ', omp_level_size
+
+    IF (MOD(omp_size,omp_level_size)/=0) THEN
+      IF (is_mpi_master) PRINT*,"omp_size /= omp_level_size x omp_domain_size  => disable omp threads on vertical layers"
+      omp_level_size=1
+    ENDIF
+    omp_domain_size=omp_size/omp_level_size
+    omp_domain_rank = omp_rank / omp_level_size    
+    omp_level_rank = MOD(omp_rank, omp_level_size)    
+    
+    IF (is_mpi_master) PRINT*,"omp_domain_size",omp_domain_size,"omp_domain_rank", omp_domain_rank
+    IF (is_mpi_master) PRINT*,"omp_level_size",omp_level_size,"omp_level_rank", omp_level_rank
+    
+    is_omp_first_level=.FALSE.
+    is_omp_last_level= .FALSE.
+    is_omp_domain_master=.FALSE.
+    is_omp_level_master=.FALSE.
+
+    IF (omp_domain_rank==0) is_omp_domain_master = .TRUE.
+    IF (omp_level_rank==0) is_omp_level_master = .TRUE.
+    IF (omp_level_rank==0) is_omp_first_level=.TRUE.
+    
+    IF (omp_level_rank==omp_level_size-1) is_omp_last_level=.TRUE.
+    
+    lle=0
+    
+    DO i=0,omp_level_rank
+      llb=lle+1
+      ll_nb=llm/omp_level_size
+      IF (MOD(llm,omp_level_size)>i) ll_nb=ll_nb+1
+      lle=llb+ll_nb-1
+    ENDDO
+    ll_begin=llb
+    ll_end=lle
+    
+    ll_beginp1=ll_begin
+    ll_endp1=ll_end
+    ll_endm1=ll_end
+
+    IF (is_omp_first_level) ll_beginp1=ll_begin+1
+    IF (is_omp_last_level) ll_endp1=ll_endp1+1
+    IF (is_omp_last_level) ll_endm1=ll_endm1-1
+    
+    
+    
+    is_omp_first_level_distrib = is_omp_first_level
+    is_omp_last_level_distrib  = is_omp_last_level
+    ll_begin_distrib           = ll_begin
+    ll_beginp1_distrib         = ll_beginp1
+    ll_end_distrib             = ll_end
+    ll_endm1_distrib           = ll_endm1
+    ll_endp1_distrib           = ll_endp1
+    
+    is_omp_first_level_full = .TRUE.
+    is_omp_last_level_full  = .TRUE.
+    ll_begin_full           = 1
+    ll_beginp1_full         = 2
+    ll_end_full             = llm
+    ll_endm1_full           = llm-1
+    ll_endp1_full           = llm+1    
+
+!$OMP END PARALLEL
+
+   ELSE
+     omp_size=1
+     omp_level_size=1
+     omp_domain_size=1
+     omp_rank=0
+     omp_level_rank=0
+     omp_domain_rank=0
+     is_master=is_mpi_master
+     is_omp_first_level=.TRUE.
+     is_omp_last_level=.TRUE.
+     is_omp_master=.TRUE.
+     is_omp_domain_master=.TRUE.
+     is_omp_level_master=.TRUE.
+     ll_begin=1
+     ll_beginp1=2
+     ll_end=llm
+     ll_endm1=llm-1
+     ll_endp1=llm+1
+     
+     is_omp_first_level_distrib = is_omp_first_level
+     is_omp_last_level_distrib  = is_omp_last_level
+     ll_begin_distrib           = ll_begin
+     ll_beginp1_distrib         = ll_beginp1
+     ll_end_distrib             = ll_end
+     ll_endm1_distrib           = ll_endm1
+     ll_endp1_distrib           = ll_endp1
+    
+     is_omp_first_level_full = .TRUE.
+     is_omp_last_level_full  = .TRUE.
+     ll_begin_full           = 1
+     ll_beginp1_full         = 2
+     ll_end_full             = llm
+     ll_endm1_full           = llm-1
+     ll_endp1_full           = llm+1    
+
+   ENDIF
+   
+  END SUBROUTINE init_omp_para
+
+  SUBROUTINE distrib_level(size,lbegin,lend)
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: size  
+    INTEGER,INTENT(OUT) :: lbegin  
+    INTEGER,INTENT(OUT) :: lend  
+    INTEGER :: div,rest
+    
+    div=size/omp_level_size
+    rest=MOD(size,omp_level_size)
+    IF (omp_level_rank<rest) THEN
+      lbegin=(div+1)*omp_level_rank+1
+      lend=lbegin+div
+    ELSE
+      lbegin=(div+1)*rest + (omp_level_rank-rest)*div+1
+      lend=lbegin+div-1
+    ENDIF
+  END SUBROUTINE distrib_level
+
+
+  SUBROUTINE switch_omp_distrib_level
+  IMPLICIT NONE
+     is_omp_first_level = is_omp_first_level_distrib 
+     is_omp_last_level  = is_omp_last_level_distrib 
+     ll_begin           = ll_begin_distrib 
+     ll_beginp1         = ll_beginp1_distrib 
+     ll_end             = ll_end_distrib 
+     ll_endm1           = ll_endm1_distrib 
+     ll_endp1           = ll_endp1_distrib 
+  
+  END SUBROUTINE switch_omp_distrib_level
+  
+
+  SUBROUTINE switch_omp_no_distrib_level
+  IMPLICIT NONE
+
+     is_omp_first_level = is_omp_first_level_full 
+     is_omp_last_level  = is_omp_last_level_full 
+     ll_begin           = ll_begin_full 
+     ll_beginp1         = ll_beginp1_full 
+     ll_end             = ll_end_full 
+     ll_endm1           = ll_endm1_full 
+     ll_endp1           = ll_endp1_full 
+  
+  END SUBROUTINE switch_omp_no_distrib_level
+  
+
+  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/devel/src/parallel/transfert.F90
===================================================================
--- codes/icosagcm/devel/src/parallel/transfert.F90	(revision 533)
+++ codes/icosagcm/devel/src/parallel/transfert.F90	(revision 533)
@@ -0,0 +1,236 @@
+MODULE transfert_mod
+
+#ifdef CPP_USING_MPI
+  USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_mpi, req_i1,req_e1_vect, &
+                                req_e1_scal, req_i0, req_e0_vect, req_e0_scal, request_add_point,             &
+                                create_request, gather_field, scatter_field,         &
+                                t_message, init_message=>init_message_mpi,           &
+                                transfert_message=>transfert_message_mpi,            &
+                                send_message=>send_message_mpi,                      &
+                                test_message=>test_message_mpi,                      &
+                                wait_message=>wait_message_mpi,barrier,bcast_mpi
+#else 
+  USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_seq, req_i1,req_e1_vect, &
+                                req_e1_scal,req_i0, req_e0_vect, req_e0_scal,        &
+                                request_add_point, create_request, gather_field,     &
+                                scatter_field, t_message,                            &
+                                init_message=>init_message_seq,                      &
+                                transfert_message=>transfert_message_seq,            &
+                                send_message=>send_message_seq,                      &
+                                test_message=>test_message_seq,                      &
+                                wait_message=>wait_message_seq,barrier, bcast_mpi
+#endif
+
+  USE transfert_omp_mod
+  
+  INTERFACE bcast
+    MODULE PROCEDURE bcast_c,                                     &
+                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
+                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
+		     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
+
+  END INTERFACE
+
+
+CONTAINS
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i
+
+  SUBROUTINE bcast_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i1
+
+
+  SUBROUTINE bcast_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i2
+
+
+  SUBROUTINE bcast_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i3
+
+
+  SUBROUTINE bcast_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i4
+
+ 
+!! -- Les reels -- !!
+  
+  SUBROUTINE bcast_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r
+
+  SUBROUTINE bcast_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r1
+
+
+  SUBROUTINE bcast_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r2
+
+
+  SUBROUTINE bcast_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r3
+
+
+  SUBROUTINE bcast_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r4 
+
+
+!! -- Les booleens -- !!
+  
+  SUBROUTINE bcast_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l
+
+  SUBROUTINE bcast_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l1
+
+
+  SUBROUTINE bcast_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l2
+
+
+  SUBROUTINE bcast_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l3
+
+
+  SUBROUTINE bcast_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l4
+
+  
+END MODULE transfert_mod
Index: codes/icosagcm/devel/src/parallel/transfert_mpi.f90
===================================================================
--- codes/icosagcm/devel/src/parallel/transfert_mpi.f90	(revision 533)
+++ codes/icosagcm/devel/src/parallel/transfert_mpi.f90	(revision 533)
@@ -0,0 +1,2151 @@
+MODULE transfert_mpi_mod
+USE genmod
+USE field_mod
+  
+  TYPE array
+    INTEGER,POINTER :: value(:)
+    INTEGER,POINTER :: sign(:)
+    INTEGER         :: domain
+    INTEGER         :: rank
+    INTEGER         :: tag
+    INTEGER         :: size
+    INTEGER         :: offset
+    INTEGER         :: ireq
+    INTEGER,POINTER :: buffer(:)
+    REAL,POINTER    :: buffer_r(:)
+    INTEGER,POINTER :: src_value(:)
+  END TYPE array
+  
+  TYPE t_buffer
+    REAL,POINTER    :: r(:)
+    INTEGER         :: size
+    INTEGER         :: rank
+  END TYPE t_buffer    
+    
+  TYPE t_request
+    INTEGER :: type_field
+    INTEGER :: max_size
+    INTEGER :: size
+    LOGICAL :: vector
+    INTEGER,POINTER :: src_domain(:)
+    INTEGER,POINTER :: src_i(:)
+    INTEGER,POINTER :: src_j(:)
+    INTEGER,POINTER :: src_ind(:)
+    INTEGER,POINTER :: target_ind(:)
+    INTEGER,POINTER :: target_i(:)
+    INTEGER,POINTER :: target_j(:)
+    INTEGER,POINTER :: target_sign(:)
+    INTEGER :: nrecv
+    TYPE(ARRAY),POINTER :: recv(:)
+    INTEGER :: nsend
+    INTEGER :: nreq_mpi
+    INTEGER :: nreq_send
+    INTEGER :: nreq_recv
+    TYPE(ARRAY),POINTER :: send(:)
+  END TYPE t_request
+  
+  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
+    CHARACTER(LEN=100) :: name ! for debug
+    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(:,:)
+    TYPE(t_buffer),POINTER :: buffers(:) 
+    TYPE(t_field),POINTER :: field(:)
+    LOGICAL :: completed
+    LOGICAL :: pending
+    LOGICAL :: open      ! for debug
+    INTEGER :: number
+  END TYPE t_message
+
+
+  INTERFACE bcast_mpi
+    MODULE PROCEDURE bcast_mpi_c,                                                     &
+                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
+                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
+		     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
+  END INTERFACE
+
+
+  
+CONTAINS
+       
+      
+  SUBROUTINE init_transfert
+  USE domain_mod
+  USE dimensions
+  USE field_mod
+  USE metric
+  USE mpipara
+  USE mpi_mod
+  IMPLICIT NONE
+  INTEGER :: ind,i,j
+  LOGICAL ::ok
+ 
+    CALL create_request(field_t,req_i1)
+
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      DO i=ii_begin,ii_end+1
+        CALL request_add_point(ind,i,jj_begin-1,req_i1)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end+1,j,req_i1)
+      ENDDO    
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_end+1,req_i1)
+      ENDDO    
+
+      DO j=jj_begin,jj_end+1
+        CALL request_add_point(ind,ii_begin-1,j,req_i1)
+      ENDDO    
+    
+    ENDDO
+  
+    CALL finalize_request(req_i1)
+
+
+    CALL create_request(field_t,req_i0)
+
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+    
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_begin,req_i0)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end,j,req_i0)
+      ENDDO    
+    
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_end,req_i0)
+      ENDDO    
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin,j,req_i0)
+      ENDDO    
+    
+    ENDDO
+ 
+    CALL finalize_request(req_i0)  
+
+
+    CALL create_request(field_u,req_e1_scal)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_begin-1,req_e1_scal,rup)
+        CALL request_add_point(ind,i+1,jj_begin-1,req_e1_scal,lup)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end+1,j,req_e1_scal,left)
+      ENDDO    
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end+1,j-1,req_e1_scal,lup)
+      ENDDO    
+    
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_end+1,req_e1_scal,ldown)
+        CALL request_add_point(ind,i-1,jj_end+1,req_e1_scal,rdown)
+      ENDDO    
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin-1,j,req_e1_scal,right)
+      ENDDO   
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_scal,rdown)
+      ENDDO   
+
+    ENDDO
+
+    CALL finalize_request(req_e1_scal)
+
+
+    CALL create_request(field_u,req_e0_scal)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+
+
+      DO i=ii_begin+1,ii_end-1
+        CALL request_add_point(ind,i,jj_begin,req_e0_scal,right)
+        CALL request_add_point(ind,i,jj_end,req_e0_scal,right)
+      ENDDO
+    
+      DO j=jj_begin+1,jj_end-1
+        CALL request_add_point(ind,ii_begin,j,req_e0_scal,rup)
+        CALL request_add_point(ind,ii_end,j,req_e0_scal,rup)
+      ENDDO   
+
+      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_scal,left)
+      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_scal,ldown)
+      CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_scal,left)
+      CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_scal,ldown)
+
+    ENDDO
+
+    CALL finalize_request(req_e0_scal)
+
+
+    
+    CALL create_request(field_u,req_e1_vect,.TRUE.)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_begin-1,req_e1_vect,rup)
+        CALL request_add_point(ind,i+1,jj_begin-1,req_e1_vect,lup)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end+1,j,req_e1_vect,left)
+      ENDDO    
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end+1,j-1,req_e1_vect,lup)
+      ENDDO    
+    
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_end+1,req_e1_vect,ldown)
+        CALL request_add_point(ind,i-1,jj_end+1,req_e1_vect,rdown)
+      ENDDO    
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin-1,j,req_e1_vect,right)
+      ENDDO   
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_vect,rdown)
+      ENDDO   
+
+  
+    ENDDO  
+
+    CALL finalize_request(req_e1_vect)
+    
+    
+    CALL create_request(field_u,req_e0_vect,.TRUE.)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+ 
+      DO i=ii_begin+1,ii_end-1
+        CALL request_add_point(ind,i,jj_begin,req_e0_vect,right)
+        CALL request_add_point(ind,i,jj_end,req_e0_vect,right)
+      ENDDO
+    
+      DO j=jj_begin+1,jj_end-1
+        CALL request_add_point(ind,ii_begin,j,req_e0_vect,rup)
+        CALL request_add_point(ind,ii_end,j,req_e0_vect,rup)
+      ENDDO   
+
+      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_vect,left)
+      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_vect,ldown)
+      CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_vect,left)
+      CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_vect,ldown)
+  
+    ENDDO  
+
+    CALL finalize_request(req_e0_vect)
+
+
+  END SUBROUTINE init_transfert
+  
+  SUBROUTINE create_request(type_field,request,vector)
+  USE domain_mod
+  USE field_mod
+  IMPLICIT NONE
+    INTEGER :: type_field
+    TYPE(t_request),POINTER :: request(:)
+    LOGICAL,OPTIONAL :: vector
+    
+    TYPE(t_request),POINTER :: req
+    TYPE(t_domain),POINTER :: d
+    INTEGER :: ind
+    INTEGER :: max_size
+       
+    ALLOCATE(request(ndomain))
+
+    DO ind=1,ndomain
+      req=>request(ind)
+      d=>domain(ind)
+      IF (type_field==field_t) THEN
+        Max_size=2*(d%iim+2)+2*(d%jjm+2)
+      ELSE IF (type_field==field_u) THEN
+        Max_size=3*(2*(d%iim+2)+2*(d%jjm+2))
+      ELSE IF (type_field==field_z) THEN
+        Max_size=2*(2*(d%iim+2)+2*(d%jjm+2))
+      ENDIF
+
+      req%type_field=type_field
+      req%max_size=max_size*2
+      req%size=0
+      req%vector=.FALSE.
+      IF (PRESENT(vector)) req%vector=vector
+      ALLOCATE(req%src_domain(req%max_size))
+      ALLOCATE(req%src_ind(req%max_size))
+      ALLOCATE(req%target_ind(req%max_size))
+      ALLOCATE(req%src_i(req%max_size))
+      ALLOCATE(req%src_j(req%max_size))
+      ALLOCATE(req%target_i(req%max_size))
+      ALLOCATE(req%target_j(req%max_size))
+      ALLOCATE(req%target_sign(req%max_size))
+    ENDDO
+  
+  END SUBROUTINE create_request
+
+  SUBROUTINE reallocate_request(req)
+  IMPLICIT NONE
+    TYPE(t_request),POINTER :: req
+      
+    INTEGER,POINTER :: src_domain(:)
+    INTEGER,POINTER :: src_ind(:)
+    INTEGER,POINTER :: target_ind(:)
+    INTEGER,POINTER :: src_i(:)
+    INTEGER,POINTER :: src_j(:)
+    INTEGER,POINTER :: target_i(:)
+    INTEGER,POINTER :: target_j(:)
+    INTEGER,POINTER :: target_sign(:)
+
+    PRINT *,"REALLOCATE_REQUEST"
+    src_domain=>req%src_domain
+    src_ind=>req%src_ind
+    target_ind=>req%target_ind
+    src_i=>req%src_i
+    src_j=>req%src_j
+    target_i=>req%target_i
+    target_j=>req%target_j
+    target_sign=>req%target_sign
+
+    ALLOCATE(req%src_domain(req%max_size*2))
+    ALLOCATE(req%src_ind(req%max_size*2))
+    ALLOCATE(req%target_ind(req%max_size*2))
+    ALLOCATE(req%src_i(req%max_size*2))
+    ALLOCATE(req%src_j(req%max_size*2))
+    ALLOCATE(req%target_i(req%max_size*2))
+    ALLOCATE(req%target_j(req%max_size*2))
+    ALLOCATE(req%target_sign(req%max_size*2))
+    
+    req%src_domain(1:req%max_size)=src_domain(:)
+    req%src_ind(1:req%max_size)=src_ind(:)
+    req%target_ind(1:req%max_size)=target_ind(:)
+    req%src_i(1:req%max_size)=src_i(:)
+    req%src_j(1:req%max_size)=src_j(:)
+    req%target_i(1:req%max_size)=target_i(:)
+    req%target_j(1:req%max_size)=target_j(:)
+    req%target_sign(1:req%max_size)=target_sign(:)
+    
+    req%max_size=req%max_size*2
+         
+    DEALLOCATE(src_domain)
+    DEALLOCATE(src_ind)
+    DEALLOCATE(target_ind)
+    DEALLOCATE(src_i)
+    DEALLOCATE(src_j)
+    DEALLOCATE(target_i)
+    DEALLOCATE(target_j)
+    DEALLOCATE(target_sign)
+
+  END SUBROUTINE reallocate_request
+
+      
+    SUBROUTINE request_add_point(ind,i,j,request,pos)
+    USE domain_mod
+    USE field_mod
+    IMPLICIT NONE
+      INTEGER,INTENT(IN)            ::  ind
+      INTEGER,INTENT(IN)            :: i
+      INTEGER,INTENT(IN)            :: j
+      TYPE(t_request),POINTER :: request(:)
+      INTEGER,INTENT(IN),OPTIONAL  :: pos
+      
+      INTEGER :: src_domain
+      INTEGER :: src_iim,src_i,src_j,src_n,src_pos,src_delta
+      TYPE(t_request),POINTER :: req
+      TYPE(t_domain),POINTER :: d
+      
+      req=>request(ind)
+      d=>domain(ind)
+      
+      IF (req%max_size==req%size) CALL reallocate_request(req)
+      req%size=req%size+1
+      IF (req%type_field==field_t) THEN
+        src_domain=domain(ind)%assign_domain(i,j)
+        src_iim=domain_glo(src_domain)%iim
+        src_i=domain(ind)%assign_i(i,j)
+        src_j=domain(ind)%assign_j(i,j)
+
+        req%target_ind(req%size)=(j-1)*d%iim+i
+        req%target_sign(req%size)=1
+        req%src_domain(req%size)=src_domain
+        req%src_ind(req%size)=(src_j-1)*src_iim+src_i
+      ELSE IF (req%type_field==field_u) THEN
+        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
+
+        src_domain=domain(ind)%edge_assign_domain(pos-1,i,j)
+        src_iim=domain_glo(src_domain)%iim
+        src_i=domain(ind)%edge_assign_i(pos-1,i,j)
+        src_j=domain(ind)%edge_assign_j(pos-1,i,j)
+        src_n=(src_j-1)*src_iim+src_i
+        src_delta=domain(ind)%delta(i,j)
+        src_pos=domain(ind)%edge_assign_pos(pos-1,i,j)+1
+                
+        req%target_ind(req%size)=(j-1)*d%iim+i+d%u_pos(pos)
+
+        req%target_sign(req%size)= 1
+        IF (req%vector) req%target_sign(req%size)= domain(ind)%edge_assign_sign(pos-1,i,j)
+
+        req%src_domain(req%size)=src_domain
+        req%src_ind(req%size)=src_n+domain_glo(src_domain)%u_pos(src_pos)
+
+      ELSE IF (req%type_field==field_z) THEN
+        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
+
+        src_domain=domain(ind)%assign_domain(i,j)
+        src_iim=domain_glo(src_domain)%iim
+        src_i=domain(ind)%assign_i(i,j)
+        src_j=domain(ind)%assign_j(i,j)
+        src_n=(src_j-1)*src_iim+src_i
+        src_delta=domain(ind)%delta(i,j)
+        
+        src_pos=MOD(pos-1+src_delta+6,6)+1
+        
+        req%target_ind(req%size)=(j-1)*d%iim+i+d%z_pos(pos)
+        req%target_sign(req%size)=1
+        req%src_domain(req%size)=src_domain
+        req%src_ind(req%size)=src_n+domain_glo(src_domain)%z_pos(src_pos)
+      ENDIF
+  END SUBROUTINE request_add_point
+  
+  
+  SUBROUTINE Finalize_request(request)
+  USE mpipara
+  USE domain_mod
+  USE mpi_mod
+  IMPLICIT NONE
+    TYPE(t_request),POINTER :: request(:)
+    TYPE(t_request),POINTER :: req, req_src
+    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)
+    INTEGER,ALLOCATABLE :: list_domain_send(:)
+    INTEGER             :: list_domain(ndomain)
+
+    INTEGER :: rank,i,j,pos
+    INTEGER :: size_,ind_glo,ind_loc, ind_src
+    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
+    
+    DO ind_loc=1,ndomain
+      req=>request(ind_loc)
+      
+      nb_data_domain_recv(:) = 0
+      nb_domain_recv(:) = 0
+      tag_rank(:)=0
+      
+      DO i=1,req%size
+        ind_glo=req%src_domain(i)
+        nb_data_domain_recv(ind_glo)=nb_data_domain_recv(ind_glo)+1
+      ENDDO
+ 
+      DO ind_glo=1,ndomain_glo
+        IF ( nb_data_domain_recv(ind_glo) > 0 )  nb_domain_recv(domglo_rank(ind_glo))=nb_domain_recv(domglo_rank(ind_glo))+1
+      ENDDO
+
+      req%nrecv=sum(nb_domain_recv(:))
+      ALLOCATE(req%recv(req%nrecv))
+
+      irecv=0
+      DO ind_glo=1,ndomain_glo
+        IF (nb_data_domain_recv(ind_glo)>0) THEN
+          irecv=irecv+1
+          list_domain_recv(ind_glo)=irecv
+          req%recv(irecv)%rank=domglo_rank(ind_glo)
+          req%recv(irecv)%size=nb_data_domain_recv(ind_glo)
+          req%recv(irecv)%domain=domglo_loc_ind(ind_glo)
+          ALLOCATE(req%recv(irecv)%value(req%recv(irecv)%size))
+          ALLOCATE(req%recv(irecv)%sign(req%recv(irecv)%size))
+          ALLOCATE(req%recv(irecv)%buffer(req%recv(irecv)%size))
+        ENDIF
+      ENDDO
+      
+      req%recv(:)%size=0
+      irecv=0
+      DO i=1,req%size
+        irecv=list_domain_recv(req%src_domain(i))
+        req%recv(irecv)%size=req%recv(irecv)%size+1
+        size_=req%recv(irecv)%size
+        req%recv(irecv)%value(size_)=req%src_ind(i)
+        req%recv(irecv)%buffer(size_)=req%target_ind(i)
+        req%recv(irecv)%sign(size_)=req%target_sign(i)
+      ENDDO
+    ENDDO
+
+    nb_domain_recv(:) = 0    
+    DO ind_loc=1,ndomain
+      req=>request(ind_loc)
+      
+      DO irecv=1,req%nrecv
+        rank=req%recv(irecv)%rank
+        nb_domain_recv(rank)=nb_domain_recv(rank)+1
+      ENDDO
+    ENDDO
+    
+    CALL MPI_Alltoall(nb_domain_recv,1,MPI_INTEGER,nb_domain_send,1,MPI_INTEGER,comm_icosa,ierr)     
+    
+
+    ALLOCATE(list_domain_send(sum(nb_domain_send)))
+    
+    nreq=sum(nb_domain_recv(:))+sum(nb_domain_send(:))
+    ALLOCATE(mpi_req(nreq))
+    ALLOCATE(status(MPI_STATUS_SIZE,nreq))
+    
+
+    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)%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
+      DO i=1,nb_domain_send(rank)
+        j=j+1
+        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)
+    
+    list_domain(:)=0
+    DO i=1,sum(nb_domain_send)
+      ind_loc=list_domain_send(i)
+      list_domain(ind_loc)=list_domain(ind_loc)+1
+    ENDDO
+    
+    DO ind_loc=1,ndomain
+      req=>request(ind_loc)
+      req%nsend=list_domain(ind_loc)
+      ALLOCATE(req%send(req%nsend))
+    ENDDO
+
+    IF (debug) PRINT *,"------------"    
+   
+   ireq=0 
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+     
+     DO irecv=1,req%nrecv
+       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 
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+     
+     DO irecv=1,req%nrecv
+       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 
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+     
+     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)%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,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
+
+   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+
+   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)%value,req%recv(irecv)%size,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
+       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,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
+     ENDDO
+   ENDDO
+
+   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+     
+     DO irecv=1,req%nrecv
+       req%recv(irecv)%value(:)=req%recv(irecv)%buffer(:)
+       req%recv(irecv)%sign(:) =req%recv(irecv)%sign(:)
+       DEALLOCATE(req%recv(irecv)%buffer)
+     ENDDO
+   ENDDO  
+   
+
+! domain is on the same mpi process => copie memory to memory
+   
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+     
+     DO irecv=1,req%nrecv
+   
+       IF (req%recv(irecv)%rank==mpi_rank) THEN
+           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)%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
+             ENDIF
+           ENDDO
+       ENDIF
+     
+     ENDDO
+   ENDDO
+   
+! 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)
+
+     DO isend=1,req%nsend
+       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 .OR. mpi_threading_mode==MPI_THREAD_SINGLE) 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) 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 .OR. mpi_threading_mode==MPI_THREAD_SINGLE) 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 
+
+
+  SUBROUTINE init_message_seq(field, request, message, name)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  USE mpi_mod
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_request),POINTER :: request(:)
+    TYPE(t_message) :: message
+    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
+!$OMP MASTER    
+    message%request=>request
+    IF(PRESENT(name)) THEN
+       message%name = TRIM(name)
+    ELSE
+       message%name = 'unknown'
+    END IF
+!$OMP END MASTER    
+!$OMP BARRIER    
+
+  END SUBROUTINE init_message_seq
+
+  SUBROUTINE send_message_seq(field,message)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  USE omp_para
+  USE trace
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_message) :: message
+
+    CALL transfert_request_seq(field,message%request)
+    
+  END SUBROUTINE send_message_seq
+  
+  SUBROUTINE test_message_seq(message)
+  IMPLICIT NONE
+    TYPE(t_message) :: message
+  END SUBROUTINE  test_message_seq
+  
+   
+  SUBROUTINE wait_message_seq(message)
+  IMPLICIT NONE
+    TYPE(t_message) :: message
+    
+  END SUBROUTINE wait_message_seq    
+
+  SUBROUTINE transfert_message_seq(field,message)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  USE omp_para
+  USE trace
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_message) :: message
+
+   CALL send_message_seq(field,message)
+    
+  END SUBROUTINE transfert_message_seq    
+    
+
+
+    
+  SUBROUTINE init_message_mpi(field,request, message, name)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  USE mpi_mod
+  IMPLICIT NONE
+  
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_request),POINTER :: request(:)
+    TYPE(t_message) :: message
+    CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: name
+
+    TYPE(ARRAY),POINTER :: recv,send 
+    TYPE(t_request),POINTER :: req
+    INTEGER :: irecv,isend
+    INTEGER :: ireq,nreq, nreq_send
+    INTEGER :: ind
+    INTEGER :: dim3,dim4
+    INTEGER :: i,j
+    INTEGER,SAVE :: message_number=0
+!    TYPE(t_reorder),POINTER :: reorder(:)
+!    TYPE(t_reorder) :: reorder_swap
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF(PRESENT(name)) THEN
+       message%name = TRIM(name)
+    ELSE
+       message%name = 'unknown'
+    END IF
+    message%number=message_number
+    message_number=message_number+1
+    IF (message_number==100) message_number=0
+
+  
+    message%request=>request
+    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.
+    message%open=.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
+     
+        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
+      
+        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
+        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
+    
+    DEALLOCATE(message%mpi_req)
+    DEALLOCATE(message%buffers)
+    DEALLOCATE(message%status)
+
+!$OMP END MASTER
+!$OMP BARRIER
+
+      
+  END SUBROUTINE Finalize_message_mpi
+
+
+  
+  SUBROUTINE barrier
+  USE mpi_mod
+  USE mpipara
+  IMPLICIT NONE
+    
+    CALL MPI_BARRIER(comm_icosa,ierr)
+    
+  END SUBROUTINE barrier  
+    
+  SUBROUTINE transfert_message_mpi(field,message)
+  USE field_mod
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_message) :: message
+    
+    CALL send_message_mpi(field,message)
+    CALL wait_message_mpi(message)
+    
+  END SUBROUTINE transfert_message_mpi
+
+
+  SUBROUTINE send_message_mpi(field,message)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  USE omp_para
+  USE trace
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_message) :: message
+    REAL(rstd),POINTER :: rval2d(:), src_rval2d(:) 
+    REAL(rstd),POINTER :: rval3d(:,:), src_rval3d(:,:) 
+    REAL(rstd),POINTER :: rval4d(:,:,:), src_rval4d(:,:,:) 
+    REAL(rstd),POINTER :: buffer_r(:) 
+    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,nreq
+    INTEGER :: ind,i,n,l,m
+    INTEGER :: dim3,dim4,d3,d4
+    INTEGER,POINTER :: src_value(:)
+    INTEGER,POINTER :: sign(:)
+    INTEGER :: offset,msize,rank
+    INTEGER :: lbegin, lend
+    INTEGER :: max_req
+
+!    CALL trace_start("send_message_mpi")
+
+!$OMP BARRIER
+
+
+!$OMP MASTER
+    IF(message%open) THEN
+       PRINT *, 'send_message_mpi : message ' // TRIM(message%name) // &
+            ' is still open, no call to wait_message_mpi after last send_message_mpi'
+       CALL ABORT
+    END IF
+    message%open=.TRUE. ! will be set to .FALSE. by wait_message_mpi
+
+    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
+
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+          
+          rval2d=>field(ind)%rval2d
+        
+          req=>message%request(ind)
+          DO isend=1,req%nsend
+            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
+                                            
+              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
+        
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) 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
+        max_req=0
+        DO ind=1,ndomain
+          req=>message%request(ind)
+          IF (req%nsend>max_req) max_req=req%nsend
+        ENDDO
+              
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) ) CYCLE
+
+          dim3=size(field(ind)%rval3d,2)
+          CALL distrib_level(dim3,lbegin,lend)
+
+          rval3d=>field(ind)%rval3d
+          req=>message%request(ind)
+ 
+          DO isend=1,req%nsend
+            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 + (lbegin-1)*send%size
+          
+              CALL trace_start("copy_to_buffer")
+
+              DO d3=lbegin,lend
+                DO n=1,send%size
+                  buffer_r(n+offset)=rval3d(value(n),d3)
+                ENDDO
+                offset=offset+send%size
+              ENDDO
+              CALL trace_end("copy_to_buffer")
+
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
+                !$OMP BARRIER
+              ENDIF
+              
+              IF (is_omp_level_master) THEN
+                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
+            ELSE
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
+                !$OMP BARRIER
+              ENDIF
+            ENDIF
+          ENDDO
+
+          IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
+            DO isend=req%nsend+1,max_req
+              !$OMP BARRIER
+            ENDDO
+          ENDIF
+
+        ENDDO
+         
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) ) CYCLE
+          dim3=size(field(ind)%rval3d,2)
+          CALL distrib_level(dim3,lbegin,lend)
+          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
+
+              CALL trace_start("copy_data")
+
+              DO d3=lbegin,lend
+                DO n=1,recv%size
+                  rval3d(value(n),d3)=src_rval3d(src_value(n),d3)*sgn(n)
+                ENDDO
+              ENDDO
+              CALL trace_end("copy_data")
+
+            ELSE
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+ 
+              IF (is_omp_level_master) THEN
+                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
+            ENDIF  
+          ENDDO
+        
+        ENDDO
+
+      ELSE  IF (field(1)%ndim==4) THEN
+
+        max_req=0
+        DO ind=1,ndomain
+          req=>message%request(ind)
+          IF (req%nsend>max_req) max_req=req%nsend
+        ENDDO
+    
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) ) CYCLE
+
+          dim3=size(field(ind)%rval4d,2)
+          CALL distrib_level(dim3,lbegin,lend)
+          dim4=size(field(ind)%rval4d,3)
+          rval4d=>field(ind)%rval4d
+          req=>message%request(ind)
+
+          DO isend=1,req%nsend
+            send=>req%send(isend)
+            value=>send%value
+
+            IF (send%rank/=mpi_rank) THEN
+
+              ireq=send%ireq
+              buffer_r=>message%buffers(ireq)%r
+
+              CALL trace_start("copy_to_buffer")
+              DO d4=1,dim4
+                offset=send%offset*dim3*dim4 + dim3*send%size*(d4-1) +               &
+                  (lbegin-1)*send%size
+
+                DO d3=lbegin,lend
+                  DO n=1,send%size
+                    buffer_r(n+offset)=rval4d(value(n),d3,d4)
+                  ENDDO
+                  offset=offset+send%size
+                ENDDO
+              ENDDO
+              CALL trace_end("copy_to_buffer")
+
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
+                !$OMP BARRIER
+              ENDIF
+
+              IF (is_omp_level_master) THEN
+                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
+            ELSE
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
+                !$OMP BARRIER
+              ENDIF
+            ENDIF
+          ENDDO
+          
+          IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
+            DO isend=req%nsend+1,max_req
+              !$OMP BARRIER
+            ENDDO
+          ENDIF
+
+        ENDDO
+        
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) ) CYCLE
+          
+          dim3=size(field(ind)%rval4d,2)
+          CALL distrib_level(dim3,lbegin,lend)
+          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
+
+              CALL trace_start("copy_data")
+              DO d4=1,dim4
+                DO d3=lbegin,lend
+                  DO n=1,recv%size
+                    rval4d(value(n),d3,d4)=src_rval4d(src_value(n),d3,d4)*sgn(n)
+                  ENDDO
+                ENDDO
+              ENDDO
+                
+              CALL trace_end("copy_data")
+                   
+            ELSE
+
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+              IF (is_omp_level_master) THEN
+                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
+            ENDIF
+          ENDDO
+        ENDDO
+
+      ENDIF      
+
+      IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) 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("send_message_mpi")
+    
+  END SUBROUTINE send_message_mpi
+  
+  SUBROUTINE test_message_mpi(message)
+  IMPLICIT NONE
+    TYPE(t_message) :: message
+    
+    INTEGER :: ierr
+
+!$OMP MASTER
+    IF (message%pending .AND. .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_r(:) 
+    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,nreq
+    INTEGER :: ind,n,l,m,i
+    INTEGER :: dim3,dim4,d3,d4,lbegin,lend
+    INTEGER :: offset
+
+    message%open=.FALSE.
+    IF (.NOT. message%pending) RETURN
+
+!    CALL trace_start("wait_message_mpi")
+
+    field=>message%field
+    nreq=message%nreq
+    
+    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
+        
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+          
+          rval2d=>field(ind)%rval2d
+          req=>message%request(ind)
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+            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
+      
+      
+      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
+          IF (.NOT. assigned_domain(ind) ) CYCLE
+
+          rval3d=>field(ind)%rval3d
+          req=>message%request(ind)
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+            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)
+    
+              CALL distrib_level(dim3,lbegin,lend)
+              offset=recv%offset*dim3 + (lbegin-1)*recv%size
+              CALL trace_start("copy_from_buffer")
+              
+              IF (req%vector) THEN
+                DO d3=lbegin,lend
+                  DO n=1,recv%size
+                    rval3d(value(n),d3)=buffer_r(n+offset)*sgn(n)  
+                  ENDDO
+                  offset=offset+recv%size
+                ENDDO
+              ELSE
+                DO d3=lbegin,lend
+                  DO n=1,recv%size
+                    rval3d(value(n),d3)=buffer_r(n+offset)  
+                  ENDDO
+                  offset=offset+recv%size
+                ENDDO
+              ENDIF
+                
+              CALL trace_end("copy_from_buffer")
+            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
+
+                
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) ) CYCLE
+
+          rval4d=>field(ind)%rval4d
+          req=>message%request(ind)
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+            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)
+              CALL distrib_level(dim3,lbegin,lend)
+              dim4=size(rval4d,3)
+              CALL trace_start("copy_from_buffer")
+              DO d4=1,dim4
+                offset=recv%offset*dim3*dim4 + dim3*recv%size*(d4-1) +               &
+                  (lbegin-1)*recv%size
+                DO d3=lbegin,lend
+                  DO n=1,recv%size
+                    rval4d(value(n),d3,d4)=buffer_r(n+offset)*sgn(n) 
+                  ENDDO
+                  offset=offset+recv%size
+                ENDDO
+              ENDDO
+              CALL trace_end("copy_from_buffer")
+            ENDIF
+          ENDDO
+        
+        ENDDO
+      
+      ENDIF      
+      
+    ENDIF
+
+!$OMP MASTER
+    message%pending=.FALSE.
+!$OMP END MASTER
+
+!    CALL trace_end("wait_message_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)
+  USE field_mod
+  USE domain_mod
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_request),POINTER :: request(:)
+    REAL(rstd),POINTER :: rval2d(:) 
+    REAL(rstd),POINTER :: rval3d(:,:) 
+    REAL(rstd),POINTER :: rval4d(:,:,:) 
+    INTEGER :: ind
+    TYPE(t_request),POINTER :: req
+    INTEGER :: n
+    REAL(rstd) :: var1,var2
+    
+    DO ind=1,ndomain
+      req=>request(ind)
+      rval2d=>field(ind)%rval2d
+      rval3d=>field(ind)%rval3d
+      rval4d=>field(ind)%rval4d
+      
+      IF (field(ind)%data_type==type_real) THEN
+        IF (field(ind)%ndim==2) THEN
+          DO n=1,req%size
+            rval2d(req%target_ind(n))=field(req%src_domain(n))%rval2d(req%src_ind(n))*&
+              req%target_sign(n)
+          ENDDO
+        ELSE IF (field(ind)%ndim==3) THEN
+          DO n=1,req%size
+            rval3d(req%target_ind(n),:)=field(req%src_domain(n))%rval3d(req%src_ind(n),:)*&
+              req%target_sign(n)
+          ENDDO
+        ELSE IF (field(ind)%ndim==4) THEN
+          DO n=1,req%size
+            rval4d(req%target_ind(n),:,:)=field(req%src_domain(n))%rval4d(req%src_ind(n),:,:)*&
+              req%target_sign(n)
+          ENDDO
+        ENDIF
+      ENDIF        
+
+    ENDDO
+    
+  END SUBROUTINE transfert_request_seq
+  
+  
+  SUBROUTINE gather_field(field_loc,field_glo)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field_loc(:)
+    TYPE(t_field),POINTER :: field_glo(:)
+    INTEGER, ALLOCATABLE :: mpi_req(:)
+    INTEGER, ALLOCATABLE :: status(:,:)
+    INTEGER :: ireq,nreq
+    INTEGER :: ind_glo,ind_loc    
+  
+    IF (.NOT. using_mpi) THEN
+    
+      DO ind_loc=1,ndomain
+        IF (field_loc(ind_loc)%ndim==2) field_glo(ind_loc)%rval2d=field_loc(ind_loc)%rval2d
+        IF (field_loc(ind_loc)%ndim==3) field_glo(ind_loc)%rval3d=field_loc(ind_loc)%rval3d
+        IF (field_loc(ind_loc)%ndim==4) field_glo(ind_loc)%rval4d=field_loc(ind_loc)%rval4d
+      ENDDO
+    
+    ELSE
+          
+      nreq=ndomain
+      IF (mpi_rank==0) nreq=nreq+ndomain_glo 
+      ALLOCATE(mpi_req(nreq))
+      ALLOCATE(status(MPI_STATUS_SIZE,nreq))
+    
+    
+      ireq=0
+      IF (mpi_rank==0) THEN
+        DO ind_glo=1,ndomain_glo
+          ireq=ireq+1
+
+          IF (field_glo(ind_glo)%ndim==2) THEN
+            CALL MPI_IRECV(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   &
+                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
+   
+          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
+            CALL MPI_IRECV(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   &
+                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
+
+          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
+            CALL MPI_IRECV(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   &
+                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
+          ENDIF
+         
+        ENDDO
+      ENDIF
+  
+      DO ind_loc=1,ndomain
+        ireq=ireq+1
+
+        IF (field_loc(ind_loc)%ndim==2) THEN
+          CALL MPI_ISEND(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   &
+                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
+        ELSE IF (field_loc(ind_loc)%ndim==3) THEN
+          CALL MPI_ISEND(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   &
+                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
+        ELSE IF (field_loc(ind_loc)%ndim==4) THEN
+          CALL MPI_ISEND(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   &
+                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
+        ENDIF
+      
+      ENDDO
+   
+      CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+
+    ENDIF
+        
+  END SUBROUTINE gather_field
+
+  SUBROUTINE bcast_field(field_glo)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field_glo(:)
+    INTEGER :: ind_glo    
+  
+    IF (.NOT. using_mpi) THEN
+    
+! nothing to do
+    
+    ELSE
+          
+      DO ind_glo=1,ndomain_glo
+
+          IF (field_glo(ind_glo)%ndim==2) THEN
+            CALL MPI_BCAST(field_glo(ind_glo)%rval2d, size(field_glo(ind_glo)%rval2d) , MPI_REAL8, 0, comm_icosa, ierr)
+          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
+            CALL MPI_BCAST(field_glo(ind_glo)%rval3d, size(field_glo(ind_glo)%rval3d) , MPI_REAL8, 0, comm_icosa, ierr)
+          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
+            CALL MPI_BCAST(field_glo(ind_glo)%rval4d, size(field_glo(ind_glo)%rval4d) , MPI_REAL8, 0, comm_icosa, ierr)
+          ENDIF
+         
+        ENDDO
+      ENDIF
+        
+  END SUBROUTINE bcast_field
+
+  SUBROUTINE scatter_field(field_glo,field_loc)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field_glo(:)
+    TYPE(t_field),POINTER :: field_loc(:)
+    INTEGER, ALLOCATABLE :: mpi_req(:)
+    INTEGER, ALLOCATABLE :: status(:,:)
+    INTEGER :: ireq,nreq
+    INTEGER :: ind_glo,ind_loc    
+  
+    IF (.NOT. using_mpi) THEN
+    
+      DO ind_loc=1,ndomain
+        IF (field_loc(ind_loc)%ndim==2) field_loc(ind_loc)%rval2d=field_glo(ind_loc)%rval2d
+        IF (field_loc(ind_loc)%ndim==3) field_loc(ind_loc)%rval3d=field_glo(ind_loc)%rval3d
+        IF (field_loc(ind_loc)%ndim==4) field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d
+      ENDDO
+    
+    ELSE
+          
+      nreq=ndomain
+      IF (mpi_rank==0) nreq=nreq+ndomain_glo 
+      ALLOCATE(mpi_req(nreq))
+      ALLOCATE(status(MPI_STATUS_SIZE,nreq))
+    
+    
+      ireq=0
+      IF (mpi_rank==0) THEN
+        DO ind_glo=1,ndomain_glo
+          ireq=ireq+1
+
+          IF (field_glo(ind_glo)%ndim==2) THEN
+            CALL MPI_ISEND(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   &
+                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
+   
+          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
+            CALL MPI_ISEND(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   &
+                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
+
+          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
+            CALL MPI_ISEND(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   &
+                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
+          ENDIF
+         
+        ENDDO
+      ENDIF
+  
+      DO ind_loc=1,ndomain
+        ireq=ireq+1
+
+        IF (field_loc(ind_loc)%ndim==2) THEN
+          CALL MPI_IRECV(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   &
+                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
+        ELSE IF (field_loc(ind_loc)%ndim==3) THEN
+          CALL MPI_IRECV(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   &
+                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
+        ELSE IF (field_loc(ind_loc)%ndim==4) THEN
+          CALL MPI_IRECV(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   &
+                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
+        ENDIF
+      
+      ENDDO
+   
+      CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+
+    ENDIF
+        
+  END SUBROUTINE scatter_field
+  
+  SUBROUTINE trace_in
+  USE trace
+  IMPLICIT NONE
+  
+    CALL trace_start("transfert_buffer")
+  END SUBROUTINE trace_in              
+
+  SUBROUTINE trace_out
+  USE trace
+  IMPLICIT NONE
+  
+    CALL trace_end("transfert_buffer")
+  END SUBROUTINE trace_out              
+
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactï¿œre -- !!
+
+  SUBROUTINE bcast_mpi_c(var1)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
+   
+    CALL bcast_mpi_cgen(Var1,len(Var1))
+
+  END SUBROUTINE bcast_mpi_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_mpi_i(var)
+  USE mpipara
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    
+    INTEGER               :: var_tmp(1)
+    
+    IF (is_mpi_master) var_tmp(1)=var
+    CALL bcast_mpi_igen(Var_tmp,1)
+    var=var_tmp(1)
+    
+  END SUBROUTINE bcast_mpi_i
+
+  SUBROUTINE bcast_mpi_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+
+    CALL bcast_mpi_igen(Var,size(Var))
+    
+  END SUBROUTINE bcast_mpi_i1
+
+  SUBROUTINE bcast_mpi_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+  
+  END SUBROUTINE bcast_mpi_i2
+
+  SUBROUTINE bcast_mpi_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i3
+
+  SUBROUTINE bcast_mpi_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_mpi_r(var)
+  USE mpipara
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL               :: var_tmp(1)
+    
+    IF (is_mpi_master) var_tmp(1)=var
+    CALL bcast_mpi_rgen(Var_tmp,1)
+    var=var_tmp(1)   
+
+  END SUBROUTINE bcast_mpi_r
+
+  SUBROUTINE bcast_mpi_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r1
+
+  SUBROUTINE bcast_mpi_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r2
+
+  SUBROUTINE bcast_mpi_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r3
+
+  SUBROUTINE bcast_mpi_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r4
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_mpi_l(var)
+  USE mpipara
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL               :: var_tmp(1)
+    
+    IF (is_mpi_master) var_tmp(1)=var
+    CALL bcast_mpi_lgen(Var_tmp,1)
+    var=var_tmp(1)   
+
+  END SUBROUTINE bcast_mpi_l
+
+  SUBROUTINE bcast_mpi_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l1
+
+  SUBROUTINE bcast_mpi_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l2
+
+  SUBROUTINE bcast_mpi_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l3
+
+  SUBROUTINE bcast_mpi_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l4
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_mpi_cgen(var,nb)
+    USE mpi_mod
+    USE mpipara
+    IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+
+    IF (.NOT. using_mpi) RETURN
+    
+    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,comm_icosa,ierr)
+        
+  END SUBROUTINE bcast_mpi_cgen
+
+
+      
+  SUBROUTINE bcast_mpi_igen(var,nb)
+    USE mpi_mod
+    USE mpipara
+    IMPLICIT NONE
+    
+    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+
+    IF (.NOT. using_mpi) RETURN
+
+    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,comm_icosa,ierr)
+        
+  END SUBROUTINE bcast_mpi_igen
+
+
+
+  
+  SUBROUTINE bcast_mpi_rgen(var,nb)
+    USE mpi_mod
+    USE mpipara
+    IMPLICIT NONE
+    
+    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+
+    IF (.NOT. using_mpi) RETURN
+
+    CALL MPI_BCAST(Var,nb,MPI_REAL8,mpi_master,comm_icosa,ierr)
+    
+  END SUBROUTINE bcast_mpi_rgen
+  
+
+
+
+  SUBROUTINE bcast_mpi_lgen(var,nb)
+    USE mpi_mod
+    USE mpipara
+    IMPLICIT NONE
+    
+    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+
+    IF (.NOT. using_mpi) RETURN
+
+    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,comm_icosa,ierr)
+
+  END SUBROUTINE bcast_mpi_lgen
+  
+   
+END MODULE transfert_mpi_mod
+      
+        
+        
+        
+      
Index: codes/icosagcm/devel/src/parallel/transfert_omp.f90
===================================================================
--- codes/icosagcm/devel/src/parallel/transfert_omp.f90	(revision 533)
+++ codes/icosagcm/devel/src/parallel/transfert_omp.f90	(revision 533)
@@ -0,0 +1,1156 @@
+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 
+
+
+  INTERFACE reduce_max_omp
+    MODULE PROCEDURE reduce_max_omp_i,reduce_max_omp_i1,reduce_max_omp_i2,reduce_max_omp_i3,reduce_max_omp_i4, &
+                     reduce_max_omp_r,reduce_max_omp_r1,reduce_max_omp_r2,reduce_max_omp_r3,reduce_max_omp_r4
+  END INTERFACE 
+
+  INTERFACE allreduce_max_omp
+    MODULE PROCEDURE allreduce_max_omp_i,allreduce_max_omp_i1,allreduce_max_omp_i2,allreduce_max_omp_i3,allreduce_max_omp_i4, &
+                     allreduce_max_omp_r,allreduce_max_omp_r1,allreduce_max_omp_r2,allreduce_max_omp_r3,allreduce_max_omp_r4
+  END INTERFACE 
+
+
+  PUBLIC bcast_omp, reduce_sum_omp, allreduce_sum_omp, reduce_max_omp, allreduce_max_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
+    INTEGER :: lenvar
+    lenvar=len(Var)
+    CALL bcast_omp_i(lenvar)
+    CALL bcast_omp_cgen(Var,lenvar,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  
+  
+
+
+
+
+
+
+
+
+
+
+
+  SUBROUTINE reduce_max_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_max_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE reduce_max_omp_i
+
+  SUBROUTINE reduce_max_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+   
+  END SUBROUTINE reduce_max_omp_i1
+  
+  
+  SUBROUTINE reduce_max_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_max_omp_i2
+
+
+  SUBROUTINE reduce_max_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_max_omp_i3
+
+
+  SUBROUTINE reduce_max_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_max_omp_i4
+
+
+  SUBROUTINE reduce_max_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_max_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE reduce_max_omp_r
+
+  SUBROUTINE reduce_max_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+   
+  END SUBROUTINE reduce_max_omp_r1
+  
+  
+  SUBROUTINE reduce_max_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_max_omp_r2
+
+
+  SUBROUTINE reduce_max_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_max_omp_r3
+
+
+  SUBROUTINE reduce_max_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_max_omp_r4  
+  
+  
+  
+  
+    SUBROUTINE allreduce_max_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_max_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE allreduce_max_omp_i
+
+  SUBROUTINE allreduce_max_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL allreduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+   
+  END SUBROUTINE allreduce_max_omp_i1
+  
+  
+  SUBROUTINE allreduce_max_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL allreduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE allreduce_max_omp_i2
+
+
+  SUBROUTINE allreduce_max_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL allreduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE allreduce_max_omp_i3
+
+
+  SUBROUTINE allreduce_max_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_i(size(VarIn))   
+    CALL allreduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE allreduce_max_omp_i4
+
+
+  SUBROUTINE allreduce_max_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_max_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE allreduce_max_omp_r
+
+  SUBROUTINE allreduce_max_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL allreduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+   
+  END SUBROUTINE allreduce_max_omp_r1
+  
+  
+  SUBROUTINE allreduce_max_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL allreduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE allreduce_max_omp_r2
+
+
+  SUBROUTINE allreduce_max_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL allreduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE allreduce_max_omp_r3
+
+
+  SUBROUTINE allreduce_max_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_r(size(VarIn))   
+    CALL allreduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE allreduce_max_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
+
+
+
+
+
+
+  SUBROUTINE reduce_max_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(:)=VarIn(1)
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=MAX(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_max_omp_igen
+
+  SUBROUTINE reduce_max_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(:)=VarIn(1)
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=MAX(Buff(i),VarIn(i))
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_max_omp_rgen
+
+
+
+  SUBROUTINE allreduce_max_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(:)=VarIn(1)
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=MAX(Buff(i),VarIn(i))
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER
+  
+  END SUBROUTINE allreduce_max_omp_igen
+
+  SUBROUTINE allreduce_max_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(:)=VarIn(1)
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=MAX(Buff(i),VarIn(i))
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+
+  !$OMP BARRIER
+  
+  END SUBROUTINE allreduce_max_omp_rgen
+    
+
+
+
+
+
+
+
+
+
+
+    
+END MODULE transfert_omp_mod
Index: codes/icosagcm/devel/src/physics.f90
===================================================================
--- codes/icosagcm/devel/src/physics.f90	(revision 531)
+++ 	(revision )
@@ -1,336 +1,0 @@
-MODULE physics_mod
-
-  USE field_mod
-
-  PRIVATE
-
-  INTEGER, PARAMETER :: phys_none=0, phys_HS94=1, phys_DCMIP=2, phys_lmdz_generic=3, phys_LB2012=4, phys_external=5,&
-                        phys_DCMIP2016=6
-
-  INTEGER :: phys_type
-  TYPE(t_field),POINTER,SAVE :: f_extra_physics_2D(:), f_extra_physics_3D(:)
-  TYPE(t_field),POINTER,SAVE :: f_dulon(:), f_dulat(:)
-  TYPE(t_field),POINTER,SAVE :: f_ulon(:), f_ulat(:)
-  TYPE(t_field),POINTER,SAVE :: f_p(:), f_pk(:)
-  TYPE(t_field),POINTER,SAVE :: f_temp(:)
-
-  CHARACTER(LEN=255),SAVE :: physics_type
-!$OMP THREADPRIVATE(physics_type)
-
-  PUBLIC :: physics, init_physics
-
-CONTAINS
-
-  SUBROUTINE init_physics
-    USE mpipara
-    USE etat0_mod
-    USE icosa
-    USE physics_interface_mod
-    USE physics_dcmip_mod, ONLY : init_physics_dcmip=>init_physics
-    USE physics_dcmip2016_mod, ONLY : init_physics_dcmip2016=>init_physics
-    USE etat0_venus_mod, ONLY : init_phys_venus=>init_physics
-    USE physics_lmdz_generic_mod, ONLY : init_physics_lmdz_generic=>init_physics
-    USE physics_external_mod, ONLY : init_physics_external=>init_physics
-    IMPLICIT NONE
-
-    physics_inout%dt_phys = dt*itau_physics
-    physics_type='none'
-    CALL getin("physics",physics_type)
-    SELECT CASE(TRIM(physics_type))
-    CASE ('none')
-       IF(is_mpi_root) PRINT*,"NO PHYSICAL PACKAGE USED"
-       phys_type = phys_none
-    CASE ('held_suarez')
-       phys_type = phys_HS94
-    CASE ('Lebonnois2012')
-       phys_type = phys_LB2012
-       CALL init_phys_venus
-
-    CASE ('phys_lmdz_generic')
-       CALL init_physics_lmdz_generic
-       phys_type=phys_lmdz_generic
-    CASE ('phys_external')
-       CALL init_physics_external
-       phys_type=phys_external
-    CASE ('dcmip')
-       CALL allocate_field(f_dulon,field_t,type_real,llm, name='dulon')
-       CALL allocate_field(f_dulat,field_t,type_real,llm, name='dulat')
-       CALL allocate_field(f_temp,field_t,type_real,llm, name='temp')
-       CALL allocate_field(f_ulon,field_t,type_real,llm, name='ulon')
-       CALL allocate_field(f_ulat,field_t,type_real,llm, name='ulat')
-       CALL allocate_field(f_p,field_t,type_real,llm+1, name='p')
-       CALL allocate_field(f_pk,field_t,type_real,llm, name='pk')
-       CALL init_pack_before ! Compute physics_inout%ngrid and offsets used by pack/unpack
-       CALL init_physics_dcmip
-       CALL init_pack_after ! Defines Ai, lon, lat in physics_inout
-       phys_type = phys_DCMIP
-    CASE ('dcmip2016')
-       CALL allocate_field(f_dulon,field_t,type_real,llm, name='dulon')
-       CALL allocate_field(f_dulat,field_t,type_real,llm, name='dulat')
-       CALL allocate_field(f_temp,field_t,type_real,llm, name='temp')
-       CALL allocate_field(f_ulon,field_t,type_real,llm, name='ulon')
-       CALL allocate_field(f_ulat,field_t,type_real,llm, name='ulat')
-       CALL allocate_field(f_p,field_t,type_real,llm+1, name='p')
-       CALL allocate_field(f_pk,field_t,type_real,llm, name='pk')
-       CALL init_pack_before ! Compute physics_inout%ngrid and offsets used by pack/unpack
-       CALL init_physics_dcmip2016
-       CALL init_pack_after ! Defines Ai, lon, lat in physics_inout
-       phys_type = phys_DCMIP2016
-    CASE DEFAULT
-       IF(is_mpi_root) PRINT*, 'init_physics : Bad selector for variable physics <',&
-            TRIM(physics_type), '> options are <none>, <held_suarez>, <Lebonnois2012>, <dcmip>', &
-                                '<phys_lmdz_generic>, <phys_external>'
-       STOP
-    END SELECT
-
-    IF(is_mpi_root) PRINT *, 'phys_type = ',phys_type
-  END SUBROUTINE init_physics
-
-  SUBROUTINE physics(it,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q)
-    USE icosa
-    USE physics_interface_mod
-    USE physics_lmdz_generic_mod, ONLY : physics_lmdz_generic => physics
-    USE physics_external_mod, ONLY : physics_external => physics
-    USE physics_dcmip_mod, ONLY : write_physics_dcmip => write_physics
-    USE physics_dcmip2016_mod, ONLY : write_physics_dcmip2016 => write_physics
-    USE etat0_heldsz_mod
-    USE etat0_venus_mod, ONLY : phys_venus => physics
-    IMPLICIT NONE
-    INTEGER, INTENT(IN)   :: it
-    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_wflux(:)
-    TYPE(t_field),POINTER :: f_q(:)
-
-    LOGICAL:: firstcall,lastcall
-    INTEGER :: ind
-    TYPE(t_physics_inout) :: args
-
-    IF(MOD(it,itau_physics)==0) THEN
-    
-       SELECT CASE(phys_type)
-       CASE (phys_none)
-          ! No physics, do nothing
-       CASE(phys_HS94)
-          CALL held_suarez(f_ps,f_theta_rhodz,f_ue) 
-       CASE (phys_lmdz_generic)
-         CALL physics_lmdz_generic(it ,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q)
-       CASE (phys_external)
-         CALL physics_external(it ,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q)
-       CASE(phys_LB2012)
-          CALL phys_venus(f_ps,f_theta_rhodz,f_ue) 
-       CASE DEFAULT
-          CALL physics_column(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q)
-       END SELECT
-
-       CALL transfert_request(f_theta_rhodz,req_i0)
-       CALL transfert_request(f_ue,req_e0_vect)
-       CALL transfert_request(f_q,req_i0)
-    END IF
-
-    IF (mod(it,itau_out)==0 ) THEN
-       SELECT CASE(phys_type)
-       CASE (phys_DCMIP)
-          CALL write_physics_dcmip
-       CASE (phys_DCMIP2016)
-          CALL write_physics_dcmip2016
-       END SELECT
-    END IF
-    
-  END SUBROUTINE physics
-
-  SUBROUTINE physics_column(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q)
-    USE icosa
-    USE physics_interface_mod
-    USE physics_dcmip_mod, ONLY : full_physics_dcmip => full_physics
-    USE physics_dcmip2016_mod, ONLY : full_physics_dcmip2016 => full_physics
-    USE theta2theta_rhodz_mod
-    USE mpipara
-    USE omp_para
-    USE checksum_mod
-    IMPLICIT NONE
-    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 :: temp(:,:)
-    REAL(rstd),POINTER :: ue(:,:)
-    REAL(rstd),POINTER :: dulon(:,:)
-    REAL(rstd),POINTER :: dulat(:,:)
-    REAL(rstd),POINTER :: q(:,:,:)
-    REAL(rstd),POINTER :: p(:,:)
-    REAL(rstd),POINTER :: pk(:,:)
-    REAL(rstd),POINTER :: ulon(:,:)
-    REAL(rstd),POINTER :: ulat(:,:)
-    INTEGER :: it, ind
-
-    CALL theta_rhodz2temperature(f_ps,f_theta_rhodz,f_temp)
-    
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       phis=f_phis(ind)
-       ps=f_ps(ind)
-       temp=f_temp(ind)
-       ue=f_ue(ind)
-       q=f_q(ind)
-       p=f_p(ind)
-       pk=f_pk(ind)
-       ulon=f_ulon(ind)
-       ulat=f_ulat(ind)
-       CALL pack_physics(pack_info(ind), phis, ps, temp, ue, q, p, pk, ulon, ulat)
-    END DO
-
-    SELECT CASE(phys_type)
-    CASE (phys_DCMIP)
-       IF (is_omp_level_master) CALL full_physics_dcmip
-    CASE (phys_DCMIP2016)
-       IF (is_omp_level_master) CALL full_physics_dcmip2016
-    CASE DEFAULT
-       IF(is_master) PRINT *,'Internal error : illegal value of phys_type', phys_type
-       STOP
-    END SELECT
-
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       ps=f_ps(ind)
-       temp=f_temp(ind)
-       q=f_q(ind)
-       dulon=f_dulon(ind)
-       dulat=f_dulat(ind)
-       CALL unpack_physics(pack_info(ind), ps, temp, q, dulon, dulat)
-    END DO
-    
-    CALL temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
-
-    ! Transfer dulon, dulat
-    CALL transfert_request(f_dulon,req_i0)
-    CALL transfert_request(f_dulat,req_i0)
-
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       ue=f_ue(ind)
-       dulon=f_dulon(ind)
-       dulat=f_dulat(ind)
-       CALL compute_update_velocity(dulon, dulat, ue)
-    END DO
-
-  END SUBROUTINE physics_column
-
-  SUBROUTINE pack_physics(info, phis, ps, temp, ue, q, p, pk, ulon, ulat )
-    USE icosa
-    USE wind_mod
-    USE pression_mod
-    USE theta2theta_rhodz_mod
-    USE physics_interface_mod
-    USE exner_mod
-    USE omp_para
-    IMPLICIT NONE
-    TYPE(t_pack_info) :: info
-    REAL(rstd) :: phis(iim*jjm)
-    REAL(rstd) :: ps(iim*jjm)
-    REAL(rstd) :: temp(iim*jjm,llm)
-    REAL(rstd) :: pks(iim*jjm)
-    REAL(rstd) :: pk(iim*jjm,llm)
-    REAL(rstd) :: ue(3*iim*jjm,llm)
-    REAL(rstd) :: q(iim*jjm,llm,nqtot)
-
-    REAL(rstd) :: p(iim*jjm,llm+1)
-    REAL(rstd) :: uc(iim*jjm,3,llm)
-    REAL(rstd) :: ulon(iim*jjm,llm)
-    REAL(rstd) :: ulat(iim*jjm,llm)
-
-!$OMP BARRIER
-    CALL compute_pression(ps,p,0)
-!$OMP BARRIER
-    CALL compute_exner(ps,p,pks,pk,0) 
-!$OMP BARRIER
-    CALL compute_wind_centered(ue,uc)
-    CALL compute_wind_centered_lonlat_compound(uc, ulon, ulat)
-!$OMP BARRIER
-    IF (is_omp_level_master) THEN
-      CALL pack_domain(info, phis, physics_inout%phis)
-      CALL pack_domain(info, p, physics_inout%p)
-      CALL pack_domain(info, pk, physics_inout%pk)
-      CALL pack_domain(info, Temp, physics_inout%Temp)
-      CALL pack_domain(info, ulon, physics_inout%ulon)
-      CALL pack_domain(info, ulat, physics_inout%ulat)
-      CALL pack_domain(info, q, physics_inout%q)
-    ENDIF
-!$OMP BARRIER
-  END SUBROUTINE pack_physics
-
-  SUBROUTINE unpack_physics(info, ps,temp, q, dulon, dulat)
-    USE icosa
-    USE physics_interface_mod
-    USE theta2theta_rhodz_mod
-    USE omp_para
-    IMPLICIT NONE
-    TYPE(t_pack_info) :: info
-    REAL(rstd) :: ps(iim*jjm)
-    REAL(rstd) :: temp(iim*jjm,llm)
-    REAL(rstd) :: q(iim*jjm,llm,nqtot)
-    REAL(rstd) :: dulon(iim*jjm,llm)
-    REAL(rstd) :: dulat(iim*jjm,llm)
-
-    REAL(rstd) :: dq(iim*jjm,llm,nqtot)
-    REAL(rstd) :: dTemp(iim*jjm,llm)
-
-!$OMP BARRIER
-    IF (is_omp_level_master) THEN
-      CALL unpack_domain(info, dulon, physics_inout%dulon)
-      CALL unpack_domain(info, dulat, physics_inout%dulat)
-      CALL unpack_domain(info, dq, physics_inout%dq)
-      CALL unpack_domain(info, Temp, physics_inout%Temp)
-      CALL unpack_domain(info, dTemp, physics_inout%dTemp)
-      q = q + physics_inout%dt_phys * dq
-      Temp = Temp + physics_inout%dt_phys * dTemp
-    ENDIF
-!$OMP BARRIER
-
-!    CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0)
-  END SUBROUTINE unpack_physics
-
-  SUBROUTINE compute_update_velocity(dulon, dulat, ue)
-    USE icosa
-    USE physics_interface_mod
-    USE wind_mod
-    USE omp_para
-    IMPLICIT NONE
-    REAL(rstd) :: dulon(iim*jjm,llm)
-    REAL(rstd) :: dulat(iim*jjm,llm)
-    REAL(rstd) :: ue(3*iim*jjm,llm)
-    REAL(rstd) :: duc(iim*jjm,3,llm)
-    REAL(rstd) :: dt2, due
-    INTEGER :: i,j,ij,l
-    ! Reconstruct wind tendencies at edges and add to normal wind
-    CALL compute_wind_centered_from_lonlat_compound(dulon,dulat,duc)
-    dt2=.5*physics_inout%dt_phys
-    DO l=ll_begin,ll_end
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          due = sum( (duc(ij,:,l) + duc(ij+t_right,:,l))*ep_e(ij+u_right,:) )
-          ue(ij+u_right,l) = ue(ij+u_right,l) + dt2*due
-
-          due = sum( (duc(ij,:,l) + duc(ij+t_lup,:,l))*ep_e(ij+u_lup,:) )
-          ue(ij+u_lup,l)=ue(ij+u_lup,l) + dt2*due
-
-          due = sum( (duc(ij,:,l) + duc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) )
-          ue(ij+u_ldown,l)=ue(ij+u_ldown,l) + dt2*due
-        ENDDO
-      ENDDO
-    ENDDO
-  END SUBROUTINE compute_update_velocity
-
-END MODULE physics_mod
Index: codes/icosagcm/devel/src/physics/dimphys.f90
===================================================================
--- codes/icosagcm/devel/src/physics/dimphys.f90	(revision 533)
+++ codes/icosagcm/devel/src/physics/dimphys.f90	(revision 533)
@@ -0,0 +1,27 @@
+MODULE dimphys_mod
+        USE ICOSA
+      INTEGER::nsoilmx=10,offset
+      INTEGER::ngridmx,nlayermx
+      LOGICAL::callrad,calldifv,calladj,callcond,callsoil
+      LOGICAL::season,diurnal,lverbose
+      INTEGER:: iradia
+      REAL:: period_sort,timeperi
+      REAL:: aphelie,periheli,year_day,peri_day,obliquit
+      REAL::e_elips,p_elips,unitastr
+      REAL:: coefvis,coefir
+
+      REAL,ALLOCATABLE:: albedo(:),emissiv(:),inertie(:)
+      REAL,ALLOCATABLE:: tsurf(:),tsoil(:,:)
+      REAL,ALLOCATABLE:: z0(:),rnatur(:)
+      REAL,ALLOCATABLE:: dtrad(:,:) ,fluxrad(:)
+      REAL,ALLOCATABLE:: capcal(:)  ,fluxgrd(:)
+      REAL,ALLOCATABLE:: q2(:,:),q2l(:,:)
+
+
+!      REAL,allocatable:: albedo(:),emissiv(:),inertie(:)
+!      REAL,allocatable:: z0(:),rnatur(:)
+
+!      REAL,allocatable::tsurf(:),tsoil(:,:)
+!      REAL,allocatable::fluxrad(:),fluxgrd(:)
+!      REAL,ALLOCATABLE::capcal(:)
+END MODULE dimphys_mod
Index: codes/icosagcm/devel/src/physics/physics.f90
===================================================================
--- codes/icosagcm/devel/src/physics/physics.f90	(revision 533)
+++ codes/icosagcm/devel/src/physics/physics.f90	(revision 533)
@@ -0,0 +1,336 @@
+MODULE physics_mod
+
+  USE field_mod
+
+  PRIVATE
+
+  INTEGER, PARAMETER :: phys_none=0, phys_HS94=1, phys_DCMIP=2, phys_lmdz_generic=3, phys_LB2012=4, phys_external=5,&
+                        phys_DCMIP2016=6
+
+  INTEGER :: phys_type
+  TYPE(t_field),POINTER,SAVE :: f_extra_physics_2D(:), f_extra_physics_3D(:)
+  TYPE(t_field),POINTER,SAVE :: f_dulon(:), f_dulat(:)
+  TYPE(t_field),POINTER,SAVE :: f_ulon(:), f_ulat(:)
+  TYPE(t_field),POINTER,SAVE :: f_p(:), f_pk(:)
+  TYPE(t_field),POINTER,SAVE :: f_temp(:)
+
+  CHARACTER(LEN=255),SAVE :: physics_type
+!$OMP THREADPRIVATE(physics_type)
+
+  PUBLIC :: physics, init_physics
+
+CONTAINS
+
+  SUBROUTINE init_physics
+    USE mpipara
+    USE etat0_mod
+    USE icosa
+    USE physics_interface_mod
+    USE physics_dcmip_mod, ONLY : init_physics_dcmip=>init_physics
+    USE physics_dcmip2016_mod, ONLY : init_physics_dcmip2016=>init_physics
+    USE etat0_venus_mod, ONLY : init_phys_venus=>init_physics
+    USE physics_lmdz_generic_mod, ONLY : init_physics_lmdz_generic=>init_physics
+    USE physics_external_mod, ONLY : init_physics_external=>init_physics
+    IMPLICIT NONE
+
+    physics_inout%dt_phys = dt*itau_physics
+    physics_type='none'
+    CALL getin("physics",physics_type)
+    SELECT CASE(TRIM(physics_type))
+    CASE ('none')
+       IF(is_mpi_root) PRINT*,"NO PHYSICAL PACKAGE USED"
+       phys_type = phys_none
+    CASE ('held_suarez')
+       phys_type = phys_HS94
+    CASE ('Lebonnois2012')
+       phys_type = phys_LB2012
+       CALL init_phys_venus
+
+    CASE ('phys_lmdz_generic')
+       CALL init_physics_lmdz_generic
+       phys_type=phys_lmdz_generic
+    CASE ('phys_external')
+       CALL init_physics_external
+       phys_type=phys_external
+    CASE ('dcmip')
+       CALL allocate_field(f_dulon,field_t,type_real,llm, name='dulon')
+       CALL allocate_field(f_dulat,field_t,type_real,llm, name='dulat')
+       CALL allocate_field(f_temp,field_t,type_real,llm, name='temp')
+       CALL allocate_field(f_ulon,field_t,type_real,llm, name='ulon')
+       CALL allocate_field(f_ulat,field_t,type_real,llm, name='ulat')
+       CALL allocate_field(f_p,field_t,type_real,llm+1, name='p')
+       CALL allocate_field(f_pk,field_t,type_real,llm, name='pk')
+       CALL init_pack_before ! Compute physics_inout%ngrid and offsets used by pack/unpack
+       CALL init_physics_dcmip
+       CALL init_pack_after ! Defines Ai, lon, lat in physics_inout
+       phys_type = phys_DCMIP
+    CASE ('dcmip2016')
+       CALL allocate_field(f_dulon,field_t,type_real,llm, name='dulon')
+       CALL allocate_field(f_dulat,field_t,type_real,llm, name='dulat')
+       CALL allocate_field(f_temp,field_t,type_real,llm, name='temp')
+       CALL allocate_field(f_ulon,field_t,type_real,llm, name='ulon')
+       CALL allocate_field(f_ulat,field_t,type_real,llm, name='ulat')
+       CALL allocate_field(f_p,field_t,type_real,llm+1, name='p')
+       CALL allocate_field(f_pk,field_t,type_real,llm, name='pk')
+       CALL init_pack_before ! Compute physics_inout%ngrid and offsets used by pack/unpack
+       CALL init_physics_dcmip2016
+       CALL init_pack_after ! Defines Ai, lon, lat in physics_inout
+       phys_type = phys_DCMIP2016
+    CASE DEFAULT
+       IF(is_mpi_root) PRINT*, 'init_physics : Bad selector for variable physics <',&
+            TRIM(physics_type), '> options are <none>, <held_suarez>, <Lebonnois2012>, <dcmip>', &
+                                '<phys_lmdz_generic>, <phys_external>'
+       STOP
+    END SELECT
+
+    IF(is_mpi_root) PRINT *, 'phys_type = ',phys_type
+  END SUBROUTINE init_physics
+
+  SUBROUTINE physics(it,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q)
+    USE icosa
+    USE physics_interface_mod
+    USE physics_lmdz_generic_mod, ONLY : physics_lmdz_generic => physics
+    USE physics_external_mod, ONLY : physics_external => physics
+    USE physics_dcmip_mod, ONLY : write_physics_dcmip => write_physics
+    USE physics_dcmip2016_mod, ONLY : write_physics_dcmip2016 => write_physics
+    USE etat0_heldsz_mod
+    USE etat0_venus_mod, ONLY : phys_venus => physics
+    IMPLICIT NONE
+    INTEGER, INTENT(IN)   :: it
+    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_wflux(:)
+    TYPE(t_field),POINTER :: f_q(:)
+
+    LOGICAL:: firstcall,lastcall
+    INTEGER :: ind
+    TYPE(t_physics_inout) :: args
+
+    IF(MOD(it,itau_physics)==0) THEN
+    
+       SELECT CASE(phys_type)
+       CASE (phys_none)
+          ! No physics, do nothing
+       CASE(phys_HS94)
+          CALL held_suarez(f_ps,f_theta_rhodz,f_ue) 
+       CASE (phys_lmdz_generic)
+         CALL physics_lmdz_generic(it ,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q)
+       CASE (phys_external)
+         CALL physics_external(it ,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q)
+       CASE(phys_LB2012)
+          CALL phys_venus(f_ps,f_theta_rhodz,f_ue) 
+       CASE DEFAULT
+          CALL physics_column(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q)
+       END SELECT
+
+       CALL transfert_request(f_theta_rhodz,req_i0)
+       CALL transfert_request(f_ue,req_e0_vect)
+       CALL transfert_request(f_q,req_i0)
+    END IF
+
+    IF (mod(it,itau_out)==0 ) THEN
+       SELECT CASE(phys_type)
+       CASE (phys_DCMIP)
+          CALL write_physics_dcmip
+       CASE (phys_DCMIP2016)
+          CALL write_physics_dcmip2016
+       END SELECT
+    END IF
+    
+  END SUBROUTINE physics
+
+  SUBROUTINE physics_column(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q)
+    USE icosa
+    USE physics_interface_mod
+    USE physics_dcmip_mod, ONLY : full_physics_dcmip => full_physics
+    USE physics_dcmip2016_mod, ONLY : full_physics_dcmip2016 => full_physics
+    USE theta2theta_rhodz_mod
+    USE mpipara
+    USE omp_para
+    USE checksum_mod
+    IMPLICIT NONE
+    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 :: temp(:,:)
+    REAL(rstd),POINTER :: ue(:,:)
+    REAL(rstd),POINTER :: dulon(:,:)
+    REAL(rstd),POINTER :: dulat(:,:)
+    REAL(rstd),POINTER :: q(:,:,:)
+    REAL(rstd),POINTER :: p(:,:)
+    REAL(rstd),POINTER :: pk(:,:)
+    REAL(rstd),POINTER :: ulon(:,:)
+    REAL(rstd),POINTER :: ulat(:,:)
+    INTEGER :: it, ind
+
+    CALL theta_rhodz2temperature(f_ps,f_theta_rhodz,f_temp)
+    
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       phis=f_phis(ind)
+       ps=f_ps(ind)
+       temp=f_temp(ind)
+       ue=f_ue(ind)
+       q=f_q(ind)
+       p=f_p(ind)
+       pk=f_pk(ind)
+       ulon=f_ulon(ind)
+       ulat=f_ulat(ind)
+       CALL pack_physics(pack_info(ind), phis, ps, temp, ue, q, p, pk, ulon, ulat)
+    END DO
+
+    SELECT CASE(phys_type)
+    CASE (phys_DCMIP)
+       IF (is_omp_level_master) CALL full_physics_dcmip
+    CASE (phys_DCMIP2016)
+       IF (is_omp_level_master) CALL full_physics_dcmip2016
+    CASE DEFAULT
+       IF(is_master) PRINT *,'Internal error : illegal value of phys_type', phys_type
+       STOP
+    END SELECT
+
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       ps=f_ps(ind)
+       temp=f_temp(ind)
+       q=f_q(ind)
+       dulon=f_dulon(ind)
+       dulat=f_dulat(ind)
+       CALL unpack_physics(pack_info(ind), ps, temp, q, dulon, dulat)
+    END DO
+    
+    CALL temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
+
+    ! Transfer dulon, dulat
+    CALL transfert_request(f_dulon,req_i0)
+    CALL transfert_request(f_dulat,req_i0)
+
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       ue=f_ue(ind)
+       dulon=f_dulon(ind)
+       dulat=f_dulat(ind)
+       CALL compute_update_velocity(dulon, dulat, ue)
+    END DO
+
+  END SUBROUTINE physics_column
+
+  SUBROUTINE pack_physics(info, phis, ps, temp, ue, q, p, pk, ulon, ulat )
+    USE icosa
+    USE wind_mod
+    USE pression_mod
+    USE theta2theta_rhodz_mod
+    USE physics_interface_mod
+    USE exner_mod
+    USE omp_para
+    IMPLICIT NONE
+    TYPE(t_pack_info) :: info
+    REAL(rstd) :: phis(iim*jjm)
+    REAL(rstd) :: ps(iim*jjm)
+    REAL(rstd) :: temp(iim*jjm,llm)
+    REAL(rstd) :: pks(iim*jjm)
+    REAL(rstd) :: pk(iim*jjm,llm)
+    REAL(rstd) :: ue(3*iim*jjm,llm)
+    REAL(rstd) :: q(iim*jjm,llm,nqtot)
+
+    REAL(rstd) :: p(iim*jjm,llm+1)
+    REAL(rstd) :: uc(iim*jjm,3,llm)
+    REAL(rstd) :: ulon(iim*jjm,llm)
+    REAL(rstd) :: ulat(iim*jjm,llm)
+
+!$OMP BARRIER
+    CALL compute_pression(ps,p,0)
+!$OMP BARRIER
+    CALL compute_exner(ps,p,pks,pk,0) 
+!$OMP BARRIER
+    CALL compute_wind_centered(ue,uc)
+    CALL compute_wind_centered_lonlat_compound(uc, ulon, ulat)
+!$OMP BARRIER
+    IF (is_omp_level_master) THEN
+      CALL pack_domain(info, phis, physics_inout%phis)
+      CALL pack_domain(info, p, physics_inout%p)
+      CALL pack_domain(info, pk, physics_inout%pk)
+      CALL pack_domain(info, Temp, physics_inout%Temp)
+      CALL pack_domain(info, ulon, physics_inout%ulon)
+      CALL pack_domain(info, ulat, physics_inout%ulat)
+      CALL pack_domain(info, q, physics_inout%q)
+    ENDIF
+!$OMP BARRIER
+  END SUBROUTINE pack_physics
+
+  SUBROUTINE unpack_physics(info, ps,temp, q, dulon, dulat)
+    USE icosa
+    USE physics_interface_mod
+    USE theta2theta_rhodz_mod
+    USE omp_para
+    IMPLICIT NONE
+    TYPE(t_pack_info) :: info
+    REAL(rstd) :: ps(iim*jjm)
+    REAL(rstd) :: temp(iim*jjm,llm)
+    REAL(rstd) :: q(iim*jjm,llm,nqtot)
+    REAL(rstd) :: dulon(iim*jjm,llm)
+    REAL(rstd) :: dulat(iim*jjm,llm)
+
+    REAL(rstd) :: dq(iim*jjm,llm,nqtot)
+    REAL(rstd) :: dTemp(iim*jjm,llm)
+
+!$OMP BARRIER
+    IF (is_omp_level_master) THEN
+      CALL unpack_domain(info, dulon, physics_inout%dulon)
+      CALL unpack_domain(info, dulat, physics_inout%dulat)
+      CALL unpack_domain(info, dq, physics_inout%dq)
+      CALL unpack_domain(info, Temp, physics_inout%Temp)
+      CALL unpack_domain(info, dTemp, physics_inout%dTemp)
+      q = q + physics_inout%dt_phys * dq
+      Temp = Temp + physics_inout%dt_phys * dTemp
+    ENDIF
+!$OMP BARRIER
+
+!    CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0)
+  END SUBROUTINE unpack_physics
+
+  SUBROUTINE compute_update_velocity(dulon, dulat, ue)
+    USE icosa
+    USE physics_interface_mod
+    USE wind_mod
+    USE omp_para
+    IMPLICIT NONE
+    REAL(rstd) :: dulon(iim*jjm,llm)
+    REAL(rstd) :: dulat(iim*jjm,llm)
+    REAL(rstd) :: ue(3*iim*jjm,llm)
+    REAL(rstd) :: duc(iim*jjm,3,llm)
+    REAL(rstd) :: dt2, due
+    INTEGER :: i,j,ij,l
+    ! Reconstruct wind tendencies at edges and add to normal wind
+    CALL compute_wind_centered_from_lonlat_compound(dulon,dulat,duc)
+    dt2=.5*physics_inout%dt_phys
+    DO l=ll_begin,ll_end
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          due = sum( (duc(ij,:,l) + duc(ij+t_right,:,l))*ep_e(ij+u_right,:) )
+          ue(ij+u_right,l) = ue(ij+u_right,l) + dt2*due
+
+          due = sum( (duc(ij,:,l) + duc(ij+t_lup,:,l))*ep_e(ij+u_lup,:) )
+          ue(ij+u_lup,l)=ue(ij+u_lup,l) + dt2*due
+
+          due = sum( (duc(ij,:,l) + duc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) )
+          ue(ij+u_ldown,l)=ue(ij+u_ldown,l) + dt2*due
+        ENDDO
+      ENDDO
+    ENDDO
+  END SUBROUTINE compute_update_velocity
+
+END MODULE physics_mod
Index: codes/icosagcm/devel/src/physics/physics_external.F90
===================================================================
--- codes/icosagcm/devel/src/physics/physics_external.F90	(revision 533)
+++ codes/icosagcm/devel/src/physics/physics_external.F90	(revision 533)
@@ -0,0 +1,55 @@
+MODULE physics_external_mod
+  USE field_mod
+  
+  INTEGER,SAVE :: it
+!$OMP THREADPRIVATE(it)
+
+  TYPE(t_field),POINTER,SAVE :: f_phis(:)
+  TYPE(t_field),POINTER,SAVE :: f_ps(:)
+  TYPE(t_field),POINTER,SAVE :: f_theta_rhodz(:)
+  TYPE(t_field),POINTER,SAVE :: f_u(:)
+  TYPE(t_field),POINTER,SAVE :: f_wflux(:)
+  TYPE(t_field),POINTER,SAVE :: f_q(:)
+  
+  
+  
+CONTAINS
+
+  SUBROUTINE init_physics
+
+    CALL initialize_external_physics
+        
+  END SUBROUTINE init_physics
+  
+  SUBROUTINE physics(it_,f_phis_, f_ps_, f_theta_rhodz_, f_u_, f_wflux_, f_q_)
+  USE field_mod
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)    :: it_
+    TYPE(t_field),POINTER :: f_phis_(:)
+    TYPE(t_field),POINTER :: f_ps_(:)
+    TYPE(t_field),POINTER :: f_theta_rhodz_(:)
+    TYPE(t_field),POINTER :: f_u_(:)
+    TYPE(t_field),POINTER :: f_wflux_(:)
+    TYPE(t_field),POINTER :: f_q_(:)
+
+    it=it_
+    
+!$OMP BARRIER
+!$OMP MASTER
+    f_phis=>f_phis_
+    f_ps=>f_ps_
+    f_theta_rhodz=>f_theta_rhodz_
+    f_u=>f_u_
+    f_wflux=>f_wflux_
+    f_q=>f_q_
+!$OMP END MASTER
+!$OMP BARRIER
+
+    CALL external_physics
+    
+  END SUBROUTINE physics
+  
+  
+END MODULE physics_external_mod
+    
+  
Index: codes/icosagcm/devel/src/physics/physics_interface.f90
===================================================================
--- codes/icosagcm/devel/src/physics/physics_interface.f90	(revision 533)
+++ codes/icosagcm/devel/src/physics/physics_interface.f90	(revision 533)
@@ -0,0 +1,394 @@
+MODULE physics_interface_mod
+
+  USE prec
+
+  PRIVATE
+
+  TYPE t_physics_inout
+     ! Input, time-independent
+     INTEGER :: ngrid
+     REAL(rstd) :: dt_phys
+     REAL(rstd), DIMENSION(:), POINTER :: Ai, lon, lat, phis
+     ! Input, time-dependent
+     REAL(rstd), DIMENSION(:,:), POINTER :: p, pk, Temp, ulon, ulat
+     REAL(rstd), DIMENSION(:,:,:), POINTER :: q
+     ! Output arrays
+     REAL(rstd), DIMENSION(:,:), POINTER :: dTemp, dulon, dulat
+     REAL(rstd), DIMENSION(:,:,:), POINTER :: dq
+  END TYPE t_physics_inout
+
+! physics_inout is used to exchange information with physics
+! Field ngrid is initialized by physics.f90/init_physics. Its other fields
+! must be defined by XX/init_physics (where XX =  e.g. physics_dcmip.f90) 
+! by either pointing to internal data of the physics package
+! or by a specific allocation
+! size : (ngrid), (ngrid,llm) except p(ngrid,llm+1), (ngrid,llm,nqtot) 
+
+  TYPE(t_physics_inout), SAVE :: physics_inout
+!$OMP THREADPRIVATE(physics_inout) 
+ 
+! pack_info contains indices used by pack/unpack routines
+! to pack together the data of all the domains managed by the MPI process
+! It is initialized by physics.f90/init_physics 
+
+  TYPE t_pack_info
+     INTEGER :: ngrid, & ! number of non-halo points in that domain
+          nseg ! number of segments (contigous parts) in that domain
+     ! size and start of each segment : ij domain index, k packed index
+     INTEGER, ALLOCATABLE :: n(:), ij(:), k(:)
+  END TYPE t_pack_info
+
+  TYPE(t_pack_info), ALLOCATABLE, SAVE :: pack_info(:)
+!$OMP THREADPRIVATE(pack_info)
+
+
+  INTERFACE pack_field
+     MODULE PROCEDURE pack_2D
+     MODULE PROCEDURE pack_3D
+     MODULE PROCEDURE pack_4D
+  END INTERFACE pack_field
+
+  INTERFACE unpack_field
+     MODULE PROCEDURE unpack_2D
+     MODULE PROCEDURE unpack_3D
+     MODULE PROCEDURE unpack_4D
+  END INTERFACE unpack_field
+
+  INTERFACE pack_domain
+     MODULE PROCEDURE pack_domain_2D
+     MODULE PROCEDURE pack_domain_3D
+     MODULE PROCEDURE pack_domain_4D
+  END INTERFACE pack_domain
+
+  INTERFACE unpack_domain
+     MODULE PROCEDURE unpack_domain_2D
+     MODULE PROCEDURE unpack_domain_3D
+     MODULE PROCEDURE unpack_domain_4D
+  END INTERFACE unpack_domain
+
+  PUBLIC :: nb_extra_physics_2D, nb_extra_physics_3D, &
+       t_physics_inout, physics_inout, &
+       t_pack_info, pack_info, init_pack_before, init_pack_after, &
+       pack_domain, pack_field, unpack_domain, unpack_field, &
+       garbage_3D
+
+CONTAINS
+  
+    SUBROUTINE init_pack_before
+    USE icosa
+    IMPLICIT NONE
+    INTEGER :: ind, offset
+
+    offset=0
+    ALLOCATE(pack_info(ndomain))
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       CALL count_segments(domain(ind)%own, pack_info(ind))
+       pack_info(ind)%k = pack_info(ind)%k + offset
+       offset = offset + pack_info(ind)%ngrid
+    END DO
+    physics_inout%ngrid = offset
+
+  END SUBROUTINE init_pack_before
+
+  SUBROUTINE count_segments(own, info)
+    USE icosa
+    IMPLICIT NONE
+    LOGICAL, DIMENSION(:,:) :: own
+    TYPE(t_pack_info) :: info
+
+    INTEGER, DIMENSION(jjm) :: n
+    INTEGER :: ngrid, nseg, i, j, jj, k
+    INTEGER, PARAMETER :: method=4
+    SELECT CASE(method)
+    CASE(1) ! Copy all points, including halo (works)
+       info%nseg=1
+       info%ngrid=iim*jjm
+       ALLOCATE(info%n(1))
+       ALLOCATE(info%ij(1))
+       ALLOCATE(info%k(1))
+       info%n(1)=iim*jjm
+       info%ij(1)=1
+       info%k(1)=1
+    CASE(2) ! Copy all points, including halo, one at a time (works, slow ?)
+       info%nseg=iim*jjm
+       info%ngrid=iim*jjm
+       ALLOCATE(info%n(iim*jjm))
+       ALLOCATE(info%ij(iim*jjm))
+       ALLOCATE(info%k(iim*jjm))
+       DO jj=1,iim*jjm
+          info%n(jj) =1
+          info%ij(jj)=jj
+          info%k(jj) =jj
+       END DO
+    CASE(3) ! Copy non-halo points only, one at a time (works, slow ?)
+       n=0
+       n(jj_begin:jj_end)=COUNT(own(ii_begin:ii_end,jj_begin:jj_end),1)
+       ngrid=SUM(n)
+       info%ngrid=ngrid
+       info%nseg=ngrid
+       ALLOCATE(info%n(ngrid))
+       ALLOCATE(info%ij(ngrid))
+       ALLOCATE(info%k(ngrid))
+       jj=1
+       DO j=1,jjm
+          DO i=1,iim
+             IF(own(i,j)) THEN
+                info%n(jj)=1
+                info%k(jj)=jj
+                info%ij(jj) = iim*(j-1)+i
+                jj=jj+1
+             END IF
+          END DO
+       END DO
+       
+    CASE DEFAULT ! Copy non-halo points only, as contiguous segments (works)
+       n=0
+       n(jj_begin:jj_end)=COUNT(own(ii_begin:ii_end,jj_begin:jj_end),1)
+       ngrid=SUM(n)
+       info%ngrid=ngrid
+       nseg=COUNT(n>0)
+       info%nseg=nseg
+       ALLOCATE(info%n(nseg))
+       ALLOCATE(info%ij(nseg))
+       ALLOCATE(info%k(nseg))
+       info%n(:)=0
+       info%ij(:)=0
+       info%k(:)=0
+       
+       jj=1
+       k=1
+       DO j=jj_begin,jj_end
+          IF(n(j)>0) THEN
+             ! find first .TRUE. value in own(:,j)
+             DO i=ii_begin,ii_end
+                IF(own(i,j)) THEN
+                   info%n(jj)=n(j)
+                   info%k(jj)=k
+                   info%ij(jj) = iim*(j-1)+i
+                   IF(COUNT(own(i:i+n(j)-1,j)) /= n(j)) STOP
+                   EXIT
+                END IF
+             END DO
+             k = k + n(j)
+             jj=jj+1
+          END IF
+       END DO
+
+       IF(k-1/=ngrid) THEN
+          PRINT *, 'Total number of grid points inconsistent', k-1, ngrid
+          STOP
+       END IF
+       IF(jj-1/=nseg) THEN
+          PRINT *, 'Number of segments inconsistent', jj-1, nseg
+          STOP
+       END IF
+
+    END SELECT
+    
+    PRINT *, 'count_segments', info%nseg, info%ngrid, SUM(info%n), COUNT(own), iim*jjm
+  END SUBROUTINE count_segments
+
+  SUBROUTINE init_pack_after
+    USE icosa
+    IMPLICIT NONE
+    INTEGER :: ind, offset
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       CALL pack_domain_2D(pack_info(ind), Ai, physics_inout%Ai)
+       CALL pack_domain_2D(pack_info(ind), lon_i, physics_inout%lon)
+       CALL pack_domain_2D(pack_info(ind), lat_i, physics_inout%lat)
+    END DO
+  END SUBROUTINE init_pack_after
+
+!-------------------------------- Pack / Unpack 2D ---------------------------
+
+  SUBROUTINE pack_2D(f_2D, packed)
+    USE icosa
+    IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_2D(:)
+    REAL(rstd)            :: packed(:)
+    REAL(rstd), POINTER   :: loc(:)
+    INTEGER :: ind
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       loc = f_2D(ind)
+       CALL pack_domain_2D(pack_info(ind), loc, packed)
+    END DO
+  END SUBROUTINE pack_2D
+
+  SUBROUTINE unpack_2D(f_2D, packed) 
+    USE icosa
+    IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_2D(:)
+    REAL(rstd)            :: packed(:)
+    REAL(rstd), POINTER   :: loc(:)
+    INTEGER :: ind
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       loc = f_2D(ind)
+       CALL unpack_domain_2D(pack_info(ind), loc, packed)
+    END DO
+  END SUBROUTINE unpack_2D
+
+  SUBROUTINE pack_domain_2D(info, loc, glob)
+    USE icosa
+    IMPLICIT NONE
+    TYPE(t_pack_info) :: info
+    REAL(rstd), DIMENSION(:) :: loc, glob
+    INTEGER :: jj,n,k,ij
+    DO jj=1, info%nseg
+       n = info%n(jj)-1
+       ij = info%ij(jj)
+       k = info%k(jj)
+       glob(k:k+n) = loc(ij:ij+n)
+    END DO
+  END SUBROUTINE pack_domain_2D
+
+  SUBROUTINE unpack_domain_2D(info, loc, glob)
+    IMPLICIT NONE
+    TYPE(t_pack_info) :: info
+    REAL(rstd), DIMENSION(:) :: loc, glob
+    INTEGER :: jj,n,k,ij
+    DO jj=1, info%nseg
+       n = info%n(jj)-1
+       ij = info%ij(jj)
+       k = info%k(jj)
+       loc(ij:ij+n) = glob(k:k+n)
+    END DO
+  END SUBROUTINE unpack_domain_2D
+
+!-------------------------------- Pack / Unpack 3D ---------------------------
+
+  SUBROUTINE pack_3D(f_3D, packed)
+    USE icosa
+    IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_3D(:)
+    REAL(rstd)            :: packed(:,:)
+    REAL(rstd), POINTER   :: loc(:,:)
+    INTEGER :: ind
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       loc = f_3D(ind)
+       CALL pack_domain_3D(pack_info(ind), loc, packed)
+    END DO
+  END SUBROUTINE pack_3D
+
+  SUBROUTINE unpack_3D(f_3D, packed) 
+    USE icosa
+    IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_3D(:)
+    REAL(rstd)            :: packed(:,:)
+    REAL(rstd), POINTER   :: loc(:,:)
+    INTEGER :: ind
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       loc = f_3D(ind)
+       CALL unpack_domain_3D(pack_info(ind), loc, packed)
+    END DO
+  END SUBROUTINE unpack_3D
+
+  SUBROUTINE pack_domain_3D(info, loc, glob)
+    IMPLICIT NONE
+    TYPE(t_pack_info) :: info
+    REAL(rstd), DIMENSION(:,:) :: loc, glob
+    INTEGER :: jj,n,k,ij
+    DO jj=1, info%nseg
+       n = info%n(jj)-1
+       ij = info%ij(jj)
+       k = info%k(jj)
+       glob(k:k+n,:) = loc(ij:ij+n,:)
+    END DO
+  END SUBROUTINE pack_domain_3D
+
+  SUBROUTINE unpack_domain_3D(info, loc, glob)
+    IMPLICIT NONE
+    TYPE(t_pack_info) :: info
+    REAL(rstd), DIMENSION(:,:) :: loc, glob
+    INTEGER :: jj,n,k,ij
+    DO jj=1, info%nseg
+       n = info%n(jj)-1
+       ij = info%ij(jj)
+       k = info%k(jj)
+       loc(ij:ij+n,:) = glob(k:k+n,:)
+    END DO    
+  END SUBROUTINE unpack_domain_3D
+
+  SUBROUTINE garbage_3D(loc,own)
+    USE icosa
+    IMPLICIT NONE
+    LOGICAL :: own(iim,jjm)
+    REAL(rstd) :: loc(iim*jjm,llm)
+    INTEGER :: i,j,ij
+    ! write garbage in non-owned points
+    DO j=1,jjm
+       DO i=1,iim
+          IF(.NOT.own(i,j)) THEN
+             ij=iim*(j-1)+i
+             loc(ij,:)=-1e30
+          END IF
+       END DO
+    END DO   
+  END SUBROUTINE garbage_3D
+
+!-------------------------------- Pack / Unpack 4D ---------------------------
+
+  SUBROUTINE pack_4D(f_4D, packed)
+    USE icosa
+    IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_4D(:)
+    REAL(rstd)            :: packed(:,:,:)
+    REAL(rstd), POINTER   :: loc(:,:,:)
+    INTEGER :: ind
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       loc = f_4D(ind)
+       CALL pack_domain_4D(pack_info(ind), loc, packed)
+    END DO
+  END SUBROUTINE pack_4D
+
+  SUBROUTINE unpack_4D(f_4D, packed) 
+    USE icosa
+    IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_4D(:)
+    REAL(rstd)            :: packed(:,:,:)
+    REAL(rstd), POINTER   :: loc(:,:,:)
+    INTEGER :: ind
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       loc = f_4D(ind)
+       CALL unpack_domain_4D(pack_info(ind), loc, packed)
+    END DO
+  END SUBROUTINE unpack_4D
+
+  SUBROUTINE pack_domain_4D(info, loc, glob)
+    IMPLICIT NONE
+    TYPE(t_pack_info) :: info
+    REAL(rstd), DIMENSION(:,:,:) :: loc, glob
+    INTEGER :: jj,n,k,ij
+    DO jj=1, info%nseg
+       n = info%n(jj)-1
+       ij = info%ij(jj)
+       k = info%k(jj)
+       glob(k:k+n,:,:) = loc(ij:ij+n,:,:)
+    END DO
+  END SUBROUTINE pack_domain_4D
+
+  SUBROUTINE unpack_domain_4D(info, loc, glob)
+    IMPLICIT NONE
+    TYPE(t_pack_info) :: info
+    REAL(rstd), DIMENSION(:,:,:) :: loc, glob
+    INTEGER :: jj,n,k,ij
+    DO jj=1, info%nseg
+       n = info%n(jj)-1
+       ij = info%ij(jj)
+       k = info%k(jj)
+       loc(ij:ij+n,:,:) = glob(k:k+n,:,:)
+    END DO
+  END SUBROUTINE unpack_domain_4D
+
+END MODULE physics_interface_mod
Index: codes/icosagcm/devel/src/physics/physics_lmdz_generic.F90
===================================================================
--- codes/icosagcm/devel/src/physics/physics_lmdz_generic.F90	(revision 533)
+++ codes/icosagcm/devel/src/physics/physics_lmdz_generic.F90	(revision 533)
@@ -0,0 +1,613 @@
+MODULE physics_lmdz_generic_mod
+  USE field_mod
+  USE transfert_mod
+  
+  INTEGER,SAVE :: nbp_phys
+  TYPE(t_message) :: req_u
+
+  TYPE(t_field),POINTER :: f_p(:) 
+  TYPE(t_field),POINTER :: f_pks(:)  
+  TYPE(t_field),POINTER :: f_pk(:)  
+  TYPE(t_field),POINTER :: f_p_layer(:)    
+  TYPE(t_field),POINTER :: f_theta(:)   
+  TYPE(t_field),POINTER :: f_phi(:)   
+  TYPE(t_field),POINTER :: f_Temp(:)    
+  TYPE(t_field),POINTER :: f_ulon(:)    
+  TYPE(t_field),POINTER :: f_ulat(:)   
+  TYPE(t_field),POINTER :: f_dulon(:)
+  TYPE(t_field),POINTER :: f_dulat(:)
+  TYPE(t_field),POINTER :: f_dTemp(:)
+  TYPE(t_field),POINTER :: f_dq(:)
+  TYPE(t_field),POINTER :: f_dps(:)
+  TYPE(t_field),POINTER :: f_duc(:)
+
+  INTEGER :: start_clock
+  INTEGER :: stop_clock
+  INTEGER :: count_clock=0
+  
+  REAL :: start_day
+  REAL :: day_length
+  REAL :: year_length
+  
+ INTEGER,ALLOCATABLE,SAVE :: domain_offset(:)
+
+  
+
+CONTAINS
+
+  SUBROUTINE init_physics
+  USE icosa
+  USE domain_mod
+  USE dimensions
+  USE mpi_mod
+  USE mpipara
+  USE disvert_mod
+  USE xios_mod
+  
+  IMPLICIT NONE
+  INTEGER  :: distrib(0:mpi_size-1)
+  INTEGER  :: ind,i,j,ij,pos
+
+  REAL(rstd),ALLOCATABLE :: latfi(:)
+  REAL(rstd),ALLOCATABLE :: lonfi(:)
+  REAL(rstd),ALLOCATABLE :: airefi(:)
+  REAL(rstd),ALLOCATABLE :: bounds_latfi(:,:)
+  REAL(rstd),ALLOCATABLE :: bounds_lonfi(:,:)
+
+    start_day=0
+    day_length=86400
+    year_length=86400*365.25
+    
+    CALL getin('start_day',start_day)
+    CALL getin('day_length',day_length)
+    CALL getin('year_length',year_length)
+
+!$OMP PARALLEL
+    CALL allocate_field(f_p,field_t,type_real,llm+1)
+    CALL allocate_field(f_pks,field_t,type_real)
+    CALL allocate_field(f_pk,field_t,type_real,llm)
+    CALL allocate_field(f_p_layer,field_t,type_real,llm)
+    CALL allocate_field(f_theta,field_t,type_real,llm)
+    CALL allocate_field(f_phi,field_t,type_real,llm)
+    CALL allocate_field(f_Temp,field_t,type_real,llm)
+    CALL allocate_field(f_ulon,field_t,type_real,llm)
+    CALL allocate_field(f_ulat,field_t,type_real,llm)
+    CALL allocate_field(f_dulon,field_t,type_real,llm)
+    CALL allocate_field(f_dulat,field_t,type_real,llm)
+    CALL allocate_field(f_dTemp,field_t,type_real,llm)
+    CALL allocate_field(f_dq,field_t,type_real,llm,nqtot)
+    CALL allocate_field(f_dps,field_t,type_real)
+    CALL allocate_field(f_duc,field_t,type_real,3,llm)    
+!$OMP END PARALLEL    
+
+    ALLOCATE(domain_offset(ndomain))
+    nbp_phys=0
+    domain_offset(1)=0
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      IF (ind<ndomain) THEN 
+        domain_offset(ind+1)=domain_offset(ind)+ii_nb*jj_nb
+      ENDIF
+      nbp_phys=nbp_phys+ii_nb*jj_nb
+    ENDDO
+    
+    CALL MPI_ALLGATHER(nbp_phys,1,MPI_INTEGER,distrib,1,MPI_INTEGER,comm_icosa,ierr)
+    
+    ALLOCATE(latfi(nbp_phys))
+    ALLOCATE(lonfi(nbp_phys))
+    ALLOCATE(airefi(nbp_phys))
+    ALLOCATE(bounds_latfi(nbp_phys,6))
+    ALLOCATE(bounds_lonfi(nbp_phys,6))
+    
+    pos=0
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          pos=pos+1
+          CALL xyz2lonlat(xyz_i(ij,:),lonfi(pos),latfi(pos))
+          CALL xyz2lonlat(xyz_v(ij+z_rup,:), bounds_lonfi(pos,1), bounds_latfi(pos,1))
+          CALL xyz2lonlat(xyz_v(ij+z_up,:), bounds_lonfi(pos,2), bounds_latfi(pos,2))
+          CALL xyz2lonlat(xyz_v(ij+z_lup,:), bounds_lonfi(pos,3), bounds_latfi(pos,3))
+          CALL xyz2lonlat(xyz_v(ij+z_ldown,:), bounds_lonfi(pos,4), bounds_latfi(pos,4))
+          CALL xyz2lonlat(xyz_v(ij+z_down,:), bounds_lonfi(pos,5), bounds_latfi(pos,5))
+          CALL xyz2lonlat(xyz_v(ij+z_rdown,:), bounds_lonfi(pos,6), bounds_latfi(pos,6))
+          airefi(pos)=Ai(ij)  
+        ENDDO
+      ENDDO
+    ENDDO
+
+
+#ifdef CPP_PHYSICS_LMDZ_GENERIC
+    CALL initialize_unstructured_physics(nbp_phys,llm, comm_icosa, mpi_size,distrib,            &
+                                         day_length,start_day,itau_physics*dt,                  &
+                                         6,latfi,lonfi,airefi,bounds_lonfi,bounds_latfi,         &
+                                         radius,g, gas_constant/mu, cpp,                        &
+                                         preff, ap, bp)                                         
+#endif
+    
+    CALL xios_set_context    
+    
+!    CALL init_phys_lmdz(128,97,llm, comm_icosa, mpi_size, distrib)
+    
+#ifdef CPP_PHYSICS_LMDZ_GENERIC
+    CALL init_gcm_lmdz(nbp_phys,mpi_size,distrib,latfi,lonfi,airefi)
+#endif
+!    CALL init_phys_lmdz(128,97,llm, comm_icosa, mpi_size, distrib)
+!    CALL iniphysiq(llm,day_length,start_day,itau_physics*dt,     &
+!                   latfi,lonfi,airefi,radius,g, gas_constant/mu, cpp,     &
+!                   ap, bp)
+    
+    
+    
+  END SUBROUTINE init_physics
+  
+  SUBROUTINE physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_wflux, f_q)
+  USE ICOSA
+  USE time_mod
+  USE disvert_mod
+  USE transfert_mod
+  USE mpipara
+  USE xios_mod
+  USE trace
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)    :: it
+    TYPE(t_field),POINTER :: f_phis(:)
+    TYPE(t_field),POINTER :: f_ps(:)
+    TYPE(t_field),POINTER :: f_theta_rhodz(:)
+    TYPE(t_field),POINTER :: f_u(:)
+    TYPE(t_field),POINTER :: f_wflux(:)
+    TYPE(t_field),POINTER :: f_q(:)
+  
+    REAL(rstd),POINTER :: phis(:)
+    REAL(rstd),POINTER :: ps(:)
+    REAL(rstd),POINTER :: theta_rhodz(:,:)
+    REAL(rstd),POINTER :: u(:,:)
+    REAL(rstd),POINTER :: wflux(:,:)
+    REAL(rstd),POINTER :: q(:,:,:)
+    REAL(rstd),POINTER :: p(:,:)
+    REAL(rstd),POINTER :: pks(:)
+    REAL(rstd),POINTER :: pk(:,:)
+    REAL(rstd),POINTER :: p_layer(:,:)
+    REAL(rstd),POINTER :: theta(:,:)
+    REAL(rstd),POINTER :: phi(:,:)
+    REAL(rstd),POINTER :: Temp(:,:)
+    REAL(rstd),POINTER :: ulon(:,:)
+    REAL(rstd),POINTER :: ulat(:,:)
+    REAL(rstd),POINTER :: dulon(:,:)
+    REAL(rstd),POINTER :: dulat(:,:)
+    REAL(rstd),POINTER :: dTemp(:,:)
+    REAL(rstd),POINTER :: dq(:,:,:)
+    REAL(rstd),POINTER :: dps(:)
+    REAL(rstd),POINTER :: duc(:,:,:)
+
+
+    INTEGER :: ind
+    
+    REAL(rstd),ALLOCATABLE,SAVE :: ps_phy(:)
+    REAL(rstd),ALLOCATABLE,SAVE :: p_phy(:,:)
+    REAL(rstd),ALLOCATABLE,SAVE :: p_layer_phy(:,:)
+    REAL(rstd),ALLOCATABLE,SAVE :: Temp_phy(:,:)
+    REAL(rstd),ALLOCATABLE,SAVE :: phis_phy(:)
+    REAL(rstd),ALLOCATABLE,SAVE :: phi_phy(:,:)
+    REAL(rstd),ALLOCATABLE,SAVE :: ulon_phy(:,:)
+    REAL(rstd),ALLOCATABLE,SAVE :: ulat_phy(:,:)
+    REAL(rstd),ALLOCATABLE,SAVE :: q_phy(:,:,:)
+    REAL(rstd),ALLOCATABLE,SAVE :: wflux_phy(:,:)
+    REAL(rstd),ALLOCATABLE,SAVE :: dulon_phy(:,:)
+    REAL(rstd),ALLOCATABLE,SAVE :: dulat_phy(:,:)
+    REAL(rstd),ALLOCATABLE,SAVE :: dTemp_phy(:,:)
+    REAL(rstd),ALLOCATABLE,SAVE :: dq_phy(:,:,:)
+    REAL(rstd),ALLOCATABLE,SAVE :: dps_phy(:)
+    REAL(rstd) :: dtphy 
+    REAL(rstd) :: time
+    REAL(rstd) :: day
+    REAL(rstd) :: real_time
+    INTEGER    :: offset
+    LOGICAL :: lafin=.FALSE.
+    LOGICAL,SAVE :: first=.TRUE.
+!$OMP THREADPRIVATE(first)
+
+    
+    IF (first) THEN
+      first=.FALSE.
+      CALL init_message(f_u,req_e1_vect,req_u)
+!$OMP MASTER
+      ALLOCATE(ps_phy(nbp_phys))
+      ALLOCATE(p_phy(nbp_phys,llm+1))
+      ALLOCATE(p_layer_phy(nbp_phys,llm))
+      ALLOCATE(Temp_phy(nbp_phys,llm))
+      ALLOCATE(phis_phy(nbp_phys))
+      ALLOCATE(phi_phy(nbp_phys,llm))
+      ALLOCATE(ulon_phy(nbp_phys,llm))
+      ALLOCATE(ulat_phy(nbp_phys,llm))
+      ALLOCATE(q_phy(nbp_phys,llm,nqtot))
+      ALLOCATE(wflux_phy(nbp_phys,llm))
+      ALLOCATE(dulon_phy(nbp_phys,llm))
+      ALLOCATE(dulat_phy(nbp_phys,llm))
+      ALLOCATE(dTemp_phy(nbp_phys,llm))
+      ALLOCATE(dq_phy(nbp_phys,llm,nqtot))
+      ALLOCATE(dps_phy(nbp_phys))
+      
+!$OMP END MASTER
+!$OMP BARRIER
+    ENDIF
+
+    IF(it==itaumax) THEN 
+      lafin=.TRUE.
+    ELSE 
+      lafin=.FALSE.
+    ENDIF
+
+!$OMP MASTER        
+!    CALL update_calendar(it)
+!$OMP END MASTER
+!$OMP BARRIER
+    dtphy=itau_physics*dt
+    real_time=start_day*day_length+it*dt
+    day  = INT( MODULO(real_time,year_length) / day_length) 
+    time = MODULO(real_time,day_length) / day_length
+
+!$OMP MASTER    
+    IF (is_mpi_root) PRINT*,"Enterring in physic : day", day, "  time : ",time 
+!$OMP END MASTER    
+    
+    
+    
+    
+    CALL transfert_message(f_u,req_u)
+    
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      IF (assigned_domain(ind)) THEN
+        offset=domain_offset(ind)
+        CALL swap_geometry(ind)
+      
+        phis=f_phis(ind)
+        ps=f_ps(ind)
+        theta_rhodz=f_theta_rhodz(ind)
+        u=f_u(ind)
+        q=f_q(ind)
+        wflux=f_wflux(ind)
+        p=f_p(ind)
+        pks=f_pks(ind)
+        pk=f_pk(ind)
+        p_layer=f_p_layer(ind)
+        theta=f_theta(ind)
+        phi=f_phi(ind)
+        Temp=f_Temp(ind)
+        ulon=f_ulon(ind)
+        ulat=f_ulat(ind)
+            
+        CALL grid_icosa_to_physics
+
+      ENDIF
+    ENDDO
+
+!$OMP BARRIER
+!$OMP MASTER
+    CALL SYSTEM_CLOCK(start_clock)
+!$OMP END MASTER
+    CALL trace_start("physic")
+!    CALL trace_off()
+
+#ifdef CPP_PHYSICS_LMDZ_GENERIC
+    CALL calfis_icosa(dtphy, lafin, day, time, presnivs,      &
+                      p_phy, p_layer_phy, phi_phy, phis_phy, ulon_phy, ulat_phy, Temp_phy, q_phy, wflux_phy, &
+                      dulon_phy, dulat_phy, dTemp_phy, dq_phy, dps_phy  )
+#endif
+!    CALL trace_on()
+    CALL trace_end("physic")
+!$OMP MASTER
+    CALL SYSTEM_CLOCK(stop_clock)
+    count_clock=count_clock+stop_clock-start_clock
+!$OMP END MASTER
+
+!$OMP BARRIER                       
+
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      IF (assigned_domain(ind)) THEN
+        CALL swap_geometry(ind)
+        offset=domain_offset(ind)
+      
+        theta_rhodz=f_theta_rhodz(ind)
+        u=f_u(ind)
+        q=f_q(ind)
+        ps=f_ps(ind)
+        dulon=f_dulon(ind)
+        dulat=f_dulat(ind)
+        Temp=f_temp(ind)
+        dTemp=f_dTemp(ind)
+        dq=f_dq(ind)
+        dps=f_dps(ind)
+        duc=f_duc(ind)
+        p=f_p(ind)
+        pks=f_pks(ind)
+        pk=f_pk(ind)
+      
+        CALL grid_physics_to_icosa
+      ENDIF
+    ENDDO
+
+!$OMP BARRIER
+    CALL xios_set_context    
+     
+  CONTAINS
+   
+    SUBROUTINE grid_physics_to_icosa
+    USE theta2theta_rhodz_mod
+    USE omp_para
+    IMPLICIT NONE
+      INTEGER :: i,j,ij,l,iq
+          
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          offset=offset+1
+          
+          dulon(ij,ll_begin:ll_end)=dulon_phy(offset,ll_begin:ll_end)
+          dulat(ij,ll_begin:ll_end)=dulat_phy(offset,ll_begin:ll_end)
+          dTemp(ij,ll_begin:ll_end)=dTemp_phy(offset,ll_begin:ll_end)
+          Temp(ij,ll_begin:ll_end) = Temp_phy(offset,ll_begin:ll_end)
+          dq(ij,ll_begin:ll_end,:)=dq_phy(offset,ll_begin:ll_end,:)
+          if (is_omp_first_level) dps(ij)=dps_phy(offset)
+        ENDDO
+      ENDDO
+    
+      DO l=ll_begin,ll_end
+        DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+            ij=(j-1)*iim+i
+            duc(ij,:,l)=dulon(ij,l)*elon_i(ij,:)+dulat(ij,l)*elat_i(ij,:)
+          ENDDO
+        ENDDO
+      ENDDO
+
+      DO l=ll_begin,ll_end
+        DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+            ij=(j-1)*iim+i
+            u(ij+u_right,l) = u(ij+u_right,l) + dtphy * sum( 0.5*(duc(ij,:,l) + duc(ij+t_right,:,l))*ep_e(ij+u_right,:) )
+            u(ij+u_lup,l) = u(ij+u_lup,l) + dtphy * sum( 0.5*(duc(ij,:,l) + duc(ij+t_lup,:,l))*ep_e(ij+u_lup,:) )
+            u(ij+u_ldown,l) = u(ij+u_ldown,l) + dtphy*sum( 0.5*(duc(ij,:,l) + duc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) )
+          ENDDO
+        ENDDO
+      ENDDO          
+
+      DO l=ll_begin,ll_end
+        DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+            ij=(j-1)*iim+i
+            Temp(ij,l)=Temp(ij,l)+ dtphy * dTemp(ij,l)
+          ENDDO
+        ENDDO
+      ENDDO          
+      
+      DO iq=1,nqtot
+        DO l=ll_begin,ll_end
+          DO j=jj_begin,jj_end
+            DO i=ii_begin,ii_end
+              ij=(j-1)*iim+i
+              q(ij,l,iq)=q(ij,l,iq)+ dtphy * dq(ij,l,iq)
+            ENDDO
+          ENDDO
+        ENDDO 
+      ENDDO
+
+!$OMP BARRIER
+      
+     IF (is_omp_first_level) THEN
+       DO j=jj_begin,jj_end
+         DO i=ii_begin,ii_end
+           ij=(j-1)*iim+i
+           ps(ij)=ps(ij)+ dtphy * dps(ij)
+          ENDDO
+       ENDDO
+     ENDIF
+
+!     CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0)
+
+! compute pression
+!$OMP BARRIER
+      DO    l    = ll_begin,ll_endp1
+        DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+            ij=(j-1)*iim+i
+            p(ij,l) = ap(l) + bp(l) * ps(ij)
+          ENDDO
+        ENDDO
+      ENDDO
+
+!$OMP BARRIER
+
+! compute exner
+       
+       IF (is_omp_first_level) THEN
+         DO j=jj_begin,jj_end
+            DO i=ii_begin,ii_end
+               ij=(j-1)*iim+i
+               pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
+            ENDDO
+         ENDDO
+       ENDIF
+
+       ! 3D : pk
+       DO l = ll_begin,ll_end
+          DO j=jj_begin,jj_end
+             DO i=ii_begin,ii_end
+                ij=(j-1)*iim+i
+                pk(ij,l) = cpp * ((.5/preff)*(p(ij,l)+p(ij,l+1))) ** kappa
+             ENDDO
+          ENDDO
+       ENDDO
+
+!$OMP BARRIER
+
+!   compute theta, temperature and pression at layer
+    DO    l    = ll_begin, ll_end
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / (pk(ij,l) / cpp )
+        ENDDO
+      ENDDO
+    ENDDO
+    
+    END SUBROUTINE grid_physics_to_icosa
+    
+    
+    SUBROUTINE grid_icosa_to_physics
+    USE pression_mod
+    USE exner_mod
+    USE theta2theta_rhodz_mod
+    USE geopotential_mod
+    USE wind_mod
+    USE omp_para
+    IMPLICIT NONE
+    
+    REAL(rstd) :: uc(3)
+    INTEGER :: i,j,ij,l
+    
+
+! compute pression
+
+      DO    l    = ll_begin,ll_endp1
+        DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+            ij=(j-1)*iim+i
+            p(ij,l) = ap(l) + bp(l) * ps(ij)
+          ENDDO
+        ENDDO
+      ENDDO
+
+!$OMP BARRIER
+
+! compute exner
+       
+       IF (is_omp_first_level) THEN
+         DO j=jj_begin,jj_end
+            DO i=ii_begin,ii_end
+               ij=(j-1)*iim+i
+               pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
+            ENDDO
+         ENDDO
+       ENDIF
+
+       ! 3D : pk
+       DO l = ll_begin,ll_end
+          DO j=jj_begin,jj_end
+             DO i=ii_begin,ii_end
+                ij=(j-1)*iim+i
+                pk(ij,l) = cpp * ((.5/preff)*(p(ij,l)+p(ij,l+1))) ** kappa
+             ENDDO
+          ENDDO
+       ENDDO
+
+!$OMP BARRIER
+
+!   compute theta, temperature and pression at layer
+    DO    l    = ll_begin, ll_end
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          theta(ij,l) = theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g)
+          Temp(ij,l) = theta(ij,l) * pk(ij,l) / cpp
+          p_layer(ij,l)=preff*(pk(ij,l)/cpp)**(1./kappa) 
+        ENDDO
+      ENDDO
+    ENDDO
+
+
+!!! Compute geopotential
+       
+  ! for first layer
+  IF (is_omp_first_level) THEN
+    DO j=jj_begin,jj_end
+      DO i=ii_begin,ii_end
+        ij=(j-1)*iim+i
+        phi( ij,1 ) = phis( ij ) + theta(ij,1) * ( pks(ij) - pk(ij,1) )
+      ENDDO
+    ENDDO
+  ENDIF
+!!-> implicit flush on phi(:,1)
+          
+  ! for other layers
+  DO l = ll_beginp1, ll_end
+    DO j=jj_begin,jj_end
+      DO i=ii_begin,ii_end
+        ij=(j-1)*iim+i
+        phi(ij,l) =  0.5 * ( theta(ij,l)  + theta(ij,l-1) )  & 
+                         * (  pk(ij,l-1) -  pk(ij,l)    )
+      ENDDO
+    ENDDO
+  ENDDO       
+
+!$OMP BARRIER
+
+
+  IF (is_omp_first_level) THEN
+    DO l = 2, llm
+      DO j=jj_begin,jj_end
+! ---> Bug compilo intel ici en openmp
+! ---> Couper la boucle
+       IF (j==jj_end+1) PRINT*,"this message must not be printed"
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          phi(ij,l) = phi(ij,l)+ phi(ij,l-1)
+        ENDDO
+      ENDDO
+    ENDDO
+! --> IMPLICIT FLUSH on phi --> non
+  ENDIF 
+
+! compute wind centered lon lat compound
+    DO l=ll_begin,ll_end
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          uc(:)=1/Ai(ij)*                                                                                                &
+                        ( ne(ij,right)*u(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_v(ij+z_rup,:))/2-centroid(ij,:))  &
+                         + ne(ij,rup)*u(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_v(ij+z_up,:))/2-centroid(ij,:))          &
+                         + ne(ij,lup)*u(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_v(ij+z_lup,:))/2-centroid(ij,:))          &
+                         + ne(ij,left)*u(ij+u_left,l)*le(ij+u_left)*((xyz_v(ij+z_lup,:)+xyz_v(ij+z_ldown,:))/2-centroid(ij,:))    &
+                         + ne(ij,ldown)*u(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_v(ij+z_ldown,:)+xyz_v(ij+z_down,:))/2-centroid(ij,:))&
+                         + ne(ij,rdown)*u(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_v(ij+z_down,:)+xyz_v(ij+z_rdown,:))/2-centroid(ij,:)))
+          ulon(ij,l)=sum(uc(:)*elon_i(ij,:))
+          ulat(ij,l)=sum(uc(:)*elat_i(ij,:)) 
+        ENDDO
+      ENDDO
+    ENDDO
+
+!$OMP BARRIER
+
+
+      
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          offset=offset+1
+
+          IF (is_omp_first_level) ps_phy(offset) = ps(ij)
+          p_phy(offset,ll_begin:ll_endp1) = p(ij,ll_begin:ll_endp1)
+          p_layer_phy(offset,ll_begin:ll_end) = p_layer(ij,ll_begin:ll_end)
+          Temp_phy(offset,ll_begin:ll_end) = Temp(ij,ll_begin:ll_end)
+          IF (is_omp_first_level) phis_phy(offset) = phis(ij)
+          phi_phy(offset,ll_begin:ll_end) = phi(ij,ll_begin:ll_end)-phis(ij)
+          ulon_phy(offset,ll_begin:ll_end) = ulon(ij,ll_begin:ll_end)
+          ulat_phy(offset,ll_begin:ll_end) = ulat(ij,ll_begin:ll_end)
+          q_phy(offset,ll_begin:ll_end,:) = q(ij,ll_begin:ll_end,:)
+          wflux_phy(offset,ll_begin:ll_end) = wflux(ij,ll_begin:ll_end)
+        ENDDO
+      ENDDO
+     
+     END SUBROUTINE grid_icosa_to_physics
+
+  END SUBROUTINE physics
+  
+  
+END MODULE physics_lmdz_generic_mod
+    
+  
Index: codes/icosagcm/devel/src/physics_external.F90
===================================================================
--- codes/icosagcm/devel/src/physics_external.F90	(revision 531)
+++ 	(revision )
@@ -1,55 +1,0 @@
-MODULE physics_external_mod
-  USE field_mod
-  
-  INTEGER,SAVE :: it
-!$OMP THREADPRIVATE(it)
-
-  TYPE(t_field),POINTER,SAVE :: f_phis(:)
-  TYPE(t_field),POINTER,SAVE :: f_ps(:)
-  TYPE(t_field),POINTER,SAVE :: f_theta_rhodz(:)
-  TYPE(t_field),POINTER,SAVE :: f_u(:)
-  TYPE(t_field),POINTER,SAVE :: f_wflux(:)
-  TYPE(t_field),POINTER,SAVE :: f_q(:)
-  
-  
-  
-CONTAINS
-
-  SUBROUTINE init_physics
-
-    CALL initialize_external_physics
-        
-  END SUBROUTINE init_physics
-  
-  SUBROUTINE physics(it_,f_phis_, f_ps_, f_theta_rhodz_, f_u_, f_wflux_, f_q_)
-  USE field_mod
-  IMPLICIT NONE
-    INTEGER,INTENT(IN)    :: it_
-    TYPE(t_field),POINTER :: f_phis_(:)
-    TYPE(t_field),POINTER :: f_ps_(:)
-    TYPE(t_field),POINTER :: f_theta_rhodz_(:)
-    TYPE(t_field),POINTER :: f_u_(:)
-    TYPE(t_field),POINTER :: f_wflux_(:)
-    TYPE(t_field),POINTER :: f_q_(:)
-
-    it=it_
-    
-!$OMP BARRIER
-!$OMP MASTER
-    f_phis=>f_phis_
-    f_ps=>f_ps_
-    f_theta_rhodz=>f_theta_rhodz_
-    f_u=>f_u_
-    f_wflux=>f_wflux_
-    f_q=>f_q_
-!$OMP END MASTER
-!$OMP BARRIER
-
-    CALL external_physics
-    
-  END SUBROUTINE physics
-  
-  
-END MODULE physics_external_mod
-    
-  
Index: codes/icosagcm/devel/src/physics_interface.f90
===================================================================
--- codes/icosagcm/devel/src/physics_interface.f90	(revision 531)
+++ 	(revision )
@@ -1,394 +1,0 @@
-MODULE physics_interface_mod
-
-  USE prec
-
-  PRIVATE
-
-  TYPE t_physics_inout
-     ! Input, time-independent
-     INTEGER :: ngrid
-     REAL(rstd) :: dt_phys
-     REAL(rstd), DIMENSION(:), POINTER :: Ai, lon, lat, phis
-     ! Input, time-dependent
-     REAL(rstd), DIMENSION(:,:), POINTER :: p, pk, Temp, ulon, ulat
-     REAL(rstd), DIMENSION(:,:,:), POINTER :: q
-     ! Output arrays
-     REAL(rstd), DIMENSION(:,:), POINTER :: dTemp, dulon, dulat
-     REAL(rstd), DIMENSION(:,:,:), POINTER :: dq
-  END TYPE t_physics_inout
-
-! physics_inout is used to exchange information with physics
-! Field ngrid is initialized by physics.f90/init_physics. Its other fields
-! must be defined by XX/init_physics (where XX =  e.g. physics_dcmip.f90) 
-! by either pointing to internal data of the physics package
-! or by a specific allocation
-! size : (ngrid), (ngrid,llm) except p(ngrid,llm+1), (ngrid,llm,nqtot) 
-
-  TYPE(t_physics_inout), SAVE :: physics_inout
-!$OMP THREADPRIVATE(physics_inout) 
- 
-! pack_info contains indices used by pack/unpack routines
-! to pack together the data of all the domains managed by the MPI process
-! It is initialized by physics.f90/init_physics 
-
-  TYPE t_pack_info
-     INTEGER :: ngrid, & ! number of non-halo points in that domain
-          nseg ! number of segments (contigous parts) in that domain
-     ! size and start of each segment : ij domain index, k packed index
-     INTEGER, ALLOCATABLE :: n(:), ij(:), k(:)
-  END TYPE t_pack_info
-
-  TYPE(t_pack_info), ALLOCATABLE, SAVE :: pack_info(:)
-!$OMP THREADPRIVATE(pack_info)
-
-
-  INTERFACE pack_field
-     MODULE PROCEDURE pack_2D
-     MODULE PROCEDURE pack_3D
-     MODULE PROCEDURE pack_4D
-  END INTERFACE pack_field
-
-  INTERFACE unpack_field
-     MODULE PROCEDURE unpack_2D
-     MODULE PROCEDURE unpack_3D
-     MODULE PROCEDURE unpack_4D
-  END INTERFACE unpack_field
-
-  INTERFACE pack_domain
-     MODULE PROCEDURE pack_domain_2D
-     MODULE PROCEDURE pack_domain_3D
-     MODULE PROCEDURE pack_domain_4D
-  END INTERFACE pack_domain
-
-  INTERFACE unpack_domain
-     MODULE PROCEDURE unpack_domain_2D
-     MODULE PROCEDURE unpack_domain_3D
-     MODULE PROCEDURE unpack_domain_4D
-  END INTERFACE unpack_domain
-
-  PUBLIC :: nb_extra_physics_2D, nb_extra_physics_3D, &
-       t_physics_inout, physics_inout, &
-       t_pack_info, pack_info, init_pack_before, init_pack_after, &
-       pack_domain, pack_field, unpack_domain, unpack_field, &
-       garbage_3D
-
-CONTAINS
-  
-    SUBROUTINE init_pack_before
-    USE icosa
-    IMPLICIT NONE
-    INTEGER :: ind, offset
-
-    offset=0
-    ALLOCATE(pack_info(ndomain))
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       CALL count_segments(domain(ind)%own, pack_info(ind))
-       pack_info(ind)%k = pack_info(ind)%k + offset
-       offset = offset + pack_info(ind)%ngrid
-    END DO
-    physics_inout%ngrid = offset
-
-  END SUBROUTINE init_pack_before
-
-  SUBROUTINE count_segments(own, info)
-    USE icosa
-    IMPLICIT NONE
-    LOGICAL, DIMENSION(:,:) :: own
-    TYPE(t_pack_info) :: info
-
-    INTEGER, DIMENSION(jjm) :: n
-    INTEGER :: ngrid, nseg, i, j, jj, k
-    INTEGER, PARAMETER :: method=4
-    SELECT CASE(method)
-    CASE(1) ! Copy all points, including halo (works)
-       info%nseg=1
-       info%ngrid=iim*jjm
-       ALLOCATE(info%n(1))
-       ALLOCATE(info%ij(1))
-       ALLOCATE(info%k(1))
-       info%n(1)=iim*jjm
-       info%ij(1)=1
-       info%k(1)=1
-    CASE(2) ! Copy all points, including halo, one at a time (works, slow ?)
-       info%nseg=iim*jjm
-       info%ngrid=iim*jjm
-       ALLOCATE(info%n(iim*jjm))
-       ALLOCATE(info%ij(iim*jjm))
-       ALLOCATE(info%k(iim*jjm))
-       DO jj=1,iim*jjm
-          info%n(jj) =1
-          info%ij(jj)=jj
-          info%k(jj) =jj
-       END DO
-    CASE(3) ! Copy non-halo points only, one at a time (works, slow ?)
-       n=0
-       n(jj_begin:jj_end)=COUNT(own(ii_begin:ii_end,jj_begin:jj_end),1)
-       ngrid=SUM(n)
-       info%ngrid=ngrid
-       info%nseg=ngrid
-       ALLOCATE(info%n(ngrid))
-       ALLOCATE(info%ij(ngrid))
-       ALLOCATE(info%k(ngrid))
-       jj=1
-       DO j=1,jjm
-          DO i=1,iim
-             IF(own(i,j)) THEN
-                info%n(jj)=1
-                info%k(jj)=jj
-                info%ij(jj) = iim*(j-1)+i
-                jj=jj+1
-             END IF
-          END DO
-       END DO
-       
-    CASE DEFAULT ! Copy non-halo points only, as contiguous segments (works)
-       n=0
-       n(jj_begin:jj_end)=COUNT(own(ii_begin:ii_end,jj_begin:jj_end),1)
-       ngrid=SUM(n)
-       info%ngrid=ngrid
-       nseg=COUNT(n>0)
-       info%nseg=nseg
-       ALLOCATE(info%n(nseg))
-       ALLOCATE(info%ij(nseg))
-       ALLOCATE(info%k(nseg))
-       info%n(:)=0
-       info%ij(:)=0
-       info%k(:)=0
-       
-       jj=1
-       k=1
-       DO j=jj_begin,jj_end
-          IF(n(j)>0) THEN
-             ! find first .TRUE. value in own(:,j)
-             DO i=ii_begin,ii_end
-                IF(own(i,j)) THEN
-                   info%n(jj)=n(j)
-                   info%k(jj)=k
-                   info%ij(jj) = iim*(j-1)+i
-                   IF(COUNT(own(i:i+n(j)-1,j)) /= n(j)) STOP
-                   EXIT
-                END IF
-             END DO
-             k = k + n(j)
-             jj=jj+1
-          END IF
-       END DO
-
-       IF(k-1/=ngrid) THEN
-          PRINT *, 'Total number of grid points inconsistent', k-1, ngrid
-          STOP
-       END IF
-       IF(jj-1/=nseg) THEN
-          PRINT *, 'Number of segments inconsistent', jj-1, nseg
-          STOP
-       END IF
-
-    END SELECT
-    
-    PRINT *, 'count_segments', info%nseg, info%ngrid, SUM(info%n), COUNT(own), iim*jjm
-  END SUBROUTINE count_segments
-
-  SUBROUTINE init_pack_after
-    USE icosa
-    IMPLICIT NONE
-    INTEGER :: ind, offset
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       CALL pack_domain_2D(pack_info(ind), Ai, physics_inout%Ai)
-       CALL pack_domain_2D(pack_info(ind), lon_i, physics_inout%lon)
-       CALL pack_domain_2D(pack_info(ind), lat_i, physics_inout%lat)
-    END DO
-  END SUBROUTINE init_pack_after
-
-!-------------------------------- Pack / Unpack 2D ---------------------------
-
-  SUBROUTINE pack_2D(f_2D, packed)
-    USE icosa
-    IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_2D(:)
-    REAL(rstd)            :: packed(:)
-    REAL(rstd), POINTER   :: loc(:)
-    INTEGER :: ind
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       loc = f_2D(ind)
-       CALL pack_domain_2D(pack_info(ind), loc, packed)
-    END DO
-  END SUBROUTINE pack_2D
-
-  SUBROUTINE unpack_2D(f_2D, packed) 
-    USE icosa
-    IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_2D(:)
-    REAL(rstd)            :: packed(:)
-    REAL(rstd), POINTER   :: loc(:)
-    INTEGER :: ind
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       loc = f_2D(ind)
-       CALL unpack_domain_2D(pack_info(ind), loc, packed)
-    END DO
-  END SUBROUTINE unpack_2D
-
-  SUBROUTINE pack_domain_2D(info, loc, glob)
-    USE icosa
-    IMPLICIT NONE
-    TYPE(t_pack_info) :: info
-    REAL(rstd), DIMENSION(:) :: loc, glob
-    INTEGER :: jj,n,k,ij
-    DO jj=1, info%nseg
-       n = info%n(jj)-1
-       ij = info%ij(jj)
-       k = info%k(jj)
-       glob(k:k+n) = loc(ij:ij+n)
-    END DO
-  END SUBROUTINE pack_domain_2D
-
-  SUBROUTINE unpack_domain_2D(info, loc, glob)
-    IMPLICIT NONE
-    TYPE(t_pack_info) :: info
-    REAL(rstd), DIMENSION(:) :: loc, glob
-    INTEGER :: jj,n,k,ij
-    DO jj=1, info%nseg
-       n = info%n(jj)-1
-       ij = info%ij(jj)
-       k = info%k(jj)
-       loc(ij:ij+n) = glob(k:k+n)
-    END DO
-  END SUBROUTINE unpack_domain_2D
-
-!-------------------------------- Pack / Unpack 3D ---------------------------
-
-  SUBROUTINE pack_3D(f_3D, packed)
-    USE icosa
-    IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_3D(:)
-    REAL(rstd)            :: packed(:,:)
-    REAL(rstd), POINTER   :: loc(:,:)
-    INTEGER :: ind
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       loc = f_3D(ind)
-       CALL pack_domain_3D(pack_info(ind), loc, packed)
-    END DO
-  END SUBROUTINE pack_3D
-
-  SUBROUTINE unpack_3D(f_3D, packed) 
-    USE icosa
-    IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_3D(:)
-    REAL(rstd)            :: packed(:,:)
-    REAL(rstd), POINTER   :: loc(:,:)
-    INTEGER :: ind
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       loc = f_3D(ind)
-       CALL unpack_domain_3D(pack_info(ind), loc, packed)
-    END DO
-  END SUBROUTINE unpack_3D
-
-  SUBROUTINE pack_domain_3D(info, loc, glob)
-    IMPLICIT NONE
-    TYPE(t_pack_info) :: info
-    REAL(rstd), DIMENSION(:,:) :: loc, glob
-    INTEGER :: jj,n,k,ij
-    DO jj=1, info%nseg
-       n = info%n(jj)-1
-       ij = info%ij(jj)
-       k = info%k(jj)
-       glob(k:k+n,:) = loc(ij:ij+n,:)
-    END DO
-  END SUBROUTINE pack_domain_3D
-
-  SUBROUTINE unpack_domain_3D(info, loc, glob)
-    IMPLICIT NONE
-    TYPE(t_pack_info) :: info
-    REAL(rstd), DIMENSION(:,:) :: loc, glob
-    INTEGER :: jj,n,k,ij
-    DO jj=1, info%nseg
-       n = info%n(jj)-1
-       ij = info%ij(jj)
-       k = info%k(jj)
-       loc(ij:ij+n,:) = glob(k:k+n,:)
-    END DO    
-  END SUBROUTINE unpack_domain_3D
-
-  SUBROUTINE garbage_3D(loc,own)
-    USE icosa
-    IMPLICIT NONE
-    LOGICAL :: own(iim,jjm)
-    REAL(rstd) :: loc(iim*jjm,llm)
-    INTEGER :: i,j,ij
-    ! write garbage in non-owned points
-    DO j=1,jjm
-       DO i=1,iim
-          IF(.NOT.own(i,j)) THEN
-             ij=iim*(j-1)+i
-             loc(ij,:)=-1e30
-          END IF
-       END DO
-    END DO   
-  END SUBROUTINE garbage_3D
-
-!-------------------------------- Pack / Unpack 4D ---------------------------
-
-  SUBROUTINE pack_4D(f_4D, packed)
-    USE icosa
-    IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_4D(:)
-    REAL(rstd)            :: packed(:,:,:)
-    REAL(rstd), POINTER   :: loc(:,:,:)
-    INTEGER :: ind
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       loc = f_4D(ind)
-       CALL pack_domain_4D(pack_info(ind), loc, packed)
-    END DO
-  END SUBROUTINE pack_4D
-
-  SUBROUTINE unpack_4D(f_4D, packed) 
-    USE icosa
-    IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_4D(:)
-    REAL(rstd)            :: packed(:,:,:)
-    REAL(rstd), POINTER   :: loc(:,:,:)
-    INTEGER :: ind
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       loc = f_4D(ind)
-       CALL unpack_domain_4D(pack_info(ind), loc, packed)
-    END DO
-  END SUBROUTINE unpack_4D
-
-  SUBROUTINE pack_domain_4D(info, loc, glob)
-    IMPLICIT NONE
-    TYPE(t_pack_info) :: info
-    REAL(rstd), DIMENSION(:,:,:) :: loc, glob
-    INTEGER :: jj,n,k,ij
-    DO jj=1, info%nseg
-       n = info%n(jj)-1
-       ij = info%ij(jj)
-       k = info%k(jj)
-       glob(k:k+n,:,:) = loc(ij:ij+n,:,:)
-    END DO
-  END SUBROUTINE pack_domain_4D
-
-  SUBROUTINE unpack_domain_4D(info, loc, glob)
-    IMPLICIT NONE
-    TYPE(t_pack_info) :: info
-    REAL(rstd), DIMENSION(:,:,:) :: loc, glob
-    INTEGER :: jj,n,k,ij
-    DO jj=1, info%nseg
-       n = info%n(jj)-1
-       ij = info%ij(jj)
-       k = info%k(jj)
-       loc(ij:ij+n,:,:) = glob(k:k+n,:,:)
-    END DO
-  END SUBROUTINE unpack_domain_4D
-
-END MODULE physics_interface_mod
Index: codes/icosagcm/devel/src/physics_lmdz_generic.F90
===================================================================
--- codes/icosagcm/devel/src/physics_lmdz_generic.F90	(revision 531)
+++ 	(revision )
@@ -1,613 +1,0 @@
-MODULE physics_lmdz_generic_mod
-  USE field_mod
-  USE transfert_mod
-  
-  INTEGER,SAVE :: nbp_phys
-  TYPE(t_message) :: req_u
-
-  TYPE(t_field),POINTER :: f_p(:) 
-  TYPE(t_field),POINTER :: f_pks(:)  
-  TYPE(t_field),POINTER :: f_pk(:)  
-  TYPE(t_field),POINTER :: f_p_layer(:)    
-  TYPE(t_field),POINTER :: f_theta(:)   
-  TYPE(t_field),POINTER :: f_phi(:)   
-  TYPE(t_field),POINTER :: f_Temp(:)    
-  TYPE(t_field),POINTER :: f_ulon(:)    
-  TYPE(t_field),POINTER :: f_ulat(:)   
-  TYPE(t_field),POINTER :: f_dulon(:)
-  TYPE(t_field),POINTER :: f_dulat(:)
-  TYPE(t_field),POINTER :: f_dTemp(:)
-  TYPE(t_field),POINTER :: f_dq(:)
-  TYPE(t_field),POINTER :: f_dps(:)
-  TYPE(t_field),POINTER :: f_duc(:)
-
-  INTEGER :: start_clock
-  INTEGER :: stop_clock
-  INTEGER :: count_clock=0
-  
-  REAL :: start_day
-  REAL :: day_length
-  REAL :: year_length
-  
- INTEGER,ALLOCATABLE,SAVE :: domain_offset(:)
-
-  
-
-CONTAINS
-
-  SUBROUTINE init_physics
-  USE icosa
-  USE domain_mod
-  USE dimensions
-  USE mpi_mod
-  USE mpipara
-  USE disvert_mod
-  USE xios_mod
-  
-  IMPLICIT NONE
-  INTEGER  :: distrib(0:mpi_size-1)
-  INTEGER  :: ind,i,j,ij,pos
-
-  REAL(rstd),ALLOCATABLE :: latfi(:)
-  REAL(rstd),ALLOCATABLE :: lonfi(:)
-  REAL(rstd),ALLOCATABLE :: airefi(:)
-  REAL(rstd),ALLOCATABLE :: bounds_latfi(:,:)
-  REAL(rstd),ALLOCATABLE :: bounds_lonfi(:,:)
-
-    start_day=0
-    day_length=86400
-    year_length=86400*365.25
-    
-    CALL getin('start_day',start_day)
-    CALL getin('day_length',day_length)
-    CALL getin('year_length',year_length)
-
-!$OMP PARALLEL
-    CALL allocate_field(f_p,field_t,type_real,llm+1)
-    CALL allocate_field(f_pks,field_t,type_real)
-    CALL allocate_field(f_pk,field_t,type_real,llm)
-    CALL allocate_field(f_p_layer,field_t,type_real,llm)
-    CALL allocate_field(f_theta,field_t,type_real,llm)
-    CALL allocate_field(f_phi,field_t,type_real,llm)
-    CALL allocate_field(f_Temp,field_t,type_real,llm)
-    CALL allocate_field(f_ulon,field_t,type_real,llm)
-    CALL allocate_field(f_ulat,field_t,type_real,llm)
-    CALL allocate_field(f_dulon,field_t,type_real,llm)
-    CALL allocate_field(f_dulat,field_t,type_real,llm)
-    CALL allocate_field(f_dTemp,field_t,type_real,llm)
-    CALL allocate_field(f_dq,field_t,type_real,llm,nqtot)
-    CALL allocate_field(f_dps,field_t,type_real)
-    CALL allocate_field(f_duc,field_t,type_real,3,llm)    
-!$OMP END PARALLEL    
-
-    ALLOCATE(domain_offset(ndomain))
-    nbp_phys=0
-    domain_offset(1)=0
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      IF (ind<ndomain) THEN 
-        domain_offset(ind+1)=domain_offset(ind)+ii_nb*jj_nb
-      ENDIF
-      nbp_phys=nbp_phys+ii_nb*jj_nb
-    ENDDO
-    
-    CALL MPI_ALLGATHER(nbp_phys,1,MPI_INTEGER,distrib,1,MPI_INTEGER,comm_icosa,ierr)
-    
-    ALLOCATE(latfi(nbp_phys))
-    ALLOCATE(lonfi(nbp_phys))
-    ALLOCATE(airefi(nbp_phys))
-    ALLOCATE(bounds_latfi(nbp_phys,6))
-    ALLOCATE(bounds_lonfi(nbp_phys,6))
-    
-    pos=0
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          pos=pos+1
-          CALL xyz2lonlat(xyz_i(ij,:),lonfi(pos),latfi(pos))
-          CALL xyz2lonlat(xyz_v(ij+z_rup,:), bounds_lonfi(pos,1), bounds_latfi(pos,1))
-          CALL xyz2lonlat(xyz_v(ij+z_up,:), bounds_lonfi(pos,2), bounds_latfi(pos,2))
-          CALL xyz2lonlat(xyz_v(ij+z_lup,:), bounds_lonfi(pos,3), bounds_latfi(pos,3))
-          CALL xyz2lonlat(xyz_v(ij+z_ldown,:), bounds_lonfi(pos,4), bounds_latfi(pos,4))
-          CALL xyz2lonlat(xyz_v(ij+z_down,:), bounds_lonfi(pos,5), bounds_latfi(pos,5))
-          CALL xyz2lonlat(xyz_v(ij+z_rdown,:), bounds_lonfi(pos,6), bounds_latfi(pos,6))
-          airefi(pos)=Ai(ij)  
-        ENDDO
-      ENDDO
-    ENDDO
-
-
-#ifdef CPP_PHYSICS_LMDZ_GENERIC
-    CALL initialize_unstructured_physics(nbp_phys,llm, comm_icosa, mpi_size,distrib,            &
-                                         day_length,start_day,itau_physics*dt,                  &
-                                         6,latfi,lonfi,airefi,bounds_lonfi,bounds_latfi,         &
-                                         radius,g, gas_constant/mu, cpp,                        &
-                                         preff, ap, bp)                                         
-#endif
-    
-    CALL xios_set_context    
-    
-!    CALL init_phys_lmdz(128,97,llm, comm_icosa, mpi_size, distrib)
-    
-#ifdef CPP_PHYSICS_LMDZ_GENERIC
-    CALL init_gcm_lmdz(nbp_phys,mpi_size,distrib,latfi,lonfi,airefi)
-#endif
-!    CALL init_phys_lmdz(128,97,llm, comm_icosa, mpi_size, distrib)
-!    CALL iniphysiq(llm,day_length,start_day,itau_physics*dt,     &
-!                   latfi,lonfi,airefi,radius,g, gas_constant/mu, cpp,     &
-!                   ap, bp)
-    
-    
-    
-  END SUBROUTINE init_physics
-  
-  SUBROUTINE physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_wflux, f_q)
-  USE ICOSA
-  USE time_mod
-  USE disvert_mod
-  USE transfert_mod
-  USE mpipara
-  USE xios_mod
-  USE trace
-  IMPLICIT NONE
-    INTEGER,INTENT(IN)    :: it
-    TYPE(t_field),POINTER :: f_phis(:)
-    TYPE(t_field),POINTER :: f_ps(:)
-    TYPE(t_field),POINTER :: f_theta_rhodz(:)
-    TYPE(t_field),POINTER :: f_u(:)
-    TYPE(t_field),POINTER :: f_wflux(:)
-    TYPE(t_field),POINTER :: f_q(:)
-  
-    REAL(rstd),POINTER :: phis(:)
-    REAL(rstd),POINTER :: ps(:)
-    REAL(rstd),POINTER :: theta_rhodz(:,:)
-    REAL(rstd),POINTER :: u(:,:)
-    REAL(rstd),POINTER :: wflux(:,:)
-    REAL(rstd),POINTER :: q(:,:,:)
-    REAL(rstd),POINTER :: p(:,:)
-    REAL(rstd),POINTER :: pks(:)
-    REAL(rstd),POINTER :: pk(:,:)
-    REAL(rstd),POINTER :: p_layer(:,:)
-    REAL(rstd),POINTER :: theta(:,:)
-    REAL(rstd),POINTER :: phi(:,:)
-    REAL(rstd),POINTER :: Temp(:,:)
-    REAL(rstd),POINTER :: ulon(:,:)
-    REAL(rstd),POINTER :: ulat(:,:)
-    REAL(rstd),POINTER :: dulon(:,:)
-    REAL(rstd),POINTER :: dulat(:,:)
-    REAL(rstd),POINTER :: dTemp(:,:)
-    REAL(rstd),POINTER :: dq(:,:,:)
-    REAL(rstd),POINTER :: dps(:)
-    REAL(rstd),POINTER :: duc(:,:,:)
-
-
-    INTEGER :: ind
-    
-    REAL(rstd),ALLOCATABLE,SAVE :: ps_phy(:)
-    REAL(rstd),ALLOCATABLE,SAVE :: p_phy(:,:)
-    REAL(rstd),ALLOCATABLE,SAVE :: p_layer_phy(:,:)
-    REAL(rstd),ALLOCATABLE,SAVE :: Temp_phy(:,:)
-    REAL(rstd),ALLOCATABLE,SAVE :: phis_phy(:)
-    REAL(rstd),ALLOCATABLE,SAVE :: phi_phy(:,:)
-    REAL(rstd),ALLOCATABLE,SAVE :: ulon_phy(:,:)
-    REAL(rstd),ALLOCATABLE,SAVE :: ulat_phy(:,:)
-    REAL(rstd),ALLOCATABLE,SAVE :: q_phy(:,:,:)
-    REAL(rstd),ALLOCATABLE,SAVE :: wflux_phy(:,:)
-    REAL(rstd),ALLOCATABLE,SAVE :: dulon_phy(:,:)
-    REAL(rstd),ALLOCATABLE,SAVE :: dulat_phy(:,:)
-    REAL(rstd),ALLOCATABLE,SAVE :: dTemp_phy(:,:)
-    REAL(rstd),ALLOCATABLE,SAVE :: dq_phy(:,:,:)
-    REAL(rstd),ALLOCATABLE,SAVE :: dps_phy(:)
-    REAL(rstd) :: dtphy 
-    REAL(rstd) :: time
-    REAL(rstd) :: day
-    REAL(rstd) :: real_time
-    INTEGER    :: offset
-    LOGICAL :: lafin=.FALSE.
-    LOGICAL,SAVE :: first=.TRUE.
-!$OMP THREADPRIVATE(first)
-
-    
-    IF (first) THEN
-      first=.FALSE.
-      CALL init_message(f_u,req_e1_vect,req_u)
-!$OMP MASTER
-      ALLOCATE(ps_phy(nbp_phys))
-      ALLOCATE(p_phy(nbp_phys,llm+1))
-      ALLOCATE(p_layer_phy(nbp_phys,llm))
-      ALLOCATE(Temp_phy(nbp_phys,llm))
-      ALLOCATE(phis_phy(nbp_phys))
-      ALLOCATE(phi_phy(nbp_phys,llm))
-      ALLOCATE(ulon_phy(nbp_phys,llm))
-      ALLOCATE(ulat_phy(nbp_phys,llm))
-      ALLOCATE(q_phy(nbp_phys,llm,nqtot))
-      ALLOCATE(wflux_phy(nbp_phys,llm))
-      ALLOCATE(dulon_phy(nbp_phys,llm))
-      ALLOCATE(dulat_phy(nbp_phys,llm))
-      ALLOCATE(dTemp_phy(nbp_phys,llm))
-      ALLOCATE(dq_phy(nbp_phys,llm,nqtot))
-      ALLOCATE(dps_phy(nbp_phys))
-      
-!$OMP END MASTER
-!$OMP BARRIER
-    ENDIF
-
-    IF(it==itaumax) THEN 
-      lafin=.TRUE.
-    ELSE 
-      lafin=.FALSE.
-    ENDIF
-
-!$OMP MASTER        
-!    CALL update_calendar(it)
-!$OMP END MASTER
-!$OMP BARRIER
-    dtphy=itau_physics*dt
-    real_time=start_day*day_length+it*dt
-    day  = INT( MODULO(real_time,year_length) / day_length) 
-    time = MODULO(real_time,day_length) / day_length
-
-!$OMP MASTER    
-    IF (is_mpi_root) PRINT*,"Enterring in physic : day", day, "  time : ",time 
-!$OMP END MASTER    
-    
-    
-    
-    
-    CALL transfert_message(f_u,req_u)
-    
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      IF (assigned_domain(ind)) THEN
-        offset=domain_offset(ind)
-        CALL swap_geometry(ind)
-      
-        phis=f_phis(ind)
-        ps=f_ps(ind)
-        theta_rhodz=f_theta_rhodz(ind)
-        u=f_u(ind)
-        q=f_q(ind)
-        wflux=f_wflux(ind)
-        p=f_p(ind)
-        pks=f_pks(ind)
-        pk=f_pk(ind)
-        p_layer=f_p_layer(ind)
-        theta=f_theta(ind)
-        phi=f_phi(ind)
-        Temp=f_Temp(ind)
-        ulon=f_ulon(ind)
-        ulat=f_ulat(ind)
-            
-        CALL grid_icosa_to_physics
-
-      ENDIF
-    ENDDO
-
-!$OMP BARRIER
-!$OMP MASTER
-    CALL SYSTEM_CLOCK(start_clock)
-!$OMP END MASTER
-    CALL trace_start("physic")
-!    CALL trace_off()
-
-#ifdef CPP_PHYSICS_LMDZ_GENERIC
-    CALL calfis_icosa(dtphy, lafin, day, time, presnivs,      &
-                      p_phy, p_layer_phy, phi_phy, phis_phy, ulon_phy, ulat_phy, Temp_phy, q_phy, wflux_phy, &
-                      dulon_phy, dulat_phy, dTemp_phy, dq_phy, dps_phy  )
-#endif
-!    CALL trace_on()
-    CALL trace_end("physic")
-!$OMP MASTER
-    CALL SYSTEM_CLOCK(stop_clock)
-    count_clock=count_clock+stop_clock-start_clock
-!$OMP END MASTER
-
-!$OMP BARRIER                       
-
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      IF (assigned_domain(ind)) THEN
-        CALL swap_geometry(ind)
-        offset=domain_offset(ind)
-      
-        theta_rhodz=f_theta_rhodz(ind)
-        u=f_u(ind)
-        q=f_q(ind)
-        ps=f_ps(ind)
-        dulon=f_dulon(ind)
-        dulat=f_dulat(ind)
-        Temp=f_temp(ind)
-        dTemp=f_dTemp(ind)
-        dq=f_dq(ind)
-        dps=f_dps(ind)
-        duc=f_duc(ind)
-        p=f_p(ind)
-        pks=f_pks(ind)
-        pk=f_pk(ind)
-      
-        CALL grid_physics_to_icosa
-      ENDIF
-    ENDDO
-
-!$OMP BARRIER
-    CALL xios_set_context    
-     
-  CONTAINS
-   
-    SUBROUTINE grid_physics_to_icosa
-    USE theta2theta_rhodz_mod
-    USE omp_para
-    IMPLICIT NONE
-      INTEGER :: i,j,ij,l,iq
-          
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          offset=offset+1
-          
-          dulon(ij,ll_begin:ll_end)=dulon_phy(offset,ll_begin:ll_end)
-          dulat(ij,ll_begin:ll_end)=dulat_phy(offset,ll_begin:ll_end)
-          dTemp(ij,ll_begin:ll_end)=dTemp_phy(offset,ll_begin:ll_end)
-          Temp(ij,ll_begin:ll_end) = Temp_phy(offset,ll_begin:ll_end)
-          dq(ij,ll_begin:ll_end,:)=dq_phy(offset,ll_begin:ll_end,:)
-          if (is_omp_first_level) dps(ij)=dps_phy(offset)
-        ENDDO
-      ENDDO
-    
-      DO l=ll_begin,ll_end
-        DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-            ij=(j-1)*iim+i
-            duc(ij,:,l)=dulon(ij,l)*elon_i(ij,:)+dulat(ij,l)*elat_i(ij,:)
-          ENDDO
-        ENDDO
-      ENDDO
-
-      DO l=ll_begin,ll_end
-        DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-            ij=(j-1)*iim+i
-            u(ij+u_right,l) = u(ij+u_right,l) + dtphy * sum( 0.5*(duc(ij,:,l) + duc(ij+t_right,:,l))*ep_e(ij+u_right,:) )
-            u(ij+u_lup,l) = u(ij+u_lup,l) + dtphy * sum( 0.5*(duc(ij,:,l) + duc(ij+t_lup,:,l))*ep_e(ij+u_lup,:) )
-            u(ij+u_ldown,l) = u(ij+u_ldown,l) + dtphy*sum( 0.5*(duc(ij,:,l) + duc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) )
-          ENDDO
-        ENDDO
-      ENDDO          
-
-      DO l=ll_begin,ll_end
-        DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-            ij=(j-1)*iim+i
-            Temp(ij,l)=Temp(ij,l)+ dtphy * dTemp(ij,l)
-          ENDDO
-        ENDDO
-      ENDDO          
-      
-      DO iq=1,nqtot
-        DO l=ll_begin,ll_end
-          DO j=jj_begin,jj_end
-            DO i=ii_begin,ii_end
-              ij=(j-1)*iim+i
-              q(ij,l,iq)=q(ij,l,iq)+ dtphy * dq(ij,l,iq)
-            ENDDO
-          ENDDO
-        ENDDO 
-      ENDDO
-
-!$OMP BARRIER
-      
-     IF (is_omp_first_level) THEN
-       DO j=jj_begin,jj_end
-         DO i=ii_begin,ii_end
-           ij=(j-1)*iim+i
-           ps(ij)=ps(ij)+ dtphy * dps(ij)
-          ENDDO
-       ENDDO
-     ENDIF
-
-!     CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0)
-
-! compute pression
-!$OMP BARRIER
-      DO    l    = ll_begin,ll_endp1
-        DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-            ij=(j-1)*iim+i
-            p(ij,l) = ap(l) + bp(l) * ps(ij)
-          ENDDO
-        ENDDO
-      ENDDO
-
-!$OMP BARRIER
-
-! compute exner
-       
-       IF (is_omp_first_level) THEN
-         DO j=jj_begin,jj_end
-            DO i=ii_begin,ii_end
-               ij=(j-1)*iim+i
-               pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
-            ENDDO
-         ENDDO
-       ENDIF
-
-       ! 3D : pk
-       DO l = ll_begin,ll_end
-          DO j=jj_begin,jj_end
-             DO i=ii_begin,ii_end
-                ij=(j-1)*iim+i
-                pk(ij,l) = cpp * ((.5/preff)*(p(ij,l)+p(ij,l+1))) ** kappa
-             ENDDO
-          ENDDO
-       ENDDO
-
-!$OMP BARRIER
-
-!   compute theta, temperature and pression at layer
-    DO    l    = ll_begin, ll_end
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / (pk(ij,l) / cpp )
-        ENDDO
-      ENDDO
-    ENDDO
-    
-    END SUBROUTINE grid_physics_to_icosa
-    
-    
-    SUBROUTINE grid_icosa_to_physics
-    USE pression_mod
-    USE exner_mod
-    USE theta2theta_rhodz_mod
-    USE geopotential_mod
-    USE wind_mod
-    USE omp_para
-    IMPLICIT NONE
-    
-    REAL(rstd) :: uc(3)
-    INTEGER :: i,j,ij,l
-    
-
-! compute pression
-
-      DO    l    = ll_begin,ll_endp1
-        DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-            ij=(j-1)*iim+i
-            p(ij,l) = ap(l) + bp(l) * ps(ij)
-          ENDDO
-        ENDDO
-      ENDDO
-
-!$OMP BARRIER
-
-! compute exner
-       
-       IF (is_omp_first_level) THEN
-         DO j=jj_begin,jj_end
-            DO i=ii_begin,ii_end
-               ij=(j-1)*iim+i
-               pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
-            ENDDO
-         ENDDO
-       ENDIF
-
-       ! 3D : pk
-       DO l = ll_begin,ll_end
-          DO j=jj_begin,jj_end
-             DO i=ii_begin,ii_end
-                ij=(j-1)*iim+i
-                pk(ij,l) = cpp * ((.5/preff)*(p(ij,l)+p(ij,l+1))) ** kappa
-             ENDDO
-          ENDDO
-       ENDDO
-
-!$OMP BARRIER
-
-!   compute theta, temperature and pression at layer
-    DO    l    = ll_begin, ll_end
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          theta(ij,l) = theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g)
-          Temp(ij,l) = theta(ij,l) * pk(ij,l) / cpp
-          p_layer(ij,l)=preff*(pk(ij,l)/cpp)**(1./kappa) 
-        ENDDO
-      ENDDO
-    ENDDO
-
-
-!!! Compute geopotential
-       
-  ! for first layer
-  IF (is_omp_first_level) THEN
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        ij=(j-1)*iim+i
-        phi( ij,1 ) = phis( ij ) + theta(ij,1) * ( pks(ij) - pk(ij,1) )
-      ENDDO
-    ENDDO
-  ENDIF
-!!-> implicit flush on phi(:,1)
-          
-  ! for other layers
-  DO l = ll_beginp1, ll_end
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        ij=(j-1)*iim+i
-        phi(ij,l) =  0.5 * ( theta(ij,l)  + theta(ij,l-1) )  & 
-                         * (  pk(ij,l-1) -  pk(ij,l)    )
-      ENDDO
-    ENDDO
-  ENDDO       
-
-!$OMP BARRIER
-
-
-  IF (is_omp_first_level) THEN
-    DO l = 2, llm
-      DO j=jj_begin,jj_end
-! ---> Bug compilo intel ici en openmp
-! ---> Couper la boucle
-       IF (j==jj_end+1) PRINT*,"this message must not be printed"
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          phi(ij,l) = phi(ij,l)+ phi(ij,l-1)
-        ENDDO
-      ENDDO
-    ENDDO
-! --> IMPLICIT FLUSH on phi --> non
-  ENDIF 
-
-! compute wind centered lon lat compound
-    DO l=ll_begin,ll_end
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          uc(:)=1/Ai(ij)*                                                                                                &
-                        ( ne(ij,right)*u(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_v(ij+z_rup,:))/2-centroid(ij,:))  &
-                         + ne(ij,rup)*u(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_v(ij+z_up,:))/2-centroid(ij,:))          &
-                         + ne(ij,lup)*u(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_v(ij+z_lup,:))/2-centroid(ij,:))          &
-                         + ne(ij,left)*u(ij+u_left,l)*le(ij+u_left)*((xyz_v(ij+z_lup,:)+xyz_v(ij+z_ldown,:))/2-centroid(ij,:))    &
-                         + ne(ij,ldown)*u(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_v(ij+z_ldown,:)+xyz_v(ij+z_down,:))/2-centroid(ij,:))&
-                         + ne(ij,rdown)*u(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_v(ij+z_down,:)+xyz_v(ij+z_rdown,:))/2-centroid(ij,:)))
-          ulon(ij,l)=sum(uc(:)*elon_i(ij,:))
-          ulat(ij,l)=sum(uc(:)*elat_i(ij,:)) 
-        ENDDO
-      ENDDO
-    ENDDO
-
-!$OMP BARRIER
-
-
-      
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          offset=offset+1
-
-          IF (is_omp_first_level) ps_phy(offset) = ps(ij)
-          p_phy(offset,ll_begin:ll_endp1) = p(ij,ll_begin:ll_endp1)
-          p_layer_phy(offset,ll_begin:ll_end) = p_layer(ij,ll_begin:ll_end)
-          Temp_phy(offset,ll_begin:ll_end) = Temp(ij,ll_begin:ll_end)
-          IF (is_omp_first_level) phis_phy(offset) = phis(ij)
-          phi_phy(offset,ll_begin:ll_end) = phi(ij,ll_begin:ll_end)-phis(ij)
-          ulon_phy(offset,ll_begin:ll_end) = ulon(ij,ll_begin:ll_end)
-          ulat_phy(offset,ll_begin:ll_end) = ulat(ij,ll_begin:ll_end)
-          q_phy(offset,ll_begin:ll_end,:) = q(ij,ll_begin:ll_end,:)
-          wflux_phy(offset,ll_begin:ll_end) = wflux(ij,ll_begin:ll_end)
-        ENDDO
-      ENDDO
-     
-     END SUBROUTINE grid_icosa_to_physics
-
-  END SUBROUTINE physics
-  
-  
-END MODULE physics_lmdz_generic_mod
-    
-  
Index: codes/icosagcm/devel/src/prec.f90
===================================================================
--- codes/icosagcm/devel/src/prec.f90	(revision 531)
+++ 	(revision )
@@ -1,14 +1,0 @@
-MODULE prec
-  INTEGER, PARAMETER :: i4=selected_int_kind(10)
-  INTEGER, PARAMETER :: i8=selected_int_kind(18)
-  INTEGER, PARAMETER :: r4=selected_real_kind(7)
-  INTEGER, PARAMETER :: r8=selected_real_kind(15)
-  INTEGER, PARAMETER :: c4=r4
-  INTEGER, PARAMETER :: c8=r8
-  INTEGER, PARAMETER :: istd=i4
-  INTEGER, PARAMETER :: rstd=r8
-  INTEGER, PARAMETER :: cstd=c8
-END MODULE prec
-  
- 
-  
Index: codes/icosagcm/devel/src/pression.f90
===================================================================
--- codes/icosagcm/devel/src/pression.f90	(revision 531)
+++ 	(revision )
@@ -1,98 +1,0 @@
-MODULE pression_mod
-
-CONTAINS
-
-  SUBROUTINE pression(f_ps,f_p)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ps(:)
-    TYPE(t_field), POINTER :: f_p(:)
-  
-    REAL(rstd), POINTER :: ps(:)
-    REAL(rstd), POINTER :: p(:,:)
-    INTEGER :: ind
-
-!$OMP BARRIER
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      ps=f_ps(ind)
-      p=f_p(ind)
-      CALL compute_pression(ps, p,0)
-    ENDDO
-!$OMP BARRIER
-  
-  END SUBROUTINE pression
-
-  SUBROUTINE pression_mid(f_ps,f_pmid)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ps(:)
-    TYPE(t_field), POINTER :: f_pmid(:)
-  
-    REAL(rstd), POINTER :: ps(:)
-    REAL(rstd), POINTER :: pmid(:,:)
-    INTEGER :: ind
-
-!$OMP BARRIER
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      ps=f_ps(ind)
-      pmid=f_pmid(ind)
-      CALL compute_pression_mid(ps, pmid,0)
-    ENDDO
-!$OMP BARRIER
-  
-  END SUBROUTINE pression_mid
-
-  SUBROUTINE compute_pression(ps,p,offset)
-  USE icosa
-  USE disvert_mod
-  USE omp_para
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
-    REAL(rstd),INTENT(OUT) :: p(iim*jjm,llm+1)
-    INTEGER,INTENT(IN) :: offset
-    INTEGER :: i,j,ij,l
-
-    IF(ap_bp_present) THEN
-      DO    l    = ll_begin, ll_endp1
-!      DO    l    = 1, llm + 1
-        DO j=jj_begin-offset,jj_end+offset
-          DO i=ii_begin-offset,ii_end+offset
-            ij=(j-1)*iim+i
-            p(ij,l) = ap(l) + bp(l) * ps(ij)
-          ENDDO
-        ENDDO
-      ENDDO
-    END IF
-
-  END SUBROUTINE compute_pression
-  
-  SUBROUTINE compute_pression_mid(ps,pmid,offset)
-  USE icosa
-  USE disvert_mod
-  USE omp_para
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
-    REAL(rstd),INTENT(OUT) :: pmid(iim*jjm,llm)
-    INTEGER,INTENT(IN) :: offset
-    INTEGER :: i,j,ij,l
-
-    IF(ap_bp_present) THEN
-      DO    l    = ll_begin, ll_end
-        DO j=jj_begin-offset,jj_end+offset
-          DO i=ii_begin-offset,ii_end+offset
-            ij=(j-1)*iim+i
-            pmid(ij,l) = 0.5*(ap(l)+ap(l+1) + (bp(l)+bp(l+1)) * ps(ij))
-          ENDDO
-        ENDDO
-      ENDDO
-    END IF
-
-  END SUBROUTINE compute_pression_mid
-
-END MODULE pression_mod
Index: codes/icosagcm/devel/src/q_sat.f90
===================================================================
--- codes/icosagcm/devel/src/q_sat.f90	(revision 531)
+++ 	(revision )
@@ -1,98 +1,0 @@
-MODULE qsat_mod
-
-
-
-
-CONTAINS
-
-  SUBROUTINE qsat(f_temp,f_p,f_qs)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_temp(:)  ! IN    : temperature
-    TYPE(t_field), POINTER :: f_p(:)     ! IN    : pressure at mid-levels
-    TYPE(t_field), POINTER :: f_qs(:)    ! OUT   : vapeur d'eau saturante en kg/kg
-    
-    REAL(rstd),POINTER :: temp(:,:),  p(:,:), qs(:,:)
-    INTEGER :: ind
-
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       temp=f_temp(ind)
-       p=f_p(ind)
-       qs=f_qs(ind)
-       CALL compute_qsat(temp,p,qs)
-    END DO
-  
-  END SUBROUTINE qsat
-
-  
-  SUBROUTINE compute_qsat(temp,p,qsat)
-  USE icosa
-  USE omp_para
-  IMPLICIT NONE
-  
-!======================================================================
-! Autheur(s): Z.X. Li (LMD/CNRS)
-!  reecriture vectorisee par F. Hourdin.
-! Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
-!======================================================================
-! Arguments:
-! kelvin---input-R: temperature en Kelvin
-! millibar--input-R: pression en mb
-!
-! q_sat----output-R: vapeur d'eau saturante en kg/kg
-!======================================================================
-!
-      REAL,INTENT(IN)  :: temp(iim*jjm,llm)
-      REAL,INTENT(IN)  :: p   (iim*jjm,llm+1)
-      REAL,INTENT(OUT) :: qsat(iim*jjm,llm)
-
-      REAL, PARAMETER  ::  r2es=611.14 *18.0153/28.9644
-
-      REAL :: r3es
-      REAL, PARAMETER ::  r3les=17.269
-      REAL, PARAMETER ::  r3ies=21.875
-
-      REAL :: r4es
-      REAL, PARAMETER :: r4les=35.86
-      REAL, PARAMETER :: r4ies=7.66
-
-      REAL, PARAMETER :: rtt=273.16
-      REAL, PARAMETER :: retv=28.9644/18.0153 - 1.0
-
-      REAL :: zqsat, pmid
-      INTEGER :: l,i,j,ij
-!
-!     ------------------------------------------------------------------
-!
-!
-
-    DO l=ll_begin,ll_end
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-
-          IF (temp(ij,l) .LE. rtt) THEN
-            r3es = r3ies
-            r4es = r4ies
-          ELSE
-            r3es = r3les
-            r4es = r4les
-          ENDIF
-          pmid=0.5*(p(ij,l)+p(ij,l+1))
-          zqsat=r2es/pmid*EXP(r3es*(temp(ij,l)-rtt)/(temp(ij,l)-r4es))
-          zqsat=MIN(0.5,zqsat)
-          zqsat=zqsat/(1.-retv *zqsat)
-
-          qsat(ij,l)= zqsat
-
-        ENDDO
-      ENDDO
-    ENDDO
-  
-  
-  END SUBROUTINE compute_qsat
-
-END MODULE qsat_mod
Index: codes/icosagcm/devel/src/restart.f90
===================================================================
--- codes/icosagcm/devel/src/restart.f90	(revision 531)
+++ 	(revision )
@@ -1,664 +1,0 @@
-MODULE restart_mod
-  USE field_mod
-
-  TYPE t_field_array
-    TYPE(t_field),POINTER :: field(:)
-  END TYPE t_field_array
-
-  LOGICAL,SAVE :: write_start=.TRUE.
-
-CONTAINS
-  
-  SUBROUTINE init_restart
-  USE xios_mod
-  USE icosa
-  USE time_mod
-  USE omp_para
-  IMPLICIT NONE
-  CHARACTER(LEN=255) :: start_file_name
-  CHARACTER(LEN=255) :: restart_file_name
-    
-    IF (using_xios) THEN
-      start_file_name="start"
-      CALL getin("start_file_name",start_file_name)
-      restart_file_name="restart"
-      CALL getin("restart_file_name",restart_file_name)
-      IF (is_omp_master) THEN
-!        CALL xios_set_file_attr("start",name=TRIM(ADJUSTL(start_file_name)),output_freq=(itaumax+1)*xios_timestep)
-        CALL xios_set_file_attr("start",name=TRIM(ADJUSTL(start_file_name)),output_freq=1*xios_timestep)
-        CALL xios_set_file_attr("restart",name=TRIM(ADJUSTL(restart_file_name)),output_freq=itaumax*xios_timestep)
-        CALL xios_set_fieldgroup_attr("group_restart", freq_op=itaumax*xios_timestep)
-      ENDIF
-    ENDIF
-    
-  END SUBROUTINE init_restart
-  
-  
-  SUBROUTINE write_restart(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9,   &
-                           field10,field11,field12,field13,field14,field15,field16,field17,field18,field19 )
-  USE prec
-  USE metric
-  USE field_mod
-  USE domain_mod
-  USE netcdf_mod
-  USE mpipara
-  USE omp_para
-  USE getin_mod
-  USE spherical_geom_mod
-  USE transfert_mod
-  USE disvert_mod
-  USE xios_mod
-  IMPLICIT NONE 
-  INTEGER,INTENT(IN)     :: it
-
-  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9
-  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field10,field11,field12,field13,field14,field15,field16,field17,field18,field19
-
-  TYPE(t_field_array) :: field_array(20)
-  INTEGER             :: nfield
-  INTEGER             :: fieldId(20)
-   
-  TYPE(t_domain),POINTER :: d
-  TYPE(t_field),POINTER :: field_glo(:)
-  TYPE(t_field),POINTER :: field(:)
-  
-  CHARACTER(LEN=255) :: file_name
-  CHARACTER(LEN=255) :: suffix
-  INTEGER,PARAMETER  :: nvert=6
-  INTEGER    ::  ncid, cellId, levId, edgeId,  vertid, lonId, latId, bounds_lonId, bounds_latId, nqId, levAxisId
-  INTEGER    :: ind,ind_glo,i,j,k,nf
-  INTEGER    :: status
-  REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
-   
-    IF (no_io) RETURN
-    
-    IF (it==0) THEN
-      file_name="start"
-      CALL getin("start_file_name",file_name)
-      suffix="_start"
-    ELSE
-      file_name="restart"
-      CALL getin("restart_file_name",file_name)
-      suffix="_restart"
-    ENDIF  
-     
-    IF (using_xios) THEN
-      IF (PRESENT(field0))  THEN ; CALL  xios_write_field(TRIM(field0(1)%name)//TRIM(suffix),field0)  ; ENDIF
-      IF (PRESENT(field1))  THEN ; CALL  xios_write_field(TRIM(field1(1)%name)//TRIM(suffix),field1)  ; ENDIF
-      IF (PRESENT(field2))  THEN ; CALL  xios_write_field(TRIM(field2(1)%name)//TRIM(suffix),field2)  ; ENDIF
-      IF (PRESENT(field3))  THEN ; CALL  xios_write_field(TRIM(field3(1)%name)//TRIM(suffix),field3)  ; ENDIF
-      IF (PRESENT(field4))  THEN ; CALL  xios_write_field(TRIM(field4(1)%name)//TRIM(suffix),field4)  ; ENDIF
-      IF (PRESENT(field5))  THEN ; CALL  xios_write_field(TRIM(field5(1)%name)//TRIM(suffix),field5)  ; ENDIF
-      IF (PRESENT(field6))  THEN ; CALL  xios_write_field(TRIM(field6(1)%name)//TRIM(suffix),field6)  ; ENDIF
-      IF (PRESENT(field7))  THEN ; CALL  xios_write_field(TRIM(field7(1)%name)//TRIM(suffix),field7)  ; ENDIF
-      IF (PRESENT(field8))  THEN ; CALL  xios_write_field(TRIM(field8(1)%name)//TRIM(suffix),field8)  ; ENDIF
-      IF (PRESENT(field9))  THEN ; CALL  xios_write_field(TRIM(field9(1)%name)//TRIM(suffix),field9)  ; ENDIF
-      IF (PRESENT(field10))  THEN ; CALL  xios_write_field(TRIM(field10(1)%name)//TRIM(suffix),field10)  ; ENDIF
-      IF (PRESENT(field11))  THEN ; CALL  xios_write_field(TRIM(field11(1)%name)//TRIM(suffix),field11)  ; ENDIF
-      IF (PRESENT(field12))  THEN ; CALL  xios_write_field(TRIM(field12(1)%name)//TRIM(suffix),field12)  ; ENDIF
-      IF (PRESENT(field13))  THEN ; CALL  xios_write_field(TRIM(field13(1)%name)//TRIM(suffix),field13)  ; ENDIF
-      IF (PRESENT(field14))  THEN ; CALL  xios_write_field(TRIM(field14(1)%name)//TRIM(suffix),field14)  ; ENDIF
-      IF (PRESENT(field15))  THEN ; CALL  xios_write_field(TRIM(field15(1)%name)//TRIM(suffix),field15)  ; ENDIF
-      IF (PRESENT(field16))  THEN ; CALL  xios_write_field(TRIM(field16(1)%name)//TRIM(suffix),field16)  ; ENDIF
-      IF (PRESENT(field17))  THEN ; CALL  xios_write_field(TRIM(field17(1)%name)//TRIM(suffix),field17)  ; ENDIF
-      IF (PRESENT(field18))  THEN ; CALL  xios_write_field(TRIM(field18(1)%name)//TRIM(suffix),field18)  ; ENDIF
-      IF (PRESENT(field19))  THEN ; CALL  xios_write_field(TRIM(field19(1)%name)//TRIM(suffix),field19)  ; ENDIF
-      IF (is_omp_master) CALL xios_send_field('it'//TRIM(suffix),it*1.0)
-
-    ELSE
-
-    !$OMP MASTER
-      
-      nfield=0
-      IF (PRESENT(field0))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0  ; ENDIF
-      IF (PRESENT(field1))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1  ; ENDIF
-      IF (PRESENT(field2))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2  ; ENDIF
-      IF (PRESENT(field3))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3  ; ENDIF
-      IF (PRESENT(field4))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4  ; ENDIF
-      IF (PRESENT(field5))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5  ; ENDIF
-      IF (PRESENT(field6))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6  ; ENDIF
-      IF (PRESENT(field7))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7  ; ENDIF
-      IF (PRESENT(field8))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8  ; ENDIF
-      IF (PRESENT(field9))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9  ; ENDIF
-      IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF
-      IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF
-      IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF
-      IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF
-      IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF
-      IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF
-      IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF
-      IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF
-      IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF
-      IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF
-      
-        
-
-      IF (is_mpi_root) THEN
-        status = NF90_CREATE(TRIM(ADJUSTL(file_name))//'.nc', NF90_CLOBBER, ncid)
-        status = NF90_DEF_DIM(ncid,'cell',ncell_glo,cellId)
-        status = NF90_DEF_DIM(ncid,'edge',3*ncell_glo,edgeId)
-        status = NF90_DEF_DIM(ncid,'lev',llm,levId)
-        status = NF90_DEF_DIM(ncid,'nvert',nvert,vertId)
-        status = NF90_DEF_DIM(ncid,'nq',nqtot,nqId)
-        status = NF90_PUT_ATT(ncid,NF90_GLOBAL,"iteration",it)
-        
-        status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ cellId /),lonId)
-        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
-        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
-        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
-        status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ cellId /),latId)
-        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
-        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
-        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
-        status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ vertId,cellId /),bounds_lonId)
-        status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ vertId,cellId /),bounds_latId)
-        status = NF90_DEF_VAR(ncid,'lev',NF90_DOUBLE,(/ levId /),levAxisId)
-        status = NF90_PUT_ATT(ncid,levAxisId,"axis","Z")
-        status = NF90_PUT_ATT(ncid,levAxisId,"units","Pa")
-        status = NF90_PUT_ATT(ncid,levAxisId,"positive","down")
-        
-        DO nf=1,nfield
-          field=>field_array(nf)%field
-          IF (field(1)%field_type==field_T) THEN
-            IF (field(1)%ndim==2) THEN
-              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId /),fieldId(nf))
-              status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lon lat")
-            ELSE IF (field(1)%ndim==3) THEN
-              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId /),fieldId(nf))
-              status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lev lon lat")
-            ELSE IF (field(1)%ndim==4) THEN
-              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId,nqId /),fieldId(nf))
-              status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","nq lev lon lat")
-            ENDIF
-          ELSE IF (field(1)%field_type==field_U) THEN
-            IF (field(1)%ndim==2) THEN
-              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId /),fieldId(nf))
-            ELSE IF (field(1)%ndim==3) THEN
-              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId, levId /),fieldId(nf))
-            ELSE IF (field(1)%ndim==4) THEN
-              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId, levId, nqId /),fieldId(nf))
-            ENDIF
-          ENDIF
-        ENDDO
-            
-        
-        status = NF90_ENDDEF(ncid)
-        
-        ALLOCATE(lon(ncell_glo),lat(ncell_glo),bounds_lon(0:nvert-1,ncell_glo),bounds_lat(0:nvert-1,ncell_glo))
-        DO ind=1,ndomain_glo
-          d=>domain_glo(ind)
-          DO j=d%jj_begin,d%jj_end
-            DO i=d%ii_begin,d%ii_end
-               ind_glo=d%assign_cell_glo(i,j)
-               CALL xyz2lonlat(d%xyz(:,i,j),lon(ind_glo),lat(ind_glo))
-               lon(ind_glo)=lon(ind_glo)*180/Pi
-               lat(ind_glo)=lat(ind_glo)*180/Pi
-               DO k=0,5
-                   CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,ind_glo), bounds_lat(k,ind_glo))
-                   bounds_lat(k,ind_glo)=bounds_lat(k,ind_glo)*180/Pi
-                   bounds_lon(k,ind_glo)=bounds_lon(k,ind_glo)*180/Pi
-               ENDDO
-            ENDDO
-          ENDDO
-        ENDDO
-
-        status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell_glo /))
-        status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell_glo /))
-        status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /))
-        status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /))
-        status=NF90_PUT_VAR(ncid,levAxisId,REAL(presnivs,r8),start=(/ 1 /),count=(/ llm /))
-      ENDIF
-
-      DO nf=1,nfield
-        field=>field_array(nf)%field
-        CALL write_restart_field(field,fieldId(nf),ncid)
-      ENDDO
-            
-    !          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name),NF90_DOUBLE,(/ ncellId /),fieldId(nf))
-    !        ELSE IF (field(1)%ndim==3) THEN
-    !          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name),NF90_DOUBLE,(/ ncellId, levId /),fieldId(nf))
-    !        ENDIF
-    !      ENDDO
-
-
-      IF (is_mpi_root) THEN
-        status = NF90_CLOSE(ncid)      
-      ENDIF
-    
-    !$OMP END MASTER
-    
-    ENDIF
-  
-  END SUBROUTINE write_restart
-  
-  SUBROUTINE write_restart_field(field,fieldId,ncid)
-  USE prec
-  USE metric
-  USE field_mod
-  USE domain_mod
-  USE netcdf_mod
-  USE mpipara
-  USE getin_mod
-  USE spherical_geom_mod
-  USE transfert_mod
-  USE xios_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    INTEGER,INTENT(IN)     :: fieldId
-    INTEGER,INTENT(IN)     :: ncid
-
-    TYPE(t_domain),POINTER :: d
-    TYPE(t_field),POINTER :: field_glo(:)
-    REAL(rstd),ALLOCATABLE :: global_field2d(:)
-    REAL(rstd),ALLOCATABLE :: global_field3d(:,:)
-    REAL(rstd),ALLOCATABLE :: global_field4d(:,:,:)
-    INTEGER :: i,j,ij,k,e,ind,ind_glo
-    INTEGER :: ndim, field_type
-    INTEGER :: status
-    
-      ndim=field(1)%ndim
-      field_Type= field(1)%field_type
-      
-      IF (is_mpi_root) THEN
- 
-        IF (ndim==2) THEN
-          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,name=field(1)%name)
-        ELSE IF (ndim==3) THEN
-          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,name=field(1)%name)
-        ELSE IF (ndim==4) THEN
-          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4,name=field(1)%name)
-        ENDIF
-      ENDIF
-      
-      CALL gather_field(field,field_glo)
-      
-
-      IF (is_mpi_root) THEN
-
-        IF (field_type==field_T) THEN
-          IF (ndim==2) THEN
-            ALLOCATE(global_field2d(ncell_glo))
-            DO ind=1,ndomain_glo
-              d=>domain_glo(ind)
-              DO j=d%jj_begin,d%jj_end
-                DO i=d%ii_begin,d%ii_end
-                  IF (d%own(i,j)) THEN 
-                    ij=(j-1)*d%iim+i
-                    ind_glo=d%assign_cell_glo(i,j)
-                    global_field2d(ind_glo)=field_glo(ind)%rval2d(ij)
-                  ENDIF 
-                ENDDO
-              ENDDO
-            ENDDO
-            status=NF90_PUT_VAR(ncid,fieldid,global_field2d,start=(/ 1 /),count=(/ ncell_glo /))
-          
-          ELSE IF (ndim==3) THEN
-            ALLOCATE(global_field3d(ncell_glo,llm))
-            DO ind=1,ndomain_glo
-              d=>domain_glo(ind)
-              DO j=d%jj_begin,d%jj_end
-                DO i=d%ii_begin,d%ii_end
-                  IF (d%own(i,j)) THEN 
-                    ij=(j-1)*d%iim+i
-                    ind_glo=d%assign_cell_glo(i,j)
-                    global_field3d(ind_glo,:)=field_glo(ind)%rval3d(ij,:)
-                  ENDIF
-                ENDDO
-              ENDDO
-            ENDDO
-            status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ ncell_glo,llm /))
-          ELSE IF (ndim==4) THEN
-            ALLOCATE(global_field4d(ncell_glo,llm,nqtot))
-            DO ind=1,ndomain_glo
-              d=>domain_glo(ind)
-              DO j=d%jj_begin,d%jj_end
-                DO i=d%ii_begin,d%ii_end
-                  IF (d%own(i,j)) THEN 
-                    ij=(j-1)*d%iim+i
-                    ind_glo=d%assign_cell_glo(i,j)
-                    global_field4d(ind_glo,:,:)=field_glo(ind)%rval4d(ij,:,:)
-                  ENDIF
-                ENDDO
-              ENDDO
-            ENDDO
-            status=NF90_PUT_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ ncell_glo,llm,nqtot /))
-          ENDIF
-        
-        ELSE IF (field_type==field_U) THEN
-        
-          IF (ndim==2) THEN
-            ALLOCATE(global_field2d(3*ncell_glo))
-            DO ind=1,ndomain_glo
-              d=>domain_glo(ind)
-              DO j=d%jj_begin,d%jj_end
-                DO i=d%ii_begin,d%ii_end
-                  DO k=0,5
-                   IF (d%edge_assign_domain(k,i,j)==ind .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
-                     .AND. d%edge_assign_pos(k,i,j)==k) THEN
-                       ij=(j-1)*d%iim+i
-                      ind_glo=d%assign_cell_glo(i,j)
-                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))  
-                      global_field2d(e)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval2d(ij+d%u_pos(k))
-                    ENDIF
-                  ENDDO
-                ENDDO
-              ENDDO
-            ENDDO
-            status=NF90_PUT_VAR(ncid,fieldid,REAL(global_field2d,r8),start=(/ 1 /),count=(/ 3*ncell_glo /))
-          ELSE IF (ndim==3) THEN
-            ALLOCATE(global_field3d(3*ncell_glo,llm))
-            DO ind=1,ndomain_glo
-              d=>domain_glo(ind)
-              DO j=d%jj_begin,d%jj_end
-                DO i=d%ii_begin,d%ii_end
-                  DO k=0,5
-                   IF (d%edge_assign_domain(k,i,j)==ind .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
-                     .AND. d%edge_assign_pos(k,i,j)==k) THEN
-                       ij=(j-1)*d%iim+i
-                      ind_glo=d%assign_cell_glo(i,j)
-                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))  
-                      global_field3d(e,:)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)
-                    ENDIF
-                  ENDDO
-                ENDDO
-              ENDDO
-            ENDDO
-            status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
-          ELSE IF (ndim==4) THEN
-            ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
-            DO ind=1,ndomain_glo
-              d=>domain_glo(ind)
-              DO j=d%jj_begin,d%jj_end
-                DO i=d%ii_begin,d%ii_end
-                  DO k=0,5
-                    IF (d%edge_assign_domain(k,i,j)==ind .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j&
-                      .AND. d%edge_assign_pos(k,i,j)==k) THEN
-                      ij=(j-1)*d%iim+i
-                      ind_glo=d%assign_cell_glo(i,j)
-                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))  
-                      global_field4d(e,:,:)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)
-                    ENDIF
-                  ENDDO
-                ENDDO
-              ENDDO
-            ENDDO
-            status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
-          ENDIF
-
-        ENDIF
-        
-        CALL deallocate_field_glo(field_glo)
-      
-      ENDIF
-      
-      
-  END SUBROUTINE write_restart_field
-
-
-  SUBROUTINE read_start(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9,   &
-                           field10,field11,field12,field13,field14,field15,field16,field17,field18,field19 )
-  USE prec
-  USE metric
-  USE field_mod
-  USE domain_mod
-  USE netcdf_mod
-  USE mpipara
-  USE getin_mod
-  USE spherical_geom_mod
-  USE transfert_mod
-  USE xios_mod
- 
-  IMPLICIT NONE
-  INTEGER, INTENT(OUT)  :: it
-  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9
-  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field10,field11,field12,field13,field14,field15,field16,field17,field18,field19
-
-  TYPE(t_field_array) :: field_array(20)
-  INTEGER             :: nfield
-  INTEGER             :: fieldId(20)
-   
-  TYPE(t_domain),POINTER :: d
-  TYPE(t_field),POINTER :: field_glo(:)
-  TYPE(t_field),POINTER :: field(:)
-  
-  CHARACTER(LEN=255) :: start_file_name
-  INTEGER,PARAMETER  :: nvert=6
-  INTEGER    ::  ncid, cellId, levId, edgeId,  vertid, lonId, latId, bounds_lonId, bounds_latId
-  INTEGER    :: ind,ind_glo,i,j,k,nf
-  INTEGER    :: status
-  REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
-  REAL(rstd) :: it_real
-  
-    IF (no_io) RETURN
-    
-    start_file_name="start"
-    CALL getin("start_file_name",start_file_name)
-
-
-
-    IF (using_xios) THEN
-      IF (PRESENT(field0))  THEN ; CALL  xios_read_field(TRIM(field0(1)%name)//'_start',field0)  ; ENDIF
-      IF (PRESENT(field1))  THEN ; CALL  xios_read_field(TRIM(field1(1)%name)//'_start',field1)  ; ENDIF
-      IF (PRESENT(field2))  THEN ; CALL  xios_read_field(TRIM(field2(1)%name)//'_start',field2)  ; ENDIF
-      IF (PRESENT(field3))  THEN ; CALL  xios_read_field(TRIM(field3(1)%name)//'_start',field3)  ; ENDIF
-      IF (PRESENT(field4))  THEN ; CALL  xios_read_field(TRIM(field4(1)%name)//'_start',field4)  ; ENDIF
-      IF (PRESENT(field5))  THEN ; CALL  xios_read_field(TRIM(field5(1)%name)//'_start',field5)  ; ENDIF
-      IF (PRESENT(field6))  THEN ; CALL  xios_read_field(TRIM(field6(1)%name)//'_start',field6)  ; ENDIF
-      IF (PRESENT(field7))  THEN ; CALL  xios_read_field(TRIM(field7(1)%name)//'_start',field7)  ; ENDIF
-      IF (PRESENT(field8))  THEN ; CALL  xios_read_field(TRIM(field8(1)%name)//'_start',field8)  ; ENDIF
-      IF (PRESENT(field9))  THEN ; CALL  xios_read_field(TRIM(field9(1)%name)//'_start',field9)  ; ENDIF
-      IF (PRESENT(field10))  THEN ; CALL  xios_read_field(TRIM(field10(1)%name)//'_start',field10)  ; ENDIF
-      IF (PRESENT(field11))  THEN ; CALL  xios_read_field(TRIM(field11(1)%name)//'_start',field11)  ; ENDIF
-      IF (PRESENT(field12))  THEN ; CALL  xios_read_field(TRIM(field12(1)%name)//'_start',field12)  ; ENDIF
-      IF (PRESENT(field13))  THEN ; CALL  xios_read_field(TRIM(field13(1)%name)//'_start',field13)  ; ENDIF
-      IF (PRESENT(field14))  THEN ; CALL  xios_read_field(TRIM(field14(1)%name)//'_start',field14)  ; ENDIF
-      IF (PRESENT(field15))  THEN ; CALL  xios_read_field(TRIM(field15(1)%name)//'_start',field15)  ; ENDIF
-      IF (PRESENT(field16))  THEN ; CALL  xios_read_field(TRIM(field16(1)%name)//'_start',field16)  ; ENDIF
-      IF (PRESENT(field17))  THEN ; CALL  xios_read_field(TRIM(field17(1)%name)//'_start',field17)  ; ENDIF
-      IF (PRESENT(field18))  THEN ; CALL  xios_read_field(TRIM(field18(1)%name)//'_start',field18)  ; ENDIF
-      IF (PRESENT(field19))  THEN ; CALL  xios_read_field(TRIM(field19(1)%name)//'_start',field19)  ; ENDIF
-
-!      CALL xios_recv_field("it_start",it_real)
-      CALL xios_read_var("it_start",it_real)
-      it=it_real
-    ELSE
-
-    !$OMP MASTER
-
-      nfield=0
-      IF (PRESENT(field0))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0  ; ENDIF
-      IF (PRESENT(field1))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1  ; ENDIF
-      IF (PRESENT(field2))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2  ; ENDIF
-      IF (PRESENT(field3))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3  ; ENDIF
-      IF (PRESENT(field4))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4  ; ENDIF
-      IF (PRESENT(field5))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5  ; ENDIF
-      IF (PRESENT(field6))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6  ; ENDIF
-      IF (PRESENT(field7))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7  ; ENDIF
-      IF (PRESENT(field8))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8  ; ENDIF
-      IF (PRESENT(field9))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9  ; ENDIF
-      IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF
-      IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF
-      IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF
-      IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF
-      IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF
-      IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF
-      IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF
-      IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF
-      IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF
-      IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF
-      
-        
-
-      IF (is_mpi_root) THEN
-        status = NF90_OPEN(TRIM(ADJUSTL(start_file_name))//'.nc', NF90_NOWRITE, ncid)
-      ENDIF
-     
-      DO nf=1,nfield
-        field=>field_array(nf)%field
-        status = nf90_inq_varid(ncid, TRIM(ADJUSTL(field(1)%name)), fieldId(nf))
-        status = nf90_get_att(ncid, NF90_GLOBAL, "iteration", it)
-        CALL read_start_field(field,fieldId(nf),ncid)
-      ENDDO
-
-
-      IF (is_mpi_root) THEN
-        status = NF90_CLOSE(ncid)      
-      ENDIF
-     
-     !$OMP END MASTER
-    
-    ENDIF
-  
-  END SUBROUTINE read_start
-
-
-  SUBROUTINE read_start_field(field,fieldId,ncid)
-  USE prec
-  USE metric
-  USE field_mod
-  USE domain_mod
-  USE netcdf_mod
-  USE mpipara
-  USE getin_mod
-  USE spherical_geom_mod
-  USE transfert_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    INTEGER,INTENT(IN)     :: fieldId
-    INTEGER,INTENT(IN)     :: ncid
-
-    TYPE(t_domain),POINTER :: d
-    TYPE(t_field),POINTER :: field_glo(:)
-    REAL(rstd),ALLOCATABLE :: global_field2d(:)
-    REAL(rstd),ALLOCATABLE :: global_field3d(:,:)
-    REAL(rstd),ALLOCATABLE :: global_field4d(:,:,:)
-    INTEGER :: i,j,ij,k,e,ind,ind_glo
-    INTEGER :: ndim, field_type
-    INTEGER :: status
-    
-      ndim=field(1)%ndim
-      field_Type= field(1)%field_type
-      
-      IF (is_mpi_root) THEN
- 
-        IF (ndim==2) THEN
-          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,name=field(1)%name)
-        ELSE IF (ndim==3) THEN
-          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,name=field(1)%name)
-        ELSE IF (ndim==4) THEN
-          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4,name=field(1)%name)
-        ENDIF
-      ENDIF
-      
-      IF (is_mpi_root) THEN
-
-        IF (field_type==field_T) THEN
-          IF (ndim==2) THEN
-            ALLOCATE(global_field2d(ncell_glo))
-            status=NF90_GET_VAR(ncid,fieldid, global_field2d, start=(/ 1 /), count=(/ ncell_glo /))
-            DO ind=1,ndomain_glo
-              d=>domain_glo(ind)
-              DO j=d%jj_begin,d%jj_end
-                DO i=d%ii_begin,d%ii_end
-                    ij=(j-1)*d%iim+i
-                    ind_glo=d%assign_cell_glo(i,j)
-                    field_glo(ind)%rval2d(ij)=global_field2d(ind_glo)
-                ENDDO
-              ENDDO
-            ENDDO
-          
-          ELSE IF (ndim==3) THEN
-            ALLOCATE(global_field3d(ncell_glo,llm))
-            status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ ncell_glo,llm /))
-            DO ind=1,ndomain_glo
-              d=>domain_glo(ind)
-              DO j=d%jj_begin,d%jj_end
-                DO i=d%ii_begin,d%ii_end
-                  ij=(j-1)*d%iim+i
-                  ind_glo=d%assign_cell_glo(i,j)
-                  field_glo(ind)%rval3d(ij,:) = global_field3d(ind_glo,:)
-                ENDDO
-              ENDDO
-            ENDDO
-          ELSE IF (ndim==4) THEN
-            ALLOCATE(global_field4d(ncell_glo,llm,nqtot))
-            status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ ncell_glo,llm,nqtot /))
-            DO ind=1,ndomain_glo
-              d=>domain_glo(ind)
-              DO j=d%jj_begin,d%jj_end
-                DO i=d%ii_begin,d%ii_end
-                  ij=(j-1)*d%iim+i
-                  ind_glo=d%assign_cell_glo(i,j)
-                  field_glo(ind)%rval4d(ij,:,:) = global_field4d(ind_glo,:,:)
-                ENDDO
-              ENDDO
-            ENDDO
-          ENDIF
-        
-        ELSE IF (field_type==field_U) THEN
-        
-          IF (ndim==2) THEN
-            ALLOCATE(global_field2d(3*ncell_glo))
-            status=NF90_GET_VAR(ncid,fieldid,global_field2d,start=(/ 1 /),count=(/ 3*ncell_glo /))
-
-            DO ind=1,ndomain_glo
-              d=>domain_glo(ind)
-              DO j=d%jj_begin,d%jj_end
-                DO i=d%ii_begin,d%ii_end
-                  DO k=0,5
-                    ij=(j-1)*d%iim+i
-                    ind_glo=d%assign_cell_glo(i,j)
-                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))  
-                    field_glo(ind)%rval2d(ij+d%u_pos(k))= global_field2d(ind_glo)*d%edge_assign_sign(k,i,j)
-                  ENDDO
-                ENDDO
-              ENDDO
-            ENDDO
-          ELSE IF (ndim==3) THEN
-            ALLOCATE(global_field3d(3*ncell_glo,llm))
-            status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
-            DO ind=1,ndomain_glo
-              d=>domain_glo(ind)
-              DO j=d%jj_begin,d%jj_end
-                DO i=d%ii_begin,d%ii_end
-                  DO k=0,5
-                    ij=(j-1)*d%iim+i
-                    ind_glo=d%assign_cell_glo(i,j)
-                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))  
-                    field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)=global_field3d(e,:)*d%edge_assign_sign(k,i,j)
-                  ENDDO
-                ENDDO
-              ENDDO
-            ENDDO
-          ELSE IF (ndim==4) THEN
-            ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
-            status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
-            DO ind=1,ndomain_glo
-              d=>domain_glo(ind)
-              DO j=d%jj_begin,d%jj_end
-                DO i=d%ii_begin,d%ii_end
-                  DO k=0,5
-                    ij=(j-1)*d%iim+i
-                    ind_glo=d%assign_cell_glo(i,j)
-                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))  
-                    field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)=global_field4d(e,:,:)*d%edge_assign_sign(k,i,j)
-                  ENDDO
-                ENDDO
-              ENDDO
-            ENDDO
-          ENDIF
-
-        ENDIF
-      ENDIF
-      
-      CALL scatter_field(field_glo,field)
-        
-      IF (is_mpi_root) THEN
-        CALL deallocate_field_glo(field_glo)
-      ENDIF
-      
-      
-  END SUBROUTINE read_start_field      
-    
-END MODULE restart_mod
-  
Index: codes/icosagcm/devel/src/sphere/geometry.f90
===================================================================
--- codes/icosagcm/devel/src/sphere/geometry.f90	(revision 533)
+++ codes/icosagcm/devel/src/sphere/geometry.f90	(revision 533)
@@ -0,0 +1,729 @@
+MODULE geometry
+  USE field_mod
+  IMPLICIT NONE
+
+  TYPE t_geometry
+    TYPE(t_field),POINTER :: centroid(:)
+    TYPE(t_field),POINTER :: xyz_i(:)
+    TYPE(t_field),POINTER :: xyz_e(:)
+    TYPE(t_field),POINTER :: xyz_v(:)
+    TYPE(t_field),POINTER :: lon_i(:)
+    TYPE(t_field),POINTER :: lon_e(:)
+    TYPE(t_field),POINTER :: lat_i(:)
+    TYPE(t_field),POINTER :: lat_e(:)
+    TYPE(t_field),POINTER :: ep_e(:)
+    TYPE(t_field),POINTER :: et_e(:)
+    TYPE(t_field),POINTER :: elon_i(:)
+    TYPE(t_field),POINTER :: elat_i(:)
+    TYPE(t_field),POINTER :: elon_e(:)
+    TYPE(t_field),POINTER :: elat_e(:)
+    TYPE(t_field),POINTER :: Ai(:)
+    TYPE(t_field),POINTER :: Av(:)
+    TYPE(t_field),POINTER :: de(:)
+    TYPE(t_field),POINTER :: le(:)
+    TYPE(t_field),POINTER :: le_de(:) ! le/de, 0. if de=0.
+    TYPE(t_field),POINTER :: Riv(:)
+    TYPE(t_field),POINTER :: S1(:)
+    TYPE(t_field),POINTER :: S2(:)
+    TYPE(t_field),POINTER :: Riv2(:)
+    TYPE(t_field),POINTER :: ne(:)
+    TYPE(t_field),POINTER :: Wee(:)
+    TYPE(t_field),POINTER :: bi(:)
+    TYPE(t_field),POINTER :: fv(:)
+  END TYPE t_geometry    
+
+  TYPE(t_geometry),SAVE,TARGET :: geom
+
+  
+  REAL(rstd),POINTER :: Ai(:)          ! area of a cell
+!$OMP THREADPRIVATE(Ai)
+  REAL(rstd),POINTER :: centroid(:,:)  ! coordinate of the centroid of the cell
+!$OMP THREADPRIVATE(centroid)
+  REAL(rstd),POINTER :: xyz_i(:,:)     ! coordinate of the center of the cell (voronoi)
+!$OMP THREADPRIVATE(xyz_i)
+  REAL(rstd),POINTER :: xyz_e(:,:)     ! coordinate of a wind point on the cell on a edge
+!$OMP THREADPRIVATE(xyz_e)
+  REAL(rstd),POINTER :: xyz_v(:,:)     ! coordinate of a vertex (center of the dual mesh)
+!$OMP THREADPRIVATE(xyz_v)
+  REAL(rstd),POINTER :: lon_i(:)       ! longitude of the center of the cell (voronoi)
+!$OMP THREADPRIVATE(lon_i)
+  REAL(rstd),POINTER :: lon_e(:)       ! longitude of a wind point on the cell on a edge
+!$OMP THREADPRIVATE(lon_e)
+  REAL(rstd),POINTER :: lat_i(:)       ! latitude of the center of the cell (voronoi)
+!$OMP THREADPRIVATE(lat_i)
+  REAL(rstd),POINTER :: lat_e(:)       ! latitude of a wind point on the cell on a edge
+!$OMP THREADPRIVATE(lat_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 :: 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 :: le_de(:)       ! le/de
+!$OMP THREADPRIVATE(le_de)
+  REAL(rstd),POINTER :: S1(:,:)        ! area of sub-triangle
+!$OMP THREADPRIVATE(S1)
+  REAL(rstd),POINTER :: S2(:,:)        ! area of sub-tirangle
+!$OMP THREADPRIVATE(S2)
+  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)
+     
+
+  INTEGER, PARAMETER :: ne_right=1
+  INTEGER, PARAMETER :: ne_rup=-1
+  INTEGER, PARAMETER :: ne_lup=1
+  INTEGER, PARAMETER :: ne_left=-1
+  INTEGER, PARAMETER :: ne_ldown=1
+  INTEGER, PARAMETER :: ne_rdown=-1
+
+CONTAINS
+
+  SUBROUTINE allocate_geometry
+  USE field_mod
+  IMPLICIT NONE
+  
+    CALL allocate_field(geom%Ai,field_t,type_real,name='Ai')
+
+    CALL allocate_field(geom%xyz_i,field_t,type_real,3)
+    CALL allocate_field(geom%lon_i,field_t,type_real)
+    CALL allocate_field(geom%lat_i,field_t,type_real)
+    CALL allocate_field(geom%elon_i,field_t,type_real,3)
+    CALL allocate_field(geom%elat_i,field_t,type_real,3)
+    CALL allocate_field(geom%centroid,field_t,type_real,3)
+
+    CALL allocate_field(geom%xyz_e,field_u,type_real,3)
+    CALL allocate_field(geom%lon_e,field_u,type_real)
+    CALL allocate_field(geom%lat_e,field_u,type_real)
+    CALL allocate_field(geom%elon_e,field_u,type_real,3)
+    CALL allocate_field(geom%elat_e,field_u,type_real,3)
+    CALL allocate_field(geom%ep_e,field_u,type_real,3)
+    CALL allocate_field(geom%et_e,field_u,type_real,3)
+
+    CALL allocate_field(geom%xyz_v,field_z,type_real,3)
+    CALL allocate_field(geom%de,field_u,type_real)
+    CALL allocate_field(geom%le,field_u,type_real)
+    CALL allocate_field(geom%le_de,field_u,type_real)
+    CALL allocate_field(geom%bi,field_t,type_real)
+    CALL allocate_field(geom%Av,field_z,type_real)
+    CALL allocate_field(geom%S1,field_t,type_real,6)
+    CALL allocate_field(geom%S2,field_t,type_real,6)
+    CALL allocate_field(geom%Riv,field_t,type_real,6)
+    CALL allocate_field(geom%Riv2,field_t,type_real,6)
+    CALL allocate_field(geom%ne,field_t,type_integer,6)
+    CALL allocate_field(geom%Wee,field_u,type_real,5,2)
+    CALL allocate_field(geom%bi,field_t,type_real)
+    CALL allocate_field(geom%fv,field_z,type_real)
+
+  END SUBROUTINE allocate_geometry
+  
+  
+  SUBROUTINE swap_geometry(ind)
+  USE field_mod
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: ind
+!!$OMP MASTER
+    Ai=geom%Ai(ind)
+    xyz_i=geom%xyz_i(ind)
+    centroid=geom%centroid(ind)
+    xyz_e=geom%xyz_e(ind)
+    ep_e=geom%ep_e(ind)
+    et_e=geom%et_e(ind)
+    lon_i=geom%lon_i(ind)
+    lat_i=geom%lat_i(ind)
+    lon_e=geom%lon_e(ind)
+    lat_e=geom%lat_e(ind)
+    elon_i=geom%elon_i(ind)
+    elat_i=geom%elat_i(ind)
+    elon_e=geom%elon_e(ind)
+    elat_e=geom%elat_e(ind)
+    xyz_v=geom%xyz_v(ind)
+    de=geom%de(ind)
+    le=geom%le(ind)
+    le_de=geom%le_de(ind)
+    Av=geom%Av(ind)
+    S1=geom%S1(ind)
+    S2=geom%S2(ind)
+    Riv=geom%Riv(ind)
+    Riv2=geom%Riv2(ind)
+    ne=geom%ne(ind)
+    Wee=geom%Wee(ind)
+    bi=geom%bi(ind)
+    fv=geom%fv(ind)
+!!$OMP END MASTER
+!!$OMP BARRIER    
+  END SUBROUTINE swap_geometry
+
+  SUBROUTINE update_circumcenters 
+    USE domain_mod
+    USE dimensions
+    USE spherical_geom_mod
+    USE vector
+    USE transfert_mod
+    USE omp_para
+
+    IMPLICIT NONE
+    REAL(rstd) :: x1(3),x2(3)
+    REAL(rstd) :: vect(3,6)
+    REAL(rstd) :: centr(3)
+    INTEGER :: ind,i,j,n,k
+    TYPE(t_message),SAVE :: message0, message1
+    LOGICAL, SAVE :: first=.TRUE.
+!$OMP THREADPRIVATE(first)    
+    
+    IF (first) THEN
+      CALL init_message(geom%xyz_i, req_i0 ,message0)
+      CALL init_message(geom%xyz_i, req_i1 ,message1)
+      first=.FALSE.
+    ENDIF
+    
+    CALL transfert_message(geom%xyz_i,message0)
+    CALL transfert_message(geom%xyz_i,message1)
+    
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          n=(j-1)*iim+i
+          DO k=0,5
+            x1(:) = xyz_i(n+t_pos(k+1),:)
+            x2(:) = xyz_i(n+t_pos(MOD(k+1,6)+1),:)
+            if (norm(x1-x2)<1e-16) x2(:) = xyz_i(n+t_pos(MOD(k+2,6)+1),:)
+            CALL circumcenter(xyz_i(n,:), x1, x2, xyz_v(n+z_pos(k+1),:))
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE update_circumcenters
+
+  SUBROUTINE remap_schmidt_loc
+    USE spherical_geom_mod
+    USE getin_mod
+    USE omp_para
+    USE domain_mod
+    USE dimensions
+    IMPLICIT NONE
+    INTEGER :: ind,i,j,n
+    REAL(rstd) :: schmidt_factor, schmidt_lon, schmidt_lat
+
+    ! Schmidt transform parameters
+    schmidt_factor = 1.
+    CALL getin('schmidt_factor', schmidt_factor)
+    schmidt_factor =  schmidt_factor**2.
+    
+    schmidt_lon = 0.
+    CALL getin('schmidt_lon', schmidt_lon)
+    schmidt_lon = schmidt_lon * pi/180.
+
+    schmidt_lat = 45.
+    CALL getin('schmidt_lat', schmidt_lat)
+    schmidt_lat = schmidt_lat * pi/180.
+
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          n=(j-1)*iim+i
+          CALL schmidt_transform(xyz_i(n,:), schmidt_factor, schmidt_lon, schmidt_lat)
+        ENDDO
+      ENDDO
+    ENDDO
+  END SUBROUTINE remap_schmidt_loc
+
+  SUBROUTINE optimize_geometry
+  USE metric
+  USE spherical_geom_mod
+  USE domain_mod
+  USE dimensions
+  USE transfert_mod
+  USE vector
+  USE getin_mod
+  USE omp_para
+  IMPLICIT NONE
+    INTEGER :: nb_it=0
+    TYPE(t_domain),POINTER :: d
+    INTEGER :: ind,it,i,j,n,k
+    REAL(rstd) :: x1(3),x2(3)
+    REAL(rstd) :: vect(3,6)
+    REAL(rstd) :: centr(3)
+    REAL(rstd) :: sum
+    LOGICAL    :: check
+    
+    
+    CALL getin('optim_it',nb_it)
+    
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
+      d=>domain(ind)
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      xyz_i(:,1) = 0 ; xyz_i(:,2) = 0 ;  xyz_i(:,3) = 1
+      
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          n=(j-1)*iim+i
+          xyz_i(n,:)=d%xyz(:,i,j) 
+        ENDDO
+      ENDDO
+    ENDDO
+    
+    CALL update_circumcenters
+
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master ) CYCLE
+      d=>domain(ind)
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          n=(j-1)*iim+i
+          DO k=0,5
+            x1(:) = xyz_v(n+z_pos(k+1),:)
+            x2(:) = d%vertex(:,k,i,j) 
+            IF (norm(x1-x2)>1e-10) THEN
+              PRINT*,"vertex diff ",ind,i,j,k
+              PRINT*,x1
+              PRINT*,x2
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    
+    
+    DO it=1,nb_it
+      IF (MOD(it,100)==0) THEN 
+        check=is_master
+      ELSE
+        check=.FALSE.
+      ENDIF
+      
+      sum=0
+      DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master ) CYCLE
+        CALL swap_dimensions(ind)
+        CALL swap_geometry(ind)
+        DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+            n=(j-1)*iim+i
+            vect(:,1)=xyz_v(n+z_rup,:)
+            vect(:,2)=xyz_v(n+z_up,:)
+            vect(:,3)=xyz_v(n+z_lup,:)
+            vect(:,4)=xyz_v(n+z_ldown,:)
+            vect(:,5)=xyz_v(n+z_down,:)
+            vect(:,6)=xyz_v(n+z_rdown,:)
+            CALL compute_centroid(vect,6,centr)
+            IF (check) THEN
+              sum=MAX(sum,norm(xyz_i(n,:)-centr(:)))
+            ENDIF
+            xyz_i(n,:)=centr(:)
+          ENDDO
+        ENDDO
+        
+      ENDDO
+
+      IF (check) PRINT *,"it = ",it,"  diff centroid circumcenter ",sum
+
+     CALL update_circumcenters
+
+    ENDDO
+    
+  END SUBROUTINE optimize_geometry
+
+  SUBROUTINE update_domain 
+    ! copy position of generators and vertices back into domain(:)%xyz/vertex
+    ! so that XIOS/create_header_gen gets the right values
+    USE omp_para
+    USE dimensions
+    USE domain_mod 
+    USE transfert_mpi_mod
+
+    INTEGER :: ind,i,j,k,n
+    TYPE(t_domain),POINTER :: d
+    TYPE(t_field),POINTER,SAVE :: xyz_glo(:), xyz_loc(:), vertex_glo(:), vertex_loc(:)
+    REAL(rstd), POINTER :: xyz(:,:), vertex(:,:)
+    
+    CALL allocate_field(xyz_loc, field_t, type_real, 3)
+    CALL allocate_field(vertex_loc, field_z, type_real, 3)
+
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master ) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       xyz = xyz_loc(ind)
+       xyz(:,:) = xyz_i(:,:)
+       vertex = vertex_loc(ind)
+       vertex(:,:) = xyz_v(:,:)
+    END DO
+
+!$OMP BARRIER    
+!$OMP MASTER
+    CALL allocate_field_glo(xyz_glo, field_t, type_real, 3)
+    CALL allocate_field_glo(vertex_glo, field_z, type_real, 3)
+
+    CALL gather_field(xyz_loc, xyz_glo)
+    CALL gather_field(vertex_loc, vertex_glo)
+
+    CALL bcast_field(xyz_glo)
+    CALL bcast_field(vertex_glo)
+
+    DO ind=1,ndomain_glo
+       d=>domain_glo(ind)
+       xyz = xyz_glo(ind)
+       vertex = vertex_glo(ind)
+       DO j=d%jj_begin,d%jj_end
+          DO i=d%ii_begin,d%ii_end          
+             n=(j-1)*d%iim+i
+             d%xyz(:,i,j)=xyz(n,:)
+             DO k=0,5
+                d%vertex(:,k,i,j) = vertex(n+d%z_pos(k+1),:)
+             END DO
+          END DO
+       END DO
+    END DO
+
+    CALL deallocate_field_glo(vertex_glo)
+    CALL deallocate_field_glo(xyz_glo)
+!$OMP END MASTER
+!$OMP BARRIER
+    CALL deallocate_field(vertex_loc)
+    CALL deallocate_field(xyz_loc)
+
+  END SUBROUTINE update_domain
+  
+  SUBROUTINE set_geometry
+  USE metric
+  USE vector
+  USE spherical_geom_mod
+  USE domain_mod
+  USE dimensions
+  USE transfert_mod
+  USE getin_mod
+  USE omp_para
+  IMPLICIT NONE
+
+    REAL(rstd) :: surf(6)
+    REAL(rstd) :: surf_v(6)
+    REAL(rstd) :: vect(3,6)
+    REAL(rstd) :: centr(3)
+    REAL(rstd) :: vet(3),vep(3), vertex(3)
+    INTEGER :: ind,i,j,k,n
+    TYPE(t_domain),POINTER :: d
+    REAL(rstd) ::  S12
+    REAL(rstd) :: w(6)
+    REAL(rstd) :: lon,lat
+    INTEGER :: ii_glo,jj_glo
+    REAL(rstd) :: S
+          
+      
+    CALL optimize_geometry
+    CALL remap_schmidt_loc
+    CALL update_circumcenters
+    ! copy position of generators and vertices back into domain(:)%xyz/vertex
+    ! so that XIOS gets the right values
+    CALL update_domain
+
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master ) CYCLE
+      d=>domain(ind)
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      lon_i(:)=0 ; lat_i(:)=0
+      lon_e(:)=0 ; lat_e(:)=0
+      DO j=jj_begin-1,jj_end+1
+        DO i=ii_begin-1,ii_end+1
+          n=(j-1)*iim+i
+
+          DO k=0,5
+            ne(n,k+1)=d%ne(k,i,j)
+          ENDDO
+
+          vect(:,1)=xyz_v(n+z_rup,:)
+          vect(:,2)=xyz_v(n+z_up,:)
+          vect(:,3)=xyz_v(n+z_lup,:)
+          vect(:,4)=xyz_v(n+z_ldown,:)
+          vect(:,5)=xyz_v(n+z_down,:)
+          vect(:,6)=xyz_v(n+z_rdown,:)
+          CALL compute_centroid(vect,6,centr)
+          centroid(n,:)=centr(:)
+
+               
+          CALL xyz2lonlat(xyz_v(n+z_up,:),lon,lat)
+          fv(n+z_up)=2*sin(lat)*omega
+          CALL xyz2lonlat(xyz_v(n+z_down,:),lon,lat)
+          fv(n+z_down)=2*sin(lat)*omega
+          
+          bi(n)=0. 
+        
+          CALL dist_cart(xyz_i(n,:),xyz_i(n+t_right,:),de(n+u_right))
+          CALL dist_cart(xyz_i(n,:),xyz_i(n+t_lup,:),de(n+u_lup))
+          CALL dist_cart(xyz_i(n,:),xyz_i(n+t_ldown,:),de(n+u_ldown))
+          
+          CALL div_arc_bis(xyz_i(n,:),xyz_i(n+t_right,:),0.5,xyz_e(n+u_right,:))
+          CALL div_arc_bis(xyz_i(n,:),xyz_i(n+t_lup,:),0.5,xyz_e(n+u_lup,:))
+          CALL div_arc_bis(xyz_i(n,:),xyz_i(n+t_ldown,:),0.5,xyz_e(n+u_ldown,:))
+
+          CALL dist_cart(xyz_v(n+z_rdown,:), xyz_v(n+z_rup,:),le(n+u_right))
+          CALL dist_cart(xyz_v(n+z_up,:), xyz_v(n+z_lup,:),le(n+u_lup))
+          CALL dist_cart(xyz_v(n+z_ldown,:), xyz_v(n+z_down,:),le(n+u_ldown))
+
+          le_de(n+u_right)=le(n+u_right)/de(n+u_right) ! NaN possible but should be harmless
+          le_de(n+u_lup)  =le(n+u_lup)  /de(n+u_lup)
+          le_de(n+u_ldown)=le(n+u_ldown)/de(n+u_ldown)
+
+          Ai(n)=0
+          DO k=0,5
+            CALL surf_triangle(xyz_i(n,:),xyz_i(n+t_pos(k+1),:),xyz_i(n+t_pos(MOD((k+1+6),6)+1),:),surf_v(k+1))
+            CALL surf_triangle(xyz_i(n,:),xyz_v(n+z_pos(MOD((k-1+6),6)+1),:),xyz_v(n+z_pos(k+1),:),surf(k+1))
+            Ai(n)=Ai(n)+surf(k+1)
+            IF (i==ii_end .AND. j==jj_begin) THEN
+              IF (Ai(n)<1e20) THEN
+              ELSE
+                PRINT *,"PB !!",Ai(n),k,surf(k+1)
+                PRINT*,xyz_i(n,:),xyz_v(n+z_pos(MOD((k-1+6),6)+1),:),xyz_v(n+z_pos(k+1),:)
+              ENDIF
+            ENDIF
+          ENDDO
+
+          ! Sign convention : Ringler et al., JCP 2010, eq. 21 p. 3071
+          ! Normal component is along outgoing normal vector if ne=1
+
+          CALL cross_product2(xyz_v(n+z_rdown,:),xyz_v(n+z_rup,:),vep)
+          IF (norm(vep)>1e-30) THEN
+            vep(:)=vep(:)/norm(vep)                         ! Inward normal vector
+            CALL cross_product2(vep,xyz_e(n+u_right,:),vet) ! Counter-clockwise tangent vector 
+            vet(:)=vet(:)/norm(vet)
+            ep_e(n+u_right,:)=-vep(:)*ne(n,right)
+            et_e(n+u_right,:)=vet(:)*ne(n,right)
+          ENDIF
+
+          CALL cross_product2(xyz_v(n+z_up,:),xyz_v(n+z_lup,:),vep)
+          IF (norm(vep)>1e-30) THEN
+            vep(:)=vep(:)/norm(vep)
+            CALL cross_product2(vep,xyz_e(n+u_lup,:),vet)
+            vet(:)=vet(:)/norm(vet)
+            ep_e(n+u_lup,:)=-vep(:)*ne(n,lup)
+            et_e(n+u_lup,:)=vet(:)*ne(n,lup)
+          ENDIF
+
+          CALL cross_product2(xyz_v(n+z_ldown,:),xyz_v(n+z_down,:),vep)
+          IF (norm(vep)>1e-30) THEN
+            vep(:)=vep(:)/norm(vep)
+            CALL cross_product2(vep,xyz_e(n+u_ldown,:),vet)
+            vet(:)=vet(:)/norm(vet)
+            ep_e(n+u_ldown,:)=-vep(:)*ne(n,ldown)
+            et_e(n+u_ldown,:)=vet(:)*ne(n,ldown)
+          ENDIF
+
+          CALL xyz2lonlat(xyz_i(n,:),lon,lat)
+          lon_i(n)=lon
+          lat_i(n)=lat
+          elon_i(n,1) = -sin(lon)
+          elon_i(n,2) = cos(lon)
+          elon_i(n,3) = 0
+          elat_i(n,1) = -cos(lon)*sin(lat)
+          elat_i(n,2) = -sin(lon)*sin(lat)
+          elat_i(n,3) = cos(lat)
+
+          
+          CALL xyz2lonlat(xyz_e(n+u_right,:),lon,lat)
+          lon_e(n+u_right)=lon
+          lat_e(n+u_right)=lat
+          elon_e(n+u_right,1) = -sin(lon)
+          elon_e(n+u_right,2) = cos(lon)
+          elon_e(n+u_right,3) = 0
+          elat_e(n+u_right,1) = -cos(lon)*sin(lat)
+          elat_e(n+u_right,2) = -sin(lon)*sin(lat)
+          elat_e(n+u_right,3) = cos(lat)
+          
+          CALL xyz2lonlat(xyz_e(n+u_lup,:),lon,lat)
+          lon_e(n+u_lup)=lon
+          lat_e(n+u_lup)=lat
+          elon_e(n+u_lup,1) = -sin(lon)
+          elon_e(n+u_lup,2) = cos(lon)
+          elon_e(n+u_lup,3) = 0
+          elat_e(n+u_lup,1) = -cos(lon)*sin(lat)
+          elat_e(n+u_lup,2) = -sin(lon)*sin(lat)
+          elat_e(n+u_lup,3) = cos(lat)
+ 
+          CALL xyz2lonlat(xyz_e(n+u_ldown,:),lon,lat)
+          lon_e(n+u_ldown)=lon
+          lat_e(n+u_ldown)=lat
+          elon_e(n+u_ldown,1) = -sin(lon)
+          elon_e(n+u_ldown,2) = cos(lon)
+          elon_e(n+u_ldown,3) = 0
+          elat_e(n+u_ldown,1) = -cos(lon)*sin(lat)
+          elat_e(n+u_ldown,2) = -sin(lon)*sin(lat)
+          elat_e(n+u_ldown,3) = cos(lat)
+ 
+          
+          DO k=0,5
+            CALL surf_triangle(xyz_i(n,:), xyz_v(n+z_pos(k+1),:), xyz_i(n+t_pos(k+1),:),S1(n,k+1) )
+            CALL surf_triangle(xyz_i(n,:), xyz_v(n+z_pos(k+1),:), xyz_i(n+t_pos(MOD(k+1+6,6)+1),:),S2(n,k+1) )
+            S12 = .5*(S1(n,k+1)+S2(n,k+1))
+            Riv(n,k+1)=S12/Ai(n)
+            Riv2(n,k+1)=S12/surf_v(k+1)
+          ENDDO
+
+          DO k=1,6
+            IF (ABS(surf_v(k))<1e-30) THEN
+              Riv(n,k)=0.
+            ENDIF
+          ENDDO
+          
+          Av(n+z_up)=surf_v(vup)+1e-100
+          Av(n+z_down)=surf_v(vdown)+1e-100
+        
+        ENDDO
+      ENDDO
+      
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          n=(j-1)*iim+i
+   
+          CALL compute_wee(n,right,w)
+          Wee(n+u_right,:,1)=w(1:5)
+
+          CALL compute_wee(n+t_right,left,w)
+          Wee(n+u_right,:,2)=w(1:5)
+
+
+          CALL compute_wee(n,lup,w)
+          Wee(n+u_lup,:,1)=w(1:5)
+
+          CALL compute_wee(n+t_lup,rdown,w)
+          Wee(n+u_lup,:,2)=w(1:5)
+
+
+          CALL compute_wee(n,ldown,w)
+          Wee(n+u_ldown,:,1)=w(1:5)
+
+          CALL compute_wee(n+t_ldown,rup,w)
+          Wee(n+u_ldown,:,2)=w(1:5)
+
+        ENDDO
+      ENDDO
+      
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          n=(j-1)*iim+i
+          ii_glo=d%ii_begin_glo-d%ii_begin+i
+          jj_glo=d%jj_begin_glo-d%jj_begin+j
+          
+          IF (ii_glo==1 .AND. jj_glo==1) THEN
+            le(n+u_ldown)=0
+            xyz_v(n+z_ldown,:)=xyz_v(n+z_down,:)
+                       
+          ENDIF
+
+          IF (ii_glo==iim_glo .AND. jj_glo==1) THEN
+            le(n+u_right)=0
+            xyz_v(n+z_rdown,:)=xyz_v(n+z_rup,:)
+          ENDIF
+
+          IF (ii_glo==iim_glo .AND. jj_glo==jjm_glo) THEN
+            le(n+u_rup)=0
+            xyz_v(n+z_rup,:)=xyz_v(n+z_up,:)
+          ENDIF
+
+          IF (ii_glo==1 .AND. jj_glo==jjm_glo) THEN
+            le(n+u_lup)=0
+            xyz_v(n+z_up,:)=xyz_v(n+z_lup,:)
+          ENDIF
+          
+        ENDDO
+      ENDDO
+
+      DO j=jj_begin-1,jj_end+1
+        DO i=ii_begin-1,ii_end+1
+          n=(j-1)*iim+i
+          xyz_i(n,:)=xyz_i(n,:) * radius
+          xyz_v(n+z_up,:)=xyz_v(n+z_up,:) * radius
+          xyz_v(n+z_down,:)=xyz_v(n+z_down,:) *radius
+          de(n+u_right)=de(n+u_right) * radius
+          de(n+u_lup)=de(n+u_lup)*radius
+          de(n+u_ldown)=de(n+u_ldown)*radius
+          xyz_e(n+u_right,:)=xyz_e(n+u_right,:)*radius
+          xyz_e(n+u_lup,:)=xyz_e(n+u_lup,:)*radius
+          xyz_e(n+u_ldown,:)=xyz_e(n+u_ldown,:)*radius
+          le(n+u_right)=le(n+u_right)*radius
+          le(n+u_lup)=le(n+u_lup)*radius
+          le(n+u_ldown)=le(n+u_ldown)*radius
+          Ai(n)=Ai(n)*radius**2
+          Av(n+z_up)=Av(n+z_up)*radius**2
+          Av(n+z_down)=Av(n+z_down)*radius**2
+        ENDDO
+      ENDDO
+                 
+    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)
+ 
+  END SUBROUTINE set_geometry
+  
+  SUBROUTINE compute_wee(n,pos,w)
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: n
+    INTEGER,INTENT(IN) :: pos
+    REAL(rstd),INTENT(OUT) ::w(6)
+
+    REAL(rstd) :: ne_(0:5)
+    REAL(rstd) :: Riv_(6)
+    INTEGER    :: k
+    
+    
+    DO k=0,5
+      ne_(k)=ne(n,MOD(pos-1+k+6,6)+1)  
+      Riv_(k+1)=Riv(n,MOD(pos-1+k+6,6)+1)
+    ENDDO
+          
+    w(1)=-ne_(0)*ne_(1)*(Riv_(1)-0.5)
+    w(2)=-ne_(2)*(ne_(0)*Riv_(2)-w(1)*ne_(1))
+    w(3)=-ne_(3)*(ne_(0)*Riv_(3)-w(2)*ne_(2))
+    w(4)=-ne_(4)*(ne_(0)*Riv_(4)-w(3)*ne_(3))
+    w(5)=-ne_(5)*(ne_(0)*Riv_(5)-w(4)*ne_(4))
+    w(6)=ne_(0)*ne_(5)*(Riv_(6)-0.5)
+    
+!    IF ( ABS(w(5)-w(6))>1e-20) PRINT *, "pb pour wee : w(5)!=w(6)",sum(Riv_(:))
+
+   END SUBROUTINE compute_wee
+            
+
+  
+  SUBROUTINE compute_geometry
+  IMPLICIT NONE
+    CALL allocate_geometry
+    CALL set_geometry
+    
+  END SUBROUTINE compute_geometry
+  
+END MODULE geometry
Index: codes/icosagcm/devel/src/sphere/metric.f90
===================================================================
--- codes/icosagcm/devel/src/sphere/metric.f90	(revision 533)
+++ codes/icosagcm/devel/src/sphere/metric.f90	(revision 533)
@@ -0,0 +1,870 @@
+MODULE metric
+  USE genmod
+  USE grid_param
+  USE domain_param
+  
+  TYPE t_cell_glo
+    INTEGER :: neighbour(0:5)
+    INTEGER :: edge(0:5)
+    INTEGER :: assign_face
+    INTEGER :: assign_i
+    INTEGER :: assign_j
+    INTEGER :: assign_domain
+    REAL(rstd) :: xyz(3)
+  END TYPE t_cell_glo
+  
+  TYPE t_vertex_glo
+    REAL(rstd) :: xyz(3)
+    INTEGER    :: neighbour(0:5)
+    INTEGER    :: ne(0:5)
+    INTEGER    :: ind
+    INTEGER    :: delta
+  END TYPE t_vertex_glo
+  
+  TYPE t_edge_glo
+   INTEGER :: e1
+   INTEGER :: e2
+   INTEGER :: assign_domain
+   INTEGER :: assign_i
+   INTEGER :: assign_j
+   INTEGER :: assign_pos
+   INTEGER :: assign_delta
+  END TYPE t_edge_glo
+    
+ 
+  TYPE(t_vertex_glo),ALLOCATABLE,SAVE :: vertex_glo(:,:,:)
+  TYPE(t_cell_glo),ALLOCATABLE,SAVE :: cell_glo(:)
+  TYPE(t_edge_glo),ALLOCATABLE,SAVE :: edge_glo(:)
+  INTEGER :: ncell_glo
+  
+  INTEGER,ALLOCATABLE,SAVE :: Tab_index(:,:,:)  
+  INTEGER,PARAMETER :: right=1
+  INTEGER,PARAMETER :: rup=2
+  INTEGER,PARAMETER :: lup=3
+  INTEGER,PARAMETER :: left=4
+  INTEGER,PARAMETER :: ldown=5
+  INTEGER,PARAMETER :: rdown=6
+  
+  INTEGER,PARAMETER :: vrup=1
+  INTEGER,PARAMETER :: vup=2
+  INTEGER,PARAMETER :: vlup=3
+  INTEGER,PARAMETER :: vldown=4
+  INTEGER,PARAMETER :: vdown=5
+  INTEGER,PARAMETER :: vrdown=6
+  
+CONTAINS
+
+  SUBROUTINE remap_schmidt_glo ! FIXME : not called any more
+    USE spherical_geom_mod
+    USE getin_mod
+    IMPLICIT NONE
+    INTEGER :: nf,i,j
+    REAL(rstd) :: schmidt_factor, schmidt_lon, schmidt_lat
+
+    ! Schmidt transform parameters
+    schmidt_factor = 1.
+    CALL getin('schmidt_factor', schmidt_factor)
+    schmidt_factor =  schmidt_factor**2.
+    
+    schmidt_lon = 0.
+    CALL getin('schmidt_lon', schmidt_lon)
+    schmidt_lon = schmidt_lon * pi/180.
+
+    schmidt_lat = 45.
+    CALL getin('schmidt_lat', schmidt_lat)
+    schmidt_lat = schmidt_lat * pi/180.
+
+    DO nf=1,nb_face
+       DO j=1,jjm_glo
+          DO i=1,iim_glo
+             CALL schmidt_transform(vertex_glo(i,j,nf)%xyz, schmidt_factor, schmidt_lon, schmidt_lat)
+          END DO
+       END DO
+    END DO
+  END SUBROUTINE remap_schmidt_glo
+
+  SUBROUTINE allocate_metric
+  IMPLICIT NONE
+    INTEGER :: ind
+    
+    ALLOCATE(vertex_glo(1-halo:iim_glo+halo,1-halo:jjm_glo+halo,nb_face))
+    ncell_glo=10*(iim_glo-2)*(jjm_glo-2)+(iim_glo-2)*20+12
+    ALLOCATE(cell_glo(ncell_glo))
+    ALLOCATE(tab_index(nb_face,nb_face,0:5))
+    ALLOCATE(edge_glo(ncell_glo*3))
+    
+    DO ind=1,ncell_glo
+      cell_glo(ind)%neighbour(:)=0
+    ENDDO
+    
+  END SUBROUTINE allocate_metric
+  
+  SUBROUTINE Compute_face
+  USE spherical_geom_mod
+  IMPLICIT NONE
+    
+    REAL(rstd) :: len_edge
+    REAL(rstd) :: rot=0.
+    INTEGER :: nf,i,j
+    REAL(rstd),DIMENSION(3) :: p1,p2,p3
+    REAL(rstd) :: d1,d2,d3
+  
+  
+   len_edge=acos(cos(Pi/5)*cos(2*Pi/5)/(sin(Pi/5)*sin(2*Pi/5)))
+   
+   DO nf=1,nb_face/2
+     CALL lonlat2xyz(0.,Pi/2,vertex_glo(1,1,nf)%xyz)
+     CALL lonlat2xyz(rot+(nf-1)*2*Pi/5,Pi/2-len_edge,vertex_glo(iim_glo,1,nf)%xyz)
+     CALL lonlat2xyz(rot+2*Pi/5+(nf-1)*2*Pi/5,Pi/2-len_edge,vertex_glo(1,jjm_glo,nf)%xyz)
+     CALL lonlat2xyz(rot+Pi/5+(nf-1)*2*Pi/5,-Pi/2+len_edge,vertex_glo(iim_glo,jjm_glo,nf)%xyz)
+
+     CALL lonlat2xyz(0.,-Pi/2,vertex_glo(1,1,nf+nb_face/2)%xyz)
+     CALL lonlat2xyz(rot+Pi/5+(nf-1)*2*Pi/5,-(Pi/2-len_edge),vertex_glo(1,jjm_glo,nf+nb_face/2)%xyz)
+     CALL lonlat2xyz(rot+Pi/5+2*Pi/5+(nf-1)*2*Pi/5,-(Pi/2-len_edge),vertex_glo(iim_glo,1,nf+nb_face/2)%xyz)
+     CALL lonlat2xyz(rot+Pi/5+Pi/5+(nf-1)*2*Pi/5,-(-Pi/2+len_edge),vertex_glo(iim_glo,jjm_glo,nf+nb_face/2)%xyz)
+   ENDDO
+
+   DO nf=1,nb_face
+     DO i=2,iim_glo-1
+       CALL div_arc(vertex_glo(1,1,nf)%xyz,vertex_glo(iim_glo,1,nf)%xyz,(i-1)*1./(iim_glo-1),vertex_glo(i,1,nf)%xyz)
+       CALL div_arc(vertex_glo(1,jjm_glo,nf)%xyz,vertex_glo(iim_glo,jjm_glo,nf)%xyz,                                 &
+                               (i-1)*1./(iim_glo-1),vertex_glo(i,jjm_glo,nf)%xyz)
+     ENDDO
+      DO j=2,jjm_glo-1
+       CALL div_arc(vertex_glo(1,1,nf)%xyz,vertex_glo(1,jjm_glo,nf)%xyz,(j-1)*1./(jjm_glo-1),vertex_glo(1,j,nf)%xyz)
+       CALL div_arc(vertex_glo(iim_glo,1,nf)%xyz,vertex_glo(iim_glo,jjm_glo,nf)%xyz,(j-1)*1./(jjm_glo-1),            &
+                    vertex_glo(iim_glo,j,nf)%xyz)
+     ENDDO
+    
+     DO j=2,jjm_glo-1
+       DO i=2,iim_glo-1
+         IF (i+j-1 > iim_glo) THEN
+           CALL div_arc(vertex_glo(iim_glo,i+j-iim_glo,nf)%xyz,vertex_glo(i+j-jjm_glo,jjm_glo,nf)%xyz,    &
+                        (iim_glo-i)*1./(2*iim_glo-(i+j)),vertex_glo(i,j,nf)%xyz) 
+         ELSE
+           CALL div_arc(vertex_glo(i+j-1,1,nf)%xyz,vertex_glo(1,i+j-1,nf)%xyz,(j-1)*1./(i+j-2),vertex_glo(i,j,nf)%xyz)
+         ENDIF
+       ENDDO
+     ENDDO
+   ENDDO
+
+  CALL dist_cart(vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,d1) 
+  CALL dist_cart(vertex_glo(2,1,1)%xyz,vertex_glo(3,1,1)%xyz,d2) 
+  CALL dist_cart(vertex_glo(3,1,1)%xyz,vertex_glo(4,1,1)%xyz,d3) 
+  CALL div_arc(vertex_glo(1,1,1)%xyz,vertex_glo(3,1,1)%xyz,0.5,p1)
+
+  CALL circumcenter(vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,vertex_glo(1,2,1)%xyz,p1)
+!  CALL Centroide(vertex_glo(1,2,1)%xyz,vertex_glo(2,1,1)%xyz,vertex_glo(1,1,1)%xyz,p1)
+!  CALL Centroide(vertex_glo(1,2,1)%xyz,vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,p1)
+  CALL dist_cart(vertex_glo(1,1,1)%xyz,p1,d1) 
+  CALL dist_cart(vertex_glo(2,1,1)%xyz,p1,d2) 
+  CALL dist_cart(vertex_glo(1,2,1)%xyz,p1,d3) 
+
+  END SUBROUTINE compute_face
+
+  SUBROUTINE Compute_face_projection
+  USE spherical_geom_mod
+  IMPLICIT NONE
+    
+    REAL(rstd) :: len_edge
+    REAL(rstd) :: rot=0.
+    INTEGER :: nf,i,j
+    REAL(rstd),DIMENSION(3) :: p1,p2,p3
+    REAL(rstd) :: d1,d2,d3
+  
+   len_edge=acos(cos(Pi/5)*cos(2*Pi/5)/(sin(Pi/5)*sin(2*Pi/5)))
+   
+   DO nf=1,nb_face/2
+     CALL lonlat2xyz(0.,Pi/2,vertex_glo(1,1,nf)%xyz)
+     CALL lonlat2xyz(rot+(nf-1)*2*Pi/5,Pi/2-len_edge,vertex_glo(iim_glo,1,nf)%xyz)
+     CALL lonlat2xyz(rot+2*Pi/5+(nf-1)*2*Pi/5,Pi/2-len_edge,vertex_glo(1,jjm_glo,nf)%xyz)
+     CALL lonlat2xyz(rot+Pi/5+(nf-1)*2*Pi/5,-Pi/2+len_edge,vertex_glo(iim_glo,jjm_glo,nf)%xyz)
+
+     CALL lonlat2xyz(0.,-Pi/2,vertex_glo(1,1,nf+nb_face/2)%xyz)
+     CALL lonlat2xyz(rot+Pi/5+(nf-1)*2*Pi/5,-(Pi/2-len_edge),vertex_glo(1,jjm_glo,nf+nb_face/2)%xyz)
+     CALL lonlat2xyz(rot+Pi/5+2*Pi/5+(nf-1)*2*Pi/5,-(Pi/2-len_edge),vertex_glo(iim_glo,1,nf+nb_face/2)%xyz)
+     CALL lonlat2xyz(rot+Pi/5+Pi/5+(nf-1)*2*Pi/5,-(-Pi/2+len_edge),vertex_glo(iim_glo,jjm_glo,nf+nb_face/2)%xyz)
+   ENDDO
+
+   DO nf=1,nb_face
+     DO i=2,iim_glo-1
+       CALL div_arc_bis(vertex_glo(1,1,nf)%xyz,vertex_glo(iim_glo,1,nf)%xyz,(i-1)*1./(iim_glo-1),vertex_glo(i,1,nf)%xyz)
+       CALL div_arc_bis(vertex_glo(1,jjm_glo,nf)%xyz,vertex_glo(iim_glo,jjm_glo,nf)%xyz,                                 &
+                               (i-1)*1./(iim_glo-1),vertex_glo(i,jjm_glo,nf)%xyz)
+     ENDDO
+      DO j=2,jjm_glo-1
+       CALL div_arc_bis(vertex_glo(1,1,nf)%xyz,vertex_glo(1,jjm_glo,nf)%xyz,(j-1)*1./(jjm_glo-1),vertex_glo(1,j,nf)%xyz)
+       CALL div_arc_bis(vertex_glo(iim_glo,1,nf)%xyz,vertex_glo(iim_glo,jjm_glo,nf)%xyz,(j-1)*1./(jjm_glo-1),            &
+                    vertex_glo(iim_glo,j,nf)%xyz)
+     ENDDO
+    
+     DO j=2,jjm_glo-1
+       DO i=2,iim_glo-1
+         IF (i+j-1 > iim_glo) THEN
+           CALL div_arc_bis(vertex_glo(iim_glo,i+j-iim_glo,nf)%xyz,vertex_glo(i+j-jjm_glo,jjm_glo,nf)%xyz,    &
+                        (iim_glo-i)*1./(2*iim_glo-(i+j)),vertex_glo(i,j,nf)%xyz) 
+         ELSE
+           CALL div_arc_bis(vertex_glo(i+j-1,1,nf)%xyz,vertex_glo(1,i+j-1,nf)%xyz,(j-1)*1./(i+j-2),vertex_glo(i,j,nf)%xyz)
+         ENDIF
+       ENDDO
+     ENDDO
+     
+!     DO j=1,jjm_glo
+!       DO i=1,iim_glo
+!         vertex_glo(i,j,nf)%xyz=vertex_glo(i,j,nf)%xyz/sqrt(sum(vertex_glo(i,j,nf)%xyz**2))
+!       ENDDO
+!     ENDDO
+   ENDDO
+
+!  CALL dist_cart(vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,d1) 
+!  CALL dist_cart(vertex_glo(2,1,1)%xyz,vertex_glo(3,1,1)%xyz,d2) 
+!  CALL dist_cart(vertex_glo(3,1,1)%xyz,vertex_glo(4,1,1)%xyz,d3) 
+!  CALL div_arc(vertex_glo(1,1,1)%xyz,vertex_glo(3,1,1)%xyz,0.5,p1)
+!  CALL div_arc(vertex_glo(2,1,1)%xyz,vertex_glo(1,3,1)%xyz,1./3,p1)
+!  CALL div_arc(vertex_glo(1,2,1)%xyz,vertex_glo(3,1,1)%xyz,1./3,p2)
+!  CALL div_arc(vertex_glo(2,2,1)%xyz,vertex_glo(1,1,1)%xyz,1./3,p3)
+!  PRINT *, "dist",d1
+!  PRINT *, "dist",d2
+!  PRINT *, "dist",d3
+!  PRINT *,"dist",vertex_glo(2,1,1)%xyz
+!  PRINT *,"dist",p1/sqrt(sum(p1**2))
+!  CALL Centroide(vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,vertex_glo(1,2,1)%xyz,p1)
+!  CALL Centroide(vertex_glo(1,2,1)%xyz,vertex_glo(2,1,1)%xyz,vertex_glo(1,1,1)%xyz,p1)
+!  CALL Centroide(vertex_glo(1,2,1)%xyz,vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,p1)
+!  CALL dist_cart(vertex_glo(1,1,1)%xyz,p1,d1) 
+!  CALL dist_cart(vertex_glo(2,1,1)%xyz,p1,d2) 
+!  CALL dist_cart(vertex_glo(1,2,1)%xyz,p1,d3) 
+!  PRINT *, "dist",d1
+!  PRINT *, "dist",d2
+!  PRINT *, "dist",d3
+
+  END SUBROUTINE compute_face_projection
+
+
+  SUBROUTINE compute_extended_face_bis
+  IMPLICIT NONE
+  
+    INTEGER :: nf
+    INTEGER :: i,j
+    INTEGER :: delta
+    INTEGER :: ind
+    INTEGER :: k,ng
+
+    DO nf=1,nb_face
+      DO i=2,iim_glo-1
+
+        CALL set_neighbour(i,1,nf,ldown-1)
+        CALL set_neighbour(i,1,nf,rdown-1)
+
+        CALL set_neighbour(i,jjm_glo,nf,lup-1)
+        CALL set_neighbour(i,jjm_glo,nf,rup-1)
+      
+      ENDDO    
+     
+      DO j=2,jjm_glo-1
+        
+        CALL set_neighbour(1,j,nf,left-1)
+        CALL set_neighbour(1,j,nf,lup-1)
+
+        CALL set_neighbour(iim_glo,j,nf,rdown-1)
+        CALL set_neighbour(iim_glo,j,nf,right-1)
+
+      ENDDO
+      
+      CALL set_neighbour(2,0,nf,left-1)
+      CALL set_neighbour(iim_glo,0,nf,right-1)
+      CALL set_neighbour(iim_glo+1,jjm_glo-1,nf,rup-1)
+      CALL set_neighbour(iim_glo-1,jjm_glo+1,nf,right-1)
+      CALL set_neighbour(1,jjm_glo+1,nf,left-1)
+      CALL set_neighbour(0,2,nf,ldown-1)
+      
+      CALL set_neighbour(1,0,nf,left-1)
+      CALL set_neighbour(iim_glo,0,nf,right-1)
+      CALL set_neighbour(0,jjm_glo,nf,rup-1)
+      CALL set_neighbour(iim_glo+1,jjm_glo,nf,rup-1)
+    ENDDO
+
+    DO nf=1,nb_face
+      DO j=0,jjm_glo+1
+        DO i=0,iim_glo+1
+          ind=vertex_glo(i,j,nf)%ind
+          delta=vertex_glo(i,j,nf)%delta
+          DO k=0,5
+            ng=MOD(delta+k+6,6)
+            vertex_glo(i,j,nf)%neighbour(k)=cell_glo(ind)%neighbour(ng)
+          ENDDO
+        ENDDO
+      ENDDO
+ 
+      i=1 ; j=1
+      vertex_glo(i,j,nf)%neighbour(0)=vertex_glo(i+1,j,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(1)=vertex_glo(i,j+1,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(2)=vertex_glo(i-1,j+1,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(3)=vertex_glo(i-1,j,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(4)=vertex_glo(i,j-1,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(5)=vertex_glo(i+1,j-1,nf)%ind
+
+      i=iim_glo ; j=1
+      vertex_glo(i,j,nf)%neighbour(0)=vertex_glo(i+1,j,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(1)=vertex_glo(i,j+1,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(2)=vertex_glo(i-1,j+1,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(3)=vertex_glo(i-1,j,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(4)=vertex_glo(i,j-1,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(5)=vertex_glo(i+1,j-1,nf)%ind
+
+      i=1 ; j=jjm_glo
+      vertex_glo(i,j,nf)%neighbour(0)=vertex_glo(i+1,j,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(1)=vertex_glo(i,j+1,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(2)=vertex_glo(i-1,j+1,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(3)=vertex_glo(i-1,j,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(4)=vertex_glo(i,j-1,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(5)=vertex_glo(i+1,j-1,nf)%ind
+
+      i=iim_glo ; j=jjm_glo
+      vertex_glo(i,j,nf)%neighbour(0)=vertex_glo(i+1,j,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(1)=vertex_glo(i,j+1,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(2)=vertex_glo(i-1,j+1,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(3)=vertex_glo(i-1,j,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(4)=vertex_glo(i,j-1,nf)%ind
+      vertex_glo(i,j,nf)%neighbour(5)=vertex_glo(i+1,j-1,nf)%ind
+   ENDDO      
+  
+  CONTAINS
+  
+    SUBROUTINE set_neighbour(i,j,nf,neighbour)
+    IMPLICIT NONE
+      INTEGER :: i,j,nf,neighbour
+      INTEGER :: in,jn
+      INTEGER :: k,ng
+      INTEGER :: delta
+      INTEGER :: ind,ind2
+    
+       SELECT CASE (neighbour)
+         CASE(right-1)
+           in=i+1 ; jn=j
+         CASE(rup-1)
+           in=i ; jn=j+1
+         CASE(lup-1)
+           in=i-1 ; jn=j+1
+         CASE(left-1)
+           in=i-1 ; jn=j
+         CASE(ldown-1)
+           in=i ; jn=j-1
+         CASE(rdown-1)
+           in=i+1; jn=j-1
+        END SELECT
+         
+        ind=vertex_glo(i,j,nf)%ind
+        delta=MOD(vertex_glo(i,j,nf)%delta+neighbour+6,6)
+        ind2=cell_glo(ind)%neighbour(delta)
+        DO k=0,5
+          IF (cell_glo(ind2)%neighbour(k)==ind) ng=k
+        ENDDO
+        vertex_glo(in,jn,nf)%ind=ind2
+        vertex_glo(in,jn,nf)%delta=MOD(ng-neighbour+3+6,6)    
+      END SUBROUTINE set_neighbour    
+  
+  END SUBROUTINE compute_extended_face_bis
+    
+    
+  SUBROUTINE compute_extended_face
+  IMPLICIT NONE
+  
+    INTEGER :: nf,nf2
+    INTEGER :: ind,ind2
+    INTEGER :: i,j,h
+    
+
+    DO h=1,halo
+      DO nf=1,nb_face
+        DO i=1-h+1,iim_glo+h-1
+          j=1-h+1
+          ind=vertex_glo(i,j,nf)%ind
+          nf2=cell_glo(ind)%assign_face
+          ind2=cell_glo(ind)%neighbour(tab_index(nf,nf2,ldown-1))
+          vertex_glo(i,j-1,nf)%ind=ind2
+          vertex_glo(i,j-1,nf)%xyz=cell_glo(ind2)%xyz
+        ENDDO
+      
+        DO j=1-h,jjm_glo+h-1
+          i=iim_glo+h-1
+          ind=vertex_glo(i,j,nf)%ind
+          nf2=cell_glo(ind)%assign_face
+          ind2=cell_glo(ind)%neighbour(tab_index(nf,nf2,right-1))
+          vertex_glo(i+1,j,nf)%ind=ind2
+          vertex_glo(i+1,j,nf)%xyz=cell_glo(ind2)%xyz
+        ENDDO
+      
+        DO i=iim_glo+h,1-h+1,-1
+          j=jjm_glo+h-1
+          ind=vertex_glo(i,j,nf)%ind
+          nf2=cell_glo(ind)%assign_face
+          ind2=cell_glo(ind)%neighbour(tab_index(nf,nf2,rup-1))
+          vertex_glo(i,j+1,nf)%ind=ind2
+          vertex_glo(i,j+1,nf)%xyz=cell_glo(ind2)%xyz
+        ENDDO
+
+         DO j=jjm_glo+h,1-h,-1
+          i=1-h+1
+          ind=vertex_glo(i,j,nf)%ind
+          nf2=cell_glo(ind)%assign_face
+          ind2=cell_glo(ind)%neighbour(tab_index(nf,nf2,left-1))
+          vertex_glo(i-1,j,nf)%ind=ind2
+          vertex_glo(i-1,j,nf)%xyz=cell_glo(ind2)%xyz
+        ENDDO
+      ENDDO
+    ENDDO
+    
+    
+  END SUBROUTINE compute_extended_face
+  
+  SUBROUTINE Set_index
+  IMPLICIT NONE
+    INTEGER :: delta
+    INTEGER :: n1,n2,i
+   
+    DO n1=1,5
+     DO delta=-2,2
+        DO i=0,5
+          n2=MOD(n1-1-delta+5,5)+1
+          tab_index(n1,n2,i)=MOD(delta+i+6,6)
+          n2=MOD(n1-1+delta+5,5)+1
+          tab_index(n1+5,n2+5,i)=MOD(delta+i+6,6)
+        ENDDO
+      ENDDO
+    ENDDO
+    
+    DO n1=1,5
+      DO i=0,5
+        delta=3
+
+        n2=5+n1
+        Tab_index(n1,n2,i)=MOD(delta+i+6,6)
+        Tab_index(n2,n1,i)=MOD(delta+i+6,6)
+      
+        n2=5+n1-1
+        IF (n2==5) n2=10
+        Tab_index(n1,n2,i)=MOD(delta+i+6,6)
+        Tab_index(n2,n1,i)=MOD(delta+i+6,6)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE set_index
+  
+  
+  SUBROUTINE set_cell
+  IMPLICIT NONE
+    INTEGER :: ind,ind2
+    INTEGER :: nf,nf2,nfm1,nfp1
+    INTEGER :: i,j,k
+    INTEGER :: delta
+    
+    ind=0
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Association des cellules !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! interieur des faces
+    DO nf=1,nb_face     
+      DO i=2,iim_glo-1
+        DO j=2,jjm_glo-1
+          ind=ind+1
+          vertex_glo(i,j,nf)%ind=ind
+          cell_glo(ind)%assign_face=nf
+          cell_glo(ind)%assign_i=i
+          cell_glo(ind)%assign_j=j
+        ENDDO
+      ENDDO
+    ENDDO
+
+! frontieres faces nord
+    DO nf=1,nb_face/2
+
+      nfm1=nf-1
+      IF (nfm1==0) nfm1=nb_face/2
+      
+      nf2=nf+nb_face/2
+
+      DO i=2,iim_glo-1
+        ind=ind+1
+        vertex_glo(i,1,nf)%ind=ind
+        vertex_glo(1,i,nfm1)%ind=ind
+        cell_glo(ind)%assign_face=nf
+        cell_glo(ind)%assign_i=i
+        cell_glo(ind)%assign_j=1
+      ENDDO
+
+      DO i=2,iim_glo-1
+        ind=ind+1
+        vertex_glo(i,jjm_glo,nf)%ind=ind
+        vertex_glo(iim_glo-i+1,jjm_glo,nf2)%ind=ind
+        
+        cell_glo(ind)%assign_face=nf
+        cell_glo(ind)%assign_i=i
+        cell_glo(ind)%assign_j=jjm_glo
+      ENDDO
+     ENDDO
+
+! frontieres faces sud
+
+    DO nf=nb_face/2+1,nb_face
+      
+      nfp1=nf+1
+      IF (nfp1==nb_face+1) nfp1=nb_face/2+1
+      
+      nf2=nf-nb_face/2+1
+      IF (nf2==nb_face/2+1) nf2=1
+      
+      DO i=2,iim_glo-1
+        ind=ind+1
+        vertex_glo(i,1,nf)%ind=ind
+        vertex_glo(1,i,nfp1)%ind=ind
+        cell_glo(ind)%assign_face=nf
+        cell_glo(ind)%assign_i=i
+        cell_glo(ind)%assign_j=1
+      ENDDO
+
+      DO j=2,jjm_glo-1
+        ind=ind+1
+        vertex_glo(iim_glo,j,nf)%ind=ind
+        vertex_glo(iim_glo,jjm_glo-j+1,nf2)%ind=ind
+        
+        cell_glo(ind)%assign_face=nf
+        cell_glo(ind)%assign_i=iim_glo
+        cell_glo(ind)%assign_j=j
+      ENDDO
+    ENDDO
+
+! vertex nord (sur 3 faces)
+
+    DO nf=1,nb_face/2
+
+      nfp1=nf+1
+      IF (nfp1==nb_face/2+1) nfp1=1
+      
+      nf2=nf+nb_face/2
+
+      ind=ind+1
+      vertex_glo(1,jjm_glo,nf)%ind=ind
+      vertex_glo(iim_glo,1,nfp1)%ind=ind
+      vertex_glo(iim_glo,jjm_glo,nf2)%ind=ind
+      cell_glo(ind)%assign_face=nf
+      cell_glo(ind)%assign_i=1
+      cell_glo(ind)%assign_j=jjm_glo
+     ENDDO
+
+! vertex sud (sur 3 faces)
+
+    DO nf=nb_face/2+1,nb_face
+
+      nfp1=nf+1
+      IF (nfp1==nb_face+1) nfp1=nb_face/2+1
+      
+      nf2=nf-nb_face/2+1
+      IF (nf2==nb_face/2+1) nf2=1
+
+      ind=ind+1
+      vertex_glo(iim_glo,1,nf)%ind=ind
+      vertex_glo(1,jjm_glo,nfp1)%ind=ind
+      vertex_glo(iim_glo,jjm_glo,nf2)%ind=ind
+      cell_glo(ind)%assign_face=nf
+      cell_glo(ind)%assign_i=iim_glo
+      cell_glo(ind)%assign_j=1
+    ENDDO
+
+
+! vertex nord (sur 5 faces)
+
+    ind=ind+1
+    vertex_glo(1,1,1)%ind=ind
+    vertex_glo(1,1,2)%ind=ind
+    vertex_glo(1,1,3)%ind=ind
+    vertex_glo(1,1,4)%ind=ind
+    vertex_glo(1,1,5)%ind=ind
+    cell_glo(ind)%assign_face=1
+    cell_glo(ind)%assign_i=1
+    cell_glo(ind)%assign_j=1
+      
+! vertex sud (sur 5 faces)
+
+    ind=ind+1    
+    vertex_glo(1,1,6)%ind=ind
+    vertex_glo(1,1,7)%ind=ind
+    vertex_glo(1,1,8)%ind=ind
+    vertex_glo(1,1,9)%ind=ind
+    vertex_glo(1,1,10)%ind=ind
+    cell_glo(ind)%assign_face=6
+    cell_glo(ind)%assign_i=1
+    cell_glo(ind)%assign_j=1
+
+! assignation des coordonnees xyz
+
+  DO ind=1,ncell_glo
+    nf=cell_glo(ind)%assign_face
+    i=cell_glo(ind)%assign_i
+    j=cell_glo(ind)%assign_j
+    cell_glo(ind)%xyz=vertex_glo(i,j,nf)%xyz
+  ENDDO
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Association des voisins !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! interieur des faces
+  
+    DO nf=1,nb_face
+      DO j=2,jjm_glo-1
+        DO i=2,iim_glo-1
+          ind=vertex_glo(i,j,nf)%ind
+! right          
+          ind2=vertex_glo(i+1,j,nf)%ind   
+          nf2=cell_glo(ind2)%assign_face
+          cell_glo(ind)%neighbour(right-1)=ind2
+          cell_glo(ind2)%neighbour(tab_index(nf,nf2,left-1))=ind
+          
+! rup          
+          ind2=vertex_glo(i,j+1,nf)%ind   
+          nf2=cell_glo(ind2)%assign_face
+          cell_glo(ind)%neighbour(rup-1)=ind2
+          cell_glo(ind2)%neighbour(tab_index(nf,nf2,ldown-1))=ind
+              
+! lup          
+          ind2=vertex_glo(i-1,j+1,nf)%ind  
+          nf2=cell_glo(ind2)%assign_face
+          cell_glo(ind)%neighbour(lup-1)=ind2
+          cell_glo(ind2)%neighbour(tab_index(nf,nf2,rdown-1))=ind
+          
+! left          
+          ind2=vertex_glo(i-1,j,nf)%ind   
+          nf2=cell_glo(ind2)%assign_face
+          cell_glo(ind)%neighbour(left-1)=ind2
+          cell_glo(ind2)%neighbour(tab_index(nf,nf2,right-1))=ind
+! ldown          
+          ind2=vertex_glo(i,j-1,nf)%ind   
+          nf2=cell_glo(ind2)%assign_face
+          cell_glo(ind)%neighbour(ldown-1)=ind2
+          cell_glo(ind2)%neighbour(tab_index(nf,nf2,rup-1))=ind
+          
+! rdown          
+          ind2=vertex_glo(i+1,j-1,nf)%ind   
+          nf2=cell_glo(ind2)%assign_face
+          cell_glo(ind)%neighbour(rdown-1)=ind2
+          cell_glo(ind2)%neighbour(tab_index(nf,nf2,lup-1))=ind
+        ENDDO
+      ENDDO
+    ENDDO
+
+! frontiere face nord
+    
+    DO nf=1,nb_face/2
+      DO i=2,iim_glo-1
+        j=1
+        ind=vertex_glo(i,j,nf)%ind
+! right          
+        ind2=vertex_glo(i+1,j,nf)%ind   
+        nf2=cell_glo(ind2)%assign_face
+        cell_glo(ind)%neighbour(right-1)=ind2
+        cell_glo(ind2)%neighbour(tab_index(nf,nf2,left-1))=ind
+! left          
+        ind2=vertex_glo(i-1,j,nf)%ind   
+        nf2=cell_glo(ind2)%assign_face
+        cell_glo(ind)%neighbour(left-1)=ind2
+        cell_glo(ind2)%neighbour(tab_index(nf,nf2,right-1))=ind
+! lup          
+          ind2=vertex_glo(i-1,j+1,nf)%ind  
+          nf2=cell_glo(ind2)%assign_face
+          cell_glo(ind)%neighbour(lup-1)=ind2
+          cell_glo(ind2)%neighbour(tab_index(nf,nf2,rdown-1))=ind
+
+      ENDDO
+
+      DO i=2,iim_glo-1
+        j=jjm_glo
+        ind=vertex_glo(i,j,nf)%ind
+! right          
+        ind2=vertex_glo(i+1,j,nf)%ind   
+        nf2=cell_glo(ind2)%assign_face
+        cell_glo(ind)%neighbour(right-1)=ind2
+        cell_glo(ind2)%neighbour(tab_index(nf,nf2,left-1))=ind
+! left          
+        ind2=vertex_glo(i-1,j,nf)%ind   
+        nf2=cell_glo(ind2)%assign_face
+        cell_glo(ind)%neighbour(left-1)=ind2
+        cell_glo(ind2)%neighbour(tab_index(nf,nf2,right-1))=ind
+! rdown          
+          ind2=vertex_glo(i+1,j-1,nf)%ind   
+          nf2=cell_glo(ind2)%assign_face
+          cell_glo(ind)%neighbour(rdown-1)=ind2
+          cell_glo(ind2)%neighbour(tab_index(nf,nf2,lup-1))=ind
+      ENDDO
+    ENDDO
+    
+
+! frontiere face sud
+
+    DO nf=nb_face/2+1,nb_face
+      DO i=2,iim_glo-1
+        j=1
+        ind=vertex_glo(i,j,nf)%ind
+! right          
+        ind2=vertex_glo(i+1,j,nf)%ind   
+        nf2=cell_glo(ind2)%assign_face
+        cell_glo(ind)%neighbour(right-1)=ind2
+        cell_glo(ind2)%neighbour(tab_index(nf,nf2,left-1))=ind
+! left          
+        ind2=vertex_glo(i-1,j,nf)%ind   
+        nf2=cell_glo(ind2)%assign_face
+        cell_glo(ind)%neighbour(left-1)=ind2
+        cell_glo(ind2)%neighbour(tab_index(nf,nf2,right-1))=ind
+! lup          
+          ind2=vertex_glo(i-1,j+1,nf)%ind  
+          nf2=cell_glo(ind2)%assign_face
+          cell_glo(ind)%neighbour(lup-1)=ind2
+          cell_glo(ind2)%neighbour(tab_index(nf,nf2,rdown-1))=ind
+      ENDDO
+
+      DO j=2,jjm_glo-1
+        i=iim_glo
+        ind=vertex_glo(i,j,nf)%ind
+! rup          
+        ind2=vertex_glo(i,j+1,nf)%ind   
+        nf2=cell_glo(ind2)%assign_face
+        cell_glo(ind)%neighbour(rup-1)=ind2
+        cell_glo(ind2)%neighbour(tab_index(nf,nf2,ldown-1))=ind
+! ldown          
+        ind2=vertex_glo(i,j-1,nf)%ind   
+        nf2=cell_glo(ind2)%assign_face
+        cell_glo(ind)%neighbour(ldown-1)=ind2
+        cell_glo(ind2)%neighbour(tab_index(nf,nf2,rup-1))=ind
+! lup          
+          ind2=vertex_glo(i-1,j+1,nf)%ind  
+          nf2=cell_glo(ind2)%assign_face
+          cell_glo(ind)%neighbour(lup-1)=ind2
+          cell_glo(ind2)%neighbour(tab_index(nf,nf2,rdown-1))=ind
+
+      ENDDO
+    ENDDO          
+
+   
+! vertex nord (sur 3 faces)
+
+    DO nf=1,nb_face/2
+      ind=vertex_glo(1,jjm_glo,nf)%ind
+      cell_glo(ind)%neighbour(2)=cell_glo(ind)%neighbour(1)
+    ENDDO
+
+! vertex sud (sur 3 faces)
+
+    DO nf=nb_face/2+1,nb_face
+
+      ind=vertex_glo(iim_glo,1,nf)%ind
+      cell_glo(ind)%neighbour(5)=cell_glo(ind)%neighbour(0)
+    ENDDO
+
+
+! vertex nord (sur 5 faces)
+
+    ind=vertex_glo(1,1,1)%ind
+    cell_glo(ind)%neighbour(3)=cell_glo(ind)%neighbour(4)
+      
+! vertex sud (sur 5 faces)
+
+    ind=vertex_glo(1,1,6)%ind
+    cell_glo(ind)%neighbour(3)=cell_glo(ind)%neighbour(2)
+      
+    
+ !! assignation des delta 
+    DO nf=1,nb_face
+      DO j=1,jjm_glo
+        DO i=1,iim_glo 
+          ind=vertex_glo(i,j,nf)%ind
+          nf2=cell_glo(ind)%assign_face
+          vertex_glo(i,j,nf)%delta=tab_index(nf,nf2,0)
+        ENDDO
+      ENDDO
+    ENDDO    
+
+     
+  END SUBROUTINE set_cell
+      
+          
+  SUBROUTINE set_cell_edge
+  IMPLICIT NONE
+    INTEGER :: ind,k,ind2,ng,ne
+    
+    DO ind=1,ncell_glo
+      cell_glo(ind)%edge(:)=0
+    ENDDO
+    
+    ne=0
+    DO ind=1,ncell_glo
+      DO k=0,5
+        IF (cell_glo(ind)%edge(k)==0) THEN
+          ind2=cell_glo(ind)%neighbour(k)
+          DO ng=0,5
+            IF (cell_glo(ind2)%neighbour(ng)==ind) THEN
+              IF (cell_glo(ind2)%edge(ng)==0) THEN
+                ne=ne+1
+                cell_glo(ind)%edge(k)=ne
+                edge_glo(ne)%e1=ind
+                edge_glo(ne)%e2=ind2
+                cell_glo(ind2)%edge(ng)=ne
+              ELSE 
+                ne=cell_glo(ind2)%edge(ng)
+                cell_glo(ind)%edge(k)=ne
+              ENDIF    
+              EXIT            
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDDO
+    
+  END SUBROUTINE  set_cell_edge    
+        
+  SUBROUTINE set_vertex_edge
+  IMPLICIT NONE
+    INTEGER :: nf
+    INTEGER :: i,j
+    INTEGER :: ind,ind2
+    INTEGER :: ne
+    INTEGER :: k,l     
+  
+    DO nf=1,nb_face
+      DO j=0,jjm_glo+1
+        DO i=0,iim_glo+1
+          ind=vertex_glo(i,j,nf)%ind
+          DO k=0,5
+            ind2=vertex_glo(i,j,nf)%neighbour(k)
+            DO l=0,5
+              ne=cell_glo(ind)%edge(l)
+              IF (edge_glo(ne)%e1==ind .AND. edge_glo(ne)%e2==ind2) THEN
+                vertex_glo(i,j,nf)%ne(k)=1
+              ELSE IF (edge_glo(ne)%e1==ind2 .AND. edge_glo(ne)%e2==ind) THEN
+                vertex_glo(i,j,nf)%ne(k)=-1
+              ENDIF
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+  END SUBROUTINE set_vertex_edge 
+     
+  SUBROUTINE compute_metric
+  IMPLICIT NONE
+  
+    CALL allocate_metric
+!    CALL compute_face
+    CALL compute_face_projection
+!    CALL remap_schmidt_glo ! replaced by call to remap_schmidt_loc in set_geometry
+
+    CALL set_index
+    CALL set_cell
+    CALL compute_extended_face_bis
+    CALL set_cell_edge
+    CALL set_vertex_edge
+    
+  END SUBROUTINE compute_metric
+
+END MODULE metric
Index: codes/icosagcm/devel/src/sphere/spherical_geom.f90
===================================================================
--- codes/icosagcm/devel/src/sphere/spherical_geom.f90	(revision 533)
+++ codes/icosagcm/devel/src/sphere/spherical_geom.f90	(revision 533)
@@ -0,0 +1,249 @@
+MODULE spherical_geom_mod
+USE genmod
+
+
+
+CONTAINS
+
+
+
+
+SUBROUTINE lonlat2xyz(lon,lat,xyz)
+IMPLICIT NONE
+  REAL(rstd),INTENT(IN) :: lon
+  REAL(rstd),INTENT(IN) :: lat
+  REAL(rstd),INTENT(OUT) :: xyz(3)
+  
+  xyz(1)=cos(lon)*cos(lat)
+  xyz(2)=sin(lon)*cos(lat)
+  xyz(3)=sin(lat)
+
+END SUBROUTINE lonlat2xyz
+
+
+SUBROUTINE xyz2lonlat(xyz,lon,lat)
+IMPLICIT NONE
+  REAL(rstd),INTENT(IN) :: xyz(3)
+  REAL(rstd),INTENT(OUT) :: lon
+  REAL(rstd),INTENT(OUT) :: lat
+  
+  REAL(rstd) :: coslat
+  REAL(rstd) :: xyzn(3)
+  
+  xyzn(:)=xyz(:)/sqrt(sum(xyz(:)**2))
+  
+  lat=asin(xyzn(3))
+  lon=atan2(xyzn(2),xyzn(1))
+END SUBROUTINE xyz2lonlat
+
+! lat/lon with respect to a displaced pole (rotated basis) :
+!  ( cos(lon0)*sin(lat0), sin(lon0)*sin(lat0), -cos(lat0)) 
+!  (-sin(lon0),           cos(lon0),           0)
+!  ( cos(lon0)*cos(lat0), sin(lon0)*cos(lat0), sin(lat0))
+
+SUBROUTINE lonlat2xyz_relative(lon,lat,lon0,lat0, xyz)
+IMPLICIT NONE
+  REAL(rstd),INTENT(IN) :: lon0, lat0, lon,lat
+  REAL(rstd),INTENT(OUT) :: xyz(3)
+  REAL(rstd) :: xx,yy,zz
+  xx = cos(lon)*cos(lat)
+  yy = sin(lon)*cos(lat)
+  zz = sin(lat)
+  xyz(1) = cos(lon0)*(sin(lat0)*xx+cos(lat0)*zz)-sin(lon0)*yy
+  xyz(2) = sin(lon0)*(sin(lat0)*xx+cos(lat0)*zz)+cos(lon0)*yy
+  xyz(3) = sin(lat0)*zz-cos(lat0)*xx
+END SUBROUTINE lonlat2xyz_relative
+
+SUBROUTINE xyz2lonlat_relative(xyz,lon0,lat0, lon,lat)
+IMPLICIT NONE
+  REAL(rstd),INTENT(IN) :: xyz(3), lon0, lat0
+  REAL(rstd),INTENT(OUT) :: lon,lat
+  REAL(rstd) :: xx,yy,zz
+  xx = sin(lat0)*(xyz(1)*cos(lon0)+xyz(2)*sin(lon0))-cos(lat0)*xyz(3)
+  yy = xyz(2)*cos(lon0)-xyz(1)*sin(lon0)
+  zz = cos(lat0)*(xyz(1)*cos(lon0)+xyz(2)*sin(lon0))+sin(lat0)*xyz(3)
+  lon = atan2(yy,xx)
+  lat = asin(zz)
+END SUBROUTINE xyz2lonlat_relative
+
+SUBROUTINE schmidt_transform(xyz,cc, lon0, lat0)
+  ! Based on formula (12) from Guo & Drake, JCP 2005
+  IMPLICIT NONE
+  REAL(rstd),INTENT(INOUT) :: xyz(3)
+  REAL(rstd), INTENT(IN) :: cc, lon0, lat0  ! stretching factor>0, lon/lat of zoomed area
+  REAL(rstd) :: lat,lon,mu
+  CALL xyz2lonlat_relative(xyz,lon0,lat0, lon,lat)
+  mu = sin(lat)
+  mu = ((cc-1)+mu*(cc+1)) / ((cc+1)+mu*(cc-1))
+  lat = asin(mu)
+  CALL lonlat2xyz_relative(lon,lat, lon0,lat0, xyz)
+END SUBROUTINE schmidt_transform
+
+SUBROUTINE dist_cart(A,B,d)
+USE vector
+IMPLICIT NONE
+  REAL(rstd),INTENT(IN)  :: A(3)
+  REAL(rstd),INTENT(IN)  :: B(3)
+  REAL(rstd),INTENT(OUT) :: d
+  
+   REAL(rstd)  :: n(3)
+   CALL cross_product2(A,B,n)
+   d=asin(sqrt(sum(n**2)))
+
+END SUBROUTINE dist_cart
+
+
+SUBROUTINE dist_lonlat(lonA,latA,lonB,latB,d)
+IMPLICIT NONE
+  REAL(rstd),INTENT(IN)  :: lonA
+  REAL(rstd),INTENT(IN)  :: latA
+  REAL(rstd),INTENT(IN)  :: lonB
+  REAL(rstd),INTENT(IN)  :: latB
+  REAL(rstd),INTENT(OUT) :: d
+  
+  d=acos(MAX(MIN(sin(latA)*sin(latB)+cos(latA)*cos(latB)*cos(lonA-lonB),1.),-1.))
+ 
+END SUBROUTINE dist_lonlat
+
+SUBROUTINE surf_triangle(A,B,C,surf)
+  REAL(rstd),INTENT(IN)  :: A(3)
+  REAL(rstd),INTENT(IN)  :: B(3)
+  REAL(rstd),INTENT(IN)  :: C(3)
+  REAL(rstd),INTENT(OUT) :: Surf
+
+  REAL(rstd)  :: AB,AC,BC
+  REAL(rstd)  :: s,x
+  
+  CALL dist_cart(A,B,AB)
+  CALL dist_cart(A,C,AC)
+  CALL dist_cart(B,C,BC)
+  
+  s=(AB+AC+BC)/2
+  x=tan(s/2) * tan((s-AB)/2)  * tan((s-AC)/2) * tan((s-BC)/2)
+  IF (x<0) x=0.
+  surf=4*atan(sqrt( x))
+  
+END SUBROUTINE surf_triangle 
+
+
+SUBROUTINE div_arc(A,B,frac,C)
+IMPLICIT NONE
+  REAL(rstd),INTENT(IN)  :: A(3)
+  REAL(rstd),INTENT(IN)  :: B(3)
+  REAL(rstd),INTENT(IN)  :: frac
+  REAL(rstd),INTENT(OUT)  :: C(3)
+  
+  REAL(rstd) :: d
+  REAL(rstd) :: M(3,3)
+  REAL(rstd) :: alpha(3,3)
+  INTEGER    :: IPIV(3)
+  INTEGER    :: info
+  REAL(rstd) :: xa,xb,xc
+  REAL(rstd) :: ya,yb,yc
+  REAL(rstd) :: za,zb,zc
+  REAL(rstd) :: alpha_A,alpha_B,alpha_C
+  REAL(rstd) :: x,y,z
+  REAL(rstd) :: a1,a2,a3
+  REAL(rstd) :: b1,b2,b3
+  
+  
+  xa=A(1) ; ya=A(2) ; za=A(3)
+  xb=B(1) ; yb=B(2) ; zb=B(3)
+
+  CALL dist_cart(A,B,d)
+
+  C(1)=cos(frac*d) 
+  C(2)=cos((1-frac)*d)
+  C(3)=0.
+
+  xc=ya*zb-yb*za ; yc=-(xa*zb-xb*za) ; zc=xa*yb-xb*ya
+  
+  M(1,1)=xa ; M(1,2)=ya ; M(1,3)=za
+  M(2,1)=xb ; M(2,2)=yb ; M(2,3)=zb
+  M(3,1)=xc ; M(3,2)=yc ; M(3,3)=zc
+  stop 'STOP'
+!  CALL DGESV(3,1,M,3,IPIV,C,3,info)
+  
+END SUBROUTINE div_arc
+
+SUBROUTINE div_arc_bis(A,B,frac,C)
+IMPLICIT NONE
+  REAL(rstd),INTENT(IN)  :: A(3)
+  REAL(rstd),INTENT(IN)  :: B(3)
+  REAL(rstd),INTENT(IN)  :: frac
+  REAL(rstd),INTENT(OUT)  :: C(3)
+  
+   C=A*(1-frac)+B*frac  
+   C=C/sqrt(sum(C**2))
+END SUBROUTINE div_arc_bis
+
+
+  SUBROUTINE circumcenter(A0,B0,C0,center)
+  USE vector
+  IMPLICIT NONE
+    REAL(rstd), INTENT(IN)  :: A0(3),B0(3),C0(3)
+    REAL(rstd), INTENT(OUT) :: Center(3)
+    
+    REAL(rstd)  :: a(3),b(3),c(3), ac(3), ab(3), p1(3), q(3), p2(3)
+    
+    a=A0/sqrt(sum(A0**2))
+    b=B0/sqrt(sum(B0**2))
+    c=C0/sqrt(sum(C0**2))
+    
+    ab=b-a
+    ac=c-a
+    CALL Cross_product2(ab,ac,p1)
+    IF(.FALSE.) THEN ! Direct solution, round-off error
+       center=p1/norm(p1)
+    ELSE ! Two-step solution, stable
+       q = SUM(ac**2)*ab-SUM(ab**2)*ac
+       CALL Cross_product2(p1,q,p2)
+       p2 = a + p2/(2.*SUM(p1**2))
+       center = p2/norm(p2)
+    END IF
+  END SUBROUTINE circumcenter
+    
+
+  SUBROUTINE compute_centroid(points,n,centr)
+  USE vector
+  IMPLICIT NONE
+    INTEGER :: n
+    REAL(rstd), INTENT(IN)  :: points(3,n)
+    REAL(rstd), INTENT(OUT) :: Centr(3)
+    
+    REAL(rstd) :: p1(3),p2(3),cross(3), cc(3)
+    REAL(rstd) :: norm_cross, area
+    INTEGER :: i,j
+
+    centr(:)=0
+    IF(.FALSE.) THEN 
+       ! Gauss formula (subject to round-off error)
+       DO i=1,n
+          j=MOD(i,n)+1
+          p1=points(:,i)/norm(points(:,i))
+          p2=points(:,j)/norm(points(:,j))
+          CALL cross_product2(p1,p2,cross)
+          norm_cross=norm(cross)
+          if (norm_cross<1e-10) CYCLE 
+          centr(:)=centr(:)+asin(norm_cross)*cross(:)/norm_cross
+       ENDDO       
+    ELSE
+       ! Simple area-weighted average (second-order accurate, stable)
+       cc=SUM(points,2) ! arithmetic average used as center
+       cc=cc/norm(cc)
+       DO i=1,n
+          j=MOD(i,n)+1
+          p1=points(:,i)/norm(points(:,i))
+          p2=points(:,j)/norm(points(:,j))
+          CALL surf_triangle(cc,p1,p2,area)
+          centr(:)=centr(:)+area*(p1+p2+cc)
+       ENDDO
+    END IF
+    
+    centr(:)=centr(:)/norm(centr(:))
+
+  END SUBROUTINE compute_centroid
+
+END MODULE spherical_geom_mod
+
+
Index: codes/icosagcm/devel/src/sphere/vector.f90
===================================================================
--- codes/icosagcm/devel/src/sphere/vector.f90	(revision 533)
+++ codes/icosagcm/devel/src/sphere/vector.f90	(revision 533)
@@ -0,0 +1,55 @@
+MODULE vector
+  USE genmod
+
+CONTAINS
+
+  FUNCTION Norm(V)
+  IMPLICIT NONE
+    REAL(rstd)            :: Norm
+    REAL(rstd),INTENT(IN) :: V(3)
+    
+    Norm=sqrt(V(1)*V(1)+V(2)*V(2)+V(3)*V(3))
+  
+  END FUNCTION Norm
+  
+  FUNCTION dot_product(V1,V2)
+  IMPLICIT NONE
+    REAL(rstd)       :: dot_product
+    REAL(rstd),INTENT(IN) :: V1(3)
+    REAL(rstd),INTENT(IN) :: V2(3)
+    
+    dot_product=V1(1)*V2(1)+V1(2)*V2(2)+V1(3)*V2(3)
+    
+   END FUNCTION dot_product
+   
+   FUNCTION cross_product(V1,V2)
+   IMPLICIT NONE
+     REAL(rstd)     ::cross_product(3)
+     REAL(rstd),INTENT(IN) :: V1(3)
+     REAL(rstd),INTENT(IN) :: V2(3)
+    
+     cross_product(1)=V1(2)*V2(3)-V1(3)*V2(2)
+     cross_product(2)=V1(3)*V2(1)-V1(1)*V2(3)
+     cross_product(3)=V1(1)*V2(2)-V1(2)*V2(1)
+     
+    END FUNCTION cross_product
+
+
+   SUBROUTINE cross_product2(V1,V2,cross_product)
+   IMPLICIT NONE
+     REAL(rstd),INTENT(OUT):: cross_product(3)
+     REAL(rstd),INTENT(IN) :: V1(3)
+     REAL(rstd),INTENT(IN) :: V2(3)
+    
+     cross_product(1)=V1(2)*V2(3)-V1(3)*V2(2)
+     cross_product(2)=V1(3)*V2(1)-V1(1)*V2(3)
+     cross_product(3)=V1(1)*V2(2)-V1(2)*V2(1)
+     
+    END SUBROUTINE cross_product2
+
+    FUNCTION arc(lon,lat, lonc,latc)
+      REAL(rstd) :: lon,lat, lonc,latc, arc
+      arc=ACOS(sin(latc)*sin(lat)+cos(latc)*cos(lat)*cos(lon-lonc))
+    END FUNCTION arc
+
+END MODULE vector
Index: codes/icosagcm/devel/src/spherical_geom.f90
===================================================================
--- codes/icosagcm/devel/src/spherical_geom.f90	(revision 531)
+++ 	(revision )
@@ -1,249 +1,0 @@
-MODULE spherical_geom_mod
-USE genmod
-
-
-
-CONTAINS
-
-
-
-
-SUBROUTINE lonlat2xyz(lon,lat,xyz)
-IMPLICIT NONE
-  REAL(rstd),INTENT(IN) :: lon
-  REAL(rstd),INTENT(IN) :: lat
-  REAL(rstd),INTENT(OUT) :: xyz(3)
-  
-  xyz(1)=cos(lon)*cos(lat)
-  xyz(2)=sin(lon)*cos(lat)
-  xyz(3)=sin(lat)
-
-END SUBROUTINE lonlat2xyz
-
-
-SUBROUTINE xyz2lonlat(xyz,lon,lat)
-IMPLICIT NONE
-  REAL(rstd),INTENT(IN) :: xyz(3)
-  REAL(rstd),INTENT(OUT) :: lon
-  REAL(rstd),INTENT(OUT) :: lat
-  
-  REAL(rstd) :: coslat
-  REAL(rstd) :: xyzn(3)
-  
-  xyzn(:)=xyz(:)/sqrt(sum(xyz(:)**2))
-  
-  lat=asin(xyzn(3))
-  lon=atan2(xyzn(2),xyzn(1))
-END SUBROUTINE xyz2lonlat
-
-! lat/lon with respect to a displaced pole (rotated basis) :
-!  ( cos(lon0)*sin(lat0), sin(lon0)*sin(lat0), -cos(lat0)) 
-!  (-sin(lon0),           cos(lon0),           0)
-!  ( cos(lon0)*cos(lat0), sin(lon0)*cos(lat0), sin(lat0))
-
-SUBROUTINE lonlat2xyz_relative(lon,lat,lon0,lat0, xyz)
-IMPLICIT NONE
-  REAL(rstd),INTENT(IN) :: lon0, lat0, lon,lat
-  REAL(rstd),INTENT(OUT) :: xyz(3)
-  REAL(rstd) :: xx,yy,zz
-  xx = cos(lon)*cos(lat)
-  yy = sin(lon)*cos(lat)
-  zz = sin(lat)
-  xyz(1) = cos(lon0)*(sin(lat0)*xx+cos(lat0)*zz)-sin(lon0)*yy
-  xyz(2) = sin(lon0)*(sin(lat0)*xx+cos(lat0)*zz)+cos(lon0)*yy
-  xyz(3) = sin(lat0)*zz-cos(lat0)*xx
-END SUBROUTINE lonlat2xyz_relative
-
-SUBROUTINE xyz2lonlat_relative(xyz,lon0,lat0, lon,lat)
-IMPLICIT NONE
-  REAL(rstd),INTENT(IN) :: xyz(3), lon0, lat0
-  REAL(rstd),INTENT(OUT) :: lon,lat
-  REAL(rstd) :: xx,yy,zz
-  xx = sin(lat0)*(xyz(1)*cos(lon0)+xyz(2)*sin(lon0))-cos(lat0)*xyz(3)
-  yy = xyz(2)*cos(lon0)-xyz(1)*sin(lon0)
-  zz = cos(lat0)*(xyz(1)*cos(lon0)+xyz(2)*sin(lon0))+sin(lat0)*xyz(3)
-  lon = atan2(yy,xx)
-  lat = asin(zz)
-END SUBROUTINE xyz2lonlat_relative
-
-SUBROUTINE schmidt_transform(xyz,cc, lon0, lat0)
-  ! Based on formula (12) from Guo & Drake, JCP 2005
-  IMPLICIT NONE
-  REAL(rstd),INTENT(INOUT) :: xyz(3)
-  REAL(rstd), INTENT(IN) :: cc, lon0, lat0  ! stretching factor>0, lon/lat of zoomed area
-  REAL(rstd) :: lat,lon,mu
-  CALL xyz2lonlat_relative(xyz,lon0,lat0, lon,lat)
-  mu = sin(lat)
-  mu = ((cc-1)+mu*(cc+1)) / ((cc+1)+mu*(cc-1))
-  lat = asin(mu)
-  CALL lonlat2xyz_relative(lon,lat, lon0,lat0, xyz)
-END SUBROUTINE schmidt_transform
-
-SUBROUTINE dist_cart(A,B,d)
-USE vector
-IMPLICIT NONE
-  REAL(rstd),INTENT(IN)  :: A(3)
-  REAL(rstd),INTENT(IN)  :: B(3)
-  REAL(rstd),INTENT(OUT) :: d
-  
-   REAL(rstd)  :: n(3)
-   CALL cross_product2(A,B,n)
-   d=asin(sqrt(sum(n**2)))
-
-END SUBROUTINE dist_cart
-
-
-SUBROUTINE dist_lonlat(lonA,latA,lonB,latB,d)
-IMPLICIT NONE
-  REAL(rstd),INTENT(IN)  :: lonA
-  REAL(rstd),INTENT(IN)  :: latA
-  REAL(rstd),INTENT(IN)  :: lonB
-  REAL(rstd),INTENT(IN)  :: latB
-  REAL(rstd),INTENT(OUT) :: d
-  
-  d=acos(MAX(MIN(sin(latA)*sin(latB)+cos(latA)*cos(latB)*cos(lonA-lonB),1.),-1.))
- 
-END SUBROUTINE dist_lonlat
-
-SUBROUTINE surf_triangle(A,B,C,surf)
-  REAL(rstd),INTENT(IN)  :: A(3)
-  REAL(rstd),INTENT(IN)  :: B(3)
-  REAL(rstd),INTENT(IN)  :: C(3)
-  REAL(rstd),INTENT(OUT) :: Surf
-
-  REAL(rstd)  :: AB,AC,BC
-  REAL(rstd)  :: s,x
-  
-  CALL dist_cart(A,B,AB)
-  CALL dist_cart(A,C,AC)
-  CALL dist_cart(B,C,BC)
-  
-  s=(AB+AC+BC)/2
-  x=tan(s/2) * tan((s-AB)/2)  * tan((s-AC)/2) * tan((s-BC)/2)
-  IF (x<0) x=0.
-  surf=4*atan(sqrt( x))
-  
-END SUBROUTINE surf_triangle 
-
-
-SUBROUTINE div_arc(A,B,frac,C)
-IMPLICIT NONE
-  REAL(rstd),INTENT(IN)  :: A(3)
-  REAL(rstd),INTENT(IN)  :: B(3)
-  REAL(rstd),INTENT(IN)  :: frac
-  REAL(rstd),INTENT(OUT)  :: C(3)
-  
-  REAL(rstd) :: d
-  REAL(rstd) :: M(3,3)
-  REAL(rstd) :: alpha(3,3)
-  INTEGER    :: IPIV(3)
-  INTEGER    :: info
-  REAL(rstd) :: xa,xb,xc
-  REAL(rstd) :: ya,yb,yc
-  REAL(rstd) :: za,zb,zc
-  REAL(rstd) :: alpha_A,alpha_B,alpha_C
-  REAL(rstd) :: x,y,z
-  REAL(rstd) :: a1,a2,a3
-  REAL(rstd) :: b1,b2,b3
-  
-  
-  xa=A(1) ; ya=A(2) ; za=A(3)
-  xb=B(1) ; yb=B(2) ; zb=B(3)
-
-  CALL dist_cart(A,B,d)
-
-  C(1)=cos(frac*d) 
-  C(2)=cos((1-frac)*d)
-  C(3)=0.
-
-  xc=ya*zb-yb*za ; yc=-(xa*zb-xb*za) ; zc=xa*yb-xb*ya
-  
-  M(1,1)=xa ; M(1,2)=ya ; M(1,3)=za
-  M(2,1)=xb ; M(2,2)=yb ; M(2,3)=zb
-  M(3,1)=xc ; M(3,2)=yc ; M(3,3)=zc
-  stop 'STOP'
-!  CALL DGESV(3,1,M,3,IPIV,C,3,info)
-  
-END SUBROUTINE div_arc
-
-SUBROUTINE div_arc_bis(A,B,frac,C)
-IMPLICIT NONE
-  REAL(rstd),INTENT(IN)  :: A(3)
-  REAL(rstd),INTENT(IN)  :: B(3)
-  REAL(rstd),INTENT(IN)  :: frac
-  REAL(rstd),INTENT(OUT)  :: C(3)
-  
-   C=A*(1-frac)+B*frac  
-   C=C/sqrt(sum(C**2))
-END SUBROUTINE div_arc_bis
-
-
-  SUBROUTINE circumcenter(A0,B0,C0,center)
-  USE vector
-  IMPLICIT NONE
-    REAL(rstd), INTENT(IN)  :: A0(3),B0(3),C0(3)
-    REAL(rstd), INTENT(OUT) :: Center(3)
-    
-    REAL(rstd)  :: a(3),b(3),c(3), ac(3), ab(3), p1(3), q(3), p2(3)
-    
-    a=A0/sqrt(sum(A0**2))
-    b=B0/sqrt(sum(B0**2))
-    c=C0/sqrt(sum(C0**2))
-    
-    ab=b-a
-    ac=c-a
-    CALL Cross_product2(ab,ac,p1)
-    IF(.FALSE.) THEN ! Direct solution, round-off error
-       center=p1/norm(p1)
-    ELSE ! Two-step solution, stable
-       q = SUM(ac**2)*ab-SUM(ab**2)*ac
-       CALL Cross_product2(p1,q,p2)
-       p2 = a + p2/(2.*SUM(p1**2))
-       center = p2/norm(p2)
-    END IF
-  END SUBROUTINE circumcenter
-    
-
-  SUBROUTINE compute_centroid(points,n,centr)
-  USE vector
-  IMPLICIT NONE
-    INTEGER :: n
-    REAL(rstd), INTENT(IN)  :: points(3,n)
-    REAL(rstd), INTENT(OUT) :: Centr(3)
-    
-    REAL(rstd) :: p1(3),p2(3),cross(3), cc(3)
-    REAL(rstd) :: norm_cross, area
-    INTEGER :: i,j
-
-    centr(:)=0
-    IF(.FALSE.) THEN 
-       ! Gauss formula (subject to round-off error)
-       DO i=1,n
-          j=MOD(i,n)+1
-          p1=points(:,i)/norm(points(:,i))
-          p2=points(:,j)/norm(points(:,j))
-          CALL cross_product2(p1,p2,cross)
-          norm_cross=norm(cross)
-          if (norm_cross<1e-10) CYCLE 
-          centr(:)=centr(:)+asin(norm_cross)*cross(:)/norm_cross
-       ENDDO       
-    ELSE
-       ! Simple area-weighted average (second-order accurate, stable)
-       cc=SUM(points,2) ! arithmetic average used as center
-       cc=cc/norm(cc)
-       DO i=1,n
-          j=MOD(i,n)+1
-          p1=points(:,i)/norm(points(:,i))
-          p2=points(:,j)/norm(points(:,j))
-          CALL surf_triangle(cc,p1,p2,area)
-          centr(:)=centr(:)+area*(p1+p2+cc)
-       ENDDO
-    END IF
-    
-    centr(:)=centr(:)/norm(centr(:))
-
-  END SUBROUTINE compute_centroid
-
-END MODULE spherical_geom_mod
-
-
Index: codes/icosagcm/devel/src/sponge.f90
===================================================================
--- codes/icosagcm/devel/src/sponge.f90	(revision 531)
+++ 	(revision )
@@ -1,148 +1,0 @@
-MODULE sponge_mod
-  USE icosa
-
-  PRIVATE
-  
-  REAL,SAVE :: tau_sponge !inverse of charactericstic relaxation time scale at the topmost layer (Hz)
-  INTEGER,SAVE :: iflag_sponge !0 --> for no sponge
-			       !1 --> for sponge over 4 topmost layers
-			       !2 --> for sponge from top to ~1% of top layer pressure
-  INTEGER,SAVE :: mode_sponge !1 --> u and v relax towards 0
-                              !2 --> u and v relax towards their zonal mean
-                              !3 --> u,v and pot. temp. relax towards their zonal mean
-!$OMP THREADPRIVATE(tau_sponge,iflag_sponge,mode_sponge)
-  REAL,ALLOCATABLE,SAVE :: rdamp(:) ! quenching coefficient
-  REAL,ALLOCATABLE,SAVE:: lambda(:) ! inverse or quenching time scale (Hz)
-
-  PUBLIC sponge, init_sponge, iflag_sponge
-
-CONTAINS
-
-  SUBROUTINE init_sponge
-  USE icosa
-  USE disvert_mod
-  USE omp_para
-  USE mpipara, ONLY: is_mpi_master
-  IMPLICIT NONE
-    INTEGER :: l
-
-    tau_sponge = 1.e-4
-    CALL getin("tau_sponge",tau_sponge)
-    PRINT*,'tau_sponge = ',tau_sponge
-
-    iflag_sponge = 0
-    CALL getin("iflag_sponge",iflag_sponge)
-    PRINT*,'iflag_sponge = ',iflag_sponge
-    
-    mode_sponge = 1
-    CALL getin("mode_sponge",mode_sponge)
-    PRINT*,'mode_sponge = ',mode_sponge
-
-    IF (iflag_sponge == 0) THEN
-      PRINT*,'init_sponge: no sponge'
-      RETURN
-    ENDIF
-
-!$OMP MASTER
-    ALLOCATE(rdamp(llm))
-    ALLOCATE(lambda(llm))
-
-    IF (iflag_sponge == 1) THEN
-! sponge quenching over the topmost 4 atmospheric layers
-        lambda(:)=0.
-        lambda(llm)=tau_sponge
-        lambda(llm-1)=tau_sponge/2.
-        lambda(llm-2)=tau_sponge/4.
-        lambda(llm-3)=tau_sponge/8.
-    ELSE IF (iflag_sponge == 2) THEN
-! sponge quenching over topmost layers down to pressures which are
-! higher than 100 times the topmost layer pressure
-        lambda(:)=tau_sponge*max(presnivs(llm)/presnivs(:)-0.01,0.)
-    ELSE
-      PRINT*,'Bad selector for variable iflag_sponge : <',iflag_sponge,             &
-            '> options are 0,1,2'
-      STOP
-    ENDIF
-
-! quenching coefficient rdamp(:)
-!         rdamp(:)=dt*lambda(:) ! Explicit Euler approx.
-!      rdamp(:)=1.-exp(-lambda(:)*dt)
-    rdamp(:)=itau_dissip*lambda(:)
-
-
-    IF (is_mpi_master) THEN
-      PRINT*,'lambda = '
-      DO l=ll_begin,ll_end
-        PRINT*,l,lambda(l)
-      ENDDO
-      PRINT*,'rdamp = '
-      DO l=ll_begin,ll_end
-        PRINT*,l,rdamp(l)
-      ENDDO
-    ENDIF
-!$OMP END MASTER
-!$OMP BARRIER
-
-  END SUBROUTINE init_sponge
-
-  SUBROUTINE sponge(f_ue,f_due,f_theta_rhodz,f_dtheta_rhodz)
-  USE icosa
-  USE theta2theta_rhodz_mod
-  USE pression_mod
-  USE exner_mod
-  USE geopotential_mod
-  USE trace
-  USE time_mod
-  USE omp_para
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_ue(:)
-    TYPE(t_field),POINTER :: f_due(:)
-    TYPE(t_field),POINTER :: f_theta_rhodz(:)
-    TYPE(t_field),POINTER :: f_dtheta_rhodz(:)
-
-    REAL(rstd),POINTER         :: due(:,:)!,due_sponge(:,:)
-    REAL(rstd),POINTER         :: ue(:,:)
-    REAL(rstd),POINTER         :: theta_rhodz(:,:,:)
-    REAL(rstd),POINTER         :: dtheta_rhodz(:,:,:)!,dtheta_sponge(:,:)
-
-    INTEGER :: ind
-    INTEGER :: l,ij
-
-!$OMP BARRIER
-    
-    CALL trace_start("sponge")
-
-    IF (mode_sponge == 1) THEN
-      DO ind=1,ndomain
-        IF (.NOT. assigned_domain(ind)) CYCLE
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        ue=f_ue(ind) 
-        due=f_due(ind) 
-        theta_rhodz=f_theta_rhodz(ind)
-        dtheta_rhodz=f_dtheta_rhodz(ind)
-
-        DO l=ll_begin,ll_end
-!$SIMD
-          DO ij=ij_begin,ij_end
-
-            due(ij+u_right,l) = -rdamp(l)*ue(ij+u_right,l)
-            due(ij+u_lup,l)   = -rdamp(l)*ue(ij+u_lup,l)
-            due(ij+u_ldown,l) = -rdamp(l)*ue(ij+u_ldown,l)
-
-            dtheta_rhodz(ij,l,:) = 0.0
-          ENDDO
-        ENDDO
-      END DO
-    ELSE
-      PRINT*,'Bad selector for variable mode_sponge : <',mode_sponge,             &
-            '> options 2 and 3 not available for the moment!'
-      STOP
-    ENDIF
-
-   CALL trace_end("sponge")
-
-!$OMP BARRIER
-  END SUBROUTINE sponge
-
-END MODULE sponge_mod
Index: codes/icosagcm/devel/src/terminator.f90
===================================================================
--- codes/icosagcm/devel/src/terminator.f90	(revision 531)
+++ 	(revision )
@@ -1,124 +1,0 @@
-!================================================================================================
-! This is the "toy" chemistry module.
-!================================================================================================
-
-MODULE Terminator
-
-implicit none
-private
-save
-
-public :: initial_value_Terminator       ! initialize cl and cl2
-public :: tendency_Terminator             ! interface to tendency computation
-
-!integer, parameter :: 8 = selected_real_kind (12)
-
-real(8), parameter :: cly_constant = 4.e-6_8
-real(8), parameter :: pi = 3.1415926535897932384626433832795028841971693993751058209749445923078164_8
-real(8), parameter :: half_pi = pi*0.5_8
-real(8), parameter :: degrees_to_radians = pi/180.0_8
-real(8), parameter :: k1_lat_center =   20.d0*degrees_to_radians
-real(8), parameter :: k1_lon_center =  300.d0*degrees_to_radians
-
-contains
-
-!===============================================================================
-!  Solar photolysis rate and recombination rate
-!===============================================================================
-
-subroutine k_vals( lat, lon, k1, k2 )
-
-!-----------------------------------------------------------------------
-! Arguments:
-!-----------------------------------------------------------------------
-real(8), intent(in)    :: lat, lon  ! latitude and longitude, radians
-real(8), intent(out)   :: k1, k2    ! reaction rates
-
-k1 = 1.0_8*max(0.d0,sin(lat)*sin(k1_lat_center) + cos(lat)*cos(k1_lat_center)*cos(lon-k1_lon_center))
-k2 = 1._8
-
-return
-
-end subroutine k_vals
-
-!===============================================================================
-!  Tendencies of cl and cl2
-!===============================================================================
-
-subroutine tendency_Terminator( lat, lon, cl, cl2, dt, cl_f, cl2_f )
-
-!-----------------------------------------------------------------------
-! Arguments:
-!-----------------------------------------------------------------------
-
-real(8), intent(in)    :: lat, lon  ! latitude and longitude, degrees
-real(8), intent(in)    :: cl, cl2   ! molar mixing ratio of cl and cl2
-real(8), intent(in)    :: dt        ! size of physics time step
-
-real(8), intent(out)   :: cl_f, cl2_f  ! time rate of change of cl and cl2
-
-!-----------------------------------------------------------------------
-! Local variables
-!-----------------------------------------------------------------------
-
-real(8) :: r, det, expdt, el ! useful algebaic quantities used in the computation
-real(8) :: k1, k2            ! reaction rates
-real(8) :: cly               ! quantity that should be conseved
-
-call k_vals( lat, lon, k1, k2 )
-
-r = k1 / (4._8*k2)
-cly = cl + 2._8* cl2
-
-det = sqrt( r*r + 2._8*r*cly )
-expdt = exp( -4._8*k2*det*dt )
-
-if ( abs(det * k2 * dt) .gt. 1e-16 ) then
-el = (1._8 - expdt) /det /dt
-else
-el = 4._8*k2
-endif
-
-cl_f  = -el * (cl - det + r)*(cl + det + r) / (1._8 + expdt + dt*el*(cl + r))
-cl2_f = -cl_f / 2._8
-
-return
-
-end subroutine tendency_Terminator
-
-!===============================================================================
-!  Compute initial values
-!===============================================================================
-
-subroutine initial_value_Terminator( lat, lon, cl, cl2 )
-
-!-----------------------------------------------------------------------
-! Arguments:
-!-----------------------------------------------------------------------
-
-real(8), intent(in)  :: lat, lon  ! latitude and longitude, degrees
-real(8), intent(out) :: cl, cl2   ! molar mixing ratio of cl and cl2
-
-!-----------------------------------------------------------------------
-! Local variables
-!-----------------------------------------------------------------------
-
-real(8) :: r, det  ! useful algebraic forms
-real(8) :: k1, k2  ! reaction rates
-
-call k_vals( lat, lon, k1, k2 )
-
-r = k1 / (4._8*k2)
-det = sqrt(r*r + 2._8*cly_constant*r)
-
-cl  = (det-r)
-cl2 = cly_constant/2._8 - (det-r)/2._8
-
-return
-
-end subroutine initial_value_Terminator
-
-end module Terminator
-
-
-
Index: codes/icosagcm/devel/src/theta_rhodz.f90
===================================================================
--- codes/icosagcm/devel/src/theta_rhodz.f90	(revision 531)
+++ 	(revision )
@@ -1,258 +1,0 @@
-MODULE theta2theta_rhodz_mod
-  USE field_mod
-  PRIVATE
-  TYPE(t_field), POINTER, SAVE  :: f_p(:)
-
-  PUBLIC :: init_theta2theta_rhodz, theta_rhodz2theta, &
-       theta_rhodz2temperature, temperature2theta_rhodz, &
-       theta2theta_rhodz, &
-       compute_theta2theta_rhodz, compute_theta_rhodz2theta
-
-CONTAINS
-  
-  SUBROUTINE init_theta2theta_rhodz
-  USE icosa
-  USE field_mod
-  IMPLICIT NONE
-    CALL allocate_field(f_p,field_t,type_real,llm+1,name='p (theta2theta_rhodz_mod)')    
-  END SUBROUTINE init_theta2theta_rhodz
-
-
-  SUBROUTINE theta_rhodz2theta(f_ps,f_theta_rhodz,f_theta)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ps(:)
-    TYPE(t_field), POINTER :: f_theta_rhodz(:)
-    TYPE(t_field), POINTER :: f_theta(:)
-  
-    REAL(rstd), POINTER :: ps(:)
-    REAL(rstd), POINTER :: theta_rhodz(:,:)
-    REAL(rstd), POINTER :: theta(:,:)
-    INTEGER :: ind
-
-!$OMP BARRIER
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      ps=f_ps(ind)
-      theta_rhodz=f_theta_rhodz(ind)
-      theta=f_theta(ind)
-      CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0)
-    ENDDO
-!$OMP BARRIER
-  
-  END SUBROUTINE theta_rhodz2theta
-
-  SUBROUTINE theta_rhodz2temperature(f_ps,f_theta_rhodz,f_temp)
-  USE icosa
-  USE pression_mod
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ps(:)
-    TYPE(t_field), POINTER :: f_theta_rhodz(:)
-    TYPE(t_field), POINTER :: f_temp(:)
-  
-    REAL(rstd), POINTER :: ps(:)
-    REAL(rstd), POINTER :: theta_rhodz(:,:,:)
-    REAL(rstd), POINTER :: temp(:,:)
-    REAL(rstd), POINTER :: p(:,:)
-    INTEGER :: ind
-
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      ps=f_ps(ind)
-      p=f_p(ind)
-      theta_rhodz=f_theta_rhodz(ind)
-      temp=f_temp(ind)
-
-!$OMP BARRIER
-      CALL compute_pression(ps,p,0)
-!$OMP BARRIER
-      CALL compute_theta_rhodz2temperature(p, theta_rhodz(:,:,1),temp,0)
-    ENDDO
-!$OMP BARRIER
-  
-  END SUBROUTINE theta_rhodz2temperature
- 
-  SUBROUTINE temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
-  USE icosa
-  USE pression_mod
-  USE exner_mod
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ps(:)
-    TYPE(t_field), POINTER :: f_theta_rhodz(:)
-    TYPE(t_field), POINTER :: f_temp(:)
-  
-    REAL(rstd), POINTER :: ps(:)
-    REAL(rstd), POINTER :: theta_rhodz(:,:,:)
-    REAL(rstd), POINTER :: temp(:,:)
-    REAL(rstd), POINTER :: p(:,:)
-    INTEGER :: ind
-
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      ps=f_ps(ind)
-      p=f_p(ind)
-      theta_rhodz=f_theta_rhodz(ind)
-      temp=f_temp(ind)
-
-!$OMP BARRIER
-      CALL compute_pression(ps,p,0)
-!$OMP BARRIER
-      CALL compute_temperature2theta_rhodz(p, temp, theta_rhodz(:,:,1), 0)
-    ENDDO
-!$OMP BARRIER
-  
-  END SUBROUTINE temperature2theta_rhodz
- 
- 
-    
-  SUBROUTINE theta2theta_rhodz(f_ps,f_theta,f_theta_rhodz)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ps(:)
-    TYPE(t_field), POINTER :: f_theta(:)
-    TYPE(t_field), POINTER :: f_theta_rhodz(:)
-  
-    REAL(rstd), POINTER :: ps(:)
-    REAL(rstd), POINTER :: theta(:,:)
-    REAL(rstd), POINTER :: theta_rhodz(:,:)
-    INTEGER :: ind
-
-!$OMP BARRIER
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      ps=f_ps(ind)
-      theta=f_theta(ind)
-      theta_rhodz=f_theta_rhodz(ind)
-      CALL compute_theta2theta_rhodz(ps, theta, theta_rhodz,0)
-    ENDDO
-!$OMP BARRIER
-  
-  END SUBROUTINE theta2theta_rhodz
-  
-  SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset)
-  USE icosa
-  USE disvert_mod
-  USE omp_para
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
-    REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm)
-    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
-    INTEGER,INTENT(IN) :: offset
-    REAL(rstd) :: rhodz
-    INTEGER :: i,j,ij,l
-    
-!$OMP BARRIER
-    DO    l    = ll_begin, ll_end
-      DO j=jj_begin-offset,jj_end+offset
-        DO i=ii_begin-offset,ii_end+offset
-          ij=(j-1)*iim+i
-          rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g
-          theta_rhodz(ij,l) = theta(ij,l) * rhodz
-        ENDDO
-      ENDDO
-    ENDDO
-!$OMP BARRIER
-
-
-  END SUBROUTINE compute_theta2theta_rhodz
-
-  SUBROUTINE compute_theta_rhodz2theta(ps,theta_rhodz,theta,offset)
-  USE icosa
-  USE disvert_mod
-  USE omp_para
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
-    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
-    REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm)
-    INTEGER,INTENT(IN) :: offset
-    REAL(rstd) :: rhodz
-    INTEGER :: i,j,ij,l
-
-!$OMP BARRIER
-    DO    l    = ll_begin, ll_end
-      DO j=jj_begin-offset,jj_end+offset
-        DO i=ii_begin-offset,ii_end+offset
-          ij=(j-1)*iim+i
-          rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g
-          theta(ij,l) = theta_rhodz(ij,l) / rhodz
-        ENDDO
-      ENDDO
-    ENDDO
-!$OMP BARRIER
-
-    
-  END SUBROUTINE compute_theta_rhodz2theta
-
-
-
-
-
-
-  SUBROUTINE compute_theta_rhodz2temperature(p,theta_rhodz,temp,offset)
-  USE icosa
-  USE pression_mod
-  USE exner_mod
-  USE omp_para
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
-    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
-    REAL(rstd),INTENT(OUT) :: temp(iim*jjm,llm)
-    INTEGER,INTENT(IN) :: offset
-    REAL(rstd) :: pk_ij
-    INTEGER :: i,j,ij,l
-        
-! flush p
-!$OMP BARRIER
-    DO    l    = ll_begin, ll_end
-      DO j=jj_begin-offset,jj_end+offset
-        DO i=ii_begin-offset,ii_end+offset
-          ij=(j-1)*iim+i
-          pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa
-          temp(ij,l) = ( theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g) ) * pk_ij
-        ENDDO
-      ENDDO
-    ENDDO
-!$OMP BARRIER
-    
-    
-  END SUBROUTINE compute_theta_rhodz2temperature
-
-  SUBROUTINE compute_temperature2theta_rhodz(p,temp,theta_rhodz,offset)
-  USE icosa
-  USE pression_mod
-  USE exner_mod
-  USE omp_para
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN)  :: p(iim*jjm,llm+1)
-    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
-    REAL(rstd),INTENT(IN)  :: temp(iim*jjm,llm)
-    INTEGER,INTENT(IN) :: offset
-    REAL(rstd) :: pk_ij
-    INTEGER :: i,j,ij,l
-
-        
-! flush p
-!$OMP BARRIER
-
-    DO    l    = ll_begin, ll_end
-      DO j=jj_begin-offset,jj_end+offset
-        DO i=ii_begin-offset,ii_end+offset
-          ij=(j-1)*iim+i
-          pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa
-          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / pk_ij
-        ENDDO
-      ENDDO
-    ENDDO
-!$OMP BARRIER
-    
-  END SUBROUTINE compute_temperature2theta_rhodz
-   
-END MODULE theta2theta_rhodz_mod
Index: codes/icosagcm/devel/src/time.f90
===================================================================
--- codes/icosagcm/devel/src/time.f90	(revision 531)
+++ 	(revision )
@@ -1,176 +1,0 @@
-MODULE time_mod
-  use prec
-  PRIVATE
-
-  INTEGER,SAVE :: ncid
-!$OMP THREADPRIVATE(ncid)  
-  INTEGER,SAVE :: time_counter_id
-!$OMP THREADPRIVATE(time_counter_id)  
-  INTEGER,SAVE :: it
-!$OMP THREADPRIVATE(it)  
-
-  INTEGER,SAVE :: itau0=0
-!$OMP THREADPRIVATE(itau0)  
-
-  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    :: itau_check_conserv
-!$OMP THREADPRIVATE(itau_check_conserv)  
-  
-  INTEGER,SAVE :: day_step,ndays
-!$OMP THREADPRIVATE(day_step,ndays)  
-
-  CHARACTER(LEN=255) :: time_style
-!$OMP THREADPRIVATE(time_style)  
-
-  PUBLIC create_time_counter_header, update_time_counter, close_time_counter, init_time,  &
-         dt, write_period, itau_out, itau_adv, itau_dissip, itau_physics, itaumax,  &
-         itau_check_conserv,  & 
-         day_step,ndays,time_style,itau0
-
-
-
-
-CONTAINS
-  
-  SUBROUTINE init_time
-    USE earth_const
-    USE getin_mod
-    USE mpipara
-    IMPLICIT NONE
-    REAL(rstd) :: run_length
-    
-    dt=90.
-    CALL getin('dt',dt)
-    write_period=0
-    CALL getin('write_period',write_period)
-    itaumax=100
-    CALL getin('itaumax',itaumax)    
-    run_length=dt*itaumax
-    CALL getin('run_length',run_length)
-    itaumax=run_length/dt
-    
-    time_style='dcmip'
-    CALL getin('time_style',time_style)
-    SELECT CASE(TRIM(time_style))
-    CASE('none') ! do nothing
-    CASE('dcmip') ! rescale time step for small-planet experiments
-       dt=dt/scale_factor       
-       write_period=write_period/scale_factor
-       IF (is_mpi_root) PRINT *, 'Output frequency (scaled) set to ',write_period
-    CASE DEFAULT
-       IF (is_mpi_root) PRINT*,"Bad selector for variable time_style >",TRIM(time_style),"> options are <none>, <dcmip>"
-       STOP
-    END SELECT
-    
-    itau_out=FLOOR(.5+write_period/dt)
-    IF (is_mpi_root) PRINT *, 'Output frequency itau_out = ',itau_out
-
-    itau_adv=1
-    CALL getin('itau_adv',itau_adv)
-
-    itau_dissip=1
-    CALL getin('itau_dissip',itau_dissip)
-
-    itau_physics=1
-    CALL getin('itau_physics',itau_physics)
-    if (itau_physics<=0) itau_physics = HUGE(itau_physics)
-
-    itau_check_conserv=HUGE(itau_check_conserv)
-    CALL getin('itau_check_conserv',itau_check_conserv)
-
-    IF (is_mpi_root)  THEN
-       PRINT *, 'itaumax=',itaumax
-       PRINT *, 'itau_adv=',itau_adv, 'itau_dissip=',itau_dissip, 'itau_physics=',itau_physics
-    END IF
-    
-    CALL create_time_counter_header
-    
-  END SUBROUTINE init_time
-
-  SUBROUTINE create_time_counter_header
-  USE netcdf_mod
-  USE prec
-  USE getin_mod
-  USE mpipara
-  IMPLICIT NONE
-  INTEGER :: status
-  INTEGER :: timeid, dtid
-  REAL(rstd) :: dt
-  CHARACTER(LEN=255) :: time_frequency
-
-  IF (no_io) RETURN
-  CALL getin("dt",dt)
-
-!$OMP BARRIER
-!$OMP MASTER  
-    IF (is_mpi_root ) THEN 
-      status = NF90_CREATE('time_counter.nc', NF90_CLOBBER, ncid)
-      status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeid)
-      status = NF90_DEF_VAR(ncid,'time_counter',NF90_DOUBLE,(/ timeid /),time_counter_id)
-      status = NF90_PUT_ATT(ncid,time_counter_id,"long_name","time")
-      status = NF90_PUT_ATT(ncid,time_counter_id,"units","seconds since 2000-01-01 00:00:00")
-      status = NF90_PUT_ATT(ncid,time_counter_id,"calendar","noleap")
-      status = NF90_DEF_VAR(ncid,'mdt',NF90_DOUBLE,varid=dtid)
-
-      WRITE(time_frequency,*) write_period
-      PRINT*,TRIM(time_frequency)
-      status = NF90_PUT_ATT(ncid,NF90_GLOBAL,"time_frequency",TRIM(time_frequency)//"s")
-
-      status = NF90_ENDDEF(ncid) 
-
-      status=NF90_PUT_VAR(ncid,dtid, dt)
-    ENDIF
-    it=0
-!$OMP END MASTER
-!$OMP BARRIER
-
-  END SUBROUTINE create_time_counter_header
-  
-  SUBROUTINE update_time_counter(time)
-  USE netcdf_mod
-  USE mpipara
-  USE prec
-  IMPLICIT NONE
-  REAL(rstd),INTENT(IN) ::time
-  INTEGER :: status
-  REAL(rstd) ::time_array(1)
-
-  IF (no_io) RETURN
-
-!$OMP BARRIER
-!$OMP MASTER
-    time_array(1)=time
-  
-    it=it+1
-    IF (is_mpi_root) THEN 
-      status=NF90_PUT_VAR(ncid,time_counter_id,time_array,start=(/ it /),count=(/ 1 /))
-      status=NF90_SYNC(ncid)
-    ENDIF
-!$OMP END MASTER
-!$OMP BARRIER
-
-  END SUBROUTINE update_time_counter    
-  
-  SUBROUTINE close_time_counter
-  USE netcdf_mod
-  USE mpipara
-  IMPLICIT NONE
-    INTEGER :: status
-
-    IF (no_io) RETURN
-    
-!$OMP BARRIER
-!$OMP MASTER
-     IF (is_mpi_root) status=NF90_CLOSE(ncid)
-!$OMP END MASTER
-!$OMP BARRIER
-    
-  END SUBROUTINE  close_time_counter 
-
-END MODULE time_mod
Index: codes/icosagcm/devel/src/time/euler_scheme.f90
===================================================================
--- codes/icosagcm/devel/src/time/euler_scheme.f90	(revision 533)
+++ codes/icosagcm/devel/src/time/euler_scheme.f90	(revision 533)
@@ -0,0 +1,219 @@
+MODULE euler_scheme_mod
+  USE field_mod
+  IMPLICIT NONE
+  PRIVATE
+
+  TYPE(t_field),POINTER,SAVE,PUBLIC :: f_geopot(:), f_q(:), &
+       f_rhodz(:), f_mass(:), f_massm1(:), f_massm2(:), f_dmass(:), & ! current and previous time steps + tendency of mass,
+       f_phis(:), f_ps(:),f_psm1(:), f_psm2(:), f_dps(:), &           ! column-integrated mass
+       f_u(:),f_um1(:),f_um2(:), f_du(:), f_W(:), &                   ! 'horizontal' and vertical (NH) momentum
+       f_theta_rhodz(:),f_theta_rhodzm1(:),f_theta_rhodzm2(:), f_dtheta_rhodz(:), & ! mass-weighted theta/entropy
+       f_hflux(:), f_wflux(:), f_hfluxt(:), f_wfluxt(:), &            ! accumulated mass fluxes
+       f_du_slow(:,:), f_du_fast(:,:), &                              ! slow/fast trend arrays 
+       f_dmass_slow(:,:), f_dps_slow(:,:), f_dtheta_rhodz_slow(:,:), &! for HEVI time scheme 
+       f_dPhi_slow(:,:), f_dPhi_fast(:,:), &                          ! geopotential tendencies (NH)
+       f_dW_slow(:,:), f_dW_fast(:,:)                                 ! vertical momentum tendencies (NH)
+
+  INTEGER, PARAMETER, PUBLIC :: explicit=1, hevi=2, euler=1, rk4=2, mlf=3, rk25=4, ark23=6, ark33=7
+
+  INTEGER,SAVE, PUBLIC :: nb_stage, matsuno_period, scheme, scheme_family
+  !$OMP THREADPRIVATE(nb_stage, matsuno_period, scheme, scheme_family)
+
+  PUBLIC :: euler_scheme, accumulate_fluxes, legacy_to_DEC, DEC_to_legacy
+CONTAINS
+
+  SUBROUTINE Euler_scheme(with_dps,fluxt_zero)
+    USE icosa
+    USE disvert_mod
+    USE omp_para
+    USE trace
+    LOGICAL :: with_dps
+    LOGICAL, OPTIONAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating fluxes in time
+    REAL(rstd),POINTER :: ps(:), dps(:)
+    REAL(rstd),POINTER :: u(:,:) , du(:,:)
+    REAL(rstd),POINTER :: mass(:,:), dmass(:,:)
+    REAL(rstd),POINTER :: theta_rhodz(:,:,:), dtheta_rhodz(:,:,:)
+    REAL(rstd),POINTER :: hflux(:,:),wflux(:,:),hfluxt(:,:),wfluxt(:,:)
+    INTEGER :: ind
+    INTEGER :: i,j,ij,l
+    CALL trace_start("Euler_scheme")  
+
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+
+       IF(with_dps) THEN ! update ps/mass
+          IF(caldyn_eta==eta_mass) THEN ! update ps
+             ps=f_ps(ind) ; dps=f_dps(ind) ;              
+             IF (is_omp_first_level) THEN
+                !DIR$ SIMD
+                DO ij=ij_begin,ij_end
+                   ps(ij)=ps(ij)+dt*dps(ij)
+                ENDDO
+             ENDIF
+          ELSE ! update mass
+             mass=f_mass(ind) ; dmass=f_dmass(ind) ;              
+             DO l=ll_begin,ll_end
+                !DIR$ SIMD
+                DO ij=ij_begin,ij_end
+                   mass(ij,l)=mass(ij,l)+dt*dmass(ij,l)
+                ENDDO
+             END DO
+          END IF
+
+          hflux=f_hflux(ind);     hfluxt=f_hfluxt(ind)
+          wflux=f_wflux(ind);     wfluxt=f_wfluxt(ind)
+          CALL accumulate_fluxes(hflux,wflux,hfluxt,wfluxt,dt,fluxt_zero(ind))
+       END IF ! update ps/mass
+
+       u=f_u(ind) ; theta_rhodz=f_theta_rhodz(ind)
+       du=f_du(ind) ; dtheta_rhodz=f_dtheta_rhodz(ind)
+
+       DO l=ll_begin,ll_end
+          !DIR$ SIMD
+          DO ij=ij_begin,ij_end
+             u(ij+u_right,l)=u(ij+u_right,l)+dt*du(ij+u_right,l)
+             u(ij+u_lup,l)=u(ij+u_lup,l)+dt*du(ij+u_lup,l)
+             u(ij+u_ldown,l)=u(ij+u_ldown,l)+dt*du(ij+u_ldown,l)
+             theta_rhodz(ij,l,1)=theta_rhodz(ij,l,1)+dt*dtheta_rhodz(ij,l,1)
+          ENDDO
+       ENDDO
+    ENDDO
+
+    CALL trace_end("Euler_scheme")  
+
+  END SUBROUTINE Euler_scheme
+
+  SUBROUTINE accumulate_fluxes(hflux,wflux, hfluxt,wfluxt, tau,fluxt_zero)
+    USE dimensions
+    USE omp_para
+    USE disvert_mod
+    IMPLICIT NONE
+    REAL(rstd), INTENT(IN)    :: hflux(3*iim*jjm,llm), wflux(iim*jjm,llm+1)
+    REAL(rstd), INTENT(INOUT) :: hfluxt(3*iim*jjm,llm), wfluxt(iim*jjm,llm+1)
+    REAL(rstd), INTENT(IN) :: tau
+    LOGICAL, INTENT(INOUT) :: fluxt_zero
+    INTEGER :: l,i,j,ij
+
+    IF(fluxt_zero) THEN
+
+       fluxt_zero=.FALSE.
+
+       DO l=ll_begin,ll_end
+          !DIR$ SIMD
+          DO ij=ij_begin_ext,ij_end_ext
+             hfluxt(ij+u_right,l) = tau*hflux(ij+u_right,l)
+             hfluxt(ij+u_lup,l) = tau*hflux(ij+u_lup,l)
+             hfluxt(ij+u_ldown,l) = tau*hflux(ij+u_ldown,l)
+          ENDDO
+       ENDDO
+
+       IF(caldyn_eta==eta_mass) THEN ! no need for vertical fluxes if eta_lag
+          DO l=ll_begin,ll_endp1
+             !DIR$ SIMD
+             DO ij=ij_begin,ij_end
+                wfluxt(ij,l) = tau*wflux(ij,l)
+             ENDDO
+          ENDDO
+       END IF
+
+    ELSE
+
+       DO l=ll_begin,ll_end
+          !DIR$ SIMD
+          DO ij=ij_begin_ext,ij_end_ext
+             hfluxt(ij+u_right,l) = hfluxt(ij+u_right,l)+tau*hflux(ij+u_right,l)
+             hfluxt(ij+u_lup,l) = hfluxt(ij+u_lup,l)+tau*hflux(ij+u_lup,l)
+             hfluxt(ij+u_ldown,l) = hfluxt(ij+u_ldown,l)+tau*hflux(ij+u_ldown,l)
+          ENDDO
+       ENDDO
+
+       IF(caldyn_eta==eta_mass) THEN ! no need for vertical fluxes if eta_lag
+          DO l=ll_begin,ll_endp1
+             !DIR$ SIMD
+             DO ij=ij_begin,ij_end
+                wfluxt(ij,l) = wfluxt(ij,l)+tau*wflux(ij,l)
+             ENDDO
+          ENDDO
+       END IF
+
+    END IF
+
+  END SUBROUTINE accumulate_fluxes
+
+  SUBROUTINE legacy_to_DEC(f_ps, f_u)
+    USE icosa
+    USE disvert_mod
+    USE omp_para
+    USE trace
+    TYPE(t_field),POINTER :: f_ps(:), f_u(:)
+    REAL(rstd), POINTER :: ps(:), u(:,:)
+    INTEGER :: ind,ij,l
+    CALL trace_start("legacy_to_DEC")
+
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+
+       IF(caldyn_eta==eta_mass .AND. is_omp_first_level) THEN ! update ps
+          ps=f_ps(ind)
+          !DIR$ SIMD
+          DO ij=ij_begin,ij_end
+             ps(ij)=(ps(ij)-ptop)/g ! convert ps to column-integrated mass
+          ENDDO
+       END IF
+
+       u=f_u(ind)
+       DO l=ll_begin,ll_end
+          !DIR$ SIMD
+          DO ij=ij_begin,ij_end
+             u(ij+u_right,l)=u(ij+u_right,l)*de(ij+u_right)
+             u(ij+u_lup,l)=u(ij+u_lup,l)*de(ij+u_lup)
+             u(ij+u_ldown,l)=u(ij+u_ldown,l)*de(ij+u_ldown)
+          ENDDO
+       ENDDO
+    ENDDO
+
+    CALL trace_end("legacy_to_DEC")  
+  END SUBROUTINE Legacy_to_DEC
+
+  SUBROUTINE DEC_to_legacy(f_ps, f_u)
+    USE icosa
+    USE disvert_mod
+    USE omp_para
+    USE trace
+    TYPE(t_field),POINTER :: f_ps(:), f_u(:)
+    REAL(rstd), POINTER :: ps(:), u(:,:)
+    INTEGER :: ind,ij,l
+    CALL trace_start("legacy_to_DEC")
+
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+
+       IF(caldyn_eta==eta_mass .AND. is_omp_first_level) THEN
+          ps=f_ps(ind)
+          !DIR$ SIMD
+          DO ij=ij_begin,ij_end
+             ps(ij)=ptop+ps(ij)*g ! convert column-integrated mass to ps
+          ENDDO
+       ENDIF
+       
+       u=f_u(ind)
+       DO l=ll_begin,ll_end
+          !DIR$ SIMD
+          DO ij=ij_begin,ij_end
+             u(ij+u_right,l)=u(ij+u_right,l)/de(ij+u_right)
+             u(ij+u_lup,l)=u(ij+u_lup,l)/de(ij+u_lup)
+             u(ij+u_ldown,l)=u(ij+u_ldown,l)/de(ij+u_ldown)
+          ENDDO
+       ENDDO
+    ENDDO
+
+    CALL trace_end("DEC_to_legacy")  
+  END SUBROUTINE DEC_to_legacy
+
+END MODULE euler_scheme_mod
Index: codes/icosagcm/devel/src/time/explicit_scheme.f90
===================================================================
--- codes/icosagcm/devel/src/time/explicit_scheme.f90	(revision 533)
+++ codes/icosagcm/devel/src/time/explicit_scheme.f90	(revision 533)
@@ -0,0 +1,225 @@
+MODULE explicit_scheme_mod
+  USE euler_scheme_mod
+  USE prec
+  USE domain_mod
+  USE field_mod
+  IMPLICIT NONE
+  PRIVATE
+
+  REAL(rstd), DIMENSION(4), PARAMETER :: coef_rk4 = (/ .25, 1./3., .5, 1. /)
+  REAL(rstd), DIMENSION(5), PARAMETER :: coef_rk25 = (/ .25, 1./6., 3./8., .5, 1. /)
+
+  PUBLIC :: explicit_scheme
+CONTAINS
+
+  SUBROUTINE explicit_scheme(it, fluxt_zero)
+    USE time_mod
+    USE omp_para
+    USE caldyn_mod
+    USE trace
+    USE dimensions
+    USE geometry
+!    USE caldyn_gcm_mod, ONLY : req_ps, req_mass
+
+    REAL(rstd),POINTER :: q(:,:,:)
+    REAL(rstd),POINTER :: phis(:), ps(:) ,psm1(:), psm2(:), dps(:)
+    REAL(rstd),POINTER :: u(:,:) , um1(:,:), um2(:,:), du(:,:)
+    REAL(rstd),POINTER :: rhodz(:,:), mass(:,:), massm1(:,:), massm2(:,:), dmass(:,:)
+    REAL(rstd),POINTER :: theta_rhodz(:,:,:) , theta_rhodzm1(:,:,:), theta_rhodzm2(:,:,:), dtheta_rhodz(:,:,:)
+    REAL(rstd),POINTER :: hflux(:,:),wflux(:,:),hfluxt(:,:),wfluxt(:,:)
+    LOGICAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating fluxes in time
+    INTEGER :: it,stage
+    
+    CALL legacy_to_DEC(f_ps, f_u)
+    DO stage=1,nb_stage
+       !       CALL checksum(f_ps)
+       !       CALL checksum(f_theta_rhodz)
+       !       CALL checksum(f_mass)
+       CALL caldyn((stage==1) .AND. (MOD(it,itau_out)==0), &
+            f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q, &
+            f_geopot, f_hflux, f_wflux, f_dps, f_dmass, f_dtheta_rhodz, f_du)
+       !       CALL checksum(f_dps)
+       !       CALL checksum(f_dtheta_rhodz)
+       !       CALL checksum(f_dmass)
+       SELECT CASE (scheme)
+       CASE(euler)
+          CALL euler_scheme(.TRUE., fluxt_zero)
+       CASE (rk4)
+          CALL rk_scheme(stage, coef_rk4)
+       CASE (rk25)
+          CALL rk_scheme(stage, coef_rk25)
+       CASE (mlf)
+          CALL  leapfrog_matsuno_scheme(stage)
+       CASE DEFAULT
+          STOP
+       END SELECT
+    END DO
+    CALL DEC_to_legacy(f_ps, f_u)
+
+  CONTAINS
+
+    SUBROUTINE RK_scheme(stage,coef)
+      USE disvert_mod
+      INTEGER :: ind, stage
+      REAL(rstd), INTENT(IN) :: coef(:)
+      REAL(rstd) :: tau
+      INTEGER :: i,j,ij,l
+
+      CALL trace_start("RK_scheme")  
+
+      tau = dt*coef(stage)
+
+      ! if mass coordinate, deal with ps first on one core
+      IF(caldyn_eta==eta_mass) THEN
+         IF (is_omp_first_level) THEN
+
+            DO ind=1,ndomain
+               IF (.NOT. assigned_domain(ind)) CYCLE
+               CALL swap_dimensions(ind)
+               CALL swap_geometry(ind)
+               ps=f_ps(ind) ; psm1=f_psm1(ind) ; dps=f_dps(ind) 
+
+               IF (stage==1) THEN ! first stage : save model state in XXm1
+                  !DIR$ SIMD
+                  DO ij=ij_begin,ij_end
+                     psm1(ij)=ps(ij)
+                  ENDDO
+               ENDIF
+
+               ! updates are of the form x1 := x0 + tau*f(x1)
+               !DIR$ SIMD
+               DO ij=ij_begin,ij_end
+                  ps(ij)=psm1(ij)+tau*dps(ij)
+               ENDDO
+            ENDDO
+         ENDIF
+         !         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)
+            mass=f_mass(ind); dmass=f_dmass(ind); massm1=f_massm1(ind)
+
+            IF (stage==1) THEN ! first stage : save model state in XXm1
+               DO l=ll_begin,ll_end
+                  !DIR$ SIMD
+                  DO ij=ij_begin,ij_end
+                     massm1(ij,l)=mass(ij,l)
+                  ENDDO
+               ENDDO
+            END IF
+
+            ! updates are of the form x1 := x0 + tau*f(x1)
+            DO l=ll_begin,ll_end
+               !DIR$ SIMD
+               DO ij=ij_begin,ij_end
+                  mass(ij,l)=massm1(ij,l)+tau*dmass(ij,l)
+               ENDDO
+            ENDDO
+         END DO
+         !         CALL send_message(f_mass,req_mass)
+         !ym no overlap for now         
+         !         CALL wait_message(req_mass)  
+
+      END IF
+
+      ! now deal with other prognostic variables
+      DO ind=1,ndomain
+         IF (.NOT. assigned_domain(ind)) CYCLE
+         CALL swap_dimensions(ind)
+         CALL swap_geometry(ind)
+         u=f_u(ind)      ; du=f_du(ind)      ; um1=f_um1(ind) 
+         theta_rhodz=f_theta_rhodz(ind)
+         theta_rhodzm1=f_theta_rhodzm1(ind)
+         dtheta_rhodz=f_dtheta_rhodz(ind)
+
+         IF (stage==1) THEN ! first stage : save model state in XXm1
+            DO l=ll_begin,ll_end
+               !DIR$ SIMD
+               DO ij=ij_begin,ij_end
+                  um1(ij+u_right,l)=u(ij+u_right,l)
+                  um1(ij+u_lup,l)=u(ij+u_lup,l)
+                  um1(ij+u_ldown,l)=u(ij+u_ldown,l)
+                  theta_rhodzm1(ij,l,1)=theta_rhodz(ij,l,1)
+               ENDDO
+            ENDDO
+         END IF
+
+         DO l=ll_begin,ll_end
+            !DIR$ SIMD
+            DO ij=ij_begin,ij_end
+               u(ij+u_right,l)=um1(ij+u_right,l)+tau*du(ij+u_right,l)
+               u(ij+u_lup,l)=um1(ij+u_lup,l)+tau*du(ij+u_lup,l)
+               u(ij+u_ldown,l)=um1(ij+u_ldown,l)+tau*du(ij+u_ldown,l)
+               theta_rhodz(ij,l,1)=theta_rhodzm1(ij,l,1)+tau*dtheta_rhodz(ij,l,1)
+            ENDDO
+         ENDDO
+
+         IF(stage==nb_stage) THEN ! accumulate mass fluxes at last stage
+            hflux=f_hflux(ind);     hfluxt=f_hfluxt(ind)
+            wflux=f_wflux(ind);     wfluxt=f_wfluxt(ind)
+            CALL accumulate_fluxes(hflux,wflux, hfluxt,wfluxt, dt,fluxt_zero(ind))
+         END IF
+      END DO
+
+      CALL trace_end("RK_scheme")
+
+    END SUBROUTINE RK_scheme
+
+    SUBROUTINE leapfrog_matsuno_scheme(stage)
+      IMPLICIT NONE
+      INTEGER :: ind, stage
+      REAL :: tau
+
+      CALL trace_start("leapfrog_matsuno_scheme")
+
+      tau = dt/nb_stage
+      DO ind=1,ndomain
+         IF (.NOT. assigned_domain(ind)) CYCLE
+         CALL swap_dimensions(ind)
+         CALL swap_geometry(ind)
+
+         ps=f_ps(ind)   ; u=f_u(ind)   ; theta_rhodz=f_theta_rhodz(ind)
+         psm1=f_psm1(ind) ; um1=f_um1(ind) ; theta_rhodzm1=f_theta_rhodzm1(ind)
+         psm2=f_psm2(ind) ; um2=f_um2(ind) ; theta_rhodzm2=f_theta_rhodzm2(ind)
+         dps=f_dps(ind) ; du=f_du(ind) ; dtheta_rhodz=f_dtheta_rhodz(ind)
+
+
+         IF (stage==1) THEN
+            psm1(:)=ps(:) ; um1(:,:)=u(:,:) ; theta_rhodzm1(:,:,:)=theta_rhodz(:,:,:)
+            ps(:)=psm1(:)+tau*dps(:)
+            u(:,:)=um1(:,:)+tau*du(:,:)
+            theta_rhodz(:,:,:)=theta_rhodzm1(:,:,:)+tau*dtheta_rhodz(:,:,:)
+
+         ELSE IF (stage==2) THEN
+
+            ps(:)=psm1(:)+tau*dps(:)
+            u(:,:)=um1(:,:)+tau*du(:,:)
+            theta_rhodz(:,:,:)=theta_rhodzm1(:,:,:)+tau*dtheta_rhodz(:,:,:)
+
+            psm2(:)=psm1(:) ; theta_rhodzm2(:,:,:)=theta_rhodzm1(:,:,:) ; um2(:,:)=um1(:,:) 
+            psm1(:)=ps(:) ; theta_rhodzm1(:,:,:)=theta_rhodz(:,:,:) ; um1(:,:)=u(:,:) 
+
+         ELSE 
+
+            ps(:)=psm2(:)+2*tau*dps(:)
+            u(:,:)=um2(:,:)+2*tau*du(:,:)
+            theta_rhodz(:,:,:)=theta_rhodzm2(:,:,:)+2*tau*dtheta_rhodz(:,:,:)
+
+            psm2(:)=psm1(:) ; theta_rhodzm2(:,:,:)=theta_rhodzm1(:,:,:) ; um2(:,:)=um1(:,:) 
+            psm1(:)=ps(:) ; theta_rhodzm1(:,:,:)=theta_rhodz(:,:,:) ; um1(:,:)=u(:,:) 
+
+         ENDIF
+
+      ENDDO
+      CALL trace_end("leapfrog_matsuno_scheme")
+
+    END SUBROUTINE leapfrog_matsuno_scheme
+
+  END SUBROUTINE Explicit_scheme
+
+END MODULE explicit_scheme_mod
Index: codes/icosagcm/devel/src/time/hevi_scheme.f90
===================================================================
--- codes/icosagcm/devel/src/time/hevi_scheme.f90	(revision 533)
+++ codes/icosagcm/devel/src/time/hevi_scheme.f90	(revision 533)
@@ -0,0 +1,169 @@
+MODULE hevi_scheme_mod
+  USE prec
+  USE domain_mod
+  USE field_mod
+  USE euler_scheme_mod
+  IMPLICIT NONE
+  PRIVATE
+
+  REAL(rstd), SAVE :: wj(3), bjl(3,3), cjl(3,3), taujj(3)
+  REAL(rstd), PARAMETER, DIMENSION(3) :: zero = (/0.,0.,0./)
+
+  PUBLIC :: set_coefs_ark23, set_coefs_ark33, hevi_scheme
+
+CONTAINS
+
+  SUBROUTINE set_coefs_ark23(dt)
+    ! ARK2 scheme by Giraldo, Kelly, Constantinescu 2013
+    ! See Weller et al., 2013 - ARK2 scheme Fig. 2
+    REAL(rstd) :: dt
+    REAL(rstd), PARAMETER :: delta=.5/SQRT(2.), gamma=1.-2.*delta
+!    REAL(rstd), PARAMETER :: alpha=(3.+SQRT(8.))/6. ! original value in GKC2013
+    REAL(rstd), PARAMETER :: alpha=0.7
+    REAL(rstd), PARAMETER, DIMENSION(3) :: wj = (/delta,delta,gamma/)
+    CALL set_coefs_hevi(dt, &
+         (/ zero, (/2.*gamma,0.,0./), (/1-alpha,alpha,0./), wj /), &
+         (/ zero, (/gamma,gamma,0./), wj, wj /) )
+  END SUBROUTINE set_coefs_ark23
+
+  SUBROUTINE set_coefs_ark33(dt)
+    ! Fully-explicit RK3 scheme disguised as ARK
+    REAL(rstd) :: dt
+    CALL set_coefs_rk(dt, (/ zero, (/.5,0.,0./), (/-1.,2.,0./), (/1./6.,2./3.,1./6./) /) )
+  END SUBROUTINE set_coefs_ark33
+    
+  SUBROUTINE set_coefs_rk(dt, ajl)
+    REAL(rstd) :: dt, ajl(3,4)
+    CALL set_coefs_hevi(dt,ajl,ajl)
+  END SUBROUTINE set_coefs_rk
+
+  SUBROUTINE set_coefs_hevi(dt, ajl_slow, ajl_fast)
+    REAL(rstd) :: dt, ajl_slow(3,4), ajl_fast(3,4) ! fast/slow Butcher tableaus
+    INTEGER :: j
+    DO j=1,3
+       bjl(:,j) = dt*(ajl_slow(:,j+1)-ajl_slow(:,j))
+       cjl(:,j) = dt*(ajl_fast(:,j+1)-ajl_fast(:,j))
+       taujj(j) = dt*ajl_fast(j,j)
+    END DO
+    wj=dt*ajl_slow(:,4)
+  END SUBROUTINE set_coefs_hevi
+
+  SUBROUTINE HEVI_scheme(it, fluxt_zero)
+    USE time_mod
+    USE disvert_mod
+    USE caldyn_hevi_mod
+    USE omp_para
+    USE checksum_mod
+    LOGICAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating fluxes in time
+    INTEGER :: it,j,l, ind
+    REAL(rstd),POINTER :: hflux(:,:),wflux(:,:),hfluxt(:,:),wfluxt(:,:)
+
+    CALL legacy_to_DEC(f_ps, f_u)
+    DO j=1,nb_stage
+       CALL caldyn_hevi((j==1) .AND. (MOD(it,itau_out)==0), taujj(j), &
+            f_phis, f_ps,f_mass,f_theta_rhodz,f_u,f_q, &
+            f_W, f_geopot, f_hflux, f_wflux, &
+            f_dps_slow(:,j), f_dmass_slow(:,j), f_dtheta_rhodz_slow(:,j), &
+            f_du_slow(:,j), f_du_fast(:,j), &
+            f_dPhi_slow(:,j), f_dPhi_fast(:,j), &
+            f_dW_slow(:,j), f_dW_fast(:,j) )
+       ! accumulate mass fluxes for transport scheme
+       
+       DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+          CALL swap_dimensions(ind)
+          hflux=f_hflux(ind);     hfluxt=f_hfluxt(ind)
+          wflux=f_wflux(ind);     wfluxt=f_wfluxt(ind)
+          CALL accumulate_fluxes(hflux,wflux, hfluxt,wfluxt, wj(j), fluxt_zero(ind))
+       END DO
+       ! update model state
+       DO l=1,j
+          IF(caldyn_eta==eta_mass) THEN
+             CALL update_2D(bjl(l,j), f_ps, f_dps_slow(:,l))
+          ELSE
+             CALL update_3D(bjl(l,j), f_mass, f_dmass_slow(:,l))
+          END IF
+          CALL update_4D(bjl(l,j), f_theta_rhodz, f_dtheta_rhodz_slow(:,l))
+          CALL update_3D(bjl(l,j), f_u, f_du_slow(:,l))
+          CALL update_3D(cjl(l,j), f_u, f_du_fast(:,l))
+          IF(.NOT. hydrostatic) THEN
+             CALL update_3D(bjl(l,j), f_W, f_dW_slow(:,l))
+             CALL update_3D(cjl(l,j), f_W, f_dW_fast(:,l))
+             CALL update_3D(bjl(l,j), f_geopot, f_dPhi_slow(:,l))
+             CALL update_3D(cjl(l,j), f_geopot, f_dPhi_fast(:,l))
+          END IF
+!$OMP BARRIER       
+       END DO
+    END DO
+    CALL DEC_to_legacy(f_ps, f_u)
+  END SUBROUTINE HEVI_scheme
+  
+  SUBROUTINE update_4D(w, f_y, f_dy)
+    USE dimensions
+    USE grid_param, ONLY : nqdyn
+    REAL(rstd) :: w
+    TYPE(t_field) :: f_y(:), f_dy(:)
+    REAL(rstd), POINTER :: y(:,:,:), dy(:,:,:)
+    INTEGER :: ind, iq
+    IF(w /= 0.) THEN
+       DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+          CALL swap_dimensions(ind)
+          dy=f_dy(ind); y=f_y(ind)
+          DO iq=1,nqdyn
+             CALL compute_update_3D(w,y(:,:,iq),dy(:,:,iq))
+          END DO
+       ENDDO
+    END IF
+  END SUBROUTINE update_4D
+    
+  SUBROUTINE update_3D(w, f_y, f_dy)
+    USE dimensions
+    REAL(rstd) :: w
+    TYPE(t_field) :: f_y(:), f_dy(:)
+    REAL(rstd), POINTER :: y(:,:), dy(:,:)
+    INTEGER :: ind
+    IF(w /= 0.) THEN
+       DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+          CALL swap_dimensions(ind)
+          dy=f_dy(ind); y=f_y(ind)
+          CALL compute_update_3D(w,y,dy)
+       ENDDO
+    END IF
+  END SUBROUTINE update_3D
+    
+  SUBROUTINE compute_update_3D(w, y, dy)
+    USE omp_para
+    USE disvert_mod
+    REAL(rstd) :: w
+    REAL(rstd) :: y(:,:), dy(:,:)
+    INTENT(INOUT) :: y
+    INTENT(IN) :: dy
+    INTEGER :: l
+    DO l=ll_begin,ll_end
+       y(:,l)=y(:,l)+w*dy(:,l)
+    ENDDO
+  END SUBROUTINE compute_update_3D
+  
+  SUBROUTINE update_2D(w, f_y, f_dy)
+  USE omp_para
+    REAL(rstd) :: w
+    TYPE(t_field) :: f_y(:), f_dy(:)
+    REAL(rstd), POINTER :: y(:), dy(:)
+    INTEGER :: ind
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       dy=f_dy(ind); y=f_y(ind)
+       IF (is_omp_level_master) CALL compute_update_2D(w,y,dy)
+    ENDDO
+  END SUBROUTINE update_2D
+    
+  SUBROUTINE compute_update_2D(w, y, dy)
+    REAL(rstd) :: w, y(:), dy(:)
+    INTENT(INOUT) :: y
+    INTENT(IN) :: dy
+    y(:)=y(:)+w*dy(:)
+  END SUBROUTINE compute_update_2D
+  
+END MODULE hevi_scheme_mod
Index: codes/icosagcm/devel/src/time/time.f90
===================================================================
--- codes/icosagcm/devel/src/time/time.f90	(revision 533)
+++ codes/icosagcm/devel/src/time/time.f90	(revision 533)
@@ -0,0 +1,176 @@
+MODULE time_mod
+  use prec
+  PRIVATE
+
+  INTEGER,SAVE :: ncid
+!$OMP THREADPRIVATE(ncid)  
+  INTEGER,SAVE :: time_counter_id
+!$OMP THREADPRIVATE(time_counter_id)  
+  INTEGER,SAVE :: it
+!$OMP THREADPRIVATE(it)  
+
+  INTEGER,SAVE :: itau0=0
+!$OMP THREADPRIVATE(itau0)  
+
+  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    :: itau_check_conserv
+!$OMP THREADPRIVATE(itau_check_conserv)  
+  
+  INTEGER,SAVE :: day_step,ndays
+!$OMP THREADPRIVATE(day_step,ndays)  
+
+  CHARACTER(LEN=255) :: time_style
+!$OMP THREADPRIVATE(time_style)  
+
+  PUBLIC create_time_counter_header, update_time_counter, close_time_counter, init_time,  &
+         dt, write_period, itau_out, itau_adv, itau_dissip, itau_physics, itaumax,  &
+         itau_check_conserv,  & 
+         day_step,ndays,time_style,itau0
+
+
+
+
+CONTAINS
+  
+  SUBROUTINE init_time
+    USE earth_const
+    USE getin_mod
+    USE mpipara
+    IMPLICIT NONE
+    REAL(rstd) :: run_length
+    
+    dt=90.
+    CALL getin('dt',dt)
+    write_period=0
+    CALL getin('write_period',write_period)
+    itaumax=100
+    CALL getin('itaumax',itaumax)    
+    run_length=dt*itaumax
+    CALL getin('run_length',run_length)
+    itaumax=run_length/dt
+    
+    time_style='dcmip'
+    CALL getin('time_style',time_style)
+    SELECT CASE(TRIM(time_style))
+    CASE('none') ! do nothing
+    CASE('dcmip') ! rescale time step for small-planet experiments
+       dt=dt/scale_factor       
+       write_period=write_period/scale_factor
+       IF (is_mpi_root) PRINT *, 'Output frequency (scaled) set to ',write_period
+    CASE DEFAULT
+       IF (is_mpi_root) PRINT*,"Bad selector for variable time_style >",TRIM(time_style),"> options are <none>, <dcmip>"
+       STOP
+    END SELECT
+    
+    itau_out=FLOOR(.5+write_period/dt)
+    IF (is_mpi_root) PRINT *, 'Output frequency itau_out = ',itau_out
+
+    itau_adv=1
+    CALL getin('itau_adv',itau_adv)
+
+    itau_dissip=1
+    CALL getin('itau_dissip',itau_dissip)
+
+    itau_physics=1
+    CALL getin('itau_physics',itau_physics)
+    if (itau_physics<=0) itau_physics = HUGE(itau_physics)
+
+    itau_check_conserv=HUGE(itau_check_conserv)
+    CALL getin('itau_check_conserv',itau_check_conserv)
+
+    IF (is_mpi_root)  THEN
+       PRINT *, 'itaumax=',itaumax
+       PRINT *, 'itau_adv=',itau_adv, 'itau_dissip=',itau_dissip, 'itau_physics=',itau_physics
+    END IF
+    
+    CALL create_time_counter_header
+    
+  END SUBROUTINE init_time
+
+  SUBROUTINE create_time_counter_header
+  USE netcdf_mod
+  USE prec
+  USE getin_mod
+  USE mpipara
+  IMPLICIT NONE
+  INTEGER :: status
+  INTEGER :: timeid, dtid
+  REAL(rstd) :: dt
+  CHARACTER(LEN=255) :: time_frequency
+
+  IF (no_io) RETURN
+  CALL getin("dt",dt)
+
+!$OMP BARRIER
+!$OMP MASTER  
+    IF (is_mpi_root ) THEN 
+      status = NF90_CREATE('time_counter.nc', NF90_CLOBBER, ncid)
+      status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeid)
+      status = NF90_DEF_VAR(ncid,'time_counter',NF90_DOUBLE,(/ timeid /),time_counter_id)
+      status = NF90_PUT_ATT(ncid,time_counter_id,"long_name","time")
+      status = NF90_PUT_ATT(ncid,time_counter_id,"units","seconds since 2000-01-01 00:00:00")
+      status = NF90_PUT_ATT(ncid,time_counter_id,"calendar","noleap")
+      status = NF90_DEF_VAR(ncid,'mdt',NF90_DOUBLE,varid=dtid)
+
+      WRITE(time_frequency,*) write_period
+      PRINT*,TRIM(time_frequency)
+      status = NF90_PUT_ATT(ncid,NF90_GLOBAL,"time_frequency",TRIM(time_frequency)//"s")
+
+      status = NF90_ENDDEF(ncid) 
+
+      status=NF90_PUT_VAR(ncid,dtid, dt)
+    ENDIF
+    it=0
+!$OMP END MASTER
+!$OMP BARRIER
+
+  END SUBROUTINE create_time_counter_header
+  
+  SUBROUTINE update_time_counter(time)
+  USE netcdf_mod
+  USE mpipara
+  USE prec
+  IMPLICIT NONE
+  REAL(rstd),INTENT(IN) ::time
+  INTEGER :: status
+  REAL(rstd) ::time_array(1)
+
+  IF (no_io) RETURN
+
+!$OMP BARRIER
+!$OMP MASTER
+    time_array(1)=time
+  
+    it=it+1
+    IF (is_mpi_root) THEN 
+      status=NF90_PUT_VAR(ncid,time_counter_id,time_array,start=(/ it /),count=(/ 1 /))
+      status=NF90_SYNC(ncid)
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+
+  END SUBROUTINE update_time_counter    
+  
+  SUBROUTINE close_time_counter
+  USE netcdf_mod
+  USE mpipara
+  IMPLICIT NONE
+    INTEGER :: status
+
+    IF (no_io) RETURN
+    
+!$OMP BARRIER
+!$OMP MASTER
+     IF (is_mpi_root) status=NF90_CLOSE(ncid)
+!$OMP END MASTER
+!$OMP BARRIER
+    
+  END SUBROUTINE  close_time_counter 
+
+END MODULE time_mod
Index: codes/icosagcm/devel/src/time/timeloop_gcm.f90
===================================================================
--- codes/icosagcm/devel/src/time/timeloop_gcm.f90	(revision 533)
+++ codes/icosagcm/devel/src/time/timeloop_gcm.f90	(revision 533)
@@ -0,0 +1,408 @@
+MODULE timeloop_gcm_mod
+  USE icosa
+  USE disvert_mod
+  USE trace
+  USE omp_para
+  USE euler_scheme_mod
+  USE explicit_scheme_mod
+  USE hevi_scheme_mod
+  IMPLICIT NONE
+  PRIVATE
+  
+  INTEGER, PARAMETER :: itau_sync=10
+  TYPE(t_message),SAVE :: req_ps0, req_mass0, req_theta_rhodz0, req_u0, req_q0, req_W0, req_geopot0
+  LOGICAL, SAVE :: positive_theta
+
+  PUBLIC :: init_timeloop, timeloop
+
+CONTAINS
+  
+  SUBROUTINE init_timeloop
+    USE dissip_gcm_mod
+    USE observable_mod
+    USE caldyn_mod
+    USE etat0_mod
+    USE guided_mod
+    USE advect_tracer_mod
+    USE check_conserve_mod
+    USE output_field_mod
+    USE theta2theta_rhodz_mod
+    USE sponge_mod
+
+    CHARACTER(len=255) :: def
+
+    CALL init_caldyn
+    
+!    IF (xios_output) itau_out=1
+    IF (.NOT. enable_io) itau_out=HUGE(itau_out)
+
+    positive_theta=.FALSE.
+    CALL getin('positive_theta',positive_theta)
+    IF(positive_theta .AND. nqtot<1) THEN
+       PRINT *, 'nqtot must be >0 if positive_theta is .TRUE.'
+       STOP
+    END IF
+
+    def='ARK2.3'
+    CALL getin('time_scheme',def)
+    SELECT CASE (TRIM(def))
+    CASE('euler')
+       scheme_family=explicit
+       scheme=euler
+       nb_stage=1
+    CASE ('runge_kutta')
+       scheme_family=explicit
+       scheme=rk4
+       nb_stage=4
+    CASE ('RK2.5')
+       scheme_family=explicit
+       scheme=rk25
+       nb_stage=5
+    CASE ('leapfrog_matsuno')
+       scheme_family=explicit
+       scheme=mlf
+       matsuno_period=5
+       CALL getin('matsuno_period',matsuno_period)
+       nb_stage=matsuno_period+1
+    CASE('ARK2.3')
+       scheme_family=hevi
+       scheme=ark23
+       nb_stage=3
+       CALL set_coefs_ark23(dt)
+    CASE('ARK3.3')
+       scheme_family=hevi
+       scheme=ark33
+       nb_stage=3
+       CALL set_coefs_ark33(dt)
+    CASE ('none')
+       nb_stage=0
+    CASE default
+       PRINT*,'Bad selector for variable scheme : <', TRIM(def),             &
+            ' > options are <euler>, <runge_kutta>, <leapfrog_matsuno>,<RK2.5>,<ARK2.3>'
+       STOP
+    END SELECT
+    
+    ! Time-independant orography
+    CALL allocate_field(f_phis,field_t,type_real,name='phis')
+    ! Model state at current time step
+    CALL allocate_field(f_ps,field_t,type_real, name='ps')
+    CALL allocate_field(f_mass,field_t,type_real,llm,name='mass')
+    CALL allocate_field(f_rhodz,field_t,type_real,llm,name='rhodz')
+    CALL allocate_field(f_theta_rhodz,field_t,type_real,llm,nqdyn,name='theta_rhodz')
+    CALL allocate_field(f_u,field_u,type_real,llm,name='u')
+    CALL allocate_field(f_geopot,field_t,type_real,llm+1,name='geopot')
+    CALL allocate_field(f_W,field_t,type_real,llm+1,name='W')
+    CALL allocate_field(f_q,field_t,type_real,llm,nqtot,'q')
+    ! Mass fluxes
+    CALL allocate_field(f_hflux,field_u,type_real,llm)    ! instantaneous mass fluxes
+    CALL allocate_field(f_hfluxt,field_u,type_real,llm)   ! mass "fluxes" accumulated in time
+    CALL allocate_field(f_wflux,field_t,type_real,llm+1)  ! vertical mass fluxes
+    CALL allocate_field(f_wfluxt,field_t,type_real,llm+1,name='wfluxt')
+    
+    SELECT CASE(scheme_family)
+    CASE(explicit)
+       ! Trends
+       CALL allocate_field(f_dps,field_t,type_real,name='dps')
+       CALL allocate_field(f_dmass,field_t,type_real,llm, name='dmass')
+       CALL allocate_field(f_dtheta_rhodz,field_t,type_real,llm,nqdyn,name='dtheta_rhodz')
+       CALL allocate_field(f_du,field_u,type_real,llm,name='du')
+       ! Model state at previous time step (RK/MLF)
+       CALL allocate_field(f_psm1,field_t,type_real,name='psm1')
+       CALL allocate_field(f_massm1,field_t,type_real,llm, name='massm1')
+       CALL allocate_field(f_theta_rhodzm1,field_t,type_real,llm,nqdyn,name='theta_rhodzm1')
+       CALL allocate_field(f_um1,field_u,type_real,llm,name='um1')
+    CASE(hevi)
+       ! Trends
+       CALL allocate_fields(nb_stage,f_dps_slow, field_t,type_real,name='dps_slow')
+       CALL allocate_fields(nb_stage,f_dmass_slow, field_t,type_real,llm, name='dmass_slow')
+       CALL allocate_fields(nb_stage,f_dtheta_rhodz_slow, field_t,type_real,llm,nqdyn,name='dtheta_rhodz_fast')
+       CALL allocate_fields(nb_stage,f_du_slow, field_u,type_real,llm,name='du_slow')
+       CALL allocate_fields(nb_stage,f_du_fast, field_u,type_real,llm,name='du_fast')
+       CALL allocate_fields(nb_stage,f_dW_slow, field_t,type_real,llm+1,name='dW_slow')
+       CALL allocate_fields(nb_stage,f_dW_fast, field_t,type_real,llm+1,name='dW_fast')
+       CALL allocate_fields(nb_stage,f_dPhi_slow, field_t,type_real,llm+1,name='dPhi_slow')
+       CALL allocate_fields(nb_stage,f_dPhi_fast, field_t,type_real,llm+1,name='dPhi_fast')
+       f_dps => f_dps_slow(:,1)
+       f_du => f_du_slow(:,1)
+       f_dtheta_rhodz => f_dtheta_rhodz_slow(:,1)
+    END SELECT
+
+    SELECT CASE(scheme)
+    CASE(mlf)
+       ! Model state 2 time steps ago (MLF)
+       CALL allocate_field(f_psm2,field_t,type_real)
+       CALL allocate_field(f_massm2,field_t,type_real,llm)
+       CALL allocate_field(f_theta_rhodzm2,field_t,type_real,llm,nqdyn)
+       CALL allocate_field(f_um2,field_u,type_real,llm)
+    END SELECT
+
+    CALL init_theta2theta_rhodz
+    CALL init_dissip
+    CALL init_sponge
+    CALL init_observable
+    CALL init_guided
+    CALL init_advect_tracer
+    CALL init_check_conserve
+
+    CALL etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_geopot,f_W, f_q)
+
+    CALL transfert_request(f_phis,req_i0) 
+    CALL transfert_request(f_phis,req_i1) 
+
+    CALL init_message(f_ps,req_i0,req_ps0)
+    CALL init_message(f_mass,req_i0,req_mass0)
+    CALL init_message(f_theta_rhodz,req_i0,req_theta_rhodz0)
+    CALL init_message(f_u,req_e0_vect,req_u0)
+    CALL init_message(f_q,req_i0,req_q0)
+    CALL init_message(f_geopot,req_i0,req_geopot0)
+    CALL init_message(f_W,req_i0,req_W0)
+
+  END SUBROUTINE init_timeloop
+  
+  SUBROUTINE timeloop
+    USE dissip_gcm_mod
+    USE sponge_mod
+    USE observable_mod
+    USE etat0_mod
+    USE guided_mod
+    USE caldyn_mod
+    USE advect_tracer_mod
+    USE physics_mod
+    USE mpipara
+    USE transfert_mod
+    USE check_conserve_mod
+    USE xios_mod
+    USE output_field_mod
+    USE write_etat0_mod
+    USE restart_mod
+    USE checksum_mod
+    USE explicit_scheme_mod
+    USE hevi_scheme_mod
+    REAL(rstd),POINTER :: rhodz(:,:), mass(:,:), ps(:)
+
+    INTEGER :: ind
+    INTEGER :: it,i,j,l,n,  stage
+    LOGICAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating fluxes in time
+    LOGICAL, PARAMETER :: check_rhodz=.FALSE.
+    INTEGER :: start_clock, stop_clock, rate_clock
+    LOGICAL,SAVE :: first_physic=.TRUE.
+    !$OMP THREADPRIVATE(first_physic)    
+
+    CALL switch_omp_distrib_level
+    CALL caldyn_BC(f_phis, f_geopot, f_wflux) ! set constant values in first/last interfaces
+
+    !$OMP BARRIER
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       rhodz=f_rhodz(ind); mass=f_mass(ind); ps=f_ps(ind)
+       IF(caldyn_eta==eta_mass) THEN
+          CALL compute_rhodz(.TRUE., ps, rhodz) ! save rhodz for transport scheme before dynamics update ps
+       ELSE
+          DO l=ll_begin,ll_end
+             rhodz(:,l)=mass(:,l)
+          ENDDO
+       END IF
+    END DO
+    !$OMP BARRIER
+    fluxt_zero=.TRUE.
+
+    IF(positive_theta) CALL copy_theta_to_q(f_theta_rhodz,f_rhodz,f_q)
+
+    CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,itau0)  
+
+    CALL trace_on
+
+    IF (xios_output) THEN ! we must call update_calendar before any XIOS output
+      IF (is_omp_master) CALL xios_update_calendar(1)
+    END IF
+    
+    IF (write_start) CALL write_etat0(itau0,f_ps, f_phis,f_theta_rhodz,f_u,f_q)  ! FIXME : write_start undefined
+   
+    CALL write_output_fields_basic(.TRUE., f_phis, f_ps, f_mass, f_geopot, f_theta_rhodz, f_u, f_W, f_q)
+
+    !$OMP MASTER
+    CALL SYSTEM_CLOCK(start_clock)
+    CALL SYSTEM_CLOCK(count_rate=rate_clock)
+    !$OMP END MASTER   
+
+    DO it=itau0+1,itau0+itaumax
+
+       IF (is_master) CALL print_iteration(it, itau0, itaumax, start_clock, rate_clock)
+
+       IF (xios_output) THEN
+
+          IF(it>itau0+1 .AND. is_omp_master) CALL xios_update_calendar(it-itau0)
+       ELSE
+          CALL update_time_counter(dt*it)
+       END IF
+
+       IF (it==itau0+1 .OR. 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_q0)
+          IF(.NOT. hydrostatic) THEN
+             CALL send_message(f_geopot,req_geopot0)
+             CALL wait_message(req_geopot0)
+             CALL send_message(f_W,req_W0)
+             CALL wait_message(req_W0)
+          END IF
+       ENDIF
+
+       CALL guided(it*dt,f_ps,f_theta_rhodz,f_u,f_q)
+
+       SELECT CASE(scheme_family)
+       CASE(explicit)
+          CALL explicit_scheme(it, fluxt_zero)
+       CASE(hevi)
+          CALL HEVI_scheme(it, fluxt_zero)
+       END SELECT
+       
+       IF (MOD(it,itau_dissip)==0) THEN
+          
+          IF(caldyn_eta==eta_mass) THEN
+             !ym flush ps
+             !$OMP BARRIER
+             DO ind=1,ndomain
+                IF (.NOT. assigned_domain(ind)) CYCLE
+                CALL swap_dimensions(ind)
+                CALL swap_geometry(ind)
+                mass=f_mass(ind); ps=f_ps(ind);
+                CALL compute_rhodz(.TRUE., ps, mass)
+             END DO
+          ENDIF
+          
+          CALL check_conserve_detailed(it, AAM_dyn, &
+               f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
+       
+          CALL dissip(f_ps,f_mass,f_phis,f_geopot,f_theta_rhodz,f_u, f_dtheta_rhodz,f_du)
+          
+          CALL euler_scheme(.FALSE.)  ! update only u, theta
+          IF (iflag_sponge > 0) THEN
+             CALL sponge(f_u,f_du,f_theta_rhodz,f_dtheta_rhodz)
+             CALL euler_scheme(.FALSE.)  ! update only u, theta
+          END IF
+
+          CALL check_conserve_detailed(it, AAM_dissip, &
+               f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
+       END IF
+       
+       IF(MOD(it,itau_adv)==0) THEN
+          CALL advect_tracer(f_hfluxt,f_wfluxt,f_u, f_q,f_rhodz)  ! update q and rhodz after RK step
+          fluxt_zero=.TRUE.
+          ! FIXME : check that rhodz is consistent with ps
+          IF (check_rhodz) THEN
+             DO ind=1,ndomain
+                IF (.NOT. assigned_domain(ind)) CYCLE
+                CALL swap_dimensions(ind)
+                CALL swap_geometry(ind)
+                rhodz=f_rhodz(ind); ps=f_ps(ind);
+                CALL compute_rhodz(.FALSE., ps, rhodz)   
+             END DO
+          ENDIF
+          IF(positive_theta) CALL copy_q_to_theta(f_theta_rhodz,f_rhodz,f_q)
+       END IF
+       
+       IF (MOD(it,itau_physics)==0) THEN
+          CALL check_conserve_detailed(it, AAM_dyn, &
+            f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
+          CALL physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_wflux, f_q)        
+          CALL check_conserve_detailed(it, AAM_phys, &
+               f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
+          !$OMP MASTER
+          IF (first_physic) CALL SYSTEM_CLOCK(start_clock)
+          !$OMP END MASTER   
+          first_physic=.FALSE.
+       END IF
+
+       IF (MOD(it,itau_check_conserv)==0) THEN
+          CALL check_conserve_detailed(it, AAM_dyn, &
+               f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
+          CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it) 
+       ENDIF
+
+       IF (mod(it,itau_out)==0 ) THEN
+          CALL transfert_request(f_u,req_e1_vect)
+          CALL write_output_fields_basic(.FALSE.,f_phis, f_ps, f_mass, f_geopot, f_theta_rhodz, f_u, f_W, f_q)
+       ENDIF
+
+    END DO
+    
+    CALL write_etat0(itau0+itaumax,f_ps, f_phis,f_theta_rhodz,f_u,f_q) 
+    
+    CALL check_conserve_detailed(it, AAM_dyn, &
+         f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
+    CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)  
+    
+    !$OMP MASTER
+    CALL SYSTEM_CLOCK(stop_clock)
+    
+    IF (mpi_rank==0) THEN 
+       PRINT *,"Time elapsed : ",(stop_clock-start_clock)*1./rate_clock 
+    ENDIF
+    !$OMP END MASTER 
+    
+    ! CONTAINS
+  END SUBROUTINE timeloop
+
+  SUBROUTINE print_iteration(it,itau0,itaumax,start_clock,rate_clock)
+    INTEGER :: it, itau0, itaumax, start_clock, stop_clock, rate_clock, throughput
+    REAL :: per_step,total, elapsed
+    WRITE(*,'(A,I7,A,F14.1)') "It No :",it,"   t :",dt*it
+    IF(MOD(it,10)==0) THEN
+       CALL SYSTEM_CLOCK(stop_clock)
+       elapsed = (stop_clock-start_clock)*1./rate_clock
+       per_step = elapsed/(it-itau0)
+       throughput = dt/per_step
+       total = per_step*(itaumax-itau0)
+       WRITE(*,'(A,I5,A,F6.2,A,I6)') 'Time spent (s):',INT(elapsed), &
+            '  -- ms/step : ', 1000*per_step, &
+            '  -- Throughput :', throughput
+       WRITE(*,'(A,I5,A,I5)') 'Whole job (min) :', INT(total/60.), &
+            '  -- Completion in (min) : ', INT((total-elapsed)/60.)
+    END IF
+  END SUBROUTINE print_iteration
+
+  SUBROUTINE copy_theta_to_q(f_theta_rhodz,f_rhodz,f_q)
+    TYPE(t_field),POINTER :: f_theta_rhodz(:),f_rhodz(:), f_q(:)
+    REAL(rstd), POINTER :: theta_rhodz(:,:,:), rhodz(:,:), q(:,:,:)
+    INTEGER :: ind, iq
+    DO ind=1, ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       theta_rhodz=f_theta_rhodz(ind)
+       rhodz=f_rhodz(ind)
+       q=f_q(ind)
+       DO iq=1, nqdyn
+          q(:,:,iq)  = theta_rhodz(:,:,iq)/rhodz(:,:)
+       END DO
+    END DO
+  END SUBROUTINE copy_theta_to_q
+
+  SUBROUTINE copy_q_to_theta(f_theta_rhodz,f_rhodz,f_q)
+    TYPE(t_field),POINTER :: f_theta_rhodz(:),f_rhodz(:), f_q(:)
+    REAL(rstd), POINTER :: theta_rhodz(:,:,:), rhodz(:,:), q(:,:,:)
+    INTEGER :: ind, iq
+    DO ind=1, ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       theta_rhodz=f_theta_rhodz(ind)
+       rhodz=f_rhodz(ind)
+       q=f_q(ind)
+       DO iq=1,nqdyn
+          theta_rhodz(:,:,iq) = rhodz(:,:)*q(:,:,iq)
+       END DO
+    END DO
+  END SUBROUTINE copy_q_to_theta
+
+END MODULE timeloop_gcm_mod
Index: codes/icosagcm/devel/src/timeloop_gcm.f90
===================================================================
--- codes/icosagcm/devel/src/timeloop_gcm.f90	(revision 531)
+++ 	(revision )
@@ -1,408 +1,0 @@
-MODULE timeloop_gcm_mod
-  USE icosa
-  USE disvert_mod
-  USE trace
-  USE omp_para
-  USE euler_scheme_mod
-  USE explicit_scheme_mod
-  USE hevi_scheme_mod
-  IMPLICIT NONE
-  PRIVATE
-  
-  INTEGER, PARAMETER :: itau_sync=10
-  TYPE(t_message),SAVE :: req_ps0, req_mass0, req_theta_rhodz0, req_u0, req_q0, req_W0, req_geopot0
-  LOGICAL, SAVE :: positive_theta
-
-  PUBLIC :: init_timeloop, timeloop
-
-CONTAINS
-  
-  SUBROUTINE init_timeloop
-    USE dissip_gcm_mod
-    USE observable_mod
-    USE caldyn_mod
-    USE etat0_mod
-    USE guided_mod
-    USE advect_tracer_mod
-    USE check_conserve_mod
-    USE output_field_mod
-    USE theta2theta_rhodz_mod
-    USE sponge_mod
-
-    CHARACTER(len=255) :: def
-
-    CALL init_caldyn
-    
-!    IF (xios_output) itau_out=1
-    IF (.NOT. enable_io) itau_out=HUGE(itau_out)
-
-    positive_theta=.FALSE.
-    CALL getin('positive_theta',positive_theta)
-    IF(positive_theta .AND. nqtot<1) THEN
-       PRINT *, 'nqtot must be >0 if positive_theta is .TRUE.'
-       STOP
-    END IF
-
-    def='ARK2.3'
-    CALL getin('time_scheme',def)
-    SELECT CASE (TRIM(def))
-    CASE('euler')
-       scheme_family=explicit
-       scheme=euler
-       nb_stage=1
-    CASE ('runge_kutta')
-       scheme_family=explicit
-       scheme=rk4
-       nb_stage=4
-    CASE ('RK2.5')
-       scheme_family=explicit
-       scheme=rk25
-       nb_stage=5
-    CASE ('leapfrog_matsuno')
-       scheme_family=explicit
-       scheme=mlf
-       matsuno_period=5
-       CALL getin('matsuno_period',matsuno_period)
-       nb_stage=matsuno_period+1
-    CASE('ARK2.3')
-       scheme_family=hevi
-       scheme=ark23
-       nb_stage=3
-       CALL set_coefs_ark23(dt)
-    CASE('ARK3.3')
-       scheme_family=hevi
-       scheme=ark33
-       nb_stage=3
-       CALL set_coefs_ark33(dt)
-    CASE ('none')
-       nb_stage=0
-    CASE default
-       PRINT*,'Bad selector for variable scheme : <', TRIM(def),             &
-            ' > options are <euler>, <runge_kutta>, <leapfrog_matsuno>,<RK2.5>,<ARK2.3>'
-       STOP
-    END SELECT
-    
-    ! Time-independant orography
-    CALL allocate_field(f_phis,field_t,type_real,name='phis')
-    ! Model state at current time step
-    CALL allocate_field(f_ps,field_t,type_real, name='ps')
-    CALL allocate_field(f_mass,field_t,type_real,llm,name='mass')
-    CALL allocate_field(f_rhodz,field_t,type_real,llm,name='rhodz')
-    CALL allocate_field(f_theta_rhodz,field_t,type_real,llm,nqdyn,name='theta_rhodz')
-    CALL allocate_field(f_u,field_u,type_real,llm,name='u')
-    CALL allocate_field(f_geopot,field_t,type_real,llm+1,name='geopot')
-    CALL allocate_field(f_W,field_t,type_real,llm+1,name='W')
-    CALL allocate_field(f_q,field_t,type_real,llm,nqtot,'q')
-    ! Mass fluxes
-    CALL allocate_field(f_hflux,field_u,type_real,llm)    ! instantaneous mass fluxes
-    CALL allocate_field(f_hfluxt,field_u,type_real,llm)   ! mass "fluxes" accumulated in time
-    CALL allocate_field(f_wflux,field_t,type_real,llm+1)  ! vertical mass fluxes
-    CALL allocate_field(f_wfluxt,field_t,type_real,llm+1,name='wfluxt')
-    
-    SELECT CASE(scheme_family)
-    CASE(explicit)
-       ! Trends
-       CALL allocate_field(f_dps,field_t,type_real,name='dps')
-       CALL allocate_field(f_dmass,field_t,type_real,llm, name='dmass')
-       CALL allocate_field(f_dtheta_rhodz,field_t,type_real,llm,nqdyn,name='dtheta_rhodz')
-       CALL allocate_field(f_du,field_u,type_real,llm,name='du')
-       ! Model state at previous time step (RK/MLF)
-       CALL allocate_field(f_psm1,field_t,type_real,name='psm1')
-       CALL allocate_field(f_massm1,field_t,type_real,llm, name='massm1')
-       CALL allocate_field(f_theta_rhodzm1,field_t,type_real,llm,nqdyn,name='theta_rhodzm1')
-       CALL allocate_field(f_um1,field_u,type_real,llm,name='um1')
-    CASE(hevi)
-       ! Trends
-       CALL allocate_fields(nb_stage,f_dps_slow, field_t,type_real,name='dps_slow')
-       CALL allocate_fields(nb_stage,f_dmass_slow, field_t,type_real,llm, name='dmass_slow')
-       CALL allocate_fields(nb_stage,f_dtheta_rhodz_slow, field_t,type_real,llm,nqdyn,name='dtheta_rhodz_fast')
-       CALL allocate_fields(nb_stage,f_du_slow, field_u,type_real,llm,name='du_slow')
-       CALL allocate_fields(nb_stage,f_du_fast, field_u,type_real,llm,name='du_fast')
-       CALL allocate_fields(nb_stage,f_dW_slow, field_t,type_real,llm+1,name='dW_slow')
-       CALL allocate_fields(nb_stage,f_dW_fast, field_t,type_real,llm+1,name='dW_fast')
-       CALL allocate_fields(nb_stage,f_dPhi_slow, field_t,type_real,llm+1,name='dPhi_slow')
-       CALL allocate_fields(nb_stage,f_dPhi_fast, field_t,type_real,llm+1,name='dPhi_fast')
-       f_dps => f_dps_slow(:,1)
-       f_du => f_du_slow(:,1)
-       f_dtheta_rhodz => f_dtheta_rhodz_slow(:,1)
-    END SELECT
-
-    SELECT CASE(scheme)
-    CASE(mlf)
-       ! Model state 2 time steps ago (MLF)
-       CALL allocate_field(f_psm2,field_t,type_real)
-       CALL allocate_field(f_massm2,field_t,type_real,llm)
-       CALL allocate_field(f_theta_rhodzm2,field_t,type_real,llm,nqdyn)
-       CALL allocate_field(f_um2,field_u,type_real,llm)
-    END SELECT
-
-    CALL init_theta2theta_rhodz
-    CALL init_dissip
-    CALL init_sponge
-    CALL init_observable
-    CALL init_guided
-    CALL init_advect_tracer
-    CALL init_check_conserve
-
-    CALL etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_geopot,f_W, f_q)
-
-    CALL transfert_request(f_phis,req_i0) 
-    CALL transfert_request(f_phis,req_i1) 
-
-    CALL init_message(f_ps,req_i0,req_ps0)
-    CALL init_message(f_mass,req_i0,req_mass0)
-    CALL init_message(f_theta_rhodz,req_i0,req_theta_rhodz0)
-    CALL init_message(f_u,req_e0_vect,req_u0)
-    CALL init_message(f_q,req_i0,req_q0)
-    CALL init_message(f_geopot,req_i0,req_geopot0)
-    CALL init_message(f_W,req_i0,req_W0)
-
-  END SUBROUTINE init_timeloop
-  
-  SUBROUTINE timeloop
-    USE dissip_gcm_mod
-    USE sponge_mod
-    USE observable_mod
-    USE etat0_mod
-    USE guided_mod
-    USE caldyn_mod
-    USE advect_tracer_mod
-    USE physics_mod
-    USE mpipara
-    USE transfert_mod
-    USE check_conserve_mod
-    USE xios_mod
-    USE output_field_mod
-    USE write_etat0_mod
-    USE restart_mod
-    USE checksum_mod
-    USE explicit_scheme_mod
-    USE hevi_scheme_mod
-    REAL(rstd),POINTER :: rhodz(:,:), mass(:,:), ps(:)
-
-    INTEGER :: ind
-    INTEGER :: it,i,j,l,n,  stage
-    LOGICAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating fluxes in time
-    LOGICAL, PARAMETER :: check_rhodz=.FALSE.
-    INTEGER :: start_clock, stop_clock, rate_clock
-    LOGICAL,SAVE :: first_physic=.TRUE.
-    !$OMP THREADPRIVATE(first_physic)    
-
-    CALL switch_omp_distrib_level
-    CALL caldyn_BC(f_phis, f_geopot, f_wflux) ! set constant values in first/last interfaces
-
-    !$OMP BARRIER
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       rhodz=f_rhodz(ind); mass=f_mass(ind); ps=f_ps(ind)
-       IF(caldyn_eta==eta_mass) THEN
-          CALL compute_rhodz(.TRUE., ps, rhodz) ! save rhodz for transport scheme before dynamics update ps
-       ELSE
-          DO l=ll_begin,ll_end
-             rhodz(:,l)=mass(:,l)
-          ENDDO
-       END IF
-    END DO
-    !$OMP BARRIER
-    fluxt_zero=.TRUE.
-
-    IF(positive_theta) CALL copy_theta_to_q(f_theta_rhodz,f_rhodz,f_q)
-
-    CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,itau0)  
-
-    CALL trace_on
-
-    IF (xios_output) THEN ! we must call update_calendar before any XIOS output
-      IF (is_omp_master) CALL xios_update_calendar(1)
-    END IF
-    
-    IF (write_start) CALL write_etat0(itau0,f_ps, f_phis,f_theta_rhodz,f_u,f_q)  ! FIXME : write_start undefined
-   
-    CALL write_output_fields_basic(.TRUE., f_phis, f_ps, f_mass, f_geopot, f_theta_rhodz, f_u, f_W, f_q)
-
-    !$OMP MASTER
-    CALL SYSTEM_CLOCK(start_clock)
-    CALL SYSTEM_CLOCK(count_rate=rate_clock)
-    !$OMP END MASTER   
-
-    DO it=itau0+1,itau0+itaumax
-
-       IF (is_master) CALL print_iteration(it, itau0, itaumax, start_clock, rate_clock)
-
-       IF (xios_output) THEN
-
-          IF(it>itau0+1 .AND. is_omp_master) CALL xios_update_calendar(it-itau0)
-       ELSE
-          CALL update_time_counter(dt*it)
-       END IF
-
-       IF (it==itau0+1 .OR. 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_q0)
-          IF(.NOT. hydrostatic) THEN
-             CALL send_message(f_geopot,req_geopot0)
-             CALL wait_message(req_geopot0)
-             CALL send_message(f_W,req_W0)
-             CALL wait_message(req_W0)
-          END IF
-       ENDIF
-
-       CALL guided(it*dt,f_ps,f_theta_rhodz,f_u,f_q)
-
-       SELECT CASE(scheme_family)
-       CASE(explicit)
-          CALL explicit_scheme(it, fluxt_zero)
-       CASE(hevi)
-          CALL HEVI_scheme(it, fluxt_zero)
-       END SELECT
-       
-       IF (MOD(it,itau_dissip)==0) THEN
-          
-          IF(caldyn_eta==eta_mass) THEN
-             !ym flush ps
-             !$OMP BARRIER
-             DO ind=1,ndomain
-                IF (.NOT. assigned_domain(ind)) CYCLE
-                CALL swap_dimensions(ind)
-                CALL swap_geometry(ind)
-                mass=f_mass(ind); ps=f_ps(ind);
-                CALL compute_rhodz(.TRUE., ps, mass)
-             END DO
-          ENDIF
-          
-          CALL check_conserve_detailed(it, AAM_dyn, &
-               f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
-       
-          CALL dissip(f_ps,f_mass,f_phis,f_geopot,f_theta_rhodz,f_u, f_dtheta_rhodz,f_du)
-          
-          CALL euler_scheme(.FALSE.)  ! update only u, theta
-          IF (iflag_sponge > 0) THEN
-             CALL sponge(f_u,f_du,f_theta_rhodz,f_dtheta_rhodz)
-             CALL euler_scheme(.FALSE.)  ! update only u, theta
-          END IF
-
-          CALL check_conserve_detailed(it, AAM_dissip, &
-               f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
-       END IF
-       
-       IF(MOD(it,itau_adv)==0) THEN
-          CALL advect_tracer(f_hfluxt,f_wfluxt,f_u, f_q,f_rhodz)  ! update q and rhodz after RK step
-          fluxt_zero=.TRUE.
-          ! FIXME : check that rhodz is consistent with ps
-          IF (check_rhodz) THEN
-             DO ind=1,ndomain
-                IF (.NOT. assigned_domain(ind)) CYCLE
-                CALL swap_dimensions(ind)
-                CALL swap_geometry(ind)
-                rhodz=f_rhodz(ind); ps=f_ps(ind);
-                CALL compute_rhodz(.FALSE., ps, rhodz)   
-             END DO
-          ENDIF
-          IF(positive_theta) CALL copy_q_to_theta(f_theta_rhodz,f_rhodz,f_q)
-       END IF
-       
-       IF (MOD(it,itau_physics)==0) THEN
-          CALL check_conserve_detailed(it, AAM_dyn, &
-            f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
-          CALL physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_wflux, f_q)        
-          CALL check_conserve_detailed(it, AAM_phys, &
-               f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
-          !$OMP MASTER
-          IF (first_physic) CALL SYSTEM_CLOCK(start_clock)
-          !$OMP END MASTER   
-          first_physic=.FALSE.
-       END IF
-
-       IF (MOD(it,itau_check_conserv)==0) THEN
-          CALL check_conserve_detailed(it, AAM_dyn, &
-               f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
-          CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it) 
-       ENDIF
-
-       IF (mod(it,itau_out)==0 ) THEN
-          CALL transfert_request(f_u,req_e1_vect)
-          CALL write_output_fields_basic(.FALSE.,f_phis, f_ps, f_mass, f_geopot, f_theta_rhodz, f_u, f_W, f_q)
-       ENDIF
-
-    END DO
-    
-    CALL write_etat0(itau0+itaumax,f_ps, f_phis,f_theta_rhodz,f_u,f_q) 
-    
-    CALL check_conserve_detailed(it, AAM_dyn, &
-         f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
-    CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)  
-    
-    !$OMP MASTER
-    CALL SYSTEM_CLOCK(stop_clock)
-    
-    IF (mpi_rank==0) THEN 
-       PRINT *,"Time elapsed : ",(stop_clock-start_clock)*1./rate_clock 
-    ENDIF
-    !$OMP END MASTER 
-    
-    ! CONTAINS
-  END SUBROUTINE timeloop
-
-  SUBROUTINE print_iteration(it,itau0,itaumax,start_clock,rate_clock)
-    INTEGER :: it, itau0, itaumax, start_clock, stop_clock, rate_clock, throughput
-    REAL :: per_step,total, elapsed
-    WRITE(*,'(A,I7,A,F14.1)') "It No :",it,"   t :",dt*it
-    IF(MOD(it,10)==0) THEN
-       CALL SYSTEM_CLOCK(stop_clock)
-       elapsed = (stop_clock-start_clock)*1./rate_clock
-       per_step = elapsed/(it-itau0)
-       throughput = dt/per_step
-       total = per_step*(itaumax-itau0)
-       WRITE(*,'(A,I5,A,F6.2,A,I6)') 'Time spent (s):',INT(elapsed), &
-            '  -- ms/step : ', 1000*per_step, &
-            '  -- Throughput :', throughput
-       WRITE(*,'(A,I5,A,I5)') 'Whole job (min) :', INT(total/60.), &
-            '  -- Completion in (min) : ', INT((total-elapsed)/60.)
-    END IF
-  END SUBROUTINE print_iteration
-
-  SUBROUTINE copy_theta_to_q(f_theta_rhodz,f_rhodz,f_q)
-    TYPE(t_field),POINTER :: f_theta_rhodz(:),f_rhodz(:), f_q(:)
-    REAL(rstd), POINTER :: theta_rhodz(:,:,:), rhodz(:,:), q(:,:,:)
-    INTEGER :: ind, iq
-    DO ind=1, ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       theta_rhodz=f_theta_rhodz(ind)
-       rhodz=f_rhodz(ind)
-       q=f_q(ind)
-       DO iq=1, nqdyn
-          q(:,:,iq)  = theta_rhodz(:,:,iq)/rhodz(:,:)
-       END DO
-    END DO
-  END SUBROUTINE copy_theta_to_q
-
-  SUBROUTINE copy_q_to_theta(f_theta_rhodz,f_rhodz,f_q)
-    TYPE(t_field),POINTER :: f_theta_rhodz(:),f_rhodz(:), f_q(:)
-    REAL(rstd), POINTER :: theta_rhodz(:,:,:), rhodz(:,:), q(:,:,:)
-    INTEGER :: ind, iq
-    DO ind=1, ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       theta_rhodz=f_theta_rhodz(ind)
-       rhodz=f_rhodz(ind)
-       q=f_q(ind)
-       DO iq=1,nqdyn
-          theta_rhodz(:,:,iq) = rhodz(:,:)*q(:,:,iq)
-       END DO
-    END DO
-  END SUBROUTINE copy_q_to_theta
-
-END MODULE timeloop_gcm_mod
Index: codes/icosagcm/devel/src/trace.F90
===================================================================
--- codes/icosagcm/devel/src/trace.F90	(revision 531)
+++ 	(revision )
@@ -1,129 +1,0 @@
-MODULE trace
-
-  INTEGER,SAVE :: markId
-  
-CONTAINS
-
-  SUBROUTINE init_trace
-  IMPLICIT NONE
-#ifdef VTRACE
-#include <vt_user.inc>
-#endif 
-
-#ifdef VTRACE
-     VT_MARKER_DEF("marker", VT_MARKER_TYPE_HINT, markId)
-#endif
-  
-  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
-    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_start    
-
-
-  SUBROUTINE trace_end(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_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
-  CHARACTER(LEN=*),INTENT(IN) :: name
-#ifdef VTRACE
-#include <vt_user.inc>
-#endif 
-
-!$OMP MASTER
-#ifdef VTRACE
-     VT_MARKER(markId,name)
-#endif
-!$OMP END MASTER
-
-  END SUBROUTINE Marker
-
-END MODULE trace
Index: codes/icosagcm/devel/src/tracer.f90
===================================================================
--- codes/icosagcm/devel/src/tracer.f90	(revision 531)
+++ 	(revision )
@@ -1,41 +1,0 @@
-MODULE tracer_mod
-
-  INTEGER, PARAMETER   :: advect_none    = 0
-  INTEGER, PARAMETER   :: advect_vanleer = 1
-  INTEGER, ALLOCATABLE,SAVE :: advection_scheme(:)
-!$OMP THREADPRIVATE(advection_scheme)
- 
-  INTERFACE set_advection_scheme
-    MODULE PROCEDURE set_advection_scheme_1, set_advection_scheme_full
-  END INTERFACE
-
-CONTAINS
-
-  SUBROUTINE init_tracer
-  USE grid_param
-  IMPLICIT NONE
-    
-    ALLOCATE(advection_scheme(nqtot))
-    advection_scheme(:) = advect_vanleer 
-
-  END SUBROUTINE init_tracer
-
-  SUBROUTINE set_advection_scheme_1(nq,scheme)
-  IMPLICIT NONE
-    INTEGER, INTENT(IN) :: nq
-    INTEGER, INTENT(IN) :: scheme
-    
-    advection_scheme(nq)=scheme
-  
-  END SUBROUTINE set_advection_scheme_1
-
-  SUBROUTINE set_advection_scheme_full(schemes)
-  USE grid_param
-  IMPLICIT NONE
-    INTEGER, INTENT(IN) :: schemes(nqtot)
-  
-    advection_scheme(:)=schemes(:)
-  
-  END SUBROUTINE set_advection_scheme_full
-
-END MODULE tracer_mod
Index: codes/icosagcm/devel/src/transfert.F90
===================================================================
--- codes/icosagcm/devel/src/transfert.F90	(revision 531)
+++ 	(revision )
@@ -1,236 +1,0 @@
-MODULE transfert_mod
-
-#ifdef CPP_USING_MPI
-  USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_mpi, req_i1,req_e1_vect, &
-                                req_e1_scal, req_i0, req_e0_vect, req_e0_scal, request_add_point,             &
-                                create_request, gather_field, scatter_field,         &
-                                t_message, init_message=>init_message_mpi,           &
-                                transfert_message=>transfert_message_mpi,            &
-                                send_message=>send_message_mpi,                      &
-                                test_message=>test_message_mpi,                      &
-                                wait_message=>wait_message_mpi,barrier,bcast_mpi
-#else 
-  USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_seq, req_i1,req_e1_vect, &
-                                req_e1_scal,req_i0, req_e0_vect, req_e0_scal,        &
-                                request_add_point, create_request, gather_field,     &
-                                scatter_field, t_message,                            &
-                                init_message=>init_message_seq,                      &
-                                transfert_message=>transfert_message_seq,            &
-                                send_message=>send_message_seq,                      &
-                                test_message=>test_message_seq,                      &
-                                wait_message=>wait_message_seq,barrier, bcast_mpi
-#endif
-
-  USE transfert_omp_mod
-  
-  INTERFACE bcast
-    MODULE PROCEDURE bcast_c,                                     &
-                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
-                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
-		     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
-
-  END INTERFACE
-
-
-CONTAINS
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Broadcast --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!! -- Les chaine de charactère -- !!
-
-  SUBROUTINE bcast_c(var)
-  IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(INOUT) :: Var
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_c
-
-!! -- Les entiers -- !!
-  
-  SUBROUTINE bcast_i(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_i
-
-  SUBROUTINE bcast_i1(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_i1
-
-
-  SUBROUTINE bcast_i2(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_i2
-
-
-  SUBROUTINE bcast_i3(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_i3
-
-
-  SUBROUTINE bcast_i4(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_i4
-
- 
-!! -- Les reels -- !!
-  
-  SUBROUTINE bcast_r(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var
-
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_r
-
-  SUBROUTINE bcast_r1(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_r1
-
-
-  SUBROUTINE bcast_r2(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_r2
-
-
-  SUBROUTINE bcast_r3(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_r3
-
-
-  SUBROUTINE bcast_r4(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:,:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_r4 
-
-
-!! -- Les booleens -- !!
-  
-  SUBROUTINE bcast_l(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_l
-
-  SUBROUTINE bcast_l1(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_l1
-
-
-  SUBROUTINE bcast_l2(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_l2
-
-
-  SUBROUTINE bcast_l3(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_l3
-
-
-  SUBROUTINE bcast_l4(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_l4
-
-  
-END MODULE transfert_mod
Index: codes/icosagcm/devel/src/transfert_mpi.f90
===================================================================
--- codes/icosagcm/devel/src/transfert_mpi.f90	(revision 531)
+++ 	(revision )
@@ -1,2151 +1,0 @@
-MODULE transfert_mpi_mod
-USE genmod
-USE field_mod
-  
-  TYPE array
-    INTEGER,POINTER :: value(:)
-    INTEGER,POINTER :: sign(:)
-    INTEGER         :: domain
-    INTEGER         :: rank
-    INTEGER         :: tag
-    INTEGER         :: size
-    INTEGER         :: offset
-    INTEGER         :: ireq
-    INTEGER,POINTER :: buffer(:)
-    REAL,POINTER    :: buffer_r(:)
-    INTEGER,POINTER :: src_value(:)
-  END TYPE array
-  
-  TYPE t_buffer
-    REAL,POINTER    :: r(:)
-    INTEGER         :: size
-    INTEGER         :: rank
-  END TYPE t_buffer    
-    
-  TYPE t_request
-    INTEGER :: type_field
-    INTEGER :: max_size
-    INTEGER :: size
-    LOGICAL :: vector
-    INTEGER,POINTER :: src_domain(:)
-    INTEGER,POINTER :: src_i(:)
-    INTEGER,POINTER :: src_j(:)
-    INTEGER,POINTER :: src_ind(:)
-    INTEGER,POINTER :: target_ind(:)
-    INTEGER,POINTER :: target_i(:)
-    INTEGER,POINTER :: target_j(:)
-    INTEGER,POINTER :: target_sign(:)
-    INTEGER :: nrecv
-    TYPE(ARRAY),POINTER :: recv(:)
-    INTEGER :: nsend
-    INTEGER :: nreq_mpi
-    INTEGER :: nreq_send
-    INTEGER :: nreq_recv
-    TYPE(ARRAY),POINTER :: send(:)
-  END TYPE t_request
-  
-  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
-    CHARACTER(LEN=100) :: name ! for debug
-    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(:,:)
-    TYPE(t_buffer),POINTER :: buffers(:) 
-    TYPE(t_field),POINTER :: field(:)
-    LOGICAL :: completed
-    LOGICAL :: pending
-    LOGICAL :: open      ! for debug
-    INTEGER :: number
-  END TYPE t_message
-
-
-  INTERFACE bcast_mpi
-    MODULE PROCEDURE bcast_mpi_c,                                                     &
-                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
-                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
-		     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
-  END INTERFACE
-
-
-  
-CONTAINS
-       
-      
-  SUBROUTINE init_transfert
-  USE domain_mod
-  USE dimensions
-  USE field_mod
-  USE metric
-  USE mpipara
-  USE mpi_mod
-  IMPLICIT NONE
-  INTEGER :: ind,i,j
-  LOGICAL ::ok
- 
-    CALL create_request(field_t,req_i1)
-
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      DO i=ii_begin,ii_end+1
-        CALL request_add_point(ind,i,jj_begin-1,req_i1)
-      ENDDO
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j,req_i1)
-      ENDDO    
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_end+1,req_i1)
-      ENDDO    
-
-      DO j=jj_begin,jj_end+1
-        CALL request_add_point(ind,ii_begin-1,j,req_i1)
-      ENDDO    
-    
-    ENDDO
-  
-    CALL finalize_request(req_i1)
-
-
-    CALL create_request(field_t,req_i0)
-
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-    
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_begin,req_i0)
-      ENDDO
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end,j,req_i0)
-      ENDDO    
-    
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_end,req_i0)
-      ENDDO    
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin,j,req_i0)
-      ENDDO    
-    
-    ENDDO
- 
-    CALL finalize_request(req_i0)  
-
-
-    CALL create_request(field_u,req_e1_scal)
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_begin-1,req_e1_scal,rup)
-        CALL request_add_point(ind,i+1,jj_begin-1,req_e1_scal,lup)
-      ENDDO
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j,req_e1_scal,left)
-      ENDDO    
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j-1,req_e1_scal,lup)
-      ENDDO    
-    
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_end+1,req_e1_scal,ldown)
-        CALL request_add_point(ind,i-1,jj_end+1,req_e1_scal,rdown)
-      ENDDO    
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin-1,j,req_e1_scal,right)
-      ENDDO   
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_scal,rdown)
-      ENDDO   
-
-    ENDDO
-
-    CALL finalize_request(req_e1_scal)
-
-
-    CALL create_request(field_u,req_e0_scal)
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-
-
-      DO i=ii_begin+1,ii_end-1
-        CALL request_add_point(ind,i,jj_begin,req_e0_scal,right)
-        CALL request_add_point(ind,i,jj_end,req_e0_scal,right)
-      ENDDO
-    
-      DO j=jj_begin+1,jj_end-1
-        CALL request_add_point(ind,ii_begin,j,req_e0_scal,rup)
-        CALL request_add_point(ind,ii_end,j,req_e0_scal,rup)
-      ENDDO   
-
-      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_scal,left)
-      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_scal,ldown)
-      CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_scal,left)
-      CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_scal,ldown)
-
-    ENDDO
-
-    CALL finalize_request(req_e0_scal)
-
-
-    
-    CALL create_request(field_u,req_e1_vect,.TRUE.)
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_begin-1,req_e1_vect,rup)
-        CALL request_add_point(ind,i+1,jj_begin-1,req_e1_vect,lup)
-      ENDDO
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j,req_e1_vect,left)
-      ENDDO    
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j-1,req_e1_vect,lup)
-      ENDDO    
-    
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_end+1,req_e1_vect,ldown)
-        CALL request_add_point(ind,i-1,jj_end+1,req_e1_vect,rdown)
-      ENDDO    
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin-1,j,req_e1_vect,right)
-      ENDDO   
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_vect,rdown)
-      ENDDO   
-
-  
-    ENDDO  
-
-    CALL finalize_request(req_e1_vect)
-    
-    
-    CALL create_request(field_u,req_e0_vect,.TRUE.)
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
- 
-      DO i=ii_begin+1,ii_end-1
-        CALL request_add_point(ind,i,jj_begin,req_e0_vect,right)
-        CALL request_add_point(ind,i,jj_end,req_e0_vect,right)
-      ENDDO
-    
-      DO j=jj_begin+1,jj_end-1
-        CALL request_add_point(ind,ii_begin,j,req_e0_vect,rup)
-        CALL request_add_point(ind,ii_end,j,req_e0_vect,rup)
-      ENDDO   
-
-      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_vect,left)
-      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_vect,ldown)
-      CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_vect,left)
-      CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_vect,ldown)
-  
-    ENDDO  
-
-    CALL finalize_request(req_e0_vect)
-
-
-  END SUBROUTINE init_transfert
-  
-  SUBROUTINE create_request(type_field,request,vector)
-  USE domain_mod
-  USE field_mod
-  IMPLICIT NONE
-    INTEGER :: type_field
-    TYPE(t_request),POINTER :: request(:)
-    LOGICAL,OPTIONAL :: vector
-    
-    TYPE(t_request),POINTER :: req
-    TYPE(t_domain),POINTER :: d
-    INTEGER :: ind
-    INTEGER :: max_size
-       
-    ALLOCATE(request(ndomain))
-
-    DO ind=1,ndomain
-      req=>request(ind)
-      d=>domain(ind)
-      IF (type_field==field_t) THEN
-        Max_size=2*(d%iim+2)+2*(d%jjm+2)
-      ELSE IF (type_field==field_u) THEN
-        Max_size=3*(2*(d%iim+2)+2*(d%jjm+2))
-      ELSE IF (type_field==field_z) THEN
-        Max_size=2*(2*(d%iim+2)+2*(d%jjm+2))
-      ENDIF
-
-      req%type_field=type_field
-      req%max_size=max_size*2
-      req%size=0
-      req%vector=.FALSE.
-      IF (PRESENT(vector)) req%vector=vector
-      ALLOCATE(req%src_domain(req%max_size))
-      ALLOCATE(req%src_ind(req%max_size))
-      ALLOCATE(req%target_ind(req%max_size))
-      ALLOCATE(req%src_i(req%max_size))
-      ALLOCATE(req%src_j(req%max_size))
-      ALLOCATE(req%target_i(req%max_size))
-      ALLOCATE(req%target_j(req%max_size))
-      ALLOCATE(req%target_sign(req%max_size))
-    ENDDO
-  
-  END SUBROUTINE create_request
-
-  SUBROUTINE reallocate_request(req)
-  IMPLICIT NONE
-    TYPE(t_request),POINTER :: req
-      
-    INTEGER,POINTER :: src_domain(:)
-    INTEGER,POINTER :: src_ind(:)
-    INTEGER,POINTER :: target_ind(:)
-    INTEGER,POINTER :: src_i(:)
-    INTEGER,POINTER :: src_j(:)
-    INTEGER,POINTER :: target_i(:)
-    INTEGER,POINTER :: target_j(:)
-    INTEGER,POINTER :: target_sign(:)
-
-    PRINT *,"REALLOCATE_REQUEST"
-    src_domain=>req%src_domain
-    src_ind=>req%src_ind
-    target_ind=>req%target_ind
-    src_i=>req%src_i
-    src_j=>req%src_j
-    target_i=>req%target_i
-    target_j=>req%target_j
-    target_sign=>req%target_sign
-
-    ALLOCATE(req%src_domain(req%max_size*2))
-    ALLOCATE(req%src_ind(req%max_size*2))
-    ALLOCATE(req%target_ind(req%max_size*2))
-    ALLOCATE(req%src_i(req%max_size*2))
-    ALLOCATE(req%src_j(req%max_size*2))
-    ALLOCATE(req%target_i(req%max_size*2))
-    ALLOCATE(req%target_j(req%max_size*2))
-    ALLOCATE(req%target_sign(req%max_size*2))
-    
-    req%src_domain(1:req%max_size)=src_domain(:)
-    req%src_ind(1:req%max_size)=src_ind(:)
-    req%target_ind(1:req%max_size)=target_ind(:)
-    req%src_i(1:req%max_size)=src_i(:)
-    req%src_j(1:req%max_size)=src_j(:)
-    req%target_i(1:req%max_size)=target_i(:)
-    req%target_j(1:req%max_size)=target_j(:)
-    req%target_sign(1:req%max_size)=target_sign(:)
-    
-    req%max_size=req%max_size*2
-         
-    DEALLOCATE(src_domain)
-    DEALLOCATE(src_ind)
-    DEALLOCATE(target_ind)
-    DEALLOCATE(src_i)
-    DEALLOCATE(src_j)
-    DEALLOCATE(target_i)
-    DEALLOCATE(target_j)
-    DEALLOCATE(target_sign)
-
-  END SUBROUTINE reallocate_request
-
-      
-    SUBROUTINE request_add_point(ind,i,j,request,pos)
-    USE domain_mod
-    USE field_mod
-    IMPLICIT NONE
-      INTEGER,INTENT(IN)            ::  ind
-      INTEGER,INTENT(IN)            :: i
-      INTEGER,INTENT(IN)            :: j
-      TYPE(t_request),POINTER :: request(:)
-      INTEGER,INTENT(IN),OPTIONAL  :: pos
-      
-      INTEGER :: src_domain
-      INTEGER :: src_iim,src_i,src_j,src_n,src_pos,src_delta
-      TYPE(t_request),POINTER :: req
-      TYPE(t_domain),POINTER :: d
-      
-      req=>request(ind)
-      d=>domain(ind)
-      
-      IF (req%max_size==req%size) CALL reallocate_request(req)
-      req%size=req%size+1
-      IF (req%type_field==field_t) THEN
-        src_domain=domain(ind)%assign_domain(i,j)
-        src_iim=domain_glo(src_domain)%iim
-        src_i=domain(ind)%assign_i(i,j)
-        src_j=domain(ind)%assign_j(i,j)
-
-        req%target_ind(req%size)=(j-1)*d%iim+i
-        req%target_sign(req%size)=1
-        req%src_domain(req%size)=src_domain
-        req%src_ind(req%size)=(src_j-1)*src_iim+src_i
-      ELSE IF (req%type_field==field_u) THEN
-        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
-
-        src_domain=domain(ind)%edge_assign_domain(pos-1,i,j)
-        src_iim=domain_glo(src_domain)%iim
-        src_i=domain(ind)%edge_assign_i(pos-1,i,j)
-        src_j=domain(ind)%edge_assign_j(pos-1,i,j)
-        src_n=(src_j-1)*src_iim+src_i
-        src_delta=domain(ind)%delta(i,j)
-        src_pos=domain(ind)%edge_assign_pos(pos-1,i,j)+1
-                
-        req%target_ind(req%size)=(j-1)*d%iim+i+d%u_pos(pos)
-
-        req%target_sign(req%size)= 1
-        IF (req%vector) req%target_sign(req%size)= domain(ind)%edge_assign_sign(pos-1,i,j)
-
-        req%src_domain(req%size)=src_domain
-        req%src_ind(req%size)=src_n+domain_glo(src_domain)%u_pos(src_pos)
-
-      ELSE IF (req%type_field==field_z) THEN
-        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
-
-        src_domain=domain(ind)%assign_domain(i,j)
-        src_iim=domain_glo(src_domain)%iim
-        src_i=domain(ind)%assign_i(i,j)
-        src_j=domain(ind)%assign_j(i,j)
-        src_n=(src_j-1)*src_iim+src_i
-        src_delta=domain(ind)%delta(i,j)
-        
-        src_pos=MOD(pos-1+src_delta+6,6)+1
-        
-        req%target_ind(req%size)=(j-1)*d%iim+i+d%z_pos(pos)
-        req%target_sign(req%size)=1
-        req%src_domain(req%size)=src_domain
-        req%src_ind(req%size)=src_n+domain_glo(src_domain)%z_pos(src_pos)
-      ENDIF
-  END SUBROUTINE request_add_point
-  
-  
-  SUBROUTINE Finalize_request(request)
-  USE mpipara
-  USE domain_mod
-  USE mpi_mod
-  IMPLICIT NONE
-    TYPE(t_request),POINTER :: request(:)
-    TYPE(t_request),POINTER :: req, req_src
-    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)
-    INTEGER,ALLOCATABLE :: list_domain_send(:)
-    INTEGER             :: list_domain(ndomain)
-
-    INTEGER :: rank,i,j,pos
-    INTEGER :: size_,ind_glo,ind_loc, ind_src
-    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
-    
-    DO ind_loc=1,ndomain
-      req=>request(ind_loc)
-      
-      nb_data_domain_recv(:) = 0
-      nb_domain_recv(:) = 0
-      tag_rank(:)=0
-      
-      DO i=1,req%size
-        ind_glo=req%src_domain(i)
-        nb_data_domain_recv(ind_glo)=nb_data_domain_recv(ind_glo)+1
-      ENDDO
- 
-      DO ind_glo=1,ndomain_glo
-        IF ( nb_data_domain_recv(ind_glo) > 0 )  nb_domain_recv(domglo_rank(ind_glo))=nb_domain_recv(domglo_rank(ind_glo))+1
-      ENDDO
-
-      req%nrecv=sum(nb_domain_recv(:))
-      ALLOCATE(req%recv(req%nrecv))
-
-      irecv=0
-      DO ind_glo=1,ndomain_glo
-        IF (nb_data_domain_recv(ind_glo)>0) THEN
-          irecv=irecv+1
-          list_domain_recv(ind_glo)=irecv
-          req%recv(irecv)%rank=domglo_rank(ind_glo)
-          req%recv(irecv)%size=nb_data_domain_recv(ind_glo)
-          req%recv(irecv)%domain=domglo_loc_ind(ind_glo)
-          ALLOCATE(req%recv(irecv)%value(req%recv(irecv)%size))
-          ALLOCATE(req%recv(irecv)%sign(req%recv(irecv)%size))
-          ALLOCATE(req%recv(irecv)%buffer(req%recv(irecv)%size))
-        ENDIF
-      ENDDO
-      
-      req%recv(:)%size=0
-      irecv=0
-      DO i=1,req%size
-        irecv=list_domain_recv(req%src_domain(i))
-        req%recv(irecv)%size=req%recv(irecv)%size+1
-        size_=req%recv(irecv)%size
-        req%recv(irecv)%value(size_)=req%src_ind(i)
-        req%recv(irecv)%buffer(size_)=req%target_ind(i)
-        req%recv(irecv)%sign(size_)=req%target_sign(i)
-      ENDDO
-    ENDDO
-
-    nb_domain_recv(:) = 0    
-    DO ind_loc=1,ndomain
-      req=>request(ind_loc)
-      
-      DO irecv=1,req%nrecv
-        rank=req%recv(irecv)%rank
-        nb_domain_recv(rank)=nb_domain_recv(rank)+1
-      ENDDO
-    ENDDO
-    
-    CALL MPI_Alltoall(nb_domain_recv,1,MPI_INTEGER,nb_domain_send,1,MPI_INTEGER,comm_icosa,ierr)     
-    
-
-    ALLOCATE(list_domain_send(sum(nb_domain_send)))
-    
-    nreq=sum(nb_domain_recv(:))+sum(nb_domain_send(:))
-    ALLOCATE(mpi_req(nreq))
-    ALLOCATE(status(MPI_STATUS_SIZE,nreq))
-    
-
-    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)%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
-      DO i=1,nb_domain_send(rank)
-        j=j+1
-        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)
-    
-    list_domain(:)=0
-    DO i=1,sum(nb_domain_send)
-      ind_loc=list_domain_send(i)
-      list_domain(ind_loc)=list_domain(ind_loc)+1
-    ENDDO
-    
-    DO ind_loc=1,ndomain
-      req=>request(ind_loc)
-      req%nsend=list_domain(ind_loc)
-      ALLOCATE(req%send(req%nsend))
-    ENDDO
-
-    IF (debug) PRINT *,"------------"    
-   
-   ireq=0 
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     DO irecv=1,req%nrecv
-       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 
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     DO irecv=1,req%nrecv
-       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 
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     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)%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,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
-
-   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-
-   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)%value,req%recv(irecv)%size,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
-       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,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
-     ENDDO
-   ENDDO
-
-   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     DO irecv=1,req%nrecv
-       req%recv(irecv)%value(:)=req%recv(irecv)%buffer(:)
-       req%recv(irecv)%sign(:) =req%recv(irecv)%sign(:)
-       DEALLOCATE(req%recv(irecv)%buffer)
-     ENDDO
-   ENDDO  
-   
-
-! domain is on the same mpi process => copie memory to memory
-   
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     DO irecv=1,req%nrecv
-   
-       IF (req%recv(irecv)%rank==mpi_rank) THEN
-           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)%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
-             ENDIF
-           ENDDO
-       ENDIF
-     
-     ENDDO
-   ENDDO
-   
-! 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)
-
-     DO isend=1,req%nsend
-       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 .OR. mpi_threading_mode==MPI_THREAD_SINGLE) 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) 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 .OR. mpi_threading_mode==MPI_THREAD_SINGLE) 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 
-
-
-  SUBROUTINE init_message_seq(field, request, message, name)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE mpi_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_request),POINTER :: request(:)
-    TYPE(t_message) :: message
-    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
-!$OMP MASTER    
-    message%request=>request
-    IF(PRESENT(name)) THEN
-       message%name = TRIM(name)
-    ELSE
-       message%name = 'unknown'
-    END IF
-!$OMP END MASTER    
-!$OMP BARRIER    
-
-  END SUBROUTINE init_message_seq
-
-  SUBROUTINE send_message_seq(field,message)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE omp_para
-  USE trace
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_message) :: message
-
-    CALL transfert_request_seq(field,message%request)
-    
-  END SUBROUTINE send_message_seq
-  
-  SUBROUTINE test_message_seq(message)
-  IMPLICIT NONE
-    TYPE(t_message) :: message
-  END SUBROUTINE  test_message_seq
-  
-   
-  SUBROUTINE wait_message_seq(message)
-  IMPLICIT NONE
-    TYPE(t_message) :: message
-    
-  END SUBROUTINE wait_message_seq    
-
-  SUBROUTINE transfert_message_seq(field,message)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE omp_para
-  USE trace
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_message) :: message
-
-   CALL send_message_seq(field,message)
-    
-  END SUBROUTINE transfert_message_seq    
-    
-
-
-    
-  SUBROUTINE init_message_mpi(field,request, message, name)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE mpi_mod
-  IMPLICIT NONE
-  
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_request),POINTER :: request(:)
-    TYPE(t_message) :: message
-    CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: name
-
-    TYPE(ARRAY),POINTER :: recv,send 
-    TYPE(t_request),POINTER :: req
-    INTEGER :: irecv,isend
-    INTEGER :: ireq,nreq, nreq_send
-    INTEGER :: ind
-    INTEGER :: dim3,dim4
-    INTEGER :: i,j
-    INTEGER,SAVE :: message_number=0
-!    TYPE(t_reorder),POINTER :: reorder(:)
-!    TYPE(t_reorder) :: reorder_swap
-
-!$OMP BARRIER
-!$OMP MASTER
-    IF(PRESENT(name)) THEN
-       message%name = TRIM(name)
-    ELSE
-       message%name = 'unknown'
-    END IF
-    message%number=message_number
-    message_number=message_number+1
-    IF (message_number==100) message_number=0
-
-  
-    message%request=>request
-    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.
-    message%open=.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
-     
-        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
-      
-        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
-        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
-    
-    DEALLOCATE(message%mpi_req)
-    DEALLOCATE(message%buffers)
-    DEALLOCATE(message%status)
-
-!$OMP END MASTER
-!$OMP BARRIER
-
-      
-  END SUBROUTINE Finalize_message_mpi
-
-
-  
-  SUBROUTINE barrier
-  USE mpi_mod
-  USE mpipara
-  IMPLICIT NONE
-    
-    CALL MPI_BARRIER(comm_icosa,ierr)
-    
-  END SUBROUTINE barrier  
-    
-  SUBROUTINE transfert_message_mpi(field,message)
-  USE field_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_message) :: message
-    
-    CALL send_message_mpi(field,message)
-    CALL wait_message_mpi(message)
-    
-  END SUBROUTINE transfert_message_mpi
-
-
-  SUBROUTINE send_message_mpi(field,message)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE omp_para
-  USE trace
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_message) :: message
-    REAL(rstd),POINTER :: rval2d(:), src_rval2d(:) 
-    REAL(rstd),POINTER :: rval3d(:,:), src_rval3d(:,:) 
-    REAL(rstd),POINTER :: rval4d(:,:,:), src_rval4d(:,:,:) 
-    REAL(rstd),POINTER :: buffer_r(:) 
-    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,nreq
-    INTEGER :: ind,i,n,l,m
-    INTEGER :: dim3,dim4,d3,d4
-    INTEGER,POINTER :: src_value(:)
-    INTEGER,POINTER :: sign(:)
-    INTEGER :: offset,msize,rank
-    INTEGER :: lbegin, lend
-    INTEGER :: max_req
-
-!    CALL trace_start("send_message_mpi")
-
-!$OMP BARRIER
-
-
-!$OMP MASTER
-    IF(message%open) THEN
-       PRINT *, 'send_message_mpi : message ' // TRIM(message%name) // &
-            ' is still open, no call to wait_message_mpi after last send_message_mpi'
-       CALL ABORT
-    END IF
-    message%open=.TRUE. ! will be set to .FALSE. by wait_message_mpi
-
-    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
-
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-          
-          rval2d=>field(ind)%rval2d
-        
-          req=>message%request(ind)
-          DO isend=1,req%nsend
-            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
-                                            
-              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
-        
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) 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
-        max_req=0
-        DO ind=1,ndomain
-          req=>message%request(ind)
-          IF (req%nsend>max_req) max_req=req%nsend
-        ENDDO
-              
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) ) CYCLE
-
-          dim3=size(field(ind)%rval3d,2)
-          CALL distrib_level(dim3,lbegin,lend)
-
-          rval3d=>field(ind)%rval3d
-          req=>message%request(ind)
- 
-          DO isend=1,req%nsend
-            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 + (lbegin-1)*send%size
-          
-              CALL trace_start("copy_to_buffer")
-
-              DO d3=lbegin,lend
-                DO n=1,send%size
-                  buffer_r(n+offset)=rval3d(value(n),d3)
-                ENDDO
-                offset=offset+send%size
-              ENDDO
-              CALL trace_end("copy_to_buffer")
-
-              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
-                !$OMP BARRIER
-              ENDIF
-              
-              IF (is_omp_level_master) THEN
-                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
-            ELSE
-              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
-                !$OMP BARRIER
-              ENDIF
-            ENDIF
-          ENDDO
-
-          IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
-            DO isend=req%nsend+1,max_req
-              !$OMP BARRIER
-            ENDDO
-          ENDIF
-
-        ENDDO
-         
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) ) CYCLE
-          dim3=size(field(ind)%rval3d,2)
-          CALL distrib_level(dim3,lbegin,lend)
-          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
-
-              CALL trace_start("copy_data")
-
-              DO d3=lbegin,lend
-                DO n=1,recv%size
-                  rval3d(value(n),d3)=src_rval3d(src_value(n),d3)*sgn(n)
-                ENDDO
-              ENDDO
-              CALL trace_end("copy_data")
-
-            ELSE
-              ireq=recv%ireq
-              buffer_r=>message%buffers(ireq)%r
- 
-              IF (is_omp_level_master) THEN
-                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
-            ENDIF  
-          ENDDO
-        
-        ENDDO
-
-      ELSE  IF (field(1)%ndim==4) THEN
-
-        max_req=0
-        DO ind=1,ndomain
-          req=>message%request(ind)
-          IF (req%nsend>max_req) max_req=req%nsend
-        ENDDO
-    
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) ) CYCLE
-
-          dim3=size(field(ind)%rval4d,2)
-          CALL distrib_level(dim3,lbegin,lend)
-          dim4=size(field(ind)%rval4d,3)
-          rval4d=>field(ind)%rval4d
-          req=>message%request(ind)
-
-          DO isend=1,req%nsend
-            send=>req%send(isend)
-            value=>send%value
-
-            IF (send%rank/=mpi_rank) THEN
-
-              ireq=send%ireq
-              buffer_r=>message%buffers(ireq)%r
-
-              CALL trace_start("copy_to_buffer")
-              DO d4=1,dim4
-                offset=send%offset*dim3*dim4 + dim3*send%size*(d4-1) +               &
-                  (lbegin-1)*send%size
-
-                DO d3=lbegin,lend
-                  DO n=1,send%size
-                    buffer_r(n+offset)=rval4d(value(n),d3,d4)
-                  ENDDO
-                  offset=offset+send%size
-                ENDDO
-              ENDDO
-              CALL trace_end("copy_to_buffer")
-
-              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
-                !$OMP BARRIER
-              ENDIF
-
-              IF (is_omp_level_master) THEN
-                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
-            ELSE
-              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
-                !$OMP BARRIER
-              ENDIF
-            ENDIF
-          ENDDO
-          
-          IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
-            DO isend=req%nsend+1,max_req
-              !$OMP BARRIER
-            ENDDO
-          ENDIF
-
-        ENDDO
-        
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) ) CYCLE
-          
-          dim3=size(field(ind)%rval4d,2)
-          CALL distrib_level(dim3,lbegin,lend)
-          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
-
-              CALL trace_start("copy_data")
-              DO d4=1,dim4
-                DO d3=lbegin,lend
-                  DO n=1,recv%size
-                    rval4d(value(n),d3,d4)=src_rval4d(src_value(n),d3,d4)*sgn(n)
-                  ENDDO
-                ENDDO
-              ENDDO
-                
-              CALL trace_end("copy_data")
-                   
-            ELSE
-
-              ireq=recv%ireq
-              buffer_r=>message%buffers(ireq)%r
-              IF (is_omp_level_master) THEN
-                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
-            ENDIF
-          ENDDO
-        ENDDO
-
-      ENDIF      
-
-      IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) 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("send_message_mpi")
-    
-  END SUBROUTINE send_message_mpi
-  
-  SUBROUTINE test_message_mpi(message)
-  IMPLICIT NONE
-    TYPE(t_message) :: message
-    
-    INTEGER :: ierr
-
-!$OMP MASTER
-    IF (message%pending .AND. .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_r(:) 
-    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,nreq
-    INTEGER :: ind,n,l,m,i
-    INTEGER :: dim3,dim4,d3,d4,lbegin,lend
-    INTEGER :: offset
-
-    message%open=.FALSE.
-    IF (.NOT. message%pending) RETURN
-
-!    CALL trace_start("wait_message_mpi")
-
-    field=>message%field
-    nreq=message%nreq
-    
-    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
-        
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-          
-          rval2d=>field(ind)%rval2d
-          req=>message%request(ind)
-          DO irecv=1,req%nrecv
-            recv=>req%recv(irecv)
-            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
-      
-      
-      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
-          IF (.NOT. assigned_domain(ind) ) CYCLE
-
-          rval3d=>field(ind)%rval3d
-          req=>message%request(ind)
-          DO irecv=1,req%nrecv
-            recv=>req%recv(irecv)
-            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)
-    
-              CALL distrib_level(dim3,lbegin,lend)
-              offset=recv%offset*dim3 + (lbegin-1)*recv%size
-              CALL trace_start("copy_from_buffer")
-              
-              IF (req%vector) THEN
-                DO d3=lbegin,lend
-                  DO n=1,recv%size
-                    rval3d(value(n),d3)=buffer_r(n+offset)*sgn(n)  
-                  ENDDO
-                  offset=offset+recv%size
-                ENDDO
-              ELSE
-                DO d3=lbegin,lend
-                  DO n=1,recv%size
-                    rval3d(value(n),d3)=buffer_r(n+offset)  
-                  ENDDO
-                  offset=offset+recv%size
-                ENDDO
-              ENDIF
-                
-              CALL trace_end("copy_from_buffer")
-            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
-
-                
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) ) CYCLE
-
-          rval4d=>field(ind)%rval4d
-          req=>message%request(ind)
-          DO irecv=1,req%nrecv
-            recv=>req%recv(irecv)
-            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)
-              CALL distrib_level(dim3,lbegin,lend)
-              dim4=size(rval4d,3)
-              CALL trace_start("copy_from_buffer")
-              DO d4=1,dim4
-                offset=recv%offset*dim3*dim4 + dim3*recv%size*(d4-1) +               &
-                  (lbegin-1)*recv%size
-                DO d3=lbegin,lend
-                  DO n=1,recv%size
-                    rval4d(value(n),d3,d4)=buffer_r(n+offset)*sgn(n) 
-                  ENDDO
-                  offset=offset+recv%size
-                ENDDO
-              ENDDO
-              CALL trace_end("copy_from_buffer")
-            ENDIF
-          ENDDO
-        
-        ENDDO
-      
-      ENDIF      
-      
-    ENDIF
-
-!$OMP MASTER
-    message%pending=.FALSE.
-!$OMP END MASTER
-
-!    CALL trace_end("wait_message_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)
-  USE field_mod
-  USE domain_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_request),POINTER :: request(:)
-    REAL(rstd),POINTER :: rval2d(:) 
-    REAL(rstd),POINTER :: rval3d(:,:) 
-    REAL(rstd),POINTER :: rval4d(:,:,:) 
-    INTEGER :: ind
-    TYPE(t_request),POINTER :: req
-    INTEGER :: n
-    REAL(rstd) :: var1,var2
-    
-    DO ind=1,ndomain
-      req=>request(ind)
-      rval2d=>field(ind)%rval2d
-      rval3d=>field(ind)%rval3d
-      rval4d=>field(ind)%rval4d
-      
-      IF (field(ind)%data_type==type_real) THEN
-        IF (field(ind)%ndim==2) THEN
-          DO n=1,req%size
-            rval2d(req%target_ind(n))=field(req%src_domain(n))%rval2d(req%src_ind(n))*&
-              req%target_sign(n)
-          ENDDO
-        ELSE IF (field(ind)%ndim==3) THEN
-          DO n=1,req%size
-            rval3d(req%target_ind(n),:)=field(req%src_domain(n))%rval3d(req%src_ind(n),:)*&
-              req%target_sign(n)
-          ENDDO
-        ELSE IF (field(ind)%ndim==4) THEN
-          DO n=1,req%size
-            rval4d(req%target_ind(n),:,:)=field(req%src_domain(n))%rval4d(req%src_ind(n),:,:)*&
-              req%target_sign(n)
-          ENDDO
-        ENDIF
-      ENDIF        
-
-    ENDDO
-    
-  END SUBROUTINE transfert_request_seq
-  
-  
-  SUBROUTINE gather_field(field_loc,field_glo)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field_loc(:)
-    TYPE(t_field),POINTER :: field_glo(:)
-    INTEGER, ALLOCATABLE :: mpi_req(:)
-    INTEGER, ALLOCATABLE :: status(:,:)
-    INTEGER :: ireq,nreq
-    INTEGER :: ind_glo,ind_loc    
-  
-    IF (.NOT. using_mpi) THEN
-    
-      DO ind_loc=1,ndomain
-        IF (field_loc(ind_loc)%ndim==2) field_glo(ind_loc)%rval2d=field_loc(ind_loc)%rval2d
-        IF (field_loc(ind_loc)%ndim==3) field_glo(ind_loc)%rval3d=field_loc(ind_loc)%rval3d
-        IF (field_loc(ind_loc)%ndim==4) field_glo(ind_loc)%rval4d=field_loc(ind_loc)%rval4d
-      ENDDO
-    
-    ELSE
-          
-      nreq=ndomain
-      IF (mpi_rank==0) nreq=nreq+ndomain_glo 
-      ALLOCATE(mpi_req(nreq))
-      ALLOCATE(status(MPI_STATUS_SIZE,nreq))
-    
-    
-      ireq=0
-      IF (mpi_rank==0) THEN
-        DO ind_glo=1,ndomain_glo
-          ireq=ireq+1
-
-          IF (field_glo(ind_glo)%ndim==2) THEN
-            CALL MPI_IRECV(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   &
-                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
-   
-          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
-            CALL MPI_IRECV(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   &
-                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
-
-          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
-            CALL MPI_IRECV(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   &
-                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
-          ENDIF
-         
-        ENDDO
-      ENDIF
-  
-      DO ind_loc=1,ndomain
-        ireq=ireq+1
-
-        IF (field_loc(ind_loc)%ndim==2) THEN
-          CALL MPI_ISEND(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   &
-                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
-        ELSE IF (field_loc(ind_loc)%ndim==3) THEN
-          CALL MPI_ISEND(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   &
-                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
-        ELSE IF (field_loc(ind_loc)%ndim==4) THEN
-          CALL MPI_ISEND(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   &
-                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
-        ENDIF
-      
-      ENDDO
-   
-      CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-
-    ENDIF
-        
-  END SUBROUTINE gather_field
-
-  SUBROUTINE bcast_field(field_glo)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field_glo(:)
-    INTEGER :: ind_glo    
-  
-    IF (.NOT. using_mpi) THEN
-    
-! nothing to do
-    
-    ELSE
-          
-      DO ind_glo=1,ndomain_glo
-
-          IF (field_glo(ind_glo)%ndim==2) THEN
-            CALL MPI_BCAST(field_glo(ind_glo)%rval2d, size(field_glo(ind_glo)%rval2d) , MPI_REAL8, 0, comm_icosa, ierr)
-          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
-            CALL MPI_BCAST(field_glo(ind_glo)%rval3d, size(field_glo(ind_glo)%rval3d) , MPI_REAL8, 0, comm_icosa, ierr)
-          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
-            CALL MPI_BCAST(field_glo(ind_glo)%rval4d, size(field_glo(ind_glo)%rval4d) , MPI_REAL8, 0, comm_icosa, ierr)
-          ENDIF
-         
-        ENDDO
-      ENDIF
-        
-  END SUBROUTINE bcast_field
-
-  SUBROUTINE scatter_field(field_glo,field_loc)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field_glo(:)
-    TYPE(t_field),POINTER :: field_loc(:)
-    INTEGER, ALLOCATABLE :: mpi_req(:)
-    INTEGER, ALLOCATABLE :: status(:,:)
-    INTEGER :: ireq,nreq
-    INTEGER :: ind_glo,ind_loc    
-  
-    IF (.NOT. using_mpi) THEN
-    
-      DO ind_loc=1,ndomain
-        IF (field_loc(ind_loc)%ndim==2) field_loc(ind_loc)%rval2d=field_glo(ind_loc)%rval2d
-        IF (field_loc(ind_loc)%ndim==3) field_loc(ind_loc)%rval3d=field_glo(ind_loc)%rval3d
-        IF (field_loc(ind_loc)%ndim==4) field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d
-      ENDDO
-    
-    ELSE
-          
-      nreq=ndomain
-      IF (mpi_rank==0) nreq=nreq+ndomain_glo 
-      ALLOCATE(mpi_req(nreq))
-      ALLOCATE(status(MPI_STATUS_SIZE,nreq))
-    
-    
-      ireq=0
-      IF (mpi_rank==0) THEN
-        DO ind_glo=1,ndomain_glo
-          ireq=ireq+1
-
-          IF (field_glo(ind_glo)%ndim==2) THEN
-            CALL MPI_ISEND(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   &
-                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
-   
-          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
-            CALL MPI_ISEND(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   &
-                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
-
-          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
-            CALL MPI_ISEND(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   &
-                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
-          ENDIF
-         
-        ENDDO
-      ENDIF
-  
-      DO ind_loc=1,ndomain
-        ireq=ireq+1
-
-        IF (field_loc(ind_loc)%ndim==2) THEN
-          CALL MPI_IRECV(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   &
-                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
-        ELSE IF (field_loc(ind_loc)%ndim==3) THEN
-          CALL MPI_IRECV(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   &
-                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
-        ELSE IF (field_loc(ind_loc)%ndim==4) THEN
-          CALL MPI_IRECV(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   &
-                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
-        ENDIF
-      
-      ENDDO
-   
-      CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-
-    ENDIF
-        
-  END SUBROUTINE scatter_field
-  
-  SUBROUTINE trace_in
-  USE trace
-  IMPLICIT NONE
-  
-    CALL trace_start("transfert_buffer")
-  END SUBROUTINE trace_in              
-
-  SUBROUTINE trace_out
-  USE trace
-  IMPLICIT NONE
-  
-    CALL trace_end("transfert_buffer")
-  END SUBROUTINE trace_out              
-
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Broadcast --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!! -- Les chaine de charactï¿œre -- !!
-
-  SUBROUTINE bcast_mpi_c(var1)
-  IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
-   
-    CALL bcast_mpi_cgen(Var1,len(Var1))
-
-  END SUBROUTINE bcast_mpi_c
-
-!! -- Les entiers -- !!
-  
-  SUBROUTINE bcast_mpi_i(var)
-  USE mpipara
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var
-    
-    INTEGER               :: var_tmp(1)
-    
-    IF (is_mpi_master) var_tmp(1)=var
-    CALL bcast_mpi_igen(Var_tmp,1)
-    var=var_tmp(1)
-    
-  END SUBROUTINE bcast_mpi_i
-
-  SUBROUTINE bcast_mpi_i1(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:)
-
-    CALL bcast_mpi_igen(Var,size(Var))
-    
-  END SUBROUTINE bcast_mpi_i1
-
-  SUBROUTINE bcast_mpi_i2(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:)
-   
-    CALL bcast_mpi_igen(Var,size(Var))
-  
-  END SUBROUTINE bcast_mpi_i2
-
-  SUBROUTINE bcast_mpi_i3(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:,:)
-   
-    CALL bcast_mpi_igen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_i3
-
-  SUBROUTINE bcast_mpi_i4(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
-   
-    CALL bcast_mpi_igen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_i4
-
-
-!! -- Les reels -- !!
-
-  SUBROUTINE bcast_mpi_r(var)
-  USE mpipara
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var
-    REAL               :: var_tmp(1)
-    
-    IF (is_mpi_master) var_tmp(1)=var
-    CALL bcast_mpi_rgen(Var_tmp,1)
-    var=var_tmp(1)   
-
-  END SUBROUTINE bcast_mpi_r
-
-  SUBROUTINE bcast_mpi_r1(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:)
-   
-    CALL bcast_mpi_rgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_r1
-
-  SUBROUTINE bcast_mpi_r2(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:)
-   
-    CALL bcast_mpi_rgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_r2
-
-  SUBROUTINE bcast_mpi_r3(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:,:)
-   
-    CALL bcast_mpi_rgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_r3
-
-  SUBROUTINE bcast_mpi_r4(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:,:,:)
-   
-    CALL bcast_mpi_rgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_r4
-  
-!! -- Les booleans -- !!
-
-  SUBROUTINE bcast_mpi_l(var)
-  USE mpipara
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var
-    LOGICAL               :: var_tmp(1)
-    
-    IF (is_mpi_master) var_tmp(1)=var
-    CALL bcast_mpi_lgen(Var_tmp,1)
-    var=var_tmp(1)   
-
-  END SUBROUTINE bcast_mpi_l
-
-  SUBROUTINE bcast_mpi_l1(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:)
-   
-    CALL bcast_mpi_lgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_l1
-
-  SUBROUTINE bcast_mpi_l2(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:)
-   
-    CALL bcast_mpi_lgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_l2
-
-  SUBROUTINE bcast_mpi_l3(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
-   
-    CALL bcast_mpi_lgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_l3
-
-  SUBROUTINE bcast_mpi_l4(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
-   
-    CALL bcast_mpi_lgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_l4
-  
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  SUBROUTINE bcast_mpi_cgen(var,nb)
-    USE mpi_mod
-    USE mpipara
-    IMPLICIT NONE
-    
-    CHARACTER(LEN=*),INTENT(INOUT) :: Var
-    INTEGER,INTENT(IN) :: nb
-
-    IF (.NOT. using_mpi) RETURN
-    
-    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,comm_icosa,ierr)
-        
-  END SUBROUTINE bcast_mpi_cgen
-
-
-      
-  SUBROUTINE bcast_mpi_igen(var,nb)
-    USE mpi_mod
-    USE mpipara
-    IMPLICIT NONE
-    
-    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
-    INTEGER,INTENT(IN) :: nb
-
-    IF (.NOT. using_mpi) RETURN
-
-    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,comm_icosa,ierr)
-        
-  END SUBROUTINE bcast_mpi_igen
-
-
-
-  
-  SUBROUTINE bcast_mpi_rgen(var,nb)
-    USE mpi_mod
-    USE mpipara
-    IMPLICIT NONE
-    
-    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
-    INTEGER,INTENT(IN) :: nb
-
-    IF (.NOT. using_mpi) RETURN
-
-    CALL MPI_BCAST(Var,nb,MPI_REAL8,mpi_master,comm_icosa,ierr)
-    
-  END SUBROUTINE bcast_mpi_rgen
-  
-
-
-
-  SUBROUTINE bcast_mpi_lgen(var,nb)
-    USE mpi_mod
-    USE mpipara
-    IMPLICIT NONE
-    
-    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
-    INTEGER,INTENT(IN) :: nb
-
-    IF (.NOT. using_mpi) RETURN
-
-    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,comm_icosa,ierr)
-
-  END SUBROUTINE bcast_mpi_lgen
-  
-   
-END MODULE transfert_mpi_mod
-      
-        
-        
-        
-      
Index: codes/icosagcm/devel/src/transfert_omp.f90
===================================================================
--- codes/icosagcm/devel/src/transfert_omp.f90	(revision 531)
+++ 	(revision )
@@ -1,1156 +1,0 @@
-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 
-
-
-  INTERFACE reduce_max_omp
-    MODULE PROCEDURE reduce_max_omp_i,reduce_max_omp_i1,reduce_max_omp_i2,reduce_max_omp_i3,reduce_max_omp_i4, &
-                     reduce_max_omp_r,reduce_max_omp_r1,reduce_max_omp_r2,reduce_max_omp_r3,reduce_max_omp_r4
-  END INTERFACE 
-
-  INTERFACE allreduce_max_omp
-    MODULE PROCEDURE allreduce_max_omp_i,allreduce_max_omp_i1,allreduce_max_omp_i2,allreduce_max_omp_i3,allreduce_max_omp_i4, &
-                     allreduce_max_omp_r,allreduce_max_omp_r1,allreduce_max_omp_r2,allreduce_max_omp_r3,allreduce_max_omp_r4
-  END INTERFACE 
-
-
-  PUBLIC bcast_omp, reduce_sum_omp, allreduce_sum_omp, reduce_max_omp, allreduce_max_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
-    INTEGER :: lenvar
-    lenvar=len(Var)
-    CALL bcast_omp_i(lenvar)
-    CALL bcast_omp_cgen(Var,lenvar,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  
-  
-
-
-
-
-
-
-
-
-
-
-
-  SUBROUTINE reduce_max_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_max_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
-    VarOut=VarOut_tmp(1)
-    
-  END SUBROUTINE reduce_max_omp_i
-
-  SUBROUTINE reduce_max_omp_i1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    CALL Check_buffer_i(size(VarIn))   
-    CALL reduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
-   
-  END SUBROUTINE reduce_max_omp_i1
-  
-  
-  SUBROUTINE reduce_max_omp_i2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-
-    CALL Check_buffer_i(size(VarIn))   
-    CALL reduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
-  
-  END SUBROUTINE reduce_max_omp_i2
-
-
-  SUBROUTINE reduce_max_omp_i3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL Check_buffer_i(size(VarIn))   
-    CALL reduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
-  
-  END SUBROUTINE reduce_max_omp_i3
-
-
-  SUBROUTINE reduce_max_omp_i4(VarIn, VarOut)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-  
-    CALL Check_buffer_i(size(VarIn))   
-    CALL reduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
-  
-  END SUBROUTINE reduce_max_omp_i4
-
-
-  SUBROUTINE reduce_max_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_max_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
-    VarOut=VarOut_tmp(1)
-  
-  END SUBROUTINE reduce_max_omp_r
-
-  SUBROUTINE reduce_max_omp_r1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarIn))   
-    CALL reduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
-   
-  END SUBROUTINE reduce_max_omp_r1
-  
-  
-  SUBROUTINE reduce_max_omp_r2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarIn))   
-    CALL reduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
-  
-  END SUBROUTINE reduce_max_omp_r2
-
-
-  SUBROUTINE reduce_max_omp_r3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarIn))   
-    CALL reduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
-  
-  END SUBROUTINE reduce_max_omp_r3
-
-
-  SUBROUTINE reduce_max_omp_r4(VarIn, VarOut)
-    IMPLICIT NONE
-
-    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-  
-    CALL Check_buffer_r(size(VarIn))   
-    CALL reduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
-  
-  END SUBROUTINE reduce_max_omp_r4  
-  
-  
-  
-  
-    SUBROUTINE allreduce_max_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_max_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
-    VarOut=VarOut_tmp(1)
-    
-  END SUBROUTINE allreduce_max_omp_i
-
-  SUBROUTINE allreduce_max_omp_i1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    CALL Check_buffer_i(size(VarIn))   
-    CALL allreduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
-   
-  END SUBROUTINE allreduce_max_omp_i1
-  
-  
-  SUBROUTINE allreduce_max_omp_i2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-
-    CALL Check_buffer_i(size(VarIn))   
-    CALL allreduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
-  
-  END SUBROUTINE allreduce_max_omp_i2
-
-
-  SUBROUTINE allreduce_max_omp_i3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL Check_buffer_i(size(VarIn))   
-    CALL allreduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
-  
-  END SUBROUTINE allreduce_max_omp_i3
-
-
-  SUBROUTINE allreduce_max_omp_i4(VarIn, VarOut)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-  
-    CALL Check_buffer_i(size(VarIn))   
-    CALL allreduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
-  
-  END SUBROUTINE allreduce_max_omp_i4
-
-
-  SUBROUTINE allreduce_max_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_max_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
-    VarOut=VarOut_tmp(1)
-  
-  END SUBROUTINE allreduce_max_omp_r
-
-  SUBROUTINE allreduce_max_omp_r1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarIn))   
-    CALL allreduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
-   
-  END SUBROUTINE allreduce_max_omp_r1
-  
-  
-  SUBROUTINE allreduce_max_omp_r2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarIn))   
-    CALL allreduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
-  
-  END SUBROUTINE allreduce_max_omp_r2
-
-
-  SUBROUTINE allreduce_max_omp_r3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarIn))   
-    CALL allreduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
-  
-  END SUBROUTINE allreduce_max_omp_r3
-
-
-  SUBROUTINE allreduce_max_omp_r4(VarIn, VarOut)
-    IMPLICIT NONE
-
-    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-  
-    CALL Check_buffer_r(size(VarIn))   
-    CALL allreduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
-  
-  END SUBROUTINE allreduce_max_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
-
-
-
-
-
-
-  SUBROUTINE reduce_max_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(:)=VarIn(1)
-  !$OMP END MASTER
-  !$OMP BARRIER
-  
-  !$OMP CRITICAL     
-    DO i=1,dimsize
-      Buff(i)=MAX(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_max_omp_igen
-
-  SUBROUTINE reduce_max_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(:)=VarIn(1)
-  !$OMP END MASTER
-  !$OMP BARRIER
-  
-  !$OMP CRITICAL     
-    DO i=1,dimsize
-      Buff(i)=MAX(Buff(i),VarIn(i))
-    ENDDO
-  !$OMP END CRITICAL
-  !$OMP BARRIER  
-  
-    DO i=1,dimsize
-      VarOut(i)=Buff(i)
-    ENDDO
-  !$OMP BARRIER
-  
-  END SUBROUTINE reduce_max_omp_rgen
-
-
-
-  SUBROUTINE allreduce_max_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(:)=VarIn(1)
-  !$OMP END MASTER
-  !$OMP BARRIER
-  
-  !$OMP CRITICAL     
-    DO i=1,dimsize
-      Buff(i)=MAX(Buff(i),VarIn(i))
-    ENDDO
-  !$OMP END CRITICAL
-  !$OMP BARRIER  
-  
-    DO i=1,dimsize
-      VarOut(i)=Buff(i)
-    ENDDO
-  !$OMP BARRIER
-  
-  END SUBROUTINE allreduce_max_omp_igen
-
-  SUBROUTINE allreduce_max_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(:)=VarIn(1)
-  !$OMP END MASTER
-  !$OMP BARRIER
-  
-  !$OMP CRITICAL     
-    DO i=1,dimsize
-      Buff(i)=MAX(Buff(i),VarIn(i))
-    ENDDO
-  !$OMP END CRITICAL
-  !$OMP BARRIER  
-  
-    DO i=1,dimsize
-      VarOut(i)=Buff(i)
-    ENDDO
-
-  !$OMP BARRIER
-  
-  END SUBROUTINE allreduce_max_omp_rgen
-    
-
-
-
-
-
-
-
-
-
-
-    
-END MODULE transfert_omp_mod
Index: codes/icosagcm/devel/src/transport/advect.f90
===================================================================
--- codes/icosagcm/devel/src/transport/advect.f90	(revision 533)
+++ codes/icosagcm/devel/src/transport/advect.f90	(revision 533)
@@ -0,0 +1,528 @@
+MODULE advect_mod
+  USE icosa
+  IMPLICIT NONE 
+
+  PRIVATE
+  
+  PUBLIC :: init_advect, compute_backward_traj, compute_gradq3d, compute_advect_horiz
+
+CONTAINS
+
+  !==========================================================================
+
+  SUBROUTINE init_advect(normal,tangent,sqrt_leng)
+    IMPLICIT NONE
+    REAL(rstd),INTENT(OUT) :: normal(3*iim*jjm,3)
+    REAL(rstd),INTENT(OUT) :: tangent(3*iim*jjm,3)
+    REAL(rstd),INTENT(OUT) :: sqrt_leng(iim*jjm)
+
+    INTEGER :: ij
+
+!DIR$ SIMD
+      DO ij=ij_begin,ij_end
+
+          CALL cross_product2(xyz_v(ij+z_rdown,:),xyz_v(ij+z_rup,:),normal(ij+u_right,:))
+          normal(ij+u_right,:)=normal(ij+u_right,:)/sqrt(sum(normal(ij+u_right,:)**2)+1e-50)*ne(ij,right)
+
+          CALL cross_product2(xyz_v(ij+z_up,:),xyz_v(ij+z_lup,:),normal(ij+u_lup,:))
+          normal(ij+u_lup,:)=normal(ij+u_lup,:)/sqrt(sum(normal(ij+u_lup,:)**2)+1e-50)*ne(ij,lup)
+
+          CALL cross_product2(xyz_v(ij+z_ldown,:),xyz_v(ij+z_down,:),normal(ij+u_ldown,:))	 
+          normal(ij+u_ldown,:)=normal(ij+u_ldown,:)/sqrt(sum(normal(ij+u_ldown,:)**2)+1e-50)*ne(ij,ldown)
+
+          tangent(ij+u_right,:)=xyz_v(ij+z_rup,:)-xyz_v(ij+z_rdown,:) 
+          tangent(ij+u_right,:)=tangent(ij+u_right,:)/sqrt(sum(tangent(ij+u_right,:)**2)+1e-50)
+
+          tangent(ij+u_lup,:)=xyz_v(ij+z_lup,:)-xyz_v(ij+z_up,:) 
+          tangent(ij+u_lup,:)=tangent(ij+u_lup,:)/sqrt(sum(tangent(ij+u_lup,:)**2)+1e-50)
+
+          tangent(ij+u_ldown,:)=xyz_v(ij+z_down,:)-xyz_v(ij+z_ldown,:)
+          tangent(ij+u_ldown,:)=tangent(ij+u_ldown,:)/sqrt(sum(tangent(ij+u_ldown,:)**2)+1e-50)
+
+          sqrt_leng(ij) = sqrt(max(sum((xyz_v(ij+z_up,:) - xyz_i(ij,:))**2),sum((xyz_v(ij+z_down,:) - xyz_i(ij,:))**2), &
+                                   sum((xyz_v(ij+z_rup,:) - xyz_i(ij,:))**2),sum((xyz_v(ij+z_rdown,:) - xyz_i(ij,:))**2),  &
+                                   sum((xyz_v(ij+z_lup,:) - xyz_i(ij,:))**2),sum((xyz_v(ij+z_ldown,:) - xyz_i(ij,:))**2)) )
+    ENDDO
+
+  END SUBROUTINE init_advect
+
+  !=======================================================================================
+
+  SUBROUTINE compute_gradq3d(qi_in,sqrt_leng_in,gradq3d_out,xyz_i,xyz_v)
+    USE trace
+    USE omp_para
+    IMPLICIT NONE
+    REAL(rstd),INTENT(IN)  :: qi_in(iim*jjm,llm)
+    REAL(rstd),INTENT(IN)  :: 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
+    REAL(rstd) :: leng1,leng2
+    REAL(rstd) :: arr(2*iim*jjm)
+    REAL(rstd) :: ar(iim*jjm)
+    REAL(rstd) :: gradtri(2*iim*jjm,llm,3) 
+    INTEGER :: ij,k,ind,l
+    REAL(rstd)  :: qi(iim*jjm,llm)
+    REAL(rstd)  :: 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
+    sqrt_leng=sqrt_leng_in
+    
+    CALL trace_start("compute_gradq3d1")
+
+    ! TODO : precompute ar, drop arr as output argument of gradq ?
+
+    !========================================================================================== GRADIENT 
+    ! Compute gradient at triangles solving a linear system
+    ! arr = area of triangle joining centroids of hexagons
+!     DO l = ll_begin,ll_end 
+!!DIR$ 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 
+!DIR$ 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,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
+
+!DIR$ 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
+    ENDDO
+    CALL trace_end("compute_gradq3d1")
+    CALL trace_start2("compute_gradq3d2")
+      
+    DO k=1,3
+      DO l =ll_begin,ll_end
+!DIR$ SIMD
+      DO ij=ij_begin,ij_end
+              gradq3d(ij,l,k) = ( gradtri(ij+z_up,l,k) + gradtri(ij+z_down,l,k)   +   &
+                                 gradtri(ij+z_rup,l,k) +  gradtri(ij+z_ldown,l,k)   +   & 
+                                 gradtri(ij+z_lup,l,k)+    gradtri(ij+z_rdown,l,k) ) / ar(ij)  
+        END DO
+      END DO
+    ENDDO
+    CALL trace_end2("compute_gradq3d2")
+    CALL trace_start("compute_gradq3d3")
+
+    !============================================================================================= LIMITING 
+    DO l =ll_begin,ll_end
+!DIR$ SIMD
+      DO ij=ij_begin,ij_end
+!             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*sqrt_leng(ij)
+             minq_c = qi(ij,l) - maggrd*sqrt_leng(ij)
+             maxq = max(qi(ij,l),qi(ij+t_right,l),qi(ij+t_lup,l),qi(ij+t_rup,l),qi(ij+t_left,l), &
+                  qi(ij+t_rdown,l),qi(ij+t_ldown,l))
+             minq = min(qi(ij,l),qi(ij+t_right,l),qi(ij+t_lup,l),qi(ij+t_rup,l),qi(ij+t_left,l), &
+                  qi(ij+t_rdown,l),qi(ij+t_ldown,l))
+             alphamx = (maxq - qi(ij,l)) ; alphamx = alphamx/(maxq_c - qi(ij,l) )
+             alphamx = max(alphamx,0.0)
+             alphami = (minq - qi(ij,l)); alphami = alphami/(minq_c - qi(ij,l))
+             alphami = max(alphami,0.0) 
+             alpha   = min(alphamx,alphami,1.0)
+!             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_gradq3d3")
+  
+  
+  DO k=1,3
+    DO l = ll_begin,ll_end
+      DO ij=ij_begin,ij_end 
+        gradq3d_out(ij,l,k)=gradq3d(ij,l,k)
+      ENDDO
+    ENDDO
+  ENDDO
+  
+  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
+
+  ! Backward trajectories, for use with Miura approach
+  SUBROUTINE compute_backward_traj(normal,tangent,ue,tau, cc)
+    USE trace
+    USE omp_para
+    IMPLICIT NONE
+    REAL(rstd),INTENT(IN)    :: normal(3*iim*jjm,3)
+    REAL(rstd),INTENT(IN)    :: tangent(3*iim*jjm,3)
+    REAL(rstd),INTENT(IN)    :: ue(iim*3*jjm,llm)
+    REAL(rstd),INTENT(OUT)   :: cc(3*iim*jjm,llm,3) ! start of backward trajectory
+    REAL(rstd),INTENT(IN)    :: tau
+
+    REAL(rstd) :: v_e(3), up_e, qe, ed(3)    
+    INTEGER :: ij,l
+
+    CALL trace_start("compute_backward_traj")
+
+    ! TODO : compute normal displacement ue*tau as hfluxt / mass(upwind) then reconstruct tangential displacement
+    
+    ! reconstruct tangential wind then 3D wind at edge then cc = edge midpoint - u*tau
+    DO l = ll_begin,ll_end
+!DIR$ SIMD
+      DO ij=ij_begin,ij_end
+             up_e =1/de(ij+u_right)*(                                                   &
+                  wee(ij+u_right,1,1)*le(ij+u_rup)*ue(ij+u_rup,l)+                        &
+                  wee(ij+u_right,2,1)*le(ij+u_lup)*ue(ij+u_lup,l)+                        &
+                  wee(ij+u_right,3,1)*le(ij+u_left)*ue(ij+u_left,l)+                      &
+                  wee(ij+u_right,4,1)*le(ij+u_ldown)*ue(ij+u_ldown,l)+                    &
+                  wee(ij+u_right,5,1)*le(ij+u_rdown)*ue(ij+u_rdown,l)+                    & 
+                  wee(ij+u_right,1,2)*le(ij+t_right+u_ldown)*ue(ij+t_right+u_ldown,l)+    &
+                  wee(ij+u_right,2,2)*le(ij+t_right+u_rdown)*ue(ij+t_right+u_rdown,l)+    &
+                  wee(ij+u_right,3,2)*le(ij+t_right+u_right)*ue(ij+t_right+u_right,l)+    &
+                  wee(ij+u_right,4,2)*le(ij+t_right+u_rup)*ue(ij+t_right+u_rup,l)+        &
+                  wee(ij+u_right,5,2)*le(ij+t_right+u_lup)*ue(ij+t_right+u_lup,l)         &
+                  )
+             v_e = ue(ij+u_right,l)*normal(ij+u_right,:) + up_e*tangent(ij+u_right,:)
+             cc(ij+u_right,l,:) = xyz_e(ij+u_right,:) - v_e*tau
+
+             up_e=1/de(ij+u_lup)*(                                                      &
+                  wee(ij+u_lup,1,1)*le(ij+u_left)*ue(ij+u_left,l)+                        &
+                  wee(ij+u_lup,2,1)*le(ij+u_ldown)*ue(ij+u_ldown,l)+                      &
+                  wee(ij+u_lup,3,1)*le(ij+u_rdown)*ue(ij+u_rdown,l)+                      &
+                  wee(ij+u_lup,4,1)*le(ij+u_right)*ue(ij+u_right,l)+                      &
+                  wee(ij+u_lup,5,1)*le(ij+u_rup)*ue(ij+u_rup,l)+                          & 
+                  wee(ij+u_lup,1,2)*le(ij+t_lup+u_right)*ue(ij+t_lup+u_right,l)+          &
+                  wee(ij+u_lup,2,2)*le(ij+t_lup+u_rup)*ue(ij+t_lup+u_rup,l)+              &
+                  wee(ij+u_lup,3,2)*le(ij+t_lup+u_lup)*ue(ij+t_lup+u_lup,l)+              &
+                  wee(ij+u_lup,4,2)*le(ij+t_lup+u_left)*ue(ij+t_lup+u_left,l)+            &
+                  wee(ij+u_lup,5,2)*le(ij+t_lup+u_ldown)*ue(ij+t_lup+u_ldown,l)           &
+                  )
+             v_e = ue(ij+u_lup,l)*normal(ij+u_lup,:) + up_e*tangent(ij+u_lup,:)
+             cc(ij+u_lup,l,:) = xyz_e(ij+u_lup,:) - v_e*tau
+            
+
+             up_e=1/de(ij+u_ldown)*(                                                    &
+                  wee(ij+u_ldown,1,1)*le(ij+u_rdown)*ue(ij+u_rdown,l)+                    &
+                  wee(ij+u_ldown,2,1)*le(ij+u_right)*ue(ij+u_right,l)+                    &
+                  wee(ij+u_ldown,3,1)*le(ij+u_rup)*ue(ij+u_rup,l)+                        &
+                  wee(ij+u_ldown,4,1)*le(ij+u_lup)*ue(ij+u_lup,l)+                        &
+                  wee(ij+u_ldown,5,1)*le(ij+u_left)*ue(ij+u_left,l)+                      & 
+                  wee(ij+u_ldown,1,2)*le(ij+t_ldown+u_lup)*ue(ij+t_ldown+u_lup,l)+        &
+                  wee(ij+u_ldown,2,2)*le(ij+t_ldown+u_left)*ue(ij+t_ldown+u_left,l)+      &
+                  wee(ij+u_ldown,3,2)*le(ij+t_ldown+u_ldown)*ue(ij+t_ldown+u_ldown,l)+    &
+                  wee(ij+u_ldown,4,2)*le(ij+t_ldown+u_rdown)*ue(ij+t_ldown+u_rdown,l)+    &
+                  wee(ij+u_ldown,5,2)*le(ij+t_ldown+u_right)*ue(ij+t_ldown+u_right,l)     &
+                  )
+             v_e = ue(ij+u_ldown,l)*normal(ij+u_ldown,:) + up_e*tangent(ij+u_ldown,:)
+             cc(ij+u_ldown,l,:) = xyz_e(ij+u_ldown,:) - v_e*tau
+       ENDDO
+    END DO
+
+    CALL trace_end("compute_backward_traj")
+
+  END SUBROUTINE compute_backward_traj
+
+  ! Horizontal transport (S. Dubey, T. Dubos)
+  ! Slope-limited van Leer approach with hexagons
+  SUBROUTINE compute_advect_horiz(update_mass,hfluxt,cc,gradq3d, mass,qi) 
+    USE trace
+    USE omp_para
+    IMPLICIT NONE
+    LOGICAL, INTENT(IN)       :: update_mass
+    REAL(rstd), INTENT(IN)    :: gradq3d(iim*jjm,llm,3) 
+    REAL(rstd), INTENT(IN)    :: hfluxt(3*iim*jjm,llm) ! mass flux
+    REAL(rstd), INTENT(IN)    :: cc(3*iim*jjm,llm,3)   ! barycenter of quadrilateral, where q is evaluated (1-point quadrature)
+    REAL(rstd), INTENT(INOUT) :: mass(iim*jjm,llm)
+    REAL(rstd), INTENT(INOUT) :: qi(iim*jjm,llm)
+
+    REAL(rstd) :: dq,dmass,qe,ed(3), newmass
+    REAL(rstd) :: qflux(3*iim*jjm,llm)
+    INTEGER :: ij,k,l
+
+    CALL trace_start("compute_advect_horiz")
+
+    ! evaluate tracer field at point cc using piecewise linear reconstruction
+    ! q(cc)= q0 + gradq.(cc-xyz_i)  with xi centroid of hexagon
+    ! ne*hfluxt>0 iff outgoing
+    DO l = ll_begin,ll_end
+
+!DIR$ SIMD
+      DO ij=ij_begin_ext,ij_end_ext
+
+             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)+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) + 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
+             
+             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)  + 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) + 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 
+
+             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) + 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)+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
+       END DO
+    END DO
+
+    ! update q and, if update_mass, update mass
+    DO l = ll_begin,ll_end
+!DIR$ SIMD
+      DO ij=ij_begin,ij_end
+             ! sign convention as Ringler et al. (2010) eq. 21
+             dmass =   hfluxt(ij+u_right,l)*ne(ij,right)   &
+                     + hfluxt(ij+u_lup,l)  *ne(ij,lup)     &
+                     + hfluxt(ij+u_ldown,l)*ne(ij,ldown)   &
+                     + hfluxt(ij+u_rup,l)  *ne(ij,rup)     &
+                     + hfluxt(ij+u_left,l) *ne(ij,left)    &
+                     + hfluxt(ij+u_rdown,l)*ne(ij,rdown)
+
+             dq    =   qflux(ij+u_right,l) *ne(ij,right)   &
+                     + qflux(ij+u_lup,l)   *ne(ij,lup)     &
+                     + qflux(ij+u_ldown,l) *ne(ij,ldown)   &
+                     + qflux(ij+u_rup,l)   *ne(ij,rup)     &
+                     + qflux(ij+u_left,l)  *ne(ij,left)    &
+                     + qflux(ij+u_rdown,l) *ne(ij,rdown)
+
+             
+             newmass = mass(ij,l) - dmass/Ai(ij)
+             qi(ij,l) = (qi(ij,l)*mass(ij,l) - dq/Ai(ij) ) / newmass
+             IF(update_mass) mass(ij,l) = newmass
+
+       END DO
+    END DO
+
+    CALL trace_end("compute_advect_horiz")
+  CONTAINS
+
+    !====================================================================================
+    PURE REAL(rstd) FUNCTION sum2(a1,a2)
+      IMPLICIT NONE
+      REAL(rstd),INTENT(IN):: a1(3), a2(3)
+      sum2 = a1(1)*a2(1)+a1(2)*a2(2)+a1(3)*a2(3)
+      ! sum2 = 0. ! Godunov scheme
+    END FUNCTION sum2
+
+  END SUBROUTINE compute_advect_horiz
+
+
+END MODULE advect_mod
Index: codes/icosagcm/devel/src/transport/advect_tracer.f90
===================================================================
--- codes/icosagcm/devel/src/transport/advect_tracer.f90	(revision 533)
+++ codes/icosagcm/devel/src/transport/advect_tracer.f90	(revision 533)
@@ -0,0 +1,331 @@
+MODULE advect_tracer_mod
+  USE icosa
+  IMPLICIT NONE
+  PRIVATE
+
+  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_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),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
+
+CONTAINS
+
+  SUBROUTINE init_advect_tracer
+    USE advect_mod
+    USE omp_para
+    REAL(rstd),POINTER :: tangent(:,:)
+    REAL(rstd),POINTER :: normal(:,:)
+    REAL(rstd),POINTER :: sqrt_leng(:)
+    INTEGER :: ind
+
+    CALL allocate_field(f_normal,field_u,type_real,3, name='normal')
+    CALL allocate_field(f_tangent,field_u,type_real,3, name='tangent')
+    CALL allocate_field(f_gradq3d,field_t,type_real,llm,3, name='gradq3d')
+    CALL allocate_field(f_cc,field_u,type_real,llm,3, name='cc')
+    CALL allocate_field(f_sqrt_leng,field_t,type_real, name='sqrt_leng')
+    CALL allocate_field(f_dzqw, field_t, type_real, llm, name='dzqw')
+    CALL allocate_field(f_adzqw, field_t, type_real, llm, name='adzqw')
+    CALL allocate_field(f_dzq, field_t, type_real, llm, name='dzq')
+    CALL allocate_field(f_wq, field_t, type_real, llm+1, name='wq')
+    
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       normal=f_normal(ind)
+       tangent=f_tangent(ind)
+       sqrt_leng=f_sqrt_leng(ind)
+       IF (is_omp_level_master) CALL init_advect(normal,tangent,sqrt_leng)
+    END DO
+
+  END SUBROUTINE init_advect_tracer
+
+  SUBROUTINE advect_tracer(f_hfluxt, f_wfluxt,f_u, f_q,f_rhodz)
+    USE advect_mod
+    USE mpipara
+    USE trace
+    USE write_field_mod
+    USE tracer_mod
+    IMPLICIT NONE
+    
+    TYPE(t_field),POINTER :: f_hfluxt(:)   ! time-integrated horizontal mass flux
+    TYPE(t_field),POINTER :: f_wfluxt(:)   ! time-integrated vertical mass flux
+    TYPE(t_field),POINTER :: f_u(:)        ! velocity (for back-trajectories)
+    TYPE(t_field),POINTER :: f_q(:)        ! tracer
+    TYPE(t_field),POINTER :: f_rhodz(:)    ! mass field at beginning of macro time step
+
+    REAL(rstd),POINTER :: q(:,:,:), normal(:,:), tangent(:,:), sqrt_leng(:), gradq3d(:,:,:), cc(:,:,:)
+    REAL(rstd),POINTER :: hfluxt(:,:), wfluxt(:,:)
+    REAL(rstd),POINTER :: rhodz(:,:), u(:,:) 
+! temporary shared variable for vlz
+    REAL(rstd),POINTER ::  dzqw(:,:)         ! vertical finite difference of q 
+    REAL(rstd),POINTER ::  adzqw(:,:)        ! abs(dzqw)
+    REAL(rstd),POINTER ::  dzq(:,:)          ! limited slope of q
+    REAL(rstd),POINTER ::  wq(:,:)           ! time-integrated flux of q
+    
+     INTEGER :: ind,k, nq_last
+    LOGICAL,SAVE :: first=.TRUE.
+!$OMP THREADPRIVATE(first)
+
+    IF (first) THEN
+      first=.FALSE.
+      CALL init_message(f_u,req_e1_vect,req_u, 'req_u')
+      CALL init_message(f_cc,req_e1_scal,req_cc, 'req_cc')
+      CALL init_message(f_wfluxt,req_i1,req_wfluxt, 'req_wfluxt')
+      CALL init_message(f_q,req_i1,req_q, 'req_q')
+      CALL init_message(f_rhodz,req_i1,req_rhodz, 'req_rhodz')
+      CALL init_message(f_gradq3d,req_i1,req_gradq3d, 'req_gradq3d')
+    ENDIF
+    
+!!$OMP BARRIER
+
+    IF(nqtot<1) RETURN
+    nq_last=-1
+    
+    DO k = 1, nqtot
+      IF (advection_scheme(k)==advect_vanleer) nq_last=k
+    ENDDO
+     
+    IF(nq_last<0) RETURN
+      
+    CALL trace_start("advect_tracer") 
+
+    CALL send_message(f_u,req_u)
+    CALL send_message(f_wfluxt,req_wfluxt)
+    CALL send_message(f_q,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)
+    
+    ! 1/2 vertical transport + back-trajectories
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       normal  = f_normal(ind)
+       tangent = f_tangent(ind)
+       cc      = f_cc(ind)
+       u       = f_u(ind)
+       q       = f_q(ind)
+       rhodz   = f_rhodz(ind)
+       wfluxt  = f_wfluxt(ind) 
+       dzqw    = f_dzqw(ind)
+       adzqw   = f_adzqw(ind)
+       dzq     = f_dzq(ind)
+       wq      = f_wq(ind) 
+
+       DO k = 1, nqtot
+          IF (advection_scheme(k)==advect_vanleer) CALL vlz(k==nq_last,0.5, wfluxt,rhodz,q(:,:,k),1,dzqw, adzqw, dzq, wq)
+       END DO
+
+       CALL compute_backward_traj(tangent,normal,u,0.5*dt*itau_adv, cc) 
+
+    END DO
+
+    CALL send_message(f_cc,req_cc)
+
+
+    ! horizontal transport - split in two to place transfer of gradq3d
+    DO k = 1, nqtot
+      IF (advection_scheme(k)==advect_vanleer) THEN
+       
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+          CALL swap_dimensions(ind)
+          CALL swap_geometry(ind)
+          q       = f_q(ind)
+          gradq3d = f_gradq3d(ind)
+          sqrt_leng=f_sqrt_leng(ind)
+          CALL compute_gradq3d(q(:,:,k),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_gradq3d)
+
+
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+          CALL swap_dimensions(ind)
+          CALL swap_geometry(ind)
+          cc      = f_cc(ind)
+          q       = f_q(ind)
+          rhodz   = f_rhodz(ind)
+          hfluxt  = f_hfluxt(ind) 
+          gradq3d = f_gradq3d(ind)
+          CALL compute_advect_horiz(k==nq_last,hfluxt,cc,gradq3d, rhodz,q(:,:,k))
+        END DO
+      ENDIF
+    END DO 
+    
+    ! 1/2 vertical transport
+!!$OMP BARRIER
+
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       q       = f_q(ind)
+       rhodz   = f_rhodz(ind)
+       wfluxt  = f_wfluxt(ind) 
+       dzqw    = f_dzqw(ind)
+       adzqw   = f_adzqw(ind)
+       dzq     = f_dzq(ind)
+       wq      = f_wq(ind) 
+
+       DO k = 1,nqtot
+         IF (advection_scheme(k)==advect_vanleer) CALL vlz(k==nq_last, 0.5,wfluxt,rhodz, q(:,:,k),0, dzqw, adzqw, dzq, wq)
+       END DO
+
+    END DO
+
+    CALL trace_end("advect_tracer")
+
+!!$OMP BARRIER
+
+  END SUBROUTINE advect_tracer
+
+  SUBROUTINE vlz(update_mass, fac,wfluxt,mass, q, halo, dzqw, adzqw, dzq, wq)
+    !
+    !     Auteurs:   P.Le Van, F.Hourdin, F.Forget, T. Dubos
+    !
+    !    ********************************************************************
+    !     Update tracers using vertical mass flux only
+    !     Van Leer scheme with minmod limiter
+    !     wfluxt >0 for upward transport
+    !    ********************************************************************
+    USE trace
+    USE omp_para
+    IMPLICIT NONE
+    LOGICAL, INTENT(IN)       :: update_mass
+    REAL(rstd), INTENT(IN)    :: fac, wfluxt(iim*jjm,llm+1) ! vertical mass flux
+    REAL(rstd), INTENT(INOUT) :: mass(iim*jjm,llm)
+    REAL(rstd), INTENT(INOUT) :: q(iim*jjm,llm)
+    INTEGER, INTENT(IN) :: halo
+
+! temporary shared variable
+    REAL(rstd),INTENT(INOUT) :: dzqw(iim*jjm,llm),        & ! vertical finite difference of q 
+                                adzqw(iim*jjm,llm),       & ! abs(dzqw)
+                                dzq(iim*jjm,llm),         & ! limited slope of q
+                                wq(iim*jjm,llm+1)           ! time-integrated flux of q
+
+
+    REAL(rstd) :: dzqmax, newmass, sigw, qq, w
+    INTEGER :: i,ij,l,j,ijb,ije
+
+    CALL trace_start("vlz")
+     
+     ijb=((jj_begin-halo)-1)*iim+ii_begin-halo
+     ije = ((jj_end+halo)-1)*iim+ii_end+halo
+
+    ! finite difference of q
+
+     DO l=ll_beginp1,ll_end
+!DIR$ SIMD
+       DO ij=ijb,ije
+         dzqw(ij,l)=q(ij,l)-q(ij,l-1)
+         adzqw(ij,l)=abs(dzqw(ij,l))
+       ENDDO
+    ENDDO
+
+!--> flush dzqw, adzqw
+!$OMP BARRIER
+
+    ! minmod-limited slope of q
+    ! dzq = slope*dz, i.e. the reconstructed q varies by dzq inside level l
+
+     DO l=ll_beginp1,ll_endm1
+!DIR$ SIMD
+       DO ij=ijb,ije 
+         IF(dzqw(ij,l)*dzqw(ij,l+1).gt.0.) THEN
+             dzq(ij,l) = 0.5*( dzqw(ij,l)+dzqw(ij,l+1) )
+             dzqmax    = pente_max * min( adzqw(ij,l),adzqw(ij,l+1) )
+             dzq(ij,l) = sign( min(abs(dzq(ij,l)),dzqmax) , dzq(ij,l) )  ! NB : sign(a,b)=a*sign(b)
+          ELSE
+             dzq(ij,l)=0.
+          ENDIF
+       ENDDO
+    ENDDO
+
+
+    ! 0 slope in top and bottom layers
+    IF (is_omp_first_level) THEN
+      DO ij=ijb,ije
+           dzq(ij,1)=0.
+      ENDDO
+    ENDIF
+      
+    IF (is_omp_last_level) THEN
+      DO ij=ijb,ije
+          dzq(ij,llm)=0.
+      ENDDO
+    ENDIF
+
+!---> flush dzq
+!$OMP BARRIER  
+
+    ! sigw = fraction of mass that leaves level l/l+1
+    ! then amount of q leaving level l/l+1 = wq = w * qq
+     DO l=ll_beginp1,ll_end
+!DIR$ SIMD
+       DO ij=ijb,ije
+             w = fac*wfluxt(ij,l)
+             IF(w>0.) THEN  ! upward transport, upwind side is at level l 
+                sigw       = w/mass(ij,l-1)
+                qq         = q(ij,l-1)+0.5*(1.-sigw)*dzq(ij,l-1) ! qq = q if sigw=1 , qq = q+dzq/2 if sigw=0
+             ELSE           ! downward transport, upwind side is at level l+1
+                sigw       = w/mass(ij,l)
+                qq         = q(ij,l)-0.5*(1.+sigw)*dzq(ij,l) ! qq = q if sigw=-1 , qq = q-dzq/2 if sigw=0                
+             ENDIF
+             wq(ij,l) = w*qq
+       ENDDO
+    END DO
+    ! wq = 0 at top and bottom
+    IF (is_omp_first_level) THEN
+       DO ij=ijb,ije
+            wq(ij,1)=0.
+      END DO
+    ENDIF
+    
+    IF (is_omp_last_level) THEN
+      DO ij=ijb,ije
+            wq(ij,llm+1)=0.
+      END DO
+    ENDIF
+
+! --> flush wq
+!$OMP BARRIER
+
+
+    ! update q, mass is updated only after all q's have been updated
+    DO l=ll_begin,ll_end
+!DIR$ SIMD
+       DO ij=ijb,ije
+             newmass = mass(ij,l) + fac*(wfluxt(ij,l)-wfluxt(ij,l+1))
+             q(ij,l) = ( q(ij,l)*mass(ij,l) + wq(ij,l)-wq(ij,l+1) ) / newmass
+             IF(update_mass) mass(ij,l)=newmass
+       ENDDO
+    END DO
+
+    CALL trace_end("vlz")
+
+  END SUBROUTINE vlz
+
+END MODULE advect_tracer_mod
Index: codes/icosagcm/devel/src/transport/tracer.f90
===================================================================
--- codes/icosagcm/devel/src/transport/tracer.f90	(revision 533)
+++ codes/icosagcm/devel/src/transport/tracer.f90	(revision 533)
@@ -0,0 +1,41 @@
+MODULE tracer_mod
+
+  INTEGER, PARAMETER   :: advect_none    = 0
+  INTEGER, PARAMETER   :: advect_vanleer = 1
+  INTEGER, ALLOCATABLE,SAVE :: advection_scheme(:)
+!$OMP THREADPRIVATE(advection_scheme)
+ 
+  INTERFACE set_advection_scheme
+    MODULE PROCEDURE set_advection_scheme_1, set_advection_scheme_full
+  END INTERFACE
+
+CONTAINS
+
+  SUBROUTINE init_tracer
+  USE grid_param
+  IMPLICIT NONE
+    
+    ALLOCATE(advection_scheme(nqtot))
+    advection_scheme(:) = advect_vanleer 
+
+  END SUBROUTINE init_tracer
+
+  SUBROUTINE set_advection_scheme_1(nq,scheme)
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: nq
+    INTEGER, INTENT(IN) :: scheme
+    
+    advection_scheme(nq)=scheme
+  
+  END SUBROUTINE set_advection_scheme_1
+
+  SUBROUTINE set_advection_scheme_full(schemes)
+  USE grid_param
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: schemes(nqtot)
+  
+    advection_scheme(:)=schemes(:)
+  
+  END SUBROUTINE set_advection_scheme_full
+
+END MODULE tracer_mod
Index: codes/icosagcm/devel/src/vector.f90
===================================================================
--- codes/icosagcm/devel/src/vector.f90	(revision 531)
+++ 	(revision )
@@ -1,55 +1,0 @@
-MODULE vector
-  USE genmod
-
-CONTAINS
-
-  FUNCTION Norm(V)
-  IMPLICIT NONE
-    REAL(rstd)            :: Norm
-    REAL(rstd),INTENT(IN) :: V(3)
-    
-    Norm=sqrt(V(1)*V(1)+V(2)*V(2)+V(3)*V(3))
-  
-  END FUNCTION Norm
-  
-  FUNCTION dot_product(V1,V2)
-  IMPLICIT NONE
-    REAL(rstd)       :: dot_product
-    REAL(rstd),INTENT(IN) :: V1(3)
-    REAL(rstd),INTENT(IN) :: V2(3)
-    
-    dot_product=V1(1)*V2(1)+V1(2)*V2(2)+V1(3)*V2(3)
-    
-   END FUNCTION dot_product
-   
-   FUNCTION cross_product(V1,V2)
-   IMPLICIT NONE
-     REAL(rstd)     ::cross_product(3)
-     REAL(rstd),INTENT(IN) :: V1(3)
-     REAL(rstd),INTENT(IN) :: V2(3)
-    
-     cross_product(1)=V1(2)*V2(3)-V1(3)*V2(2)
-     cross_product(2)=V1(3)*V2(1)-V1(1)*V2(3)
-     cross_product(3)=V1(1)*V2(2)-V1(2)*V2(1)
-     
-    END FUNCTION cross_product
-
-
-   SUBROUTINE cross_product2(V1,V2,cross_product)
-   IMPLICIT NONE
-     REAL(rstd),INTENT(OUT):: cross_product(3)
-     REAL(rstd),INTENT(IN) :: V1(3)
-     REAL(rstd),INTENT(IN) :: V2(3)
-    
-     cross_product(1)=V1(2)*V2(3)-V1(3)*V2(2)
-     cross_product(2)=V1(3)*V2(1)-V1(1)*V2(3)
-     cross_product(3)=V1(1)*V2(2)-V1(2)*V2(1)
-     
-    END SUBROUTINE cross_product2
-
-    FUNCTION arc(lon,lat, lonc,latc)
-      REAL(rstd) :: lon,lat, lonc,latc, arc
-      arc=ACOS(sin(latc)*sin(lat)+cos(latc)*cos(lat)*cos(lon-lonc))
-    END FUNCTION arc
-
-END MODULE vector
Index: codes/icosagcm/devel/src/vorticity.f90
===================================================================
--- codes/icosagcm/devel/src/vorticity.f90	(revision 531)
+++ 	(revision )
@@ -1,56 +1,0 @@
-MODULE vorticity_mod
-
-CONTAINS
-
-  SUBROUTINE vorticity(f_ue,f_vort)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ue(:)
-    TYPE(t_field), POINTER :: f_vort(:)
-  
-    REAL(rstd), POINTER :: ue(:,:)
-    REAL(rstd), POINTER :: vort(:,:)
-    INTEGER :: ind
-
-    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)
-      ue=f_ue(ind)
-      vort=f_vort(ind)
-      CALL compute_vorticity(ue, vort)
-    ENDDO
-  
-  END SUBROUTINE vorticity
-  
-  SUBROUTINE compute_vorticity(ue,vort)
-  USE icosa
-  USE disvert_mod
-  USE omp_para
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN)  :: ue(3*iim*jjm,llm)
-    REAL(rstd),INTENT(OUT) :: vort(2*iim*jjm,llm)
-    INTEGER :: i,j,ij,l
-
-    DO l = ll_begin,ll_end
-      DO j=jj_begin-1,jj_end+1
-        DO i=ii_begin-1,ii_end+1
-          ij=(j-1)*iim+i
-        
-           vort(ij+z_up,l) = 1./Av(ij+z_up)*(  ne(ij,rup)        * ue(ij+u_rup,l)        * de(ij+u_rup)         &
-                                + ne(ij+t_rup,left) * ue(ij+t_rup+u_left,l) * de(ij+t_rup+u_left)               &
-                                - ne(ij,lup)        * ue(ij+u_lup,l)        * de(ij+u_lup) )                               
-
-           vort(ij+z_down,l) = 1./Av(ij+z_down)*(  ne(ij,ldown)         * ue(ij+u_ldown,l)         * de(ij+u_ldown)          &
-                                   + ne(ij+t_ldown,right) * ue(ij+t_ldown+u_right,l) * de(ij+t_ldown+u_right)                &
-                                   - ne(ij,rdown)         * ue(ij+u_rdown,l)          * de(ij+u_rdown) )
-
-        ENDDO
-      ENDDO
-    ENDDO
-    
-  END SUBROUTINE compute_vorticity
-
-END MODULE vorticity_mod
Index: codes/icosagcm/devel/src/wind.f90
===================================================================
--- codes/icosagcm/devel/src/wind.f90	(revision 531)
+++ 	(revision )
@@ -1,408 +1,0 @@
-MODULE wind_mod
-
-CONTAINS
-
-  SUBROUTINE un2ulonlat(f_u, f_ulon, f_ulat)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_u(:) ! IN  : normal velocity components on edges
-    TYPE(t_field), POINTER :: f_ulon(:), f_ulat(:) ! OUT : velocity reconstructed at hexagons
-    
-    REAL(rstd),POINTER :: u(:,:),  ulon(:,:), ulat(:,:)
-    INTEGER :: ind
-
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       u=f_u(ind)
-       ulon=f_ulon(ind)
-       ulat=f_ulat(ind)
-       CALL compute_un2ulonlat(u,ulon, ulat)
-    END DO
-
-  END SUBROUTINE un2ulonlat
-
-  SUBROUTINE ulonlat2un(f_ulon, f_ulat,f_u)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ulon(:), f_ulat(:) ! IN : velocity reconstructed at hexagons
-    TYPE(t_field), POINTER :: f_u(:) ! OUT  : normal velocity components on edges
-    
-    REAL(rstd),POINTER :: u(:,:),  ulon(:,:), ulat(:,:)
-    INTEGER :: ind
-
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       u=f_u(ind)
-       ulon=f_ulon(ind)
-       ulat=f_ulat(ind)
-       CALL compute_ulonlat2un(ulon, ulat,u)
-    END DO
-
-  END SUBROUTINE ulonlat2un
- 
-  SUBROUTINE compute_wind_centered(ue,ucenter)
-  USE icosa
-  USE omp_para
-  IMPLICIT NONE
-  REAL(rstd) :: ue(3*iim*jjm,llm)
-  REAL(rstd) :: ucenter(iim*jjm,3,llm)
-  INTEGER :: i,j,ij,l    
- 
-    DO l=ll_begin,ll_end
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          ucenter(ij,:,l)=1/Ai(ij)*                                                                                                &
-                        ( ne(ij,right)*ue(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_v(ij+z_rup,:))/2-centroid(ij,:))  &
-                         + ne(ij,rup)*ue(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_v(ij+z_up,:))/2-centroid(ij,:))          &
-                         + ne(ij,lup)*ue(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_v(ij+z_lup,:))/2-centroid(ij,:))          &
-                         + ne(ij,left)*ue(ij+u_left,l)*le(ij+u_left)*((xyz_v(ij+z_lup,:)+xyz_v(ij+z_ldown,:))/2-centroid(ij,:))    &
-                         + ne(ij,ldown)*ue(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_v(ij+z_ldown,:)+xyz_v(ij+z_down,:))/2-centroid(ij,:))&
-                         + ne(ij,rdown)*ue(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_v(ij+z_down,:)+xyz_v(ij+z_rdown,:))/2-centroid(ij,:)))
-        ENDDO
-      ENDDO
-    ENDDO
- 
- END SUBROUTINE compute_wind_centered
- 
-  
- SUBROUTINE compute_wind_on_edge(ue,uedge)
-  USE icosa
-  USE omp_para
-    
-  IMPLICIT NONE
-  REAL(rstd) :: ue(3*iim*jjm,llm)
-  REAL(rstd) :: uedge(3*iim*jjm,3,llm)
-
-  REAL(rstd) :: ut(3*iim*jjm,llm)
-  INTEGER :: i,j,ij,l     
-    
-    CALL compute_tangential_compound(ue,ut)
-  
-    DO l=ll_begin,ll_end
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          uedge(ij+u_right,:,l)=ue(ij+u_right,l)*ep_e(ij+u_right,:)*ne(ij,right) + ut(ij+u_right,l)*et_e(ij+u_right,:)*ne(ij,right) 
-          uedge(ij+u_lup,:,l)=ue(ij+u_lup,l)*ep_e(ij+u_lup,:)*ne(ij,lup) + ut(ij+u_lup,l)*et_e(ij+u_lup,:)*ne(ij,lup)
-          uedge(ij+u_ldown,:,l)=ue(ij+u_ldown,l)*ep_e(ij+u_ldown,:)*ne(ij,ldown) + ut(ij+u_ldown,l)*et_e(ij+u_ldown,:)*ne(ij,ldown)
-        ENDDO
-      ENDDO
-    ENDDO
- 
- END SUBROUTINE compute_wind_on_edge
- 
- 
- 
- SUBROUTINE compute_tangential_compound(ue,ut)
-  USE icosa  
-  USE omp_para
-  IMPLICIT NONE
-  REAL(rstd) :: ue(3*iim*jjm,llm)
-  REAL(rstd) :: ut(3*iim*jjm,llm)
-  INTEGER :: i,j,l,ij
-    
-  DO l=ll_begin,ll_end
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        ij=(j-1)*iim+i
-   
-        ut(ij+u_right,l) = 1/de(ij+u_right) *                                            &  
-                         ( wee(ij+u_right,1,1)*ue(ij+u_rup,l)+                           &
-                           wee(ij+u_right,2,1)*ue(ij+u_lup,l)+                           &
-                           wee(ij+u_right,3,1)*ue(ij+u_left,l)+                          &
-                           wee(ij+u_right,4,1)*ue(ij+u_ldown,l)+                         &
-                           wee(ij+u_right,5,1)*ue(ij+u_rdown,l)+                         & 
-                           wee(ij+u_right,1,2)*ue(ij+t_right+u_ldown,l)+                 &
-                           wee(ij+u_right,2,2)*ue(ij+t_right+u_rdown,l)+                 &
-                           wee(ij+u_right,3,2)*ue(ij+t_right+u_right,l)+                 &
-                           wee(ij+u_right,4,2)*ue(ij+t_right+u_rup,l)+                   &
-                           wee(ij+u_right,5,2)*ue(ij+t_right+u_lup,l) )   
-     
-        ut(ij+u_lup,l) =  1/de(ij+u_lup) *                                           &  
-                         ( wee(ij+u_lup,1,1)*ue(ij+u_left,l)+                        &
-                           wee(ij+u_lup,2,1)*ue(ij+u_ldown,l)+                       &
-                           wee(ij+u_lup,3,1)*ue(ij+u_rdown,l)+                       &
-                           wee(ij+u_lup,4,1)*ue(ij+u_right,l)+                       &
-                           wee(ij+u_lup,5,1)*ue(ij+u_rup,l)+                         & 
-                           wee(ij+u_lup,1,2)*ue(ij+t_lup+u_right,l)+                 &
-                           wee(ij+u_lup,2,2)*ue(ij+t_lup+u_rup,l)+                   &
-                           wee(ij+u_lup,3,2)*ue(ij+t_lup+u_lup,l)+                   &
-                           wee(ij+u_lup,4,2)*ue(ij+t_lup+u_left,l)+                  &
-                           wee(ij+u_lup,5,2)*ue(ij+t_lup+u_ldown,l) )
-
-    
-        ut(ij+u_ldown,l) = 1/de(ij+u_ldown) *   &  
-                         ( wee(ij+u_ldown,1,1)*ue(ij+u_rdown,l)+                      &
-                           wee(ij+u_ldown,2,1)*ue(ij+u_right,l)+                      &
-                           wee(ij+u_ldown,3,1)*ue(ij+u_rup,l)+                        &
-                           wee(ij+u_ldown,4,1)*ue(ij+u_lup,l)+                        &
-                           wee(ij+u_ldown,5,1)*ue(ij+u_left,l)+                       & 
-                           wee(ij+u_ldown,1,2)*ue(ij+t_ldown+u_lup,l)+                &
-                           wee(ij+u_ldown,2,2)*ue(ij+t_ldown+u_left,l)+               &
-                           wee(ij+u_ldown,3,2)*ue(ij+t_ldown+u_ldown,l)+              &
-                           wee(ij+u_ldown,4,2)*ue(ij+t_ldown+u_rdown,l)+              &
-                           wee(ij+u_ldown,5,2)*ue(ij+t_ldown+u_right,l) )  
-        
-        ENDDO
-      ENDDO
-    ENDDO
-                        
- END SUBROUTINE compute_tangential_compound
- 
- SUBROUTINE compute_wind_lonlat_compound(u, ulon, ulat)
-  USE icosa  
-  USE omp_para
-    
-  IMPLICIT NONE
-  REAL(rstd) :: u(3*iim*jjm,3,llm)
-  REAL(rstd) :: ulon(3*iim*jjm,3,llm)
-  REAL(rstd) :: ulat(3*iim*jjm,3,llm)
-
-  INTEGER :: i,j,ij,l     
-    
-  
-    DO l=ll_begin,ll_end
-      DO j=jj_begin-1,jj_end+1
-        DO i=ii_begin-1,ii_end+1
-          ij=(j-1)*iim+i
-          ulon(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elon_e(ij+u_right,:))*elon_e(ij+u_right,:) 
-          ulon(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elon_e(ij+u_lup,:))*elon_e(ij+u_lup,:)
-          ulon(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elon_e(ij+u_ldown,:))*elon_e(ij+u_ldown,:)
-          
-          ulat(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elat_e(ij+u_right,:))*elat_e(ij+u_right,:) 
-          ulat(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elat_e(ij+u_lup,:))*elat_e(ij+u_lup,:) 
-          ulat(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elat_e(ij+u_ldown,:))*elat_e(ij+u_ldown,:) 
-          
-        ENDDO
-      ENDDO
-    ENDDO
- 
- END SUBROUTINE compute_wind_lonlat_compound
- 
-  SUBROUTINE compute_wind_from_lonlat_compound(ulon, ulat, u)
-  USE icosa  
-  USE omp_para
-    
-  IMPLICIT NONE
-  REAL(rstd) :: u(3*iim*jjm,3,llm)
-  REAL(rstd) :: ulon(3*iim*jjm,llm)
-  REAL(rstd) :: ulat(3*iim*jjm,llm)
-
-  INTEGER :: i,j,ij,l     
-  
-    DO l=ll_begin,ll_end
-      DO j=jj_begin-1,jj_end+1
-        DO i=ii_begin-1,ii_end+1
-          ij=(j-1)*iim+i
-          u(ij+u_right,:,l)=ulon(ij+u_right,l)*elon_e(ij+u_right,:)+ ulat(ij+u_right,l)*elat_e(ij+u_right,:)
-          u(ij+u_lup,:,l)=ulon(ij+u_lup,l)*elon_e(ij+u_lup,:) + ulat(ij+u_lup,l)*elat_e(ij+u_lup,:)
-          u(ij+u_ldown,:,l)=ulon(ij+u_ldown,l)*elon_e(ij+u_ldown,:) + ulat(ij+u_ldown,l)*elat_e(ij+u_ldown,:)
-        ENDDO
-      ENDDO
-    ENDDO
- 
-  END SUBROUTINE compute_wind_from_lonlat_compound
- 
-  SUBROUTINE compute_wind_centered_from_lonlat_compound(ulon, ulat, u)
-  USE icosa  
-  USE omp_para
-    
-  IMPLICIT NONE
-  REAL(rstd) :: u(iim*jjm,3,llm)
-  REAL(rstd) :: ulon(iim*jjm,llm)
-  REAL(rstd) :: ulat(iim*jjm,llm)
-
-  INTEGER :: i,j,ij,l     
-  DO l=ll_begin,ll_end
-      DO j=jj_begin-1,jj_end+1
-        DO i=ii_begin-1,ii_end+1
-          ij=(j-1)*iim+i
-          u(ij,:,l)=ulon(ij,l)*elon_i(ij,:)+ ulat(ij,l)*elat_i(ij,:)
-        ENDDO
-      ENDDO
-    ENDDO
- 
-  END SUBROUTINE compute_wind_centered_from_lonlat_compound
- 
-  SUBROUTINE compute_wind2D_from_lonlat_compound(ulon, ulat, u)
-  USE icosa  
-  
-  IMPLICIT NONE
-  REAL(rstd) :: u(3*iim*jjm,3)
-  REAL(rstd) :: ulon(3*iim*jjm)
-  REAL(rstd) :: ulat(3*iim*jjm)
-  
-  INTEGER :: i,j,ij
-  
-  DO j=jj_begin-1,jj_end+1
-     DO i=ii_begin-1,ii_end+1
-        ij=(j-1)*iim+i
-        u(ij+u_right,:)=ulon(ij+u_right)*elon_e(ij+u_right,:)+ ulat(ij+u_right)*elat_e(ij+u_right,:)
-        u(ij+u_lup,:)=ulon(ij+u_lup)*elon_e(ij+u_lup,:) + ulat(ij+u_lup)*elat_e(ij+u_lup,:)
-        u(ij+u_ldown,:)=ulon(ij+u_ldown)*elon_e(ij+u_ldown,:) + ulat(ij+u_ldown)*elat_e(ij+u_ldown,:)
-     ENDDO
-  ENDDO
-    
-  END SUBROUTINE compute_wind2D_from_lonlat_compound
- 
-  SUBROUTINE compute_wind_perp_from_lonlat_compound(ulon, ulat, up)
-  USE icosa  
-  USE omp_para
-    
-  IMPLICIT NONE
-  REAL(rstd) :: up(3*iim*jjm,llm)
-  REAL(rstd) :: ulon(3*iim*jjm,llm)
-  REAL(rstd) :: ulat(3*iim*jjm,llm)
-  REAL(rstd) :: u(3*iim*jjm,3,llm)
-
-  INTEGER :: i,j,ij,l     
-  
-   CALL compute_wind_from_lonlat_compound(ulon, ulat, u)
-
-    DO l=ll_begin,ll_end
-      DO j=jj_begin-1,jj_end+1
-        DO i=ii_begin-1,ii_end+1
-          ij=(j-1)*iim+i
-          up(ij+u_right,l)=sum(u(ij+u_right,:,l)*ep_e(ij+u_right,:))
-          up(ij+u_lup,l)=sum(u(ij+u_lup,:,l)*ep_e(ij+u_lup,:))
-          up(ij+u_ldown,l)=sum(u(ij+u_ldown,:,l)*ep_e(ij+u_ldown,:))
-        ENDDO
-      ENDDO
-    ENDDO
- 
-  END SUBROUTINE compute_wind_perp_from_lonlat_compound
-   
-  SUBROUTINE compute_wind2D_perp_from_lonlat_compound(ulon, ulat, up)
-  USE icosa  
-    
-  IMPLICIT NONE
-  REAL(rstd) :: up(3*iim*jjm)
-  REAL(rstd) :: ulon(3*iim*jjm)
-  REAL(rstd) :: ulat(3*iim*jjm)
-  REAL(rstd) :: u(3*iim*jjm,3)
-
-  INTEGER :: i,j,ij 
-  
-  CALL compute_wind2D_from_lonlat_compound(ulon, ulat, u)
-  DO j=jj_begin-1,jj_end+1
-     DO i=ii_begin-1,ii_end+1
-        ij=(j-1)*iim+i
-        up(ij+u_right)=sum(u(ij+u_right,:)*ep_e(ij+u_right,:))
-        up(ij+u_lup)=sum(u(ij+u_lup,:)*ep_e(ij+u_lup,:))
-        up(ij+u_ldown)=sum(u(ij+u_ldown,:)*ep_e(ij+u_ldown,:))
-     ENDDO
-  ENDDO
-   
-  END SUBROUTINE compute_wind2D_perp_from_lonlat_compound
-   
- SUBROUTINE compute_wind_centered_lonlat_compound(uc, ulon, ulat)
-  USE icosa  
-  USE omp_para
-    
-  IMPLICIT NONE
-  REAL(rstd) :: uc(iim*jjm,3,llm)
-  REAL(rstd) :: ulon(iim*jjm,llm)
-  REAL(rstd) :: ulat(iim*jjm,llm)
-
-  INTEGER :: i,j,ij,l     
-    
-  
-    DO l=ll_begin,ll_end
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          ulon(ij,l)=sum(uc(ij,:,l)*elon_i(ij,:))
-          ulat(ij,l)=sum(uc(ij,:,l)*elat_i(ij,:)) 
-        ENDDO
-      ENDDO
-    ENDDO
- 
- END SUBROUTINE compute_wind_centered_lonlat_compound
-
- SUBROUTINE compute_wind_centered_from_wind_lonlat_centered(ulon, ulat,uc)
-  USE icosa  
-  USE omp_para
-    
-  IMPLICIT NONE
-  REAL(rstd) :: ulon(iim*jjm,llm)
-  REAL(rstd) :: ulat(iim*jjm,llm)
-  REAL(rstd) :: uc(iim*jjm,3,llm)
-
-  INTEGER :: i,j,ij,l     
-    
-  
-    DO l=ll_begin,ll_end
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          uc(ij,:,l)=ulon(ij,l)*elon_i(ij,:)+ulat(ij,l)*elat_i(ij,:)
-        ENDDO
-      ENDDO
-    ENDDO
- 
- END SUBROUTINE compute_wind_centered_from_wind_lonlat_centered
-
-
-
- SUBROUTINE compute_wind_perp_from_wind_centered(uc,un)
-  USE icosa  
-  USE omp_para
-    
-  IMPLICIT NONE
-  REAL(rstd),INTENT(IN)   :: uc(iim*jjm,3,llm)
-  REAL(rstd),INTENT(OUT)  :: un(3*iim*jjm,llm)
-
-  INTEGER :: i,j,ij,l     
-    
-  
-    DO l=ll_begin,ll_end
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          un(ij+u_right,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:))
-          un(ij+u_lup,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:))
-          un(ij+u_ldown,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:))
-         ENDDO
-      ENDDO
-    ENDDO
- 
- END SUBROUTINE compute_wind_perp_from_wind_centered
-
-
- SUBROUTINE compute_un2ulonlat(un, ulon, ulat)
-  USE icosa  
-    
-  IMPLICIT NONE
-  REAL(rstd),INTENT(IN)  :: un(3*iim*jjm,llm)
-  REAL(rstd),INTENT(OUT) :: ulon(iim*jjm,llm)
-  REAL(rstd),INTENT(OUT) :: ulat(iim*jjm,llm)
-
-  REAL(rstd)             :: uc(iim*jjm,3,llm)
-    
-  CALL compute_wind_centered(un,uc)  
-  CALL compute_wind_centered_lonlat_compound(uc, ulon, ulat)
- 
- END SUBROUTINE compute_un2ulonlat
-
- SUBROUTINE compute_ulonlat2un(ulon, ulat,un)
-  USE icosa  
-    
-  IMPLICIT NONE
-  REAL(rstd),INTENT(IN) :: ulon(iim*jjm,llm)
-  REAL(rstd),INTENT(IN) :: ulat(iim*jjm,llm)
-  REAL(rstd),INTENT(OUT)  :: un(3*iim*jjm,llm)
-
-  REAL(rstd)             :: uc(iim*jjm,3,llm)
-    
-    CALL compute_wind_centered_from_wind_lonlat_centered(ulon, ulat, uc)  
-    CALL compute_wind_perp_from_wind_centered(uc, un)
- 
- END SUBROUTINE compute_ulonlat2un
-
-
-END MODULE wind_mod
Index: codes/icosagcm/devel/src/write_etat0.f90
===================================================================
--- codes/icosagcm/devel/src/write_etat0.f90	(revision 531)
+++ 	(revision )
@@ -1,51 +1,0 @@
-MODULE write_etat0_mod
-
-
-
-CONTAINS
-
-  SUBROUTINE write_etat0(it,f_ps,f_phis,f_theta_rhodz,f_u, f_q)
-  USE icosa
-  USE restart_mod
-  USE wind_mod
-  USE write_field_mod
-  USE domain_mod
-  USE omp_para
-  USE xios_mod
-  IMPLICIT NONE
-    INTEGER,INTENT(IN)    :: it
-    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,SAVE :: f_ulon(:)
-    TYPE(t_field),POINTER,SAVE :: f_ulat(:)
-    TYPE(t_field),POINTER,SAVE :: f_theta_rhodz_1d(:)
-    REAL(rstd), POINTER :: theta_rhodz(:,:,:),theta_rhodz_1d(:,:)
-    INTEGER :: ind
-    
-    
-    CALL allocate_field(f_ulon,field_t,type_real,llm,name='ulon')
-    CALL allocate_field(f_ulat,field_t,type_real,llm,name='ulat')
-    CALL allocate_field(f_theta_rhodz_1d,field_t,type_real,llm,name='theta_rhodz')
-
-!$OMP BARRIER    
-    DO ind=1, ndomain
-       IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-       theta_rhodz=f_theta_rhodz(ind) ; theta_rhodz_1d=f_theta_rhodz_1d(ind)
-       theta_rhodz_1d(:,:)=theta_rhodz(:,:,1)
-    ENDDO
-    
-    CALL transfert_request(f_u,req_e1_vect)
-    CALL un2ulonlat(f_u, f_ulon, f_ulat)
-    
-    CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q)
-
-    CALL deallocate_field(f_ulon)
-    CALL deallocate_field(f_ulat)
-    
-  END SUBROUTINE write_etat0
-    
-END MODULE write_etat0_mod
Index: codes/icosagcm/devel/src/write_field.f90
===================================================================
--- codes/icosagcm/devel/src/write_field.f90	(revision 531)
+++ 	(revision )
@@ -1,1814 +1,0 @@
-module write_field_mod
-  USE genmod
-  IMPLICIT NONE
-  PRIVATE  
-  INTEGER,SAVE :: ncprec
-  
-  TYPE ncvar
-    INTEGER :: size
-    INTEGER,POINTER :: nc_id(:)
-    INTEGER :: displ
-  END TYPE ncvar
-
-  INTEGER, PARAMETER :: MaxWriteField = 1000
-  INTEGER, DIMENSION(MaxWriteField),SAVE :: FieldId
-  TYPE(ncvar), dimension(MaxWriteField),SAVE :: FieldVarId
-  INTEGER, DIMENSION(MaxWriteField),SAVE :: FieldIndex
-  CHARACTER(len=255), DIMENSION(MaxWriteField) ::  FieldName 
-   
-  INTEGER,SAVE :: NbField = 0
-  
-  PUBLIC init_writeField, writefield, close_files
-  
-  CONTAINS
-  
-    SUBROUTINE init_writeField
-      USE ioipsl
-      use netcdf_mod
-      CHARACTER(LEN=255) :: netcdf_prec
-      
-      !$OMP CRITICAL
-      netcdf_prec='float'
-      CALL getin("netcdf_prec",netcdf_prec)
-      SELECT CASE(TRIM(netcdf_prec))
-        CASE('float')
-          ncprec=NF90_FLOAT
-        CASE('double')
-          ncprec=NF90_DOUBLE
-        CASE default
-        PRINT*,'Bad selector for variable netcdf_prec : <', TRIM(netcdf_prec),"> options are <float>, <double>" 
-        STOP   
-      END SELECT
-      !$OMP END CRITICAL
-    END SUBROUTINE init_writeField
-    
-    function GetFieldIndex(name)
-    implicit none
-      integer          :: GetFieldindex
-      character(len=*) :: name
-    
-      character(len=255) :: TrueName
-      integer            :: i
-       
-      
-      TrueName=TRIM(ADJUSTL(name))
-    
-      GetFieldIndex=-1
-      do i=1,NbField
-        if (TrueName==FieldName(i)) then
-          GetFieldIndex=i
-          exit
-        endif
-      enddo
-    end function GetFieldIndex
-    
-    SUBROUTINE Writefield(name_in,field,nind,once)
-    USE domain_mod
-    USE field_mod
-    USE transfert_mpi_mod
-    USE dimensions
-    USE mpipara
-    USE netcdf_mod
-    IMPLICIT NONE  
-     CHARACTER(LEN=*),INTENT(IN) :: name_in
-      TYPE(t_field),POINTER :: field(:)
-      INTEGER,OPTIONAL,INTENT(IN) :: nind
-      LOGICAL,OPTIONAL,INTENT(IN) :: once
-      LOGICAL                     :: once_
-      
-      TYPE(t_field),POINTER :: field_glo(:)
-      
-      IF (no_io) RETURN
-      
-!$OMP BARRIER
-!$OMP MASTER      
-      IF(PRESENT(once)) THEN
-         once_=once
-      ELSE
-         once_=.FALSE.
-      END IF
-
-      IF (field(1)%ndim==2) THEN
-        CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type)
-      ELSE IF (field(1)%ndim==3) THEN
-        CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3) 
-      ELSE IF (field(1)%ndim==4) THEN
-        CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4)
-      ENDIF
-      
-      CALL gather_field(field,field_glo)
-      
-      IF (mpi_rank==0) THEN
-        IF (PRESENT(nind)) THEN
-         CALL writefield_gen(name_in,field_glo,domain_glo,nind,once=once_)
-        ELSE
-         CALL writefield_gen(name_in,field_glo,domain_glo,1,ndomain_glo,once=once_)
-        ENDIF
-      ENDIF
-      
-      CALL deallocate_field_glo(field_glo)
-!$OMP END MASTER
-!$OMP BARRIER
-      
-   END SUBROUTINE writefield
-   
-!   SUBROUTINE Writefield(name_in,field,nind)
-!   USE netcdf
-!   USE domain_mod
-!   use field_mod
-!   USE dimensions
-!   USE geometry
-!   IMPLICIT NONE
-!     CHARACTER(LEN=*),INTENT(IN) :: name_in
-!     TYPE(t_field),POINTER :: field(:)
-!     INTEGER,OPTIONAL,INTENT(IN) :: nind
-!     REAL(r8),ALLOCATABLE :: field_val2d(:)
-!     REAL(r8),ALLOCATABLE :: field_val3d(:,:)
-!     REAL(r8),ALLOCATABLE :: field_val4d(:,:,:)
-!     TYPE(t_domain),POINTER :: d
-!     INTEGER :: Index
-!     INTEGER :: ind,i,j,k,n,ncell,q
-!     INTEGER :: iie,jje,iin,jjn
-!     INTEGER :: status
-!     CHARACTER(len=255) :: name
-!     CHARACTER(len=255) :: str_ind
-!     INTEGER :: ind_b,ind_e
-!     INTEGER :: halo_size
-!     LOGICAL :: single
-!     
-!     
-!     name=TRIM(ADJUSTL(name_in))
-
-!     IF (PRESENT(nind)) THEN
-!       name=TRIM(name)//"_"//TRIM(int2str(nind))
-!       PRINT *,"NAME",nind,int2str(nind),name
-!       ind_b=nind
-!       ind_e=nind
-!       halo_size=1
-!       single=.TRUE.
-!     ELSE
-!       ind_b=1
-!       ind_e=ndomain
-!       halo_size=0
-!       single=.FALSE.
-!     ENDIF      
-
-!     Index=GetFieldIndex(name)
-!     if (Index==-1) then
-!       call create_header(name,field,nind)
-!	Index=GetFieldIndex(name)
-!     else
-!       FieldIndex(Index)=FieldIndex(Index)+1.
-!     endif
-!     
-!     IF (Field(ind_b)%field_type==field_T) THEN
-!       ncell=1
-!       DO ind=ind_b,ind_e
-!         d=>domain(ind)
-!         IF (Field(ind)%field_type/=field_T) THEN
-!           PRINT *,"Writefield, grille non geree"
-!           RETURN
-!         ENDIF
-
-!       n=0
-!       DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-!         DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-!           IF (d%own(i,j) .OR. single) n=n+1
-!         ENDDO
-!       ENDDO
-
-!       IF (field(ind)%ndim==2) THEN
-!         ALLOCATE(Field_val2d(n))
-!         n=0
-!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-!             k=d%iim*(j-1)+i
-!             IF (d%own(i,j) .OR. single) THEN
-!               n=n+1
-!               Field_val2d(n)=field(ind)%rval2d(k)
-!             ENDIF
-!           ENDDO
-!         ENDDO
-!         status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,  &
-!                             start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /))
-!         DEALLOCATE(field_val2d)
-!       ELSE IF (field(ind)%ndim==3) THEN
-!         ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
-!         n=0
-!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-!             k=d%iim*(j-1)+i
-!             IF (d%own(i,j) .OR. single) THEN
-!               n=n+1
-!               Field_val3d(n,:)=field(ind)%rval3d(k,:)
-!             ENDIF
-!           ENDDO
-!         ENDDO
-!          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /),   &
-!                              count=(/n,size(field(1)%rval3d,2),1 /))
-!         DEALLOCATE(field_val3d)
-!       ELSE IF (field(1)%ndim==4) THEN
-
-!         DO q=1,FieldVarId(index)%size
-!         
-!           ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
-!           n=0
-!           DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-!             DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-!               k=d%iim*(j-1)+i
-!               IF (d%own(i,j) .OR. single) THEN
-!                 n=n+1
-!                 Field_val3d(n,:)=field(ind)%rval4d(k,:,q)
-!               ENDIF
-!             ENDDO
-!           ENDDO
-!           status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /),   &
-!                              count=(/n,size(field(1)%rval4d,2),1 /))
-!           DEALLOCATE(field_val3d)
-!         ENDDO         
-!       ENDIF
-!       
-!        PRINT *,NF90_STRERROR(status)
-!       ncell=ncell+n
-
-!    ENDDO
-!    
-!    ELSE IF (Field(ind_b)%field_type==field_Z) THEN
-!       ncell=1
-!       n=0
-!       DO ind=ind_b,ind_e
-!         d=>domain(ind)
-!         CALL swap_geometry(ind)
-!         CALL swap_dimensions(ind)
-! 
-!         n=0
-!         DO j=jj_begin+1,jj_end
-!           DO i=ii_begin,ii_end-1
-!             n=n+1
-!           ENDDO
-!         ENDDO
-
-!         DO j=jj_begin,jj_end-1
-!           DO i=ii_begin+1,ii_end
-!             n=n+1
-!           ENDDO
-!         ENDDO
-
-!       IF (field(ind)%ndim==2) THEN
-!         ALLOCATE(Field_val2d(n))
-
-!         n=0
-!         DO j=jj_begin+1,jj_end
-!           DO i=ii_begin,ii_end-1
-!             n=n+1
-!             k=iim*(j-1)+i
-!             Field_val2d(n)=field(ind)%rval2d(k+z_down)
-!           ENDDO
-!         ENDDO
-
-!         DO j=jj_begin,jj_end-1
-!           DO i=ii_begin+1,ii_end
-!             n=n+1
-!             k=iim*(j-1)+i
-!             Field_val2d(n)=field(ind)%rval2d(k+z_up)
-!           ENDDO
-!         ENDDO
-
-!         status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),                       &
-!                             Field_val2d,start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /))
-!         DEALLOCATE(field_val2d)
-
-!       ELSE IF (field(ind)%ndim==3) THEN
-!         ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
-!         n=0
-!         DO j=jj_begin+1,jj_end
-!           DO i=ii_begin,ii_end-1
-!             n=n+1
-!             k=iim*(j-1)+i
-!             Field_val3d(n,:)=field(ind)%rval3d(k+z_down,:)
-!           ENDDO
-!         ENDDO
-
-!         DO j=jj_begin,jj_end-1
-!           DO i=ii_begin+1,ii_end
-!             n=n+1
-!             k=iim*(j-1)+i
-!             Field_val3d(n,:)=field(ind)%rval3d(k+z_up,:)
-!           ENDDO
-!         ENDDO
-!          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /),   &
-!                              count=(/n,size(field(1)%rval3d,2),1 /))
-!         DEALLOCATE(field_val3d)
-!       ELSE IF (field(1)%ndim==4) THEN
-
-!         DO q=1,FieldVarId(index)%size
-!           ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
-!           n=0
-!           DO j=jj_begin+1,jj_end
-!             DO i=ii_begin,ii_end-1
-!               n=n+1
-!               k=iim*(j-1)+i
-!               Field_val3d(n,:)=field(ind)%rval4d(k+z_down,:,q)
-!             ENDDO
-!           ENDDO
-
-!           DO j=jj_begin,jj_end-1
-!             DO i=ii_begin+1,ii_end
-!               n=n+1
-!               k=iim*(j-1)+i
-!               Field_val3d(n,:)=field(ind)%rval4d(k+z_up,:,q)
-!             ENDDO
-!           ENDDO
-
-!           status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ ncell,1,1,FieldIndex(Index) /),   &
-!                               count=(/n,size(field(1)%rval4d,2),1 /))
-!           DEALLOCATE(field_val3d)
-!         ENDDO
-!       ENDIF
-!       
-!        PRINT *,NF90_STRERROR(status)
-!       ncell=ncell+n
-
-!    ENDDO
-!    
-!    ENDIF
-!    status=NF90_SYNC(FieldId(Index))
-!     
-!   END SUBROUTINE Writefield
-
-
-    SUBROUTINE Writefield_gen(name_in, field, domain_type, ind_b_in, ind_e_in,once )
-    USE netcdf_mod
-    USE domain_mod
-    USE field_mod
-    IMPLICIT NONE
-      CHARACTER(LEN=*),INTENT(IN) :: name_in
-      TYPE(t_field), POINTER :: field(:)
-      TYPE(t_domain),INTENT(IN),TARGET :: domain_type(:)
-      INTEGER,OPTIONAL,INTENT(IN) :: ind_b_in
-      INTEGER,OPTIONAL,INTENT(IN) :: ind_e_in
-      REAL(r8),ALLOCATABLE :: field_val2d(:)
-      REAL(r8),ALLOCATABLE :: field_val3d(:,:)
-      REAL(r8),ALLOCATABLE :: field_val4d(:,:,:)
-      LOGICAL, INTENT(IN) :: once
-      TYPE(t_domain),POINTER :: d
-      INTEGER :: Index
-      INTEGER :: ind,i,j,k,n,ncell,q
-      INTEGER :: iie,jje,iin,jjn
-      INTEGER :: status
-      CHARACTER(len=255) :: name
-      CHARACTER(len=255) :: str_ind
-      INTEGER :: ind_b,ind_e
-      INTEGER :: halo_size
-      LOGICAL :: single
-      
-      name=TRIM(ADJUSTL(name_in))
-
-      IF (PRESENT(ind_b_in) .AND. .NOT. PRESENT(ind_e_in)) THEN
-        name=TRIM(name)//"_"//TRIM(int2str(ind_b))
-        ind_b=ind_b_in
-        ind_e=ind_b_in
-        halo_size=1
-        single=.TRUE.
-      ELSE IF (.NOT. PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN
-        name=TRIM(name)//"_"//TRIM(int2str(ind_e))
-        ind_b=ind_e_in
-        ind_e=ind_e_in
-        halo_size=1
-        single=.TRUE.
-      ELSE IF ( PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN
-        ind_b=ind_b_in
-        ind_e=ind_e_in
-        halo_size=0
-        single=.FALSE.
-      ELSE
-        halo_size=0
-        ind_b=1
-        ind_e=ndomain
-        single=.FALSE.
-      ENDIF      
-      
-      Index=GetFieldIndex(name)
-      if (Index==-1) then
-        call create_header_gen(name_in,field,domain_type,ind_b_in,ind_e_in,once)
-	Index=GetFieldIndex(name)
-      else
-        FieldIndex(Index)=FieldIndex(Index)+1.
-      endif
-      
-      IF (Field(ind_b)%field_type==field_T) THEN
-
-        ncell=0
-        DO ind=ind_b,ind_e
-          d=>domain_type(ind)
-          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-              IF (d%assign_domain(i,j)==ind .OR. single) ncell=ncell+1
-            ENDDO
-          ENDDO
-        ENDDO
-        
-        IF (field(1)%ndim==2) THEN
-          ALLOCATE(Field_val2d(ncell))
-          n=0
-          DO ind=ind_b,ind_e
-            d=>domain_type(ind)
-            DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-              DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-                k=d%iim*(j-1)+i
-                IF (d%assign_domain(i,j)==ind .OR. single) THEN
-                  n=n+1
-                  Field_val2d(n)=field(ind)%rval2d(k)
-                ENDIF
-              ENDDO
-            ENDDO
-          ENDDO
-
-          IF (once) THEN 
-            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,  &
-                               start=(/ 1 /),count=(/ncell /))
-          ELSE
-            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,  &
-                               start=(/ 1,FieldIndex(Index) /),count=(/ncell,1 /))
-          ENDIF
-          
-          DEALLOCATE(field_val2d)
-        ELSE IF (field(1)%ndim==3) THEN
-          ALLOCATE(Field_val3d(ncell,size(field(1)%rval3d,2)))
-          n=0
-          DO ind=ind_b,ind_e
-            d=>domain_type(ind)
-            DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-              DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-                k=d%iim*(j-1)+i
-                IF (d%assign_domain(i,j)==ind .OR. single) THEN
-                  n=n+1
-                  Field_val3d(n,:)=field(ind)%rval3d(k,:)
-                ENDIF
-              ENDDO
-            ENDDO
-          ENDDO
-
-          PRINT *, 'Writefield ', TRIM(name), MAXVAL(Field_val3d(:,1)), MINVAL(Field_val3d(:,1)) ! FIXME
-
-          IF (once) THEN 
-            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ 1,1 /),   &
-                                 count=(/ncell,size(field(1)%rval3d,2) /))
-          ELSE
-             status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ 1,1,FieldIndex(Index) /),   &
-                                 count=(/ncell,size(field(1)%rval3d,2),1 /))
-          ENDIF
-                                
-          DEALLOCATE(field_val3d)
-        ELSE IF (field(1)%ndim==4) THEN
-
-          DO q=1,FieldVarId(index)%size
-          
-            ALLOCATE(Field_val3d(ncell,size(field(1)%rval4d,2)))
-            n=0
-            DO ind=ind_b,ind_e
-              d=>domain_type(ind)
-              DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-                DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-                  k=d%iim*(j-1)+i
-                  IF (d%assign_domain(i,j)==ind .OR. single) THEN
-                    n=n+1
-                    Field_val3d(n,:)=field(ind)%rval4d(k,:,q)
-                  ENDIF
-                ENDDO
-              ENDDO
-            ENDDO
-            
-            IF (once) THEN 
-              status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ 1,1 /),   &
-                                 count=(/ncell,size(field(1)%rval4d,2),1 /))
-            ELSE
-              status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ 1,1,FieldIndex(Index) /),   &
-                                 count=(/ncell,size(field(1)%rval4d,2),1 /))
-            ENDIF
-            DEALLOCATE(field_val3d)
-          ENDDO         
-        ENDIF
-        
-     
-     ELSE IF (Field(ind_b)%field_type==field_Z) THEN
-
-        ncell=0
-        DO ind=ind_b,ind_e
-          d=>domain_type(ind)
-  
-          DO j=d%jj_begin+1,d%jj_end
-            DO i=d%ii_begin,d%ii_end-1
-              ncell=ncell+1
-            ENDDO
-          ENDDO
-
-          DO j=d%jj_begin,d%jj_end-1
-            DO i=d%ii_begin+1,d%ii_end
-              ncell=ncell+1
-            ENDDO
-          ENDDO
-        ENDDO
-
-        IF (field(1)%ndim==2) THEN
-          ALLOCATE(Field_val2d(ncell))
-
-          n=0
-          
-          DO ind=ind_b,ind_e
-            d=>domain_type(ind)
-            DO j=d%jj_begin+1,d%jj_end
-              DO i=d%ii_begin,d%ii_end-1
-                n=n+1
-                k=d%iim*(j-1)+i
-                Field_val2d(n)=field(ind)%rval2d(k+d%z_down)
-              ENDDO
-            ENDDO
-
-            DO j=d%jj_begin,d%jj_end-1
-              DO i=d%ii_begin+1,d%ii_end
-                n=n+1
-                k=d%iim*(j-1)+i
-                Field_val2d(n)=field(ind)%rval2d(k+d%z_up)
-              ENDDO
-            ENDDO
-          ENDDO
-          
-          IF (once) THEN 
-            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),                       &
-                                Field_val2d,start=(/ 1 /),count=(/ncell /))
-           ELSE
-            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),                       &
-                                Field_val2d,start=(/ 1,FieldIndex(Index) /),count=(/ncell,1 /))
-          ENDIF
-          DEALLOCATE(field_val2d)
-
-        ELSE IF (field(1)%ndim==3) THEN
-          ALLOCATE(Field_val3d(ncell,size(field(1)%rval3d,2)))
-          n=0
-          DO ind=ind_b,ind_e
-            d=>domain_type(ind)
-            DO j=d%jj_begin+1,d%jj_end
-              DO i=d%ii_begin,d%ii_end-1
-                n=n+1
-                k=d%iim*(j-1)+i
-                Field_val3d(n,:)=field(ind)%rval3d(k+d%z_down,:)
-              ENDDO
-            ENDDO
-
-            DO j=d%jj_begin,d%jj_end-1
-              DO i=d%ii_begin+1,d%ii_end
-                n=n+1
-                k=d%iim*(j-1)+i
-                Field_val3d(n,:)=field(ind)%rval3d(k+d%z_up,:)
-              ENDDO
-            ENDDO
-          ENDDO
-          
-          IF (once) THEN 
-            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ 1,1 /),   &
-                                count=(/ncell,size(field(1)%rval3d,2) /))
-          ELSE
-            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ 1,1,FieldIndex(Index) /),   &
-                                count=(/ncell,size(field(1)%rval3d,2),1 /))
-          ENDIF
-          DEALLOCATE(field_val3d)
-        
-        ELSE IF (field(1)%ndim==4) THEN
-
-          DO q=1,FieldVarId(index)%size
-            ALLOCATE(Field_val3d(ncell,size(field(1)%rval4d,2)))
-            n=0
-            DO ind=ind_b,ind_e
-              d=>domain_type(ind)
-              DO j=d%jj_begin+1,d%jj_end
-                DO i=d%ii_begin,d%ii_end-1
-                  n=n+1
-                  k=d%iim*(j-1)+i
-                  Field_val3d(n,:)=field(ind)%rval4d(k+d%z_down,:,q)
-                ENDDO
-              ENDDO
-
-              DO j=d%jj_begin,d%jj_end-1
-                DO i=d%ii_begin+1,d%ii_end
-                  n=n+1
-                  k=d%iim*(j-1)+i
-                  Field_val3d(n,:)=field(ind)%rval4d(k+d%z_up,:,q)
-                ENDDO
-              ENDDO
-            ENDDO
-
-            IF (once) THEN 
-              status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ 1,1,1 /),   &
-                                  count=(/ncell,size(field(1)%rval4d,2) /))
-            ELSE
-              status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ 1,1,1,FieldIndex(Index) /),   &
-                                  count=(/ncell,size(field(1)%rval4d,2),1 /))
-            ENDIF
-            DEALLOCATE(field_val3d)
-          ENDDO
-        ENDIF
-     
-     ENDIF
-     status=NF90_SYNC(FieldId(Index))
-      
-    END SUBROUTINE Writefield_gen
-
-      
-
-    SUBROUTINE Writefield_mpi(name_in,field,nind)
-    USE netcdf_mod
-    USE domain_mod
-    use field_mod
-    USE dimensions
-    USE geometry
-    IMPLICIT NONE
-      CHARACTER(LEN=*),INTENT(IN) :: name_in
-      TYPE(t_field),POINTER :: field(:)
-      INTEGER,OPTIONAL,INTENT(IN) :: nind
-      REAL(r8),ALLOCATABLE :: field_val2d(:)
-      REAL(r8),ALLOCATABLE :: field_val3d(:,:)
-      REAL(r8),ALLOCATABLE :: field_val4d(:,:,:)
-      TYPE(t_domain),POINTER :: d
-      INTEGER :: Index
-      INTEGER :: ind,i,j,l,k,n,ncell,q
-      INTEGER :: iie,jje,iin,jjn
-      INTEGER :: status
-      CHARACTER(len=255) :: name
-      CHARACTER(len=255) :: str_ind
-      INTEGER :: ind_b,ind_e
-      INTEGER :: halo_size
-      LOGICAL :: single
-      INTEGER :: displ
-      
-      
-      name=TRIM(ADJUSTL(name_in))
-
-      IF (PRESENT(nind)) THEN
-        name=TRIM(name)//"_"//TRIM(int2str(nind))
-        PRINT *,"NAME",nind,int2str(nind),name
-        ind_b=nind
-        ind_e=nind
-        halo_size=1
-        single=.TRUE.
-      ELSE
-        ind_b=1
-        ind_e=ndomain
-        halo_size=0
-        single=.FALSE.
-      ENDIF      
-
-      Index=GetFieldIndex(name)
-      if (Index==-1) then
-        call create_header_mpi(name,field,nind)
-	Index=GetFieldIndex(name)
-      else
-        FieldIndex(Index)=FieldIndex(Index)+1.
-      endif
-      
-      IF (Field(ind_b)%field_type==field_T) THEN
-        ncell=1
-        DO ind=ind_b,ind_e
-          d=>domain(ind)
-          IF (Field(ind)%field_type/=field_T) THEN
-            PRINT *,"Writefield, grille non geree"
-            RETURN
-          ENDIF
-
-        n=0
-        DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-          DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-            IF (d%own(i,j) .OR. single) n=n+1
-          ENDDO
-        ENDDO
-
-        displ=FieldVarId(index)%displ
-        
-        IF (field(ind)%ndim==2) THEN
-          ALLOCATE(Field_val2d(n))
-          n=0
-          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-              k=d%iim*(j-1)+i
-              IF (d%own(i,j) .OR. single) THEN
-                n=n+1
-                Field_val2d(n)=field(ind)%rval2d(k)
-              ENDIF
-            ENDDO
-          ENDDO
-          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,  &
-                              start=(/ displ+ncell,FieldIndex(Index) /),count=(/n,1 /))
-          DEALLOCATE(field_val2d)
-        ELSE IF (field(ind)%ndim==3) THEN
-          ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
-          n=0
-          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-              k=d%iim*(j-1)+i
-              IF (d%own(i,j) .OR. single) THEN
-                n=n+1
-                Field_val3d(n,:)=field(ind)%rval3d(k,:)
-              ENDIF
-            ENDDO
-          ENDDO
-          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,  &
-                                start=(/ displ+ncell,1,FieldIndex(Index) /), count=(/n,size(field(ind)%rval3d,2),1 /))
-          DEALLOCATE(field_val3d)
-
-        ELSE IF (field(1)%ndim==4) THEN
-
-          DO q=1,FieldVarId(index)%size
-          
-            ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
-            n=0
-            DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-              DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-                k=d%iim*(j-1)+i
-                IF (d%own(i,j) .OR. single) THEN
-                  n=n+1
-                  Field_val3d(n,:)=field(ind)%rval4d(k,:,q)
-                ENDIF
-              ENDDO
-             ENDDO
-
-            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d(:,l), &
-                                start=(/ displ+ncell,l,FieldIndex(Index) /), count=(/n,size(field(ind)%rval4d,2),1 /))
-            DEALLOCATE(field_val3d)
-          ENDDO         
-        ENDIF
-        
-        ncell=ncell+n
-
-     ENDDO
-     
-     ELSE IF (Field(ind_b)%field_type==field_Z) THEN
-        ncell=1
-        n=0
-        DO ind=ind_b,ind_e
-          d=>domain(ind)
-          CALL swap_geometry(ind)
-          CALL swap_dimensions(ind)
-  
-          n=0
-          DO j=jj_begin+1,jj_end
-            DO i=ii_begin,ii_end-1
-              n=n+1
-            ENDDO
-          ENDDO
-
-          DO j=jj_begin,jj_end-1
-            DO i=ii_begin+1,ii_end
-              n=n+1
-            ENDDO
-          ENDDO
-
-        displ=FieldVarId(index)%displ
-
-        IF (field(ind)%ndim==2) THEN
-          ALLOCATE(Field_val2d(n))
-
-          n=0
-          DO j=jj_begin+1,jj_end
-            DO i=ii_begin,ii_end-1
-              n=n+1
-              k=iim*(j-1)+i
-              Field_val2d(n)=field(ind)%rval2d(k+z_down)
-            ENDDO
-          ENDDO
-
-          DO j=jj_begin,jj_end-1
-            DO i=ii_begin+1,ii_end
-              n=n+1
-              k=iim*(j-1)+i
-              Field_val2d(n)=field(ind)%rval2d(k+z_up)
-            ENDDO
-          ENDDO
-
-          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),                       &
-                              Field_val2d,start=(/ displ+ncell,FieldIndex(Index) /),count=(/n,1 /))
-          DEALLOCATE(field_val2d)
-
-        ELSE IF (field(ind)%ndim==3) THEN
-          ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
-          n=0
-          DO j=jj_begin+1,jj_end
-            DO i=ii_begin,ii_end-1
-              n=n+1
-              k=iim*(j-1)+i
-              Field_val3d(n,:)=field(ind)%rval3d(k+z_down,:)
-            ENDDO
-          ENDDO
-
-          DO j=jj_begin,jj_end-1
-            DO i=ii_begin+1,ii_end
-              n=n+1
-              k=iim*(j-1)+i
-              Field_val3d(n,:)=field(ind)%rval3d(k+z_up,:)
-            ENDDO
-          ENDDO
-
-           status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,    &
-                               start=(/ displ+ncell,1,FieldIndex(Index) /), count=(/n,size(field(ind)%rval3d,2),1 /))
-          DEALLOCATE(field_val3d)
-
-        ELSE IF (field(1)%ndim==4) THEN
-
-          DO q=1,FieldVarId(index)%size
-            ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
-            n=0
-            DO j=jj_begin+1,jj_end
-              DO i=ii_begin,ii_end-1
-                n=n+1
-                k=iim*(j-1)+i
-                Field_val3d(n,:)=field(ind)%rval4d(k+z_down,:,q)
-              ENDDO
-            ENDDO
-
-            DO j=jj_begin,jj_end-1
-              DO i=ii_begin+1,ii_end
-                n=n+1
-                k=iim*(j-1)+i
-                Field_val3d(n,:)=field(ind)%rval4d(k+z_up,:,q)
-              ENDDO
-            ENDDO
-
-            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,  &
-                                start=(/ displ+ncell,1,FieldIndex(Index) /), count=(/n,size(field(ind)%rval4d,2),1 /))
-            DEALLOCATE(field_val3d)
-          ENDDO
-        ENDIF
-        
-        ncell=ncell+n
-
-     ENDDO
-     
-     ENDIF
-     status=NF90_SYNC(FieldId(Index))
-      
-    END SUBROUTINE Writefield_mpi
-    
-    
-           
-!   SUBROUTINE Create_header(name,field,nind)
-!   USE netcdf
-!   USE field_mod
-!   USE domain_mod
-!   USE spherical_geom_mod
-!   USE dimensions
-!   USE geometry
-!   IMPLICIT NONE
-!     CHARACTER(LEN=*) :: name
-!     TYPE(t_field),POINTER :: field(:)
-!     INTEGER,OPTIONAL,INTENT(IN) :: nind
-!     INTEGER :: ncell
-!     INTEGER :: nvert
-!     REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
-!     TYPE(t_domain),POINTER :: d
-!     INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId
-!     INTEGER :: dim3id,dim4id
-!     INTEGER :: status
-!     INTEGER :: ind,i,j,k,n,q
-!     INTEGER :: iie,jje,iin,jjn
-!     INTEGER :: ind_b,ind_e
-!     INTEGER :: halo_size
-!     LOGICAL :: single 
-!     INTEGER :: nij
-!         
-!     NbField=NbField+1
-!     FieldName(NbField)=TRIM(ADJUSTL(name))
-!     FieldIndex(NbField)=1
-!     
-!     IF (PRESENT(nind)) THEN
-!       ind_b=nind
-!       ind_e=nind
-!       halo_size=1
-!       single=.TRUE.
-!     ELSE
-!       ind_b=1
-!       ind_e=ndomain
-!       halo_size=0
-!       single=.FALSE.
-!     ENDIF
-!     
-!     ncell=0
-!     
-!     IF (Field(ind_b)%field_type==field_T) THEN
-!       nvert=6
-!       
-!       DO ind=ind_b,ind_e
-!         d=>domain(ind)
-!       
-!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-!             IF (single .OR. domain(ind)%own(i,j)) ncell=ncell+1
-!           ENDDO
-!         ENDDO
-
-!       END DO
-!     
-!       status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
-!       FieldId(NbField)=ncid
-!       status = NF90_DEF_DIM(ncid,'cell',ncell,ncellId)
-!       status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
-
-!       IF (Field(ind_b)%ndim==2)  THEN
-!         FieldVarId(NbField)%size=1
-!         ALLOCATE(FieldVarId(NbField)%nc_id(1))
-!       ELSE IF (Field(ind_b)%ndim==3)  THEN
-!         FieldVarId(NbField)%size=1
-!         ALLOCATE(FieldVarId(NbField)%nc_id(1))
-!         status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval3d,2),dim3id)
-!       ELSE IF (Field(1)%ndim==4) THEN
-!         FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
-!         ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
-!         status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval4d,2),dim3id)
-!          status = NF90_DEF_DIM(ncid,'Q',size(field(ind_b)%rval4d,3),dim4id)
-!       ENDIF
-!     
-!       status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
-!     
-!       status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
-!       status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
-!       status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
-!       status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
-!       status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
-!       status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
-!       status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
-!       status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
-!       status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
-!       status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
-
-!       IF (Field(ind_b)%ndim==2) THEN
-!         status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
-!         status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
-!       ELSE IF (Field(ind_b)%ndim==3) THEN
-!         status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
-!         status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
-!       ELSE IF (Field(ind_b)%ndim==4) THEN
-!         DO i=1,FieldVarId(NbField)%size
-!           status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),  &
-!                                 FieldVarId(NbField)%nc_id(i))
-!           status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon lat")
-!         ENDDO        
-!       ENDIF 
-! 
-!     
-!       status = NF90_ENDDEF(ncid)      
-
-!       ncell=1
-!       DO ind=ind_b,ind_e
-!         d=>domain(ind)
-! 
-!         n=0
-!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-!             IF (single .OR. d%own(i,j)) n=n+1
-!           ENDDO
-!         ENDDO
-!         
-!        ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
-!         
-!         n=0  
-!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-!               IF (d%own(i,j) .OR. single) THEN
-!               n=n+1
-!               CALL xyz2lonlat(d%xyz(:,i,j),lon(n),lat(n))
-!               lon(n)=lon(n)*180/Pi
-!               lat(n)=lat(n)*180/Pi
-!               DO k=0,5
-!                 CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,n), bounds_lat(k,n))
-!                 bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
-!                 bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
-!               ENDDO
-!             ENDIF
-!           ENDDO
-!         ENDDO
-!         status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ ncell /),count=(/ n /))
-!         status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ ncell /),count=(/ n /))
-!         status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,ncell /),count=(/ nvert,n /))
-!         status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,ncell /),count=(/ nvert,n /))
-! 
-!         ncell=ncell+n
-!         DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
-!     END DO 
-
-!   ELSE IF (Field(ind_b)%field_type==field_Z) THEN
-!       nvert=3
-!       DO ind=ind_b,ind_e
-!         d=>domain(ind)
-!       
-!         DO j=d%jj_begin+1,d%jj_end
-!           DO i=d%ii_begin,d%ii_end-1
-!             ncell=ncell+1
-!           ENDDO
-!         ENDDO
-
-!         DO j=d%jj_begin,d%jj_end-1
-!           DO i=d%ii_begin+1,d%ii_end
-!             ncell=ncell+1
-!           ENDDO
-!         ENDDO
-
-!       END DO
-!     
-!       status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
-!       FieldId(NbField)=ncid
-!       status = NF90_DEF_DIM(ncid,'cell',ncell,ncellId)
-!       status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
-
-!       IF (Field(ind_b)%ndim==2)  THEN
-!         FieldVarId(NbField)%size=1
-!         ALLOCATE(FieldVarId(NbField)%nc_id(1))
-!       ELSE IF (Field(ind_b)%ndim==3)  THEN
-!         FieldVarId(NbField)%size=1
-!         ALLOCATE(FieldVarId(NbField)%nc_id(1))
-!         status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval3d,2),dim3id)
-!       ELSE IF (Field(1)%ndim==4) THEN
-!         FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
-!         ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
-!         status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval4d,2),dim3id)
-!       ENDIF
-
-
-!     
-!       status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
-!     
-!       status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
-!       status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
-!       status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
-!       status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
-!       status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
-!       status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
-!       status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
-!       status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
-!       status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
-!       status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
-
-
-!       IF (Field(ind_b)%ndim==2) THEN
-!         status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
-!         status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
-!       ELSE IF (Field(ind_b)%ndim==3) THEN
-!         status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
-!         status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
-!       ELSE IF (Field(ind_b)%ndim==4) THEN
-!         DO q=1,FieldVarId(NbField)%size
-!           status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),NF90_DOUBLE,             &
-!                                 (/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q))
-!           status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon lat")
-!         ENDDO        
-!       ENDIF 
-!       
-!       status = NF90_ENDDEF(ncid)      
-
-!       ncell=1
-!       DO ind=ind_b,ind_e
-!         d=>domain(ind)
-!         CALL swap_geometry(ind)
-!         CALL swap_dimensions(ind)
-! 
-!         n=0
-!         DO j=jj_begin+1,jj_end
-!           DO i=ii_begin,ii_end-1
-!             n=n+1
-!           ENDDO
-!         ENDDO
-
-!         DO j=jj_begin,jj_end-1
-!           DO i=ii_begin+1,ii_end
-!             n=n+1
-!           ENDDO
-!         ENDDO
-
-!        ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
-!         
-!         n=0  
-!      
-!         DO j=jj_begin+1,jj_end
-!           DO i=ii_begin,ii_end-1
-!             nij=(j-1)*iim+i
-!             n=n+1
-!             CALL xyz2lonlat(xyz_v(nij+z_down,:)/radius,lon(n),lat(n))
-!             lon(n)=lon(n)*180/Pi
-!!             IF (lon(n)<0) lon(n)=lon(n)+360
-!             lat(n)=lat(n)*180/Pi
-!             CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
-!             CALL xyz2lonlat(xyz_i(nij+t_ldown,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
-!             CALL xyz2lonlat(xyz_i(nij+t_rdown,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
-
-!             DO k=0,2
-!               bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
-!               bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
-!                IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360
-!             ENDDO
-!           ENDDO
-!         ENDDO
-
-!         DO j=jj_begin,jj_end-1
-!           DO i=ii_begin+1,ii_end
-!             nij=(j-1)*iim+i
-!             n=n+1
-!             CALL xyz2lonlat(xyz_v(nij+z_up,:)/radius,lon(n),lat(n))
-!             lon(n)=lon(n)*180/Pi
-!              IF (lon(n)<0) lon(n)=lon(n)+360
-!             lat(n)=lat(n)*180/Pi
-!             CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
-!             CALL xyz2lonlat(xyz_i(nij+t_rup,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
-!             CALL xyz2lonlat(xyz_i(nij+t_lup,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
-
-!             DO k=0,2
-!               bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
-!               bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
-!                IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360
-!             ENDDO
-!           ENDDO
-!         ENDDO
-!         
-!         
-!         status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ ncell /),count=(/ n /))
-!         status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ ncell /),count=(/ n /))
-!         status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,ncell /),count=(/ nvert,n /))
-!         status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,ncell /),count=(/ nvert,n /))
-! 
-!         ncell=ncell+n
-!         DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
-!     END DO          
-!   ENDIF
-
-
-!     
-!      status = NF90_CLOSE(ncid)
-
-!   END SUBROUTINE Create_Header
-
-
-
-   
-    SUBROUTINE Create_header_gen(name_in,field,domain_type,ind_b_in,ind_e_in,once)
-    USE netcdf_mod
-    USE field_mod
-    USE domain_mod
-    USE metric
-    USE spherical_geom_mod
-    IMPLICIT NONE
-      CHARACTER(LEN=*),INTENT(IN) :: name_in
-      TYPE(t_field),POINTER :: field(:)
-      TYPE(t_domain),INTENT(IN),TARGET :: domain_type(:)
-      INTEGER,OPTIONAL,INTENT(IN) :: ind_b_in
-      INTEGER,OPTIONAL,INTENT(IN) :: ind_e_in
-      LOGICAL,INTENT(IN) :: once
-      
-      INTEGER :: ncell
-      INTEGER :: nvert
-      REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
-      TYPE(t_domain),POINTER :: d
-      INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId
-      INTEGER :: dim3id,dim4id
-      INTEGER :: status
-      INTEGER :: ind,i,j,k,n,q
-      INTEGER :: iie,jje,iin,jjn
-      INTEGER :: ind_b,ind_e
-      INTEGER :: halo_size
-      LOGICAL :: single 
-      INTEGER :: nij
-      CHARACTER(LEN=255) :: name
-      INTEGER :: l,level_size, levId, dimlevId
-            
-      name=TRIM(ADJUSTL(name_in))
-
-      IF (PRESENT(ind_b_in) .AND. .NOT. PRESENT(ind_e_in)) THEN
-        name=TRIM(name)//"_"//TRIM(int2str(ind_b))
-        ind_b=ind_b_in
-        ind_e=ind_b_in
-        halo_size=1
-        single=.TRUE.
-      ELSE IF (.NOT. PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN
-        name=TRIM(name)//"_"//TRIM(int2str(ind_e))
-        ind_b=ind_e_in
-        ind_e=ind_e_in
-        halo_size=1
-        single=.TRUE.
-      ELSE IF ( PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN
-        ind_b=ind_b_in
-        ind_e=ind_e_in
-        halo_size=0
-        single=.FALSE.
-      ELSE
-        halo_size=0
-        ind_b=1
-        ind_e=ndomain
-        single=.FALSE.
-      ENDIF      
-                
-      NbField=NbField+1
-      FieldName(NbField)=TRIM(ADJUSTL(name))
-      FieldIndex(NbField)=1
-      
-      ncell=0
-      
-      IF (Field(ind_b)%field_type==field_T) THEN
-        nvert=6
-        
-        DO ind=ind_b,ind_e
-          d=>domain_type(ind)
-        
-          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-              IF (single .OR. d%assign_domain(i,j)==ind) ncell=ncell+1
-            ENDDO
-          ENDDO
-
-        END DO
-      
-        status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
-        FieldId(NbField)=ncid
-        status = NF90_DEF_DIM(ncid,'cell_i',ncell,ncellId)
-        status = NF90_DEF_DIM(ncid,'nvert_i',nvert,nvertid)
-        level_size=0
-        IF (Field(ind_b)%ndim==2)  THEN
-          FieldVarId(NbField)%size=1
-          ALLOCATE(FieldVarId(NbField)%nc_id(1))
-        ELSE IF (Field(ind_b)%ndim==3)  THEN
-          FieldVarId(NbField)%size=1
-          ALLOCATE(FieldVarId(NbField)%nc_id(1))
-          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
-          level_size=size(field(ind_b)%rval3d,2)
-        ELSE IF (Field(1)%ndim==4) THEN
-          FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
-          ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
-          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
-          level_size=size(field(ind_b)%rval4d,2)
-!          status = NF90_DEF_DIM(ncid,'Q',size(field(ind_b)%rval4d,3),dim4id)
-        ENDIF
-        PRINT*,"LEVEL_SIZE=",level_size
-
-        status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
-        IF (level_size>0) THEN
-          status = NF90_DEF_VAR(ncid,'lev',NF90_DOUBLE,(/ dim3id /),levId)
-          status = NF90_PUT_ATT(ncid,levId,"axis","Z")
-        ENDIF
-        
-        status = NF90_DEF_VAR(ncid,'lon_i',NF90_DOUBLE,(/ ncellId /),lonId)
-        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
-        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
-        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon_i")
-        status = NF90_DEF_VAR(ncid,'lat_i',NF90_DOUBLE,(/ ncellId /),latId)
-        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
-        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
-        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat_i")
-        status = NF90_DEF_VAR(ncid,'bounds_lon_i',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
-        status = NF90_DEF_VAR(ncid,'bounds_lat_i',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
-
-        IF (Field(ind_b)%ndim==2) THEN
-          IF (once) THEN 
-            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId /),FieldVarId(NbField)%nc_id(1))
-          ELSE
-             status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
-          ENDIF
-          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon_i lat_i")
-        ELSE IF (Field(ind_b)%ndim==3) THEN
-          IF (once) THEN 
-            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id /),FieldVarId(NbField)%nc_id(1))
-          ELSE
-            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
-          ENDIF
-          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon_i lat_i")
-        ELSE IF (Field(ind_b)%ndim==4) THEN
-          DO i=1,FieldVarId(NbField)%size
-            IF (once) THEN 
-              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),ncprec,(/ ncellId,dim3id /),  &
-                                    FieldVarId(NbField)%nc_id(i))
-            ELSE
-              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),ncprec,(/ ncellId,dim3id,timeId /),  &
-                                   FieldVarId(NbField)%nc_id(i))
-            ENDIF
-            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon_i lat_i")
-          ENDDO        
-        ENDIF 
-  
-      
-        status = NF90_ENDDEF(ncid)      
-
-        if (level_size>0) status = NF90_PUT_VAR(ncid,levId,(/ (l,l=1,level_size) /))
-         
-         ALLOCATE(lon(ncell),lat(ncell),bounds_lon(0:nvert-1,ncell),bounds_lat(0:nvert-1,ncell))
-          
-         n=0  
-         DO ind=ind_b,ind_e
-           d=>domain_type(ind)
-           DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-             DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-               IF (d%assign_domain(i,j)==ind .OR. single) THEN
-                 n=n+1
-                 CALL xyz2lonlat(d%xyz(:,i,j),lon(n),lat(n))
-                 lon(n)=lon(n)*180/Pi
-                 lat(n)=lat(n)*180/Pi
-                 DO k=0,5
-                   CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,n), bounds_lat(k,n))
-                   bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
-                   bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
-                 ENDDO
-               ENDIF
-             ENDDO
-           ENDDO
-         ENDDO
-         status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell /))
-         status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell /))
-         status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell /))
-         status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell /))
-  
-         DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
-
-    ELSE IF (Field(ind_b)%field_type==field_Z) THEN
-        nvert=3
-        DO ind=ind_b,ind_e
-          d=>domain_type(ind)
-        
-          DO j=d%jj_begin+1,d%jj_end
-            DO i=d%ii_begin,d%ii_end-1
-              ncell=ncell+1
-            ENDDO
-          ENDDO
-
-          DO j=d%jj_begin,d%jj_end-1
-            DO i=d%ii_begin+1,d%ii_end
-              ncell=ncell+1
-            ENDDO
-          ENDDO
-
-        END DO
-      
-        status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
-        FieldId(NbField)=ncid
-        status = NF90_DEF_DIM(ncid,'cell_v',ncell,ncellId)
-        status = NF90_DEF_DIM(ncid,'nvert_v',nvert,nvertid)
-
-        IF (Field(ind_b)%ndim==2)  THEN
-          FieldVarId(NbField)%size=1
-          ALLOCATE(FieldVarId(NbField)%nc_id(1))
-        ELSE IF (Field(ind_b)%ndim==3)  THEN
-          FieldVarId(NbField)%size=1
-          ALLOCATE(FieldVarId(NbField)%nc_id(1))
-          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
-        ELSE IF (Field(1)%ndim==4) THEN
-          FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
-          ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
-          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
-        ENDIF
-
-
-      
-        status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
-      
-        status = NF90_DEF_VAR(ncid,'lon_v',NF90_DOUBLE,(/ ncellId /),lonId)
-        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
-        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
-        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon_v")
-        status = NF90_DEF_VAR(ncid,'lat_v',NF90_DOUBLE,(/ ncellId /),latId)
-        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
-        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
-        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat_v")
-        status = NF90_DEF_VAR(ncid,'bounds_lon_v',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
-        status = NF90_DEF_VAR(ncid,'bounds_lat_v',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
-
-
-        IF (Field(ind_b)%ndim==2) THEN
-          IF (once) THEN 
-            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId /),FieldVarId(NbField)%nc_id(1))
-          ELSE
-            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
-          ENDIF
-          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon_v lat_v")
-        ELSE IF (Field(ind_b)%ndim==3) THEN
-          IF (once) THEN 
-            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id /),FieldVarId(NbField)%nc_id(1))
-          ELSE
-            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
-          ENDIF
-          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon_v lat_v")
-        ELSE IF (Field(ind_b)%ndim==4) THEN
-          DO q=1,FieldVarId(NbField)%size
-            IF (once) THEN 
-              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),ncprec,             &
-                                    (/ ncellId,dim3id /),FieldVarId(NbField)%nc_id(q))
-            ELSE
-              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),ncprec,             &
-                                    (/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q))
-            ENDIF
-            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon_v lat_v")
-          ENDDO        
-        ENDIF 
-        
-        status = NF90_ENDDEF(ncid)      
-
-         ALLOCATE(lon(ncell),lat(ncell),bounds_lon(0:nvert-1,ncell),bounds_lat(0:nvert-1,ncell))
-          
-         n=0  
-       
-         DO ind=ind_b,ind_e
-           d=>domain_type(ind)
-           DO j=d%jj_begin+1,d%jj_end
-             DO i=d%ii_begin,d%ii_end-1
-               nij=(j-1)*d%iim+i
-               n=n+1
-               CALL xyz2lonlat(d%vertex(:,vdown,i,j),lon(n),lat(n))
-               lon(n)=lon(n)*180/Pi
-               lat(n)=lat(n)*180/Pi
-
-               CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,n), bounds_lat(0,n))
-               CALL xyz2lonlat(d%xyz(:,i,j-1),bounds_lon(1,n), bounds_lat(1,n))
-               CALL xyz2lonlat(d%xyz(:,i+1,j-1),bounds_lon(2,n), bounds_lat(2,n))
-
-               DO k=0,2
-                 bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
-                 bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
-               ENDDO
-             ENDDO
-           ENDDO
-
-           DO j=d%jj_begin,d%jj_end-1
-             DO i=d%ii_begin+1,d%ii_end
-               nij=(j-1)*d%iim+i
-               n=n+1
-               CALL xyz2lonlat(d%vertex(:,vup,i,j),lon(n),lat(n))
-               lon(n)=lon(n)*180/Pi
-               lat(n)=lat(n)*180/Pi
-               CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,n), bounds_lat(0,n))
-               CALL xyz2lonlat(d%xyz(:,i,j+1),bounds_lon(1,n), bounds_lat(1,n))
-               CALL xyz2lonlat(d%xyz(:,i-1,j+1),bounds_lon(2,n), bounds_lat(2,n))
-
-               DO k=0,2
-                 bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
-                 bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
-               ENDDO
-             ENDDO
-           ENDDO
-         ENDDO 
-          
-         status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell /))
-         status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell /))
-         status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell /))
-         status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell /))
-  
-          DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
-      ENDIF
-
-
-    END SUBROUTINE Create_Header_gen
-
-    SUBROUTINE Create_header_mpi(name,field,nind)
-    USE netcdf_mod
-    USE field_mod
-    USE domain_mod
-    USE spherical_geom_mod
-    USE dimensions
-    USE geometry
-    USE mpi_mod
-    USE mpipara
-    IMPLICIT NONE
-      CHARACTER(LEN=*) :: name
-      CHARACTER(LEN=LEN_TRIM(ADJUSTL(name))) :: name_adj
-      TYPE(t_field),POINTER :: field(:)
-      INTEGER,OPTIONAL,INTENT(IN) :: nind
-      INTEGER :: ncell
-      INTEGER :: nvert
-      REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
-      TYPE(t_domain),POINTER :: d
-      INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId
-      INTEGER :: dim3id,dim4id
-      INTEGER :: status
-      INTEGER :: ind,i,j,k,n,q
-      INTEGER :: iie,jje,iin,jjn
-      INTEGER :: ind_b,ind_e
-      INTEGER :: halo_size
-      LOGICAL :: single 
-      INTEGER :: nij
-      INTEGER :: ncell_glo(0:mpi_size-1)
-      INTEGER :: displ, ncell_tot
-      
-          
-      NbField=NbField+1
-      name_adj=TRIM(ADJUSTL(name))  ! work around ICE with pgf90
-      FieldName(NbField)=name_adj
-      FieldIndex(NbField)=1
-      
-      IF (PRESENT(nind)) THEN
-        ind_b=nind
-        ind_e=nind
-        halo_size=1
-        single=.TRUE.
-      ELSE
-        ind_b=1
-        ind_e=ndomain
-        halo_size=0
-        single=.FALSE.
-      ENDIF
-      
-      ncell=0
-      
-      IF (Field(ind_b)%field_type==field_T) THEN
-        nvert=6
-        
-        DO ind=ind_b,ind_e
-          d=>domain(ind)
-        
-          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-              IF (single .OR. domain(ind)%own(i,j)) ncell=ncell+1
-            ENDDO
-          ENDDO
-
-        END DO
-      
-        CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
-
-        displ=0
-        DO i=1,mpi_rank
-          displ=displ+ncell_glo(i-1)
-        ENDDO
-        FieldVarId(NbField)%displ=displ
-        ncell_tot=sum(ncell_glo(:))
-        
-!        status = NF90_CREATE_PAR(TRIM(ADJUSTL(name))//'.nc', IOR(NF90_NETCDF4, NF90_MPIIO), comm_icosa, MPI_INFO_NULL, ncid)
-        FieldId(NbField)=ncid
-        status = NF90_DEF_DIM(ncid,'cell',ncell_tot,ncellId)
-        status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
-
-        IF (Field(ind_b)%ndim==2)  THEN
-          FieldVarId(NbField)%size=1
-          ALLOCATE(FieldVarId(NbField)%nc_id(1))
-        ELSE IF (Field(ind_b)%ndim==3)  THEN
-          FieldVarId(NbField)%size=1
-          ALLOCATE(FieldVarId(NbField)%nc_id(1))
-          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
-        ELSE IF (Field(1)%ndim==4) THEN
-          FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
-          ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
-          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
-!          status = NF90_DEF_DIM(ncid,'Q',size(field(ind_b)%rval4d,3),dim4id)
-        ENDIF
-      
-        status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
-      
-        status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
-        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
-        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
-        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
-        status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
-        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
-        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
-        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
-        status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
-        status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
-
-        IF (Field(ind_b)%ndim==2) THEN
-          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
-          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
-          status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, (/ncell_tot,1/))
-        ELSE IF (Field(ind_b)%ndim==3) THEN
-          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
-          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
-          status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED,   &
-                                         (/ncell_tot,size(field(ind_b)%rval3d,2),1/))
-        ELSE IF (Field(ind_b)%ndim==4) THEN
-          DO i=1,FieldVarId(NbField)%size
-            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),ncprec,(/ ncellId,dim3id,timeId /),  &
-                                  FieldVarId(NbField)%nc_id(i))
-            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon lat")
-            status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(q), NF90_CHUNKED,   &
-                                           (/ncell_tot,size(field(ind_b)%rval4d,2),1/))
-          ENDDO        
-        ENDIF 
-  
-      
-        status = NF90_ENDDEF(ncid)      
-
-        ncell=1
-        DO ind=ind_b,ind_e
-          d=>domain(ind)
-  
-          n=0
-          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-              IF (single .OR. d%own(i,j)) n=n+1
-            ENDDO
-          ENDDO
-          
-         ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
-          
-          n=0  
-          DO j=d%jj_begin-halo_size,d%jj_end+halo_size
-            DO i=d%ii_begin-halo_size,d%ii_end+halo_size
-                IF (d%own(i,j) .OR. single) THEN
-                n=n+1
-                CALL xyz2lonlat(d%xyz(:,i,j),lon(n),lat(n))
-                lon(n)=lon(n)*180/Pi
-                lat(n)=lat(n)*180/Pi
-                DO k=0,5
-                  CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,n), bounds_lat(k,n))
-                  bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
-                  bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
-                ENDDO
-              ENDIF
-            ENDDO
-          ENDDO
-          status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ displ+ncell /),count=(/ n /))
-          status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ displ+ncell /),count=(/ n /))
-          status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
-          status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
-  
-          ncell=ncell+n
-          DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
-      END DO 
-
-    ELSE IF (Field(ind_b)%field_type==field_Z) THEN
-        nvert=3
-        DO ind=ind_b,ind_e
-          d=>domain(ind)
-        
-          DO j=d%jj_begin+1,d%jj_end
-            DO i=d%ii_begin,d%ii_end-1
-              ncell=ncell+1
-            ENDDO
-          ENDDO
-
-          DO j=d%jj_begin,d%jj_end-1
-            DO i=d%ii_begin+1,d%ii_end
-              ncell=ncell+1
-            ENDDO
-          ENDDO
-
-        END DO
-        
-        CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
-
-        displ=0
-        DO i=1,mpi_rank
-          displ=displ+ncell_glo(i-1)
-        ENDDO
-        FieldVarId(NbField)%displ=displ
-        ncell_tot=sum(ncell_glo(:))
-              
-!        status = NF90_CREATE_PAR(TRIM(ADJUSTL(name))//'.nc',IOR(NF90_NETCDF4, NF90_MPIIO), comm_icosa, MPI_INFO_NULL, ncid)
-!        status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
-        FieldId(NbField)=ncid
-        status = NF90_DEF_DIM(ncid,'cell',ncell_tot,ncellId)
-        status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
-
-        IF (Field(ind_b)%ndim==2)  THEN
-          FieldVarId(NbField)%size=1
-          ALLOCATE(FieldVarId(NbField)%nc_id(1))
-        ELSE IF (Field(ind_b)%ndim==3)  THEN
-          FieldVarId(NbField)%size=1
-          ALLOCATE(FieldVarId(NbField)%nc_id(1))
-          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
-        ELSE IF (Field(1)%ndim==4) THEN
-          FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
-          ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
-          status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
-        ENDIF
-
-
-      
-        status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
-      
-        status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
-        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
-        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
-        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
-        status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
-        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
-        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
-        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
-        status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
-        status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
-
-
-        IF (Field(ind_b)%ndim==2) THEN
-          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
-          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
-          status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, (/ncell_tot,1/))
-        ELSE IF (Field(ind_b)%ndim==3) THEN
-          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
-          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
-          status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED,   &
-                                         (/ncell_tot,size(field(ind_b)%rval3d,2),1/))
-        ELSE IF (Field(ind_b)%ndim==4) THEN
-          DO q=1,FieldVarId(NbField)%size
-            status = NF90_DEF_VAR(ncid,name_adj//int2str(q),ncprec,             &
-                                  (/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q))
-            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon lat")
-           status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(q), NF90_CHUNKED, &
-                                          (/ncell_tot,size(field(ind_b)%rval4d,2),1/))
-          ENDDO        
-        ENDIF 
-        
-        status = NF90_ENDDEF(ncid)      
-
-        ncell=1
-        DO ind=ind_b,ind_e
-          d=>domain(ind)
-          CALL swap_geometry(ind)
-          CALL swap_dimensions(ind)
-  
-          n=0
-          DO j=jj_begin+1,jj_end
-            DO i=ii_begin,ii_end-1
-              n=n+1
-            ENDDO
-          ENDDO
-
-          DO j=jj_begin,jj_end-1
-            DO i=ii_begin+1,ii_end
-              n=n+1
-            ENDDO
-          ENDDO
-
-         ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
-          
-          n=0  
-       
-          DO j=jj_begin+1,jj_end
-            DO i=ii_begin,ii_end-1
-              nij=(j-1)*iim+i
-              n=n+1
-              CALL xyz2lonlat(xyz_v(nij+z_down,:)/radius,lon(n),lat(n))
-              lon(n)=lon(n)*180/Pi
-              lat(n)=lat(n)*180/Pi
-              CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
-              CALL xyz2lonlat(xyz_i(nij+t_ldown,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
-              CALL xyz2lonlat(xyz_i(nij+t_rdown,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
-
-              DO k=0,2
-                bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
-                bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
-              ENDDO
-            ENDDO
-          ENDDO
-
-          DO j=jj_begin,jj_end-1
-            DO i=ii_begin+1,ii_end
-              nij=(j-1)*iim+i
-              n=n+1
-              CALL xyz2lonlat(xyz_v(nij+z_up,:)/radius,lon(n),lat(n))
-              lon(n)=lon(n)*180/Pi
-              lat(n)=lat(n)*180/Pi
-              CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
-              CALL xyz2lonlat(xyz_i(nij+t_rup,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
-              CALL xyz2lonlat(xyz_i(nij+t_lup,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
-
-              DO k=0,2
-                bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
-                bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
-              ENDDO
-            ENDDO
-          ENDDO
-          
-          
-          status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ displ+ncell /),count=(/ n /))
-          status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ displ+ncell /),count=(/ n /))
-          status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
-          status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
-  
-          ncell=ncell+n
-          DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
-      END DO          
-    ENDIF
-
-
-   END SUBROUTINE Create_Header_mpi  
-   
-   SUBROUTINE Close_files
-   USE netcdf_mod
-   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
-     
-     
-  function int2str(int)
-    implicit none
-    integer, parameter :: MaxLen=10
-    integer,intent(in) :: int
-    character(len=MaxLen) :: int2str
-    logical :: flag
-    integer :: i
-    flag=.true.
-    
-    i=int
-    
-    int2str=''
-    do while (flag)
-      int2str=CHAR(MOD(i,10)+48)//int2str
-      i=i/10
-      if (i==0) flag=.false.
-    enddo
-  end function int2str
-
-end module write_field_mod
-  
Index: codes/icosagcm/devel/src/xios_mod.F90
===================================================================
--- codes/icosagcm/devel/src/xios_mod.F90	(revision 531)
+++ 	(revision )
@@ -1,1051 +1,0 @@
-MODULE xios_mod
-
-#ifdef CPP_USING_XIOS
-   USE xios
-#endif
-   IMPLICIT NONE 
-
-  PUBLIC
-  LOGICAL,SAVE :: using_xios
-
-  INTEGER,SAVE :: ncell_i
-!$OMP THREADPRIVATE(ncell_i)
-  INTEGER,SAVE :: ncell_v
-!$OMP THREADPRIVATE(ncell_v)
-  INTEGER,SAVE :: ncell_e
-!$OMP THREADPRIVATE(ncell_e)
-
-  PRIVATE ncell_i,ncell_v,ncell_e
-
-#ifdef CPP_USING_XIOS
-  
-CONTAINS
- 
- SUBROUTINE xios_init
-   USE getin_mod
-   USE xios
-   USE mpipara
-   IMPLICIT NONE
-    TYPE(xios_context) :: ctx_hdl
-
-     using_xios=.TRUE.
-     CALL xios_context_initialize("icosagcm",comm_icosa)
-     CALL xios_get_handle("icosagcm",ctx_hdl)
-     CALL xios_set_current_context(ctx_hdl)
-   
- END SUBROUTINE xios_init  
- 
- SUBROUTINE xios_init_write_field
- USE genmod
- USE mpipara
- USE xios
- USE grid_param
- USE domain_mod
- USE dimensions
- USE spherical_geom_mod
- USE geometry
- USE mpi_mod
- USE time_mod
- USE metric, ONLY : vup,vdown, cell_glo
- IMPLICIT NONE
-  TYPE(xios_context) :: ctx_hdl
-  TYPE(xios_duration)      :: dtime
-  REAL(rstd) :: lev_value(llm)
-  REAL(rstd) :: lev_valuep1(llm+1)
-  REAL(rstd) :: nq_value(nqtot)
-  INTEGER :: ncell, ncell_tot, ncell_glo(0:mpi_size-1), displ
-  INTEGER :: ind, i,j,k,l,ij
-  REAL(rstd),ALLOCATABLE    :: lon(:), lat(:), bounds_lon(:,:), bounds_lat(:,:)
-  INTEGER, ALLOCATABLE      :: ind_glo(:)
-  TYPE(t_domain),POINTER :: d
-
-!$OMP BARRIER
-!$OMP MASTER
-!   CALL xios_context_initialize("icosagcm",comm_icosa)
-   CALL xios_get_handle("icosagcm",ctx_hdl)
-   CALL xios_set_current_context(ctx_hdl)
-   lev_value(:) = (/ (l,l=1,llm) /)     
-   lev_valuep1(:) = (/ (l,l=1,llm+1) /)     
-   nq_value(:) = (/ (l,l=1,nqtot) /)     
-   CALL xios_set_axis_attr("lev",n_glo=llm ,value=lev_value) ;
-   CALL xios_set_axis_attr("levp1",n_glo=llm+1 ,value=lev_valuep1) ;
-   CALL xios_set_axis_attr("nq",n_glo=nqtot, value=nq_value) ;
-   
-   ncell=0
-   DO ind=1,ndomain
-     d=>domain(ind)
-        
-     DO j=d%jj_begin,d%jj_end
-       DO i=d%ii_begin,d%ii_end
-         IF (domain(ind)%own(i,j)) ncell=ncell+1
-       ENDDO
-     ENDDO
-   ENDDO      
-   ncell_i=ncell
-   
-   CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
-
-   displ=0
-   DO i=1,mpi_rank
-     displ=displ+ncell_glo(i-1)
-   ENDDO
-
-   ncell_tot=sum(ncell_glo(:))
-   
-   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:5,ncell), bounds_lat(0:5,ncell), ind_glo(ncell)) 
-   
-   ncell=0
-   DO ind=1,ndomain
-     d=>domain(ind)
-        
-     DO j=d%jj_begin,d%jj_end
-       DO i=d%ii_begin,d%ii_end
-         IF (domain(ind)%own(i,j)) THEN 
-           ncell=ncell+1
-           CALL xyz2lonlat(d%xyz(:,i,j),lon(ncell),lat(ncell))
-           lon(ncell)=lon(ncell)*180/Pi
-           lat(ncell)=lat(ncell)*180/Pi
-           DO k=0,5
-             CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,ncell), bounds_lat(k,ncell))
-             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
-             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
-           ENDDO
-           ind_glo(ncell)=domain(ind)%assign_cell_glo(i,j)-1 
-         ENDIF
-       ENDDO
-     ENDDO
-   ENDDO         
-
-   CALL xios_set_domaingroup_attr("i",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
-   CALL xios_set_domaingroup_attr("i", data_dim=1, type='unstructured' , nvertex=6, i_index=ind_glo)
-   CALL xios_set_domaingroup_attr("i",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
-   
-   DEALLOCATE(lon, lat, bounds_lon, bounds_lat,ind_glo) 
-    
-
-
-   ncell=0
-   DO ind=1,ndomain
-     d=>domain(ind)
-
-     DO j=d%jj_begin,d%jj_end
-       DO i=d%ii_begin,d%ii_end
-         DO k=0,5
-            IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
-                                                                                 .AND. d%edge_assign_pos(k,i,j)==k) THEN
-               ncell=ncell+1
-            ENDIF
-         ENDDO
-       ENDDO
-     ENDDO
-   ENDDO
-   ncell_e=ncell
-   
-   CALL MPI_ALLGATHER(ncell_e,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
-   displ=0
-   DO i=1,mpi_rank
-     displ=displ+ncell_glo(i-1)
-   ENDDO
-   ncell_tot=sum(ncell_glo(:))
-   
-   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:1,ncell), bounds_lat(0:1,ncell),ind_glo(ncell)) 
-
-
-   ncell=0
-   DO ind=1,ndomain
-     d=>domain(ind)
-     CALL swap_dimensions(ind)
-     CALL swap_geometry(ind)
-
-     DO j=d%jj_begin,d%jj_end
-       DO i=d%ii_begin,d%ii_end
-         DO k=0,5
-           IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
-                                                                                 .AND. d%edge_assign_pos(k,i,j)==k) THEN
-              ncell=ncell+1
-              ij=(j-1)*iim+i
-
-              lon(ncell)=lon_e(ij+u_pos(k+1))*180/Pi
-              lat(ncell)=lat_e(ij+u_pos(k+1))*180/Pi
-               
-              CALL xyz2lonlat(d%vertex(:,MOD((k-1)+6,6),i,j),bounds_lon(0,ncell), bounds_lat(0,ncell))
-              CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(1,ncell), bounds_lat(1,ncell))
-              bounds_lon(:,ncell)=bounds_lon(:,ncell)*180/Pi
-              bounds_lat(:,ncell)=bounds_lat(:,ncell)*180/Pi
-              ind_glo(ncell)=cell_glo(d%assign_cell_glo(i,j))%edge(MOD(k+d%delta(i,j)+6,6))-1 
-           ENDIF               
-         ENDDO
-       ENDDO
-     ENDDO
-   ENDDO
-   CALL xios_set_domain_attr("u",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
-   CALL xios_set_domain_attr("u", data_dim=1, type='unstructured' , nvertex=2, i_index=ind_glo)
-   CALL xios_set_domain_attr("u",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
-
-   DEALLOCATE(lon, lat, bounds_lon, bounds_lat,ind_glo) 
-
-
-   ncell=0
-   DO ind=1,ndomain
-     d=>domain(ind)
-        
-     DO j=d%jj_begin+1,d%jj_end
-       DO i=d%ii_begin,d%ii_end-1
-         ncell=ncell+1
-       ENDDO
-     ENDDO
-
-     DO j=d%jj_begin,d%jj_end-1
-       DO i=d%ii_begin+1,d%ii_end
-          ncell=ncell+1
-        ENDDO
-     ENDDO
-
-   ENDDO      
-   
-   ncell_v=ncell
-   
-   CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
-
-   displ=0
-   DO i=1,mpi_rank
-     displ=displ+ncell_glo(i-1)
-   ENDDO
-
-   ncell_tot=sum(ncell_glo(:))
-   
-   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:2,ncell), bounds_lat(0:2,ncell)) 
-   
-   ncell=0
-   DO ind=1,ndomain
-     d=>domain(ind)
- 
-     DO j=d%jj_begin+1,d%jj_end
-       DO i=d%ii_begin,d%ii_end-1
-           ncell=ncell+1
-           CALL xyz2lonlat(d%vertex(:,vdown,i,j),lon(ncell),lat(ncell))
-           lon(ncell)=lon(ncell)*180/Pi
-           lat(ncell)=lat(ncell)*180/Pi
-
-           CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,ncell), bounds_lat(0,ncell))
-           CALL xyz2lonlat(d%xyz(:,i,j-1),bounds_lon(1,ncell), bounds_lat(1,ncell))
-           CALL xyz2lonlat(d%xyz(:,i+1,j-1),bounds_lon(2,ncell), bounds_lat(2,ncell))
-
-           DO k=0,2
-             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
-             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
-           ENDDO
-         ENDDO
-       ENDDO 
- 
-       DO j=d%jj_begin,d%jj_end-1
-         DO i=d%ii_begin+1,d%ii_end
-           ncell=ncell+1
-           CALL xyz2lonlat(d%vertex(:,vup,i,j),lon(ncell),lat(ncell))
-           lon(ncell)=lon(ncell)*180/Pi
-           lat(ncell)=lat(ncell)*180/Pi
-           CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,ncell), bounds_lat(0,ncell))
-           CALL xyz2lonlat(d%xyz(:,i,j+1),bounds_lon(1,ncell), bounds_lat(1,ncell))
-           CALL xyz2lonlat(d%xyz(:,i-1,j+1),bounds_lon(2,ncell), bounds_lat(2,ncell))
-
-           DO k=0,2
-             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
-             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
-           ENDDO
-         ENDDO
-       ENDDO 
-        
-   ENDDO         
-
-  
-   CALL xios_set_domain_attr("v",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
-   CALL xios_set_domain_attr("v", data_dim=1, type='unstructured' , nvertex=3)
-   CALL xios_set_domain_attr("v",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
-
-
-   dtime%second=dt
-   CALL xios_set_timestep(dtime)
-   
-   CALL xios_set_fieldgroup_attr("standard_output", freq_op=itau_out*xios_timestep, freq_offset=(itau_out-1)*xios_timestep)
-    
-   CALL xios_close_context_definition()
-!$OMP END MASTER
-!$OMP BARRIER
-   
- END SUBROUTINE xios_init_write_field
-  
-  
- SUBROUTINE xios_write_field(name,field)
- USE field_mod
- IMPLICIT NONE 
-   CHARACTER(LEN=*),INTENT(IN) :: name
-   TYPE(t_field), POINTER :: field(:)
-   CHARACTER(LEN=10) :: str_number
-   INTEGER :: iq
-
-!$OMP BARRIER
-!$OMP MASTER
-   
-   IF (Field(1)%field_type==field_T) THEN
-     IF (field(1)%ndim==2) THEN
-        CALL xios_write_field_scalar(name,field,1,1)
-     ELSE IF (field(1)%ndim==3) THEN
-        CALL xios_write_field_scalar(name,field,size(field(1)%rval3d,2),1)
-     ELSE IF (field(1)%ndim==4) THEN
-!        DO iq=1,size(field(1)%rval4d,3)
-!          WRITE(str_number,'(i10)') iq
-!          CALL xios_write_field_scalar(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
-          CALL xios_write_field_scalar(name,field,size(field(1)%rval4d,2),size(field(1)%rval4d,3))
-!        ENDDO
-     ELSE
-        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
-     ENDIF
-
-   ELSE IF (Field(1)%field_type==field_U) THEN
-      IF (field(1)%ndim==2) THEN
-        CALL xios_write_field_U(name,field,1,1)
-      ELSE IF (field(1)%ndim==3) THEN
-        CALL xios_write_field_U(name,field,size(field(1)%rval3d,2),1)
-      ELSE IF (field(1)%ndim==4) THEN
-        CALL xios_write_field_U(name,field,size(field(1)%rval4d,2),size(field(1)%rval4d,3))
-      ELSE
-        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
-      ENDIF
-
-    ELSE IF (Field(1)%field_type==field_Z) THEN
-     IF (field(1)%ndim==2) THEN
-        CALL xios_write_field_vort(name,field,1)
-      ELSE IF (field(1)%ndim==3) THEN
-        CALL xios_write_field_vort(name,field,size(field(1)%rval3d,2))
-      ELSE IF (field(1)%ndim==4) THEN
-        DO iq=1,size(field(1)%rval4d,3)
-          WRITE(str_number,'(i10)') iq
-          CALL xios_write_field_vort(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
-        ENDDO
-      ELSE
-        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
-      ENDIF
-    ENDIF
-!$OMP END MASTER
-!$OMP BARRIER
-      
- END SUBROUTINE xios_write_field
-
- SUBROUTINE xios_read_field(name,field)
- USE field_mod
- IMPLICIT NONE 
-   CHARACTER(LEN=*),INTENT(IN) :: name
-   TYPE(t_field), POINTER :: field(:)
-   CHARACTER(LEN=10) :: str_number
-   INTEGER :: iq
-
-!$OMP BARRIER
-!$OMP MASTER
-   
-   IF (Field(1)%field_type==field_T) THEN
-     IF (field(1)%ndim==2) THEN
-        CALL xios_read_field_scalar(name,field,1,1)
-      ELSE IF (field(1)%ndim==3) THEN
-        CALL xios_read_field_scalar(name,field,size(field(1)%rval3d,2),1)
-      ELSE IF (field(1)%ndim==4) THEN
-!        DO iq=1,size(field(1)%rval4d,3)
-!          WRITE(str_number,'(i10)') iq
-!          CALL xios_read_field_scalar(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
-!        ENDDO
-          CALL xios_read_field_scalar(name,field,size(field(1)%rval4d,2),size(field(1)%rval4d,3))
-      ELSE
-        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
-      ENDIF
-   ELSE IF (Field(1)%field_type==field_U) THEN
-     IF (field(1)%ndim==2) THEN
-        CALL xios_read_field_u(name,field,1,1)
-      ELSE IF (field(1)%ndim==3) THEN
-        CALL xios_read_field_u(name,field,size(field(1)%rval3d,2),1)
-      ELSE IF (field(1)%ndim==4) THEN
-          CALL xios_read_field_u(name,field,size(field(1)%rval4d,2),size(field(1)%rval4d,3))
-      ELSE
-        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
-      ENDIF
-    ELSE IF (Field(1)%field_type==field_Z) THEN
-     IF (field(1)%ndim==2) THEN
-        CALL xios_read_field_vort(name,field,1)
-      ELSE IF (field(1)%ndim==3) THEN
-        CALL xios_read_field_vort(name,field,size(field(1)%rval3d,2))
-      ELSE IF (field(1)%ndim==4) THEN
-        DO iq=1,size(field(1)%rval4d,3)
-          WRITE(str_number,'(i10)') iq
-          CALL xios_read_field_vort(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
-        ENDDO
-      ELSE
-        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
-      ENDIF
-    ENDIF
-!$OMP END MASTER
-!$OMP BARRIER
-      
- END SUBROUTINE xios_read_field
-
-
- 
- SUBROUTINE xios_write_field_scalar(name,field,nlev,nq)
- USE genmod
- USE mpipara
- USE xios
- USE grid_param
- USE domain_mod
- USE dimensions
- USE spherical_geom_mod
- USE geometry
- USE mpi_mod
- IMPLICIT NONE 
-   CHARACTER(LEN=*),INTENT(IN) :: name
-   TYPE(t_field), POINTER :: field(:)
-   INTEGER,INTENT(IN) :: nlev
-   INTEGER,INTENT(IN) :: nq
-   
-   REAL(rstd) :: field_tmp(ncell_i,nlev,nq)
-   TYPE(t_domain),POINTER :: d
-   INTEGER :: n,i,j,ij,ind
-   
-   IF (field(1)%ndim==2) THEN
-     n=0
-     DO ind=1,ndomain
-       
-       d=>domain(ind)
-        
-       DO j=d%jj_begin,d%jj_end
-         DO i=d%ii_begin,d%ii_end
-           IF (d%own(i,j)) THEN
-             n=n+1
-             ij=d%iim*(j-1)+i
-             field_tmp(n,1,1)=field(ind)%rval2d(ij)
-           ENDIF
-         ENDDO
-       ENDDO
-     ENDDO
-   ELSE IF (field(1)%ndim==3) THEN
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-        
-       DO j=d%jj_begin,d%jj_end
-         DO i=d%ii_begin,d%ii_end
-           IF (d%own(i,j)) THEN
-             n=n+1
-             ij=d%iim*(j-1)+i
-             field_tmp(n,:,1)=field(ind)%rval3d(ij,:)
-           ENDIF
-         ENDDO
-       ENDDO
-     ENDDO
-   ELSE IF (field(1)%ndim==4) THEN
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-        
-       DO j=d%jj_begin,d%jj_end
-         DO i=d%ii_begin,d%ii_end
-           IF (d%own(i,j)) THEN
-             n=n+1
-             ij=d%iim*(j-1)+i
-             field_tmp(n,:,:)=field(ind)%rval4d(ij,:,:)
-           ENDIF
-         ENDDO
-       ENDDO
-     ENDDO     
-   ENDIF
-   
-   CALL xios_send_field(name,field_tmp)
- 
- END SUBROUTINE xios_write_field_scalar  
-
-
- SUBROUTINE xios_read_var(name,field)
-   USE prec
-   CHARACTER(LEN=*),INTENT(IN) :: name
-   REAL(rstd), INTENT(OUT) :: field
-   CALL xios_recv_field(name,field)
- END SUBROUTINE
-
- SUBROUTINE xios_read_field_scalar(name,field,nlev,nq)
- USE genmod
- USE mpipara
- USE xios
- USE grid_param
- USE domain_mod
- USE dimensions
- USE spherical_geom_mod
- USE geometry
- USE mpi_mod
- IMPLICIT NONE 
-   CHARACTER(LEN=*),INTENT(IN) :: name
-   TYPE(t_field), POINTER :: field(:)
-   INTEGER,INTENT(IN) :: nlev
-   INTEGER,INTENT(IN) :: nq
-   
-   REAL(rstd) :: field_tmp(ncell_i,nlev,nq)
-   TYPE(t_domain),POINTER :: d
-   INTEGER :: n,i,j,ij,ind
-
-   CALL xios_recv_field(name,field_tmp)
-   
-   IF (field(1)%ndim==2) THEN
-     n=0
-     DO ind=1,ndomain
-       
-       d=>domain(ind)
-        
-       DO j=d%jj_begin,d%jj_end
-         DO i=d%ii_begin,d%ii_end
-           IF (d%own(i,j)) THEN
-             n=n+1
-             ij=d%iim*(j-1)+i
-             field(ind)%rval2d(ij)=field_tmp(n,1,1)
-           ENDIF
-         ENDDO
-       ENDDO
-     ENDDO
-   ELSE IF (field(1)%ndim==3) THEN
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-        
-       DO j=d%jj_begin,d%jj_end
-         DO i=d%ii_begin,d%ii_end
-           IF (d%own(i,j)) THEN
-             n=n+1
-             ij=d%iim*(j-1)+i
-             field(ind)%rval3d(ij,:)=field_tmp(n,:,1)
-           ENDIF
-         ENDDO
-       ENDDO
-     ENDDO
-   ELSE IF (field(1)%ndim==4) THEN
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-        
-       DO j=d%jj_begin,d%jj_end
-         DO i=d%ii_begin,d%ii_end
-           IF (d%own(i,j)) THEN
-             n=n+1
-             ij=d%iim*(j-1)+i
-             field(ind)%rval4d(ij,:,:)=field_tmp(n,:,:)
-           ENDIF
-         ENDDO
-       ENDDO
-     ENDDO     
-   ENDIF
- 
- END SUBROUTINE xios_read_field_scalar
-
- SUBROUTINE xios_write_field_U(name,field,nlev,nq)
- USE genmod
- USE mpipara
- USE xios
- USE grid_param
- USE domain_mod
- USE dimensions
- USE spherical_geom_mod
- USE geometry
- USE mpi_mod
- IMPLICIT NONE 
-   CHARACTER(LEN=*),INTENT(IN) :: name
-   TYPE(t_field), POINTER :: field(:)
-   INTEGER,INTENT(IN) :: nlev
-   INTEGER,INTENT(IN) :: nq
-   
-   REAL(rstd) :: field_tmp(ncell_e,nlev,nq)
-   TYPE(t_domain),POINTER :: d
-   INTEGER :: n,i,j,k,ij,ind
-   
-   IF (field(1)%ndim==2) THEN
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-
-       DO j=d%jj_begin,d%jj_end
-         DO i=d%ii_begin,d%ii_end
-           DO k=0,5
-             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
-                                                                                 .AND. d%edge_assign_pos(k,i,j)==k) THEN
-               n=n+1
-               ij=iim*(j-1)+i
-               Field_tmp(n,1,1)=d%edge_assign_sign(k,i,j)*field(ind)%rval2d(ij+d%u_pos(k+1))
-             ENDIF
-           ENDDO
-         ENDDO
-       ENDDO
-     ENDDO       
-  
-   ELSE IF (field(1)%ndim==3) THEN
-
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-
-       DO j=d%jj_begin,d%jj_end
-         DO i=d%ii_begin,d%ii_end
-           DO k=0,5
-             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
-                                                                                  .AND. d%edge_assign_pos(k,i,j)==k) THEN
-               n=n+1
-               ij=iim*(j-1)+i
-               Field_tmp(n,:,1)=d%edge_assign_sign(k,i,j)*field(ind)%rval3d(ij+d%u_pos(k+1),:)
-             ENDIF
-           ENDDO
-         ENDDO
-       ENDDO
-     ENDDO       
-
-   ELSE IF (field(1)%ndim==4) THEN
-
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-
-       DO j=d%jj_begin,d%jj_end
-         DO i=d%ii_begin,d%ii_end
-           DO k=0,5
-             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
-                                                                                  .AND. d%edge_assign_pos(k,i,j)==k) THEN
-               n=n+1
-               ij=iim*(j-1)+i
-               Field_tmp(n,:,:)=d%edge_assign_sign(k,i,j)*field(ind)%rval4d(ij+d%u_pos(k+1),:,:)
-             ENDIF
-           ENDDO
-         ENDDO
-       ENDDO
-     ENDDO       
-
-   ENDIF
-   
-   CALL xios_send_field(name,field_tmp)
- 
- END SUBROUTINE xios_write_field_u 
-
-
- SUBROUTINE xios_read_field_u(name,field,nlev,nq)
- USE genmod
- USE mpipara
- USE xios
- USE grid_param
- USE domain_mod
- USE dimensions
- USE spherical_geom_mod
- USE geometry
- USE mpi_mod
- IMPLICIT NONE 
-   CHARACTER(LEN=*),INTENT(IN) :: name
-   TYPE(t_field), POINTER :: field(:)
-   INTEGER,INTENT(IN) :: nlev
-   INTEGER,INTENT(IN) :: nq
-   
-   REAL(rstd) :: field_tmp(ncell_e,nlev,nq)
-   TYPE(t_domain),POINTER :: d
-   INTEGER :: n,i,j,k,ij,ind
-
-   CALL xios_recv_field(name,field_tmp)
-   
-   IF (field(1)%ndim==2) THEN
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-
-       DO j=d%jj_begin,d%jj_end
-         DO i=d%ii_begin,d%ii_end
-           DO k=0,5
-             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
-                                                                                 .AND. d%edge_assign_pos(k,i,j)==k) THEN
-               n=n+1
-               ij=iim*(j-1)+i
-               field(ind)%rval2d(ij+d%u_pos(k+1))=Field_tmp(n,1,1)*d%edge_assign_sign(k,i,j)
-             ENDIF
-           ENDDO
-         ENDDO
-       ENDDO
-     ENDDO       
-  
-   ELSE IF (field(1)%ndim==3) THEN
-
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-
-       DO j=d%jj_begin,d%jj_end
-         DO i=d%ii_begin,d%ii_end
-           DO k=0,5
-             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
-                                                                                  .AND. d%edge_assign_pos(k,i,j)==k) THEN
-               n=n+1
-               ij=iim*(j-1)+i
-               field(ind)%rval3d(ij+d%u_pos(k+1),:)=Field_tmp(n,:,1)*d%edge_assign_sign(k,i,j)
-             ENDIF
-           ENDDO
-         ENDDO
-       ENDDO
-     ENDDO       
-
-   ELSE IF (field(1)%ndim==4) THEN
-
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-
-       DO j=d%jj_begin,d%jj_end
-         DO i=d%ii_begin,d%ii_end
-           DO k=0,5
-             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
-                                                                                  .AND. d%edge_assign_pos(k,i,j)==k) THEN
-               n=n+1
-               ij=iim*(j-1)+i
-               field(ind)%rval4d(ij+d%u_pos(k+1),:,:)=Field_tmp(n,:,:)*d%edge_assign_sign(k,i,j)
-             ENDIF
-           ENDDO
-         ENDDO
-       ENDDO
-     ENDDO       
-
-   ENDIF
-   
- 
- END SUBROUTINE xios_read_field_u 
-
-
-
-      
- SUBROUTINE xios_write_field_vort(name,field,nlev,iq)
- USE genmod
- USE mpipara
- USE xios
- USE grid_param
- USE domain_mod
- USE dimensions
- USE spherical_geom_mod
- USE geometry
- USE mpi_mod
- IMPLICIT NONE 
-   CHARACTER(LEN=*),INTENT(IN) :: name
-   TYPE(t_field), POINTER :: field(:)
-   INTEGER,INTENT(IN) :: nlev
-   INTEGER,INTENT(IN),OPTIONAL :: iq
-   
-   REAL(rstd) :: field_tmp(ncell_v,nlev)
-   TYPE(t_domain),POINTER :: d
-   INTEGER :: n,i,j,ij,ind
-   
-   IF (field(1)%ndim==2) THEN
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-       CALL swap_dimensions(ind)  
-       
-       DO j=d%jj_begin+1,d%jj_end
-         DO i=d%ii_begin,d%ii_end-1
-           n=n+1
-           ij=iim*(j-1)+i
-           Field_tmp(n,1)=field(ind)%rval2d(ij+z_down)
-         ENDDO
-       ENDDO
-
-       DO j=d%jj_begin,d%jj_end-1
-         DO i=d%ii_begin+1,d%ii_end
-           n=n+1
-           ij=iim*(j-1)+i
-           Field_tmp(n,1)=field(ind)%rval2d(ij+z_up)
-          ENDDO
-       ENDDO
-          
-     ENDDO
-
-   ELSE IF (field(1)%ndim==3) THEN
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-       CALL swap_dimensions(ind)    
-             
-       DO j=d%jj_begin+1,d%jj_end
-         DO i=d%ii_begin,d%ii_end-1
-           n=n+1
-           ij=iim*(j-1)+i
-           Field_tmp(n,:)=field(ind)%rval3d(ij+z_down,:)
-         ENDDO
-       ENDDO
-
-       DO j=d%jj_begin,d%jj_end-1
-         DO i=d%ii_begin+1,d%ii_end
-           n=n+1
-           ij=iim*(j-1)+i
-           Field_tmp(n,:)=field(ind)%rval3d(ij+z_up,:)
-          ENDDO
-       ENDDO
-          
-     ENDDO
-
-   ELSE IF (field(1)%ndim==4) THEN
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-       CALL swap_dimensions(ind) 
-               
-       DO j=d%jj_begin+1,d%jj_end
-         DO i=d%ii_begin,d%ii_end-1
-           n=n+1
-           ij=iim*(j-1)+i
-           Field_tmp(n,:)=field(ind)%rval4d(ij+z_down,:,iq)
-         ENDDO
-       ENDDO
-
-       DO j=d%jj_begin,d%jj_end-1
-         DO i=d%ii_begin+1,d%ii_end
-           n=n+1
-           ij=iim*(j-1)+i
-           Field_tmp(n,:)=field(ind)%rval4d(ij+z_up,:,iq)
-          ENDDO
-       ENDDO
-          
-     ENDDO
-
-   ENDIF
-   
-   CALL xios_send_field(name,field_tmp)
- 
- END SUBROUTINE xios_write_field_vort 
-
- SUBROUTINE xios_read_field_vort(name,field,nlev,iq)
- USE genmod
- USE mpipara
- USE xios
- USE grid_param
- USE domain_mod
- USE dimensions
- USE spherical_geom_mod
- USE geometry
- USE mpi_mod
- IMPLICIT NONE 
-   CHARACTER(LEN=*),INTENT(IN) :: name
-   TYPE(t_field), POINTER :: field(:)
-   INTEGER,INTENT(IN) :: nlev
-   INTEGER,INTENT(IN),OPTIONAL :: iq
-   
-   REAL(rstd) :: field_tmp(ncell_v,nlev)
-   TYPE(t_domain),POINTER :: d
-   INTEGER :: n,i,j,ij,ind
-
-   CALL xios_recv_field(name,field_tmp)
-
-   
-   IF (field(1)%ndim==2) THEN
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-       CALL swap_dimensions(ind)  
-       
-       DO j=d%jj_begin+1,d%jj_end
-         DO i=d%ii_begin,d%ii_end-1
-           n=n+1
-           ij=iim*(j-1)+i
-           field(ind)%rval2d(ij+z_down)=Field_tmp(n,1)
-         ENDDO
-       ENDDO
-
-       DO j=d%jj_begin,d%jj_end-1
-         DO i=d%ii_begin+1,d%ii_end
-           n=n+1
-           ij=iim*(j-1)+i
-           Field_tmp(n,1)=field(ind)%rval2d(ij+z_up)
-           field(ind)%rval2d(ij+z_up)=Field_tmp(n,1)
-          ENDDO
-       ENDDO
-          
-     ENDDO
-
-   ELSE IF (field(1)%ndim==3) THEN
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-       CALL swap_dimensions(ind)    
-             
-       DO j=d%jj_begin+1,d%jj_end
-         DO i=d%ii_begin,d%ii_end-1
-           n=n+1
-           ij=iim*(j-1)+i
-           field(ind)%rval3d(ij+z_down,:)=Field_tmp(n,:)
-         ENDDO
-       ENDDO
-
-       DO j=d%jj_begin,d%jj_end-1
-         DO i=d%ii_begin+1,d%ii_end
-           n=n+1
-           ij=iim*(j-1)+i
-           field(ind)%rval3d(ij+z_up,:)=Field_tmp(n,:)
-          ENDDO
-       ENDDO
-          
-     ENDDO
-
-   ELSE IF (field(1)%ndim==4) THEN
-     n=0
-     DO ind=1,ndomain
-       d=>domain(ind)
-       CALL swap_dimensions(ind) 
-               
-       DO j=d%jj_begin+1,d%jj_end
-         DO i=d%ii_begin,d%ii_end-1
-           n=n+1
-           ij=iim*(j-1)+i
-           field(ind)%rval4d(ij+z_down,:,iq)=Field_tmp(n,:)
-         ENDDO
-       ENDDO
-
-       DO j=d%jj_begin,d%jj_end-1
-         DO i=d%ii_begin+1,d%ii_end
-           n=n+1
-           ij=iim*(j-1)+i
-           field(ind)%rval4d(ij+z_up,:,iq)=Field_tmp(n,:)
-          ENDDO
-       ENDDO
-          
-     ENDDO
-
-   ENDIF
- 
- END SUBROUTINE xios_read_field_vort 
-
-
-
-
-  
- 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
-
- SUBROUTINE xios_set_context
- IMPLICIT NONE   
-  TYPE(xios_context) :: ctx_hdl
-
-!$OMP MASTER 
-   CALL xios_get_handle("icosagcm",ctx_hdl)
-   CALL xios_set_current_context(ctx_hdl)
-!$OMP END MASTER
-
-  END SUBROUTINE xios_set_context
-
-
-#else
-  
-
-INTERFACE xios_send_field
-  MODULE PROCEDURE xios_send_field_scalar, xios_send_field_1d
-END INTERFACE  xios_send_field
-
-INTEGER,PARAMETER :: xios_timestep=1
-
-CONTAINS  
-  
-  
-  SUBROUTINE xios_init
-   IMPLICIT NONE
-         
-    using_xios=.FALSE.
-    
-  END SUBROUTINE xios_init
-  
-  SUBROUTINE xios_send_field_scalar(name,field)
-  IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(IN) :: name
-    REAL,INTENT(IN) :: field
-  END SUBROUTINE xios_send_field_scalar  
-
-  SUBROUTINE xios_send_field_1d(name,field)
-  IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(IN) :: name
-    REAL,INTENT(IN) :: field(:)
-  END SUBROUTINE xios_send_field_1d  
- 
-  SUBROUTINE xios_write_field(name,field)
-  USE field_mod
-  IMPLICIT NONE 
-   CHARACTER(LEN=*),INTENT(IN) :: name
-   TYPE(t_field), POINTER :: field(:)
-  END SUBROUTINE xios_write_field
-
-  SUBROUTINE xios_read_field(name,field)
-  USE field_mod
-  IMPLICIT NONE 
-   CHARACTER(LEN=*),INTENT(IN) :: name
-   TYPE(t_field), POINTER :: field(:)
-  END SUBROUTINE xios_read_field
-
- SUBROUTINE xios_read_var(name,field)
-   USE prec
-   CHARACTER(LEN=*),INTENT(IN) :: name
-   REAL(rstd), INTENT(OUT) :: field
- END SUBROUTINE
- 
-  SUBROUTINE xios_update_calendar(step)
-  IMPLICIT NONE
-   INTEGER, INTENT(IN):: step  
-  END SUBROUTINE xios_update_calendar
-
-  SUBROUTINE xios_write_field_finalize
-  END SUBROUTINE xios_write_field_finalize
-  
-  SUBROUTINE xios_init_write_field
-  END SUBROUTINE xios_init_write_field  
-  
-  SUBROUTINE xios_set_context
-  END SUBROUTINE xios_set_context
-  
-  SUBROUTINE xios_set_fieldgroup_attr(name,enabled,freq_op)
-    CHARACTER(LEN=*) :: name
-    LOGICAL,OPTIONAL          :: enabled
-    INTEGER,OPTIONAL          :: freq_op
-  END SUBROUTINE xios_set_fieldgroup_attr
-
-  SUBROUTINE xios_set_filegroup_attr(name,enabled)
-    CHARACTER(LEN=*) :: name
-    LOGICAL,OPTIONAL          :: enabled
-  END SUBROUTINE xios_set_filegroup_attr
-
-  SUBROUTINE xios_set_file_attr(id,name,enabled, output_freq)
-    CHARACTER(LEN=*) :: id
-    CHARACTER(LEN=*),OPTIONAL :: name
-    LOGICAL,OPTIONAL          :: enabled
-    INTEGER,OPTIONAL          :: output_freq
-  END SUBROUTINE xios_set_file_attr
-
-  SUBROUTINE xios_get_axis_attr(name,n_glo,value)
-    CHARACTER(LEN=*) :: name
-    INTEGER,OPTIONAL          :: n_glo
-    REAL,OPTIONAL             :: value(:)
-  END SUBROUTINE xios_get_axis_attr
-
-  SUBROUTINE xios_set_axis_attr(id,n_glo,value)
-    CHARACTER(LEN=*) :: id
-    INTEGER,OPTIONAL          :: n_glo
-    REAL,OPTIONAL             :: value(:)
-  END SUBROUTINE xios_set_axis_attr
-
-#endif  
-
-END MODULE xios_mod
