Index: des/icosagcm/trunk/src/caldyn_sw.f90
===================================================================
--- /codes/icosagcm/trunk/src/caldyn_sw.f90	(revision 184)
+++ 	(revision )
@@ -1,534 +1,0 @@
-MODULE caldyn_sw_mod
-  USE icosa
-  USE transfert_mpi_mod, ONLY : t_request
-  PRIVATE
-  TYPE(t_field),POINTER,SAVE :: f_Fe(:)
-  REAL(rstd),POINTER,SAVE    :: Fe(:)
-  TYPE(t_field),POINTER,SAVE :: f_Ki(:)
-  REAL(rstd),POINTER,SAVE    :: Ki(:)
-  TYPE(t_field),POINTER,SAVE :: f_qv(:)
-  REAL(rstd),POINTER,SAVE    :: qv(:)
-  TYPE(t_field),POINTER,SAVE :: f_qv2(:)
-  REAL(rstd),POINTER,SAVE    :: qv2(:)
-
-  TYPE(t_field),POINTER,SAVE :: f_t_tmp(:)
-  REAL(rstd),POINTER,SAVE    :: t_tmp(:)
-  TYPE(t_field),POINTER,SAVE :: f_u_tmp(:)
-  REAL(rstd),POINTER,SAVE    :: u_tmp(:)
-  TYPE(t_field),POINTER,SAVE :: f_z_tmp(:)
-  REAL(rstd),POINTER,SAVE    :: z_tmp(:)
-  TYPE(t_field),POINTER,SAVE :: f_dZ(:)
-  REAL(rstd),POINTER,SAVE    :: dZ(:)
-  TYPE(t_field),POINTER,SAVE :: f_diff_dhv(:)
-  REAL(rstd),POINTER,SAVE    :: diff_dhv(:)
-
-  TYPE(t_request),POINTER :: req(:) 
-  TYPE(t_request),POINTER :: req_u(:)   
-  PUBLIC :: allocate_caldyn,swap_caldyn,caldyn,write_caldyn,Compute_PV,Compute_enstrophy
-CONTAINS
-
-  SUBROUTINE allocate_caldyn
-  USE icosa
-  IMPLICIT NONE
-    INTEGER :: ind,i,j
-
-    CALL allocate_field(f_Fe,field_u,type_real)
-    CALL allocate_field(f_Ki,field_t,type_real)
-    CALL allocate_field(f_qv,field_z,type_real)
-    CALL allocate_field(f_qv2,field_z,type_real)
-    CALL allocate_field(f_t_tmp,field_t,type_real)
-    CALL allocate_field(f_u_tmp,field_u,type_real)
-    CALL allocate_field(f_z_tmp,field_z,type_real)
-    CALL allocate_field(f_dZ,field_z,type_real)
-    CALL allocate_field(f_diff_dhv,field_z,type_real)
-
-  CALL create_request(field_t,req)
-
-  DO ind=1,ndomain
-    DO i=ii_begin,ii_end+1
-      CALL request_add_point(ind,i,jj_begin-1,req)
-    ENDDO
-
-    DO j=jj_begin,jj_end
-      CALL request_add_point(ind,ii_end+1,j,req)
-    ENDDO    
-    DO i=ii_begin,ii_end
-      CALL request_add_point(ind,i,jj_end+1,req)
-    ENDDO    
-
-    DO j=jj_begin,jj_end+1
-      CALL request_add_point(ind,ii_begin-1,j,req)
-    ENDDO    
-    
-    DO i=ii_begin,ii_end
-      CALL request_add_point(ind,i,jj_begin,req)
-    ENDDO
-
-    DO j=jj_begin,jj_end
-      CALL request_add_point(ind,ii_end,j,req)
-    ENDDO    
-    
-    DO i=ii_begin,ii_end
-      CALL request_add_point(ind,i,jj_end,req)
-    ENDDO    
-
-    DO j=jj_begin,jj_end
-      CALL request_add_point(ind,ii_begin,j,req)
-    ENDDO    
-    
-  ENDDO
-
-  CALL create_request(field_u,req_u,.TRUE.)
-  DO ind=1,ndomain
-    DO i=ii_begin,ii_end
-      CALL request_add_point(ind,i,jj_begin-1,req_u,rup)
-      CALL request_add_point(ind,i+1,jj_begin-1,req_u,lup)
-    ENDDO
-
-    DO j=jj_begin,jj_end
-      CALL request_add_point(ind,ii_end+1,j,req_u,left)
-      CALL request_add_point(ind,ii_end+1,j-1,req_u,lup)
-    ENDDO    
-    
-    DO i=ii_begin,ii_end
-      CALL request_add_point(ind,i,jj_end+1,req_u,ldown)
-      CALL request_add_point(ind,i-1,jj_end+1,req_u,rdown)
-    ENDDO    
-
-    DO j=jj_begin,jj_end
-      CALL request_add_point(ind,ii_begin-1,j,req_u,right)
-      CALL request_add_point(ind,ii_begin-1,j+1,req_u,rdown)
-    ENDDO    
-  ENDDO
-    
-  END SUBROUTINE allocate_caldyn
-  
-  SUBROUTINE swap_caldyn(ind)
-  USE icosa
-  IMPLICIT NONE
-    INTEGER,INTENT(IN) :: ind
-    
-      Fe=f_Fe(ind)
-      Ki=f_Ki(ind)
-      qv=f_qv(ind)
-      qv2=f_qv2(ind)
-      t_tmp=f_t_tmp(ind)
-      u_tmp=f_u_tmp(ind)
-      z_tmp=f_z_tmp(ind)
-      dZ=f_dZ(ind)
-      diff_dhv=f_diff_dhv(ind)
-      
-  END SUBROUTINE swap_caldyn
-
-  
-  SUBROUTINE caldyn(f_h, f_u, f_dh, f_du)
-  USE icosa
-  IMPLICIT NONE
-  TYPE(t_field),POINTER :: f_h(:)
-  TYPE(t_field),POINTER :: f_u(:)
-  TYPE(t_field),POINTER :: f_dh(:)
-  TYPE(t_field),POINTER :: f_du(:)
-
-  REAL(rstd),POINTER :: h(:)
-  REAL(rstd),POINTER :: u(:)
-  REAL(rstd),POINTER :: dh(:)
-  REAL(rstd),POINTER :: du(:)
-  INTEGER :: ind
-  INTEGER,SAVE :: it=0
-  
-    CALL transfert_request(f_h,req_i1) 
-    CALL transfert_request(f_u,req_e1_vect)
-    CALL transfert_request(f_u,req_e1_vect) 
-   
-
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      CALL swap_caldyn(ind)
-      
-      h=f_h(ind)
-      u=f_u(ind)
-      dh=f_dh(ind)
-      du=f_du(ind)
-      
-      CALL compute_caldyn(h, u, dh, du)
-
-    ENDDO
-
-
-
-    IF (mod(it,240)==0) THEN
-      CALL writefield("h",f_h)
-      CALL writefield("dh",f_dh)
-      CALL Compute_enstrophy
-!      CALL Compute_PV
-    ENDIF
-    it=it+1      
-  END SUBROUTINE caldyn
-  
-  
-  SUBROUTINE compute_caldyn(hi,ue,dhi,due)
-  USE icosa
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: hi(iim*jjm)
-    REAL(rstd),INTENT(IN) :: ue(iim*3*jjm)
-    REAL(rstd),INTENT(OUT):: dhi(iim*jjm)
-    REAL(rstd),INTENT(OUT):: due(iim*3*jjm)
-
-    REAL(rstd)            :: Fep(iim*3*jjm)
-    
-    INTEGER :: i,j,n
-    REAL(rstd) :: etav,hv
-    
-    DO j=jj_begin-1,jj_end+1
-      DO i=ii_begin-1,ii_end+1
-        n=(j-1)*iim+i
-        
-        Fe(n+u_right)=0.5*(hi(n)+hi(n+t_right))*ue(n+u_right)
-        Fe(n+u_lup)=0.5*(hi(n)+hi(n+t_lup))*ue(n+u_lup)
-        Fe(n+u_ldown)=0.5*(hi(n)+hi(n+t_ldown))*ue(n+u_ldown)
-      
-       u_tmp(n+u_right)=ue(n+u_right)
-       u_tmp(n+u_lup)=ue(n+u_lup)
-       u_tmp(n+u_ldown)=ue(n+u_ldown)
-       
-      ENDDO
-    ENDDO
-    
-    
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        n=(j-1)*iim+i
-
-        dhi(n)=-1./Ai(n)*(ne(n,right)*Fe(n+u_right)*le(n+u_right)  +  &
-                          ne(n,rup)*Fe(n+u_rup)*le(n+u_rup)        +  &  
-                          ne(n,lup)*Fe(n+u_lup)*le(n+u_lup)        +  &  
-                          ne(n,left)*Fe(n+u_left)*le(n+u_left)     +  &  
-                          ne(n,ldown)*Fe(n+u_ldown)*le(n+u_ldown)  +  &  
-                          ne(n,rdown)*Fe(n+u_rdown)*le(n+u_rdown))    
-
-      ENDDO
-    ENDDO
-
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        n=(j-1)*iim+i
-
-        Ki(n)=1/(4*Ai(n))*(le(n+u_right)*de(n+u_right)*ue(n+u_right)**2 +  &
-                           le(n+u_rup)*de(n+u_rup)*ue(n+u_rup)**2 +        &
-                           le(n+u_lup)*de(n+u_lup)*ue(n+u_lup)**2 +        &
-                           le(n+u_left)*de(n+u_left)*ue(n+u_left)**2 +     &
-                           le(n+u_ldown)*de(n+u_ldown)*ue(n+u_ldown)**2 +  &
-                           le(n+u_rdown)*de(n+u_rdown)*ue(n+u_rdown)**2 )  
-       
-      ENDDO
-    ENDDO
-    
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        n=(j-1)*iim+i
-        
-        due(n+u_right)=1/de(n+u_right)*(ne(n,right)*(g*(hi(n)+bi(n))+Ki(n))+                            &
-                                        ne(n+t_right,left)*(g*(hi(n+t_right)+bi(n+t_right))+Ki(n+t_right)) )       
-        
-        due(n+u_lup)=1/de(n+u_lup)*(ne(n,lup)*(g*(hi(n)+bi(n))+Ki(n))+                                  &
-                                    ne(n+t_lup,rdown)*(g*(hi(n+t_lup)+bi(n+t_lup))+Ki(n+t_lup)) )       
-
-        due(n+u_ldown)=1/de(n+u_ldown)*(ne(n,ldown)*(g*(hi(n)+bi(n))+Ki(n))+                            &
-                                        ne(n+t_ldown,rup)*(g*(hi(n+t_ldown)+bi(n+t_ldown))+Ki(n+t_ldown)) )       
-      ENDDO
-    ENDDO
-
-    
-   
-    DO j=jj_begin-1,jj_end+1
-      DO i=ii_begin-1,ii_end+1
-        n=(j-1)*iim+i
-        
-          etav= 1./Av(n+z_up)*(  ne(n,rup)*ue(n+u_rup)*de(n+u_rup)                       &
-                               + ne(n+t_rup,left)*ue(n+t_rup+u_left)*de(n+t_rup+u_left)  &
-                               - ne(n,lup)*ue(n+u_lup)*de(n+u_lup) )                               
-
-          hv= Riv2(n,vup)*hi(n)+                  &
-              Riv2(n+t_rup,vldown)*hi(n+t_rup)+    &
-              Riv2(n+t_lup,vrdown)*hi(n+t_lup)
-     
-          qv(n+z_up)=(etav+fv(n+z_up))/hv
-          qv2(n+z_up)= (etav+fv(n+z_down))**2/hv
-          z_tmp(n+z_up)= Av(n+z_up)
-          
-          etav = 1./Av(n+z_down)*(  ne(n,ldown)*ue(n+u_ldown)*de(n+u_ldown)                          &
-                                  + ne(n+t_ldown,right)*ue(n+t_ldown+u_right)*de(n+t_ldown+u_right)  &
-                                  - ne(n,rdown)*ue(n+u_rdown)*de(n+u_rdown) )
-       
-          hv = Riv2(n,vdown)*hi(n)+                  &
-               Riv2(n+t_ldown,vrup)*hi(n+t_ldown)+   &
-               Riv2(n+t_rdown,vlup)*hi(n+t_rdown)
-                       
-          qv(n+z_down)=(etav+fv(n+z_down))/hv
-          qv2(n+z_down)= (etav+fv(n+z_down))**2/hv
-          
-          z_tmp(n+z_down)=Av(n+z_down)
-        ENDDO
-      ENDDO
-
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        n=(j-1)*iim+i
-
-        due(n+u_right) = due(n+u_right)+0.5*(qv(n+z_rdown)+qv(n+z_rup))/de(n+u_right) *     &  
-                       ( wee(n+u_right,1,1)*le(n+u_rup)*Fe(n+u_rup)+                        &
-                         wee(n+u_right,2,1)*le(n+u_lup)*Fe(n+u_lup)+                        &
-                         wee(n+u_right,3,1)*le(n+u_left)*Fe(n+u_left)+                      &
-                         wee(n+u_right,4,1)*le(n+u_ldown)*Fe(n+u_ldown)+                    &
-                         wee(n+u_right,5,1)*le(n+u_rdown)*Fe(n+u_rdown)+                    & 
-                         wee(n+u_right,1,2)*le(n+t_right+u_ldown)*Fe(n+t_right+u_ldown)+    &
-                         wee(n+u_right,2,2)*le(n+t_right+u_rdown)*Fe(n+t_right+u_rdown)+    &
-                         wee(n+u_right,3,2)*le(n+t_right+u_right)*Fe(n+t_right+u_right)+    &
-                         wee(n+u_right,4,2)*le(n+t_right+u_rup)*Fe(n+t_right+u_rup)+        &
-                         wee(n+u_right,5,2)*le(n+t_right+u_lup)*Fe(n+t_right+u_lup) )
- 
-
-        due(n+u_lup) = due(n+u_lup) + 0.5*(qv(n+z_up)+qv(n+z_lup))/de(n+u_lup) *            &  
-                       ( wee(n+u_lup,1,1)*le(n+u_left)*Fe(n+u_left)+                        &
-                         wee(n+u_lup,2,1)*le(n+u_ldown)*Fe(n+u_ldown)+                      &
-                         wee(n+u_lup,3,1)*le(n+u_rdown)*Fe(n+u_rdown)+                      &
-                         wee(n+u_lup,4,1)*le(n+u_right)*Fe(n+u_right)+                      &
-                         wee(n+u_lup,5,1)*le(n+u_rup)*Fe(n+u_rup)+                          & 
-                         wee(n+u_lup,1,2)*le(n+t_lup+u_right)*Fe(n+t_lup+u_right)+          &
-                         wee(n+u_lup,2,2)*le(n+t_lup+u_rup)*Fe(n+t_lup+u_rup)+              &
-                         wee(n+u_lup,3,2)*le(n+t_lup+u_lup)*Fe(n+t_lup+u_lup)+              &
-                         wee(n+u_lup,4,2)*le(n+t_lup+u_left)*Fe(n+t_lup+u_left)+            &
-                         wee(n+u_lup,5,2)*le(n+t_lup+u_ldown)*Fe(n+t_lup+u_ldown) )
-
-
-        due(n+u_ldown) = due(n+u_ldown)+ 0.5*(qv(n+z_ldown)+qv(n+z_down))/de(n+u_ldown) *   &  
-                       ( wee(n+u_ldown,1,1)*le(n+u_rdown)*Fe(n+u_rdown)+                    &
-                         wee(n+u_ldown,2,1)*le(n+u_right)*Fe(n+u_right)+                    &
-                         wee(n+u_ldown,3,1)*le(n+u_rup)*Fe(n+u_rup)+                        &
-                         wee(n+u_ldown,4,1)*le(n+u_lup)*Fe(n+u_lup)+                        &
-                         wee(n+u_ldown,5,1)*le(n+u_left)*Fe(n+u_left)+                      & 
-                         wee(n+u_ldown,1,2)*le(n+t_ldown+u_lup)*Fe(n+t_ldown+u_lup)+        &
-                         wee(n+u_ldown,2,2)*le(n+t_ldown+u_left)*Fe(n+t_ldown+u_left)+      &
-                         wee(n+u_ldown,3,2)*le(n+t_ldown+u_ldown)*Fe(n+t_ldown+u_ldown)+    &
-                         wee(n+u_ldown,4,2)*le(n+t_ldown+u_rdown)*Fe(n+t_ldown+u_rdown)+    &
-                         wee(n+u_ldown,5,2)*le(n+t_ldown+u_right)*Fe(n+t_ldown+u_right) )
-
-     
-      ENDDO
-    ENDDO
-    
-    DO j=jj_begin-1,jj_end+1
-      DO i=ii_begin-1,ii_end+1
-        n=(j-1)*iim+i
-        
-          dZ(n+z_up) = 2*qv(n+z_up)/Av(n+z_up)*(  ne(n,rup)*due(n+u_rup)*de(n+u_rup)                       &
-                                                + ne(n+t_rup,left)*due(n+t_rup+u_left)*de(n+t_rup+u_left)  &
-                                                - ne(n,lup)*due(n+u_lup)*de(n+u_lup) )
-          dZ(n+z_up)= dZ(n+z_up)-(Riv2(n,vup)*dhi(n)+                  &
-                                   Riv2(n+t_rup,vldown)*dhi(n+t_rup)+    &
-                                   Riv2(n+t_lup,vrdown)*dhi(n+t_lup))*qv(n+z_up)**2
-                                             
-          dZ(n+z_down) = 2*qv(n+z_down)/Av(n+z_down)*(  ne(n,ldown)*due(n+u_ldown)*de(n+u_ldown)                          &
-                                                      + ne(n+t_ldown,right)*due(n+t_ldown+u_right)*de(n+t_ldown+u_right)  &
-                                                      - ne(n,rdown)*due(n+u_rdown)*de(n+u_rdown) )
-          dZ(n+z_down)= dZ(n+z_down)- (Riv2(n,vdown)*dhi(n)+                  &
-                                      Riv2(n+t_ldown,vrup)*dhi(n+t_ldown)+   &
-                                      Riv2(n+t_rdown,vlup)*dhi(n+t_rdown))*qv(n+z_down)**2
-                                                      
-      ENDDO
-     ENDDO
-
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        n=(j-1)*iim+i
-
-        Fep(n+u_right) = 1./de(n+u_right) *     &  
-                       ( wee(n+u_right,1,1)*le(n+u_rup)*Fe(n+u_rup)+                        &
-                         wee(n+u_right,2,1)*le(n+u_lup)*Fe(n+u_lup)+                        &
-                         wee(n+u_right,3,1)*le(n+u_left)*Fe(n+u_left)+                      &
-                         wee(n+u_right,4,1)*le(n+u_ldown)*Fe(n+u_ldown)+                    &
-                         wee(n+u_right,5,1)*le(n+u_rdown)*Fe(n+u_rdown)+                    & 
-                         wee(n+u_right,1,2)*le(n+t_right+u_ldown)*Fe(n+t_right+u_ldown)+    &
-                         wee(n+u_right,2,2)*le(n+t_right+u_rdown)*Fe(n+t_right+u_rdown)+    &
-                         wee(n+u_right,3,2)*le(n+t_right+u_right)*Fe(n+t_right+u_right)+    &
-                         wee(n+u_right,4,2)*le(n+t_right+u_rup)*Fe(n+t_right+u_rup)+        &
-                         wee(n+u_right,5,2)*le(n+t_right+u_lup)*Fe(n+t_right+u_lup) )
- 
-
-        Fep(n+u_lup) = 1/de(n+u_lup) *            &  
-                       ( wee(n+u_lup,1,1)*le(n+u_left)*Fe(n+u_left)+                        &
-                         wee(n+u_lup,2,1)*le(n+u_ldown)*Fe(n+u_ldown)+                      &
-                         wee(n+u_lup,3,1)*le(n+u_rdown)*Fe(n+u_rdown)+                      &
-                         wee(n+u_lup,4,1)*le(n+u_right)*Fe(n+u_right)+                      &
-                         wee(n+u_lup,5,1)*le(n+u_rup)*Fe(n+u_rup)+                          & 
-                         wee(n+u_lup,1,2)*le(n+t_lup+u_right)*Fe(n+t_lup+u_right)+          &
-                         wee(n+u_lup,2,2)*le(n+t_lup+u_rup)*Fe(n+t_lup+u_rup)+              &
-                         wee(n+u_lup,3,2)*le(n+t_lup+u_lup)*Fe(n+t_lup+u_lup)+              &
-                         wee(n+u_lup,4,2)*le(n+t_lup+u_left)*Fe(n+t_lup+u_left)+            &
-                         wee(n+u_lup,5,2)*le(n+t_lup+u_ldown)*Fe(n+t_lup+u_ldown) )
-
-
-        Fep(n+u_ldown) = 1./de(n+u_ldown) *   &  
-                       ( wee(n+u_ldown,1,1)*le(n+u_rdown)*Fe(n+u_rdown)+                    &
-                         wee(n+u_ldown,2,1)*le(n+u_right)*Fe(n+u_right)+                    &
-                         wee(n+u_ldown,3,1)*le(n+u_rup)*Fe(n+u_rup)+                        &
-                         wee(n+u_ldown,4,1)*le(n+u_lup)*Fe(n+u_lup)+                        &
-                         wee(n+u_ldown,5,1)*le(n+u_left)*Fe(n+u_left)+                      & 
-                         wee(n+u_ldown,1,2)*le(n+t_ldown+u_lup)*Fe(n+t_ldown+u_lup)+        &
-                         wee(n+u_ldown,2,2)*le(n+t_ldown+u_left)*Fe(n+t_ldown+u_left)+      &
-                         wee(n+u_ldown,3,2)*le(n+t_ldown+u_ldown)*Fe(n+t_ldown+u_ldown)+    &
-                         wee(n+u_ldown,4,2)*le(n+t_ldown+u_rdown)*Fe(n+t_ldown+u_rdown)+    &
-                         wee(n+u_ldown,5,2)*le(n+t_ldown+u_right)*Fe(n+t_ldown+u_right) )
-
-     
-      ENDDO
-    ENDDO
-
-    DO j=jj_begin-1,jj_end+1
-      DO i=ii_begin-1,ii_end+1
-        n=(j-1)*iim+i
-          
-          diff_dhv(n+z_up)= 1./Av(n+z_up)*(  ne(n,rup)*Fep(n+u_rup)*de(n+u_rup)                       &
-                                           + ne(n+t_rup,left)*Fep(n+t_rup+u_left)*de(n+t_rup+u_left)  &
-                                           - ne(n,lup)*Fep(n+u_lup)*de(n+u_lup) )                               
-
-          diff_dhv(n+z_up)=diff_dhv(n+z_up)-(Riv2(n,vup)*dhi(n)+                   &
-                                             Riv2(n+t_rup,vldown)*dhi(n+t_rup)+    &
-                                             Riv2(n+t_lup,vrdown)*dhi(n+t_lup))
-          
-          
-          diff_dhv(n+z_down) = 1./Av(n+z_down)*(  ne(n,ldown)*Fep(n+u_ldown)*de(n+u_ldown)                          &
-                                                + ne(n+t_ldown,right)*Fep(n+t_ldown+u_right)*de(n+t_ldown+u_right)  &
-                                                - ne(n,rdown)*Fep(n+u_rdown)*de(n+u_rdown) )
-
-          diff_dhv(n+z_down) = diff_dhv(n+z_down) - (Riv2(n,vdown)*dhi(n)+                  &
-                                                     Riv2(n+t_ldown,vrup)*dhi(n+t_ldown)+   &
-                                                     Riv2(n+t_rdown,vlup)*dhi(n+t_rdown))
-       ENDDO
-    ENDDO    
-                                                                         
-  END SUBROUTINE compute_caldyn
-   
-  SUBROUTINE write_caldyn
-  USE icosa
-  IMPLICIT NONE
-    
-    INTEGER :: ind,i,j,n
-    
-    CALL transfert_request(f_u_tmp,req_u)
-
-    DO ind=1,ndomain
-      CALL swap_caldyn(ind)
-      CALL swap_geometry(ind)
-      CALL swap_dimensions(ind)
-      
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          n=(j-1)*iim+i
-
-          Ki(n)=1/(4*Ai(n))*(le(n+u_right)*de(n+u_right)*u_tmp(n+u_right)**2 +  &
-                             le(n+u_rup)*de(n+u_rup)*u_tmp(n+u_rup)**2 +        &
-                             le(n+u_lup)*de(n+u_lup)*u_tmp(n+u_lup)**2 +        &
-                             le(n+u_left)*de(n+u_left)*u_tmp(n+u_left)**2 +     &
-                             le(n+u_ldown)*de(n+u_ldown)*u_tmp(n+u_ldown)**2 +  &
-                             le(n+u_rdown)*de(n+u_rdown)*u_tmp(n+u_rdown)**2 )  
-       
-        ENDDO
-      ENDDO
-    ENDDO
-    
-    CALL writefield("Ki",f_Ki)
-
-  END SUBROUTINE write_caldyn
-     
-  SUBROUTINE Compute_PV
-  USE icosa
-  IMPLICIT NONE
-    REAL(rstd) :: PV
-    INTEGER :: i,j,n,ind
-    PV=0
-    DO ind=1,ndomain
-      CALL swap_caldyn(ind)
-      CALL swap_geometry(ind)
-      CALL swap_dimensions(ind)
- 
-      DO j=jj_begin+1,jj_end
-        DO i=ii_begin,ii_end-1
-          n=(j-1)*iim+i
-          qv(n+z_down)=qv(n+z_down)*Av(n+z_down)
-          PV=PV+qv(n+z_down)
-        ENDDO
-      ENDDO
-
-      DO j=jj_begin,jj_end-1
-        DO i=ii_begin+1,ii_end
-          n=(j-1)*iim+i
-          qv(n+z_up)=qv(n+z_up)*Av(n+z_up)
-          PV=PV+qv(n+z_up)
-        ENDDO
-      ENDDO
-    ENDDO
-    CALL writefield("PV",f_qv)
-    
-    PRINT *,"PV=",PV  
-  END SUBROUTINE Compute_PV   
-  
-  SUBROUTINE Compute_enstrophy
-  USE icosa
-  
-  IMPLICIT NONE
-    REAL(rstd) :: Es
-    INTEGER :: i,j,n,ind
-    Es=0
-    DO ind=1,ndomain
-      CALL swap_caldyn(ind)
-      CALL swap_geometry(ind)
-      CALL swap_dimensions(ind)
- 
-      DO j=jj_begin+1,jj_end
-        DO i=ii_begin,ii_end-1
-          n=(j-1)*iim+i
-          Es=Es+qv2(n+z_down)*Av(n+z_down)
-        ENDDO
-      ENDDO
-
-      DO j=jj_begin,jj_end-1
-        DO i=ii_begin+1,ii_end
-          n=(j-1)*iim+i
-          Es=Es+qv2(n+z_up)*Av(n+z_up)
-        ENDDO
-      ENDDO
-    ENDDO
-    
-    PRINT *,"Enstrophy=",Es  
-    CALL writefield("Ens",f_qv2)
-
-    Es=0
-    DO ind=1,ndomain
-      CALL swap_caldyn(ind)
-      CALL swap_geometry(ind)
-      CALL swap_dimensions(ind)
- 
-      DO j=jj_begin+1,jj_end
-        DO i=ii_begin,ii_end-1
-          n=(j-1)*iim+i
-          Es=Es+dZ(n+z_down)*Av(n+z_down)
-        ENDDO
-      ENDDO
-
-      DO j=jj_begin,jj_end-1
-        DO i=ii_begin+1,ii_end
-          n=(j-1)*iim+i
-          Es=Es+dZ(n+z_up)*Av(n+z_up)
-        ENDDO
-      ENDDO
-    ENDDO
-    
-    PRINT *,"D/dt Enstrophy=",Es 
-    CALL writefield("dEns",f_dZ)
-    CALL writefield("diff_dhv",f_diff_dhv)
-         
-  END SUBROUTINE Compute_enstrophy
-  
-END MODULE caldyn_sw_mod
Index: des/icosagcm/trunk/src/caldyn_wave.f90
===================================================================
--- /codes/icosagcm/trunk/src/caldyn_wave.f90	(revision 184)
+++ 	(revision )
@@ -1,132 +1,0 @@
-MODULE caldyn_wave_mod
-    
-  
-CONTAINS
-
-  SUBROUTINE allocate_caldyn
-  IMPLICIT NONE
-    
-  END SUBROUTINE allocate_caldyn
-
-  SUBROUTINE swap_caldyn(ind)
-  IMPLICIT NONE
-    INTEGER,INTENT(IN) :: ind
-    
-      
-  END SUBROUTINE swap_caldyn
-
-  SUBROUTINE init_wave(hi,ue)
-  USE icosa
-  IMPLICIT NONE
-    REAL(rstd),INTENT(OUT) :: hi(iim*jjm)
-    REAL(rstd),INTENT(OUT) :: ue(iim*3*jjm)
-    REAL(rstd) :: lon, lat,X0(3)
-    INTEGER :: i,j,n
-
-    lon=Pi/4
-    lat=Pi/2-Pi/8
-    CALL lonlat2xyz(lon,lat,X0)
-
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        n=(j-1)*iim+i
-        hi(n)=exp(-128.*sum((xyz_i(n,:)-X0(:))**2))
-
-        ue(n+u_right)=0
-        ue(n+u_lup)=0
-        ue(n+u_ldown)=0
-      ENDDO
-    ENDDO
-   
-  END SUBROUTINE init_wave
-
-
-  SUBROUTINE caldyn(f_h, f_u, f_dh, f_du)
-  USE icosa
-  IMPLICIT NONE
-  TYPE(t_field),POINTER :: f_h(:)
-  TYPE(t_field),POINTER :: f_u(:)
-  TYPE(t_field),POINTER :: f_dh(:)
-  TYPE(t_field),POINTER :: f_du(:)
-
-  REAL(rstd),POINTER :: h(:)
-  REAL(rstd),POINTER :: u(:)
-  REAL(rstd),POINTER :: dh(:)
-  REAL(rstd),POINTER :: du(:)
-  INTEGER :: ind
-  INTEGER,SAVE :: it=0
-  
-    CALL transfert_request(f_h,req_i1) 
-    CALL transfert_request(f_u,req_e1_vect)
-    CALL transfert_request(f_u,req_e1) 
-   
-
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      CALL swap_caldyn(ind)
-      
-      h=f_h(ind)
-      u=f_u(ind)
-      dh=f_dh(ind)
-      du=f_du(ind)
-      
-      CALL compute_caldyn(h, u, dh, du)
-
-    ENDDO
-
-    IF (mod(it,240)==0) THEN
-      CALL writefield("h",f_h)
-      CALL writefield("dh",f_dh)
-      CALL Compute_enstrophy
-    ENDIF
-    it=it+1      
-  END SUBROUTINE caldyn
-
-
-  SUBROUTINE compute_caldyn(hi,ue,dhi,due)
-  USE icosa
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: hi(iim*jjm)
-    REAL(rstd),INTENT(IN) :: ue(iim*3*jjm)
-    REAL(rstd),INTENT(OUT) :: dhi(iim*jjm)
-    REAL(rstd),INTENT(OUT) :: due(iim*3*jjm)
-    
-    INTEGER :: i,j,n
-    
-    
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-
-        n=(j-1)*iim+i
-
-        dhi(n)=-1./Ai(n)*(ne(n,right)*ue(n+u_right)*le(n+u_right)  +  &
-                          ne(n,rup)*ue(n+u_rup)*le(n+u_rup)        +  &  
-                          ne(n,lup)*ue(n+u_lup)*le(n+u_lup)        +  &  
-                          ne(n,left)*ue(n+u_left)*le(n+u_left)     +  &  
-                          ne(n,ldown)*ue(n+u_ldown)*le(n+u_ldown)  +  &  
-                          ne(n,rdown)*ue(n+u_rdown)*le(n+u_rdown))    
-      
-      ENDDO
-    ENDDO
-    
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        n=(j-1)*iim+i
-        
-        due(n+u_right)=1/de(n+u_right)*(ne(n,right)*hi(n)+ ne(n+t_right,left)*hi(n+t_right) )       
-    
-        due(n+u_lup)=1/de(n+u_lup)*(ne(n,lup)*hi(n)+ ne(n+t_lup,rdown)*hi(n+t_lup ))       
-    
-        due(n+u_ldown)=1/de(n+u_ldown)*(ne(n,ldown)*hi(n)+ne(n+t_ldown,rup)*hi(n+t_ldown) )
-
-
-               
-      ENDDO
-    ENDDO
-   
-                                                                     
-   END SUBROUTINE compute_caldyn
-   
-   
-END MODULE caldyn_wave_mod
Index: des/icosagcm/trunk/src/dissip_sw.f90
===================================================================
--- /codes/icosagcm/trunk/src/dissip_sw.f90	(revision 184)
+++ 	(revision )
@@ -1,434 +1,0 @@
-MODULE dissip_sw_mod
-  USE icosa
-  USE transfert_mpi_mod, ONLY : t_request
-  TYPE(t_field),POINTER,SAVE :: f_gradrot(:)
-  TYPE(t_request),POINTER :: req_dissip(:) 
-  TYPE(t_field),POINTER,SAVE :: f_due(:)
- 
-  INTEGER,PARAMETER :: nitergdiv=1
-  INTEGER,PARAMETER :: nitergrot=1
-
-  REAL :: tetagdiv
-  REAL :: tetagrot
-  
-  REAL :: cdivu
-  REAL :: crot
-  INTEGER :: idissip
-  REAL    :: dtdissip
-  
-CONTAINS
-
-  SUBROUTINE allocate_dissip
-  IMPLICIT NONE  
-    CALL allocate_field(f_gradrot,field_u,type_real)
-    CALL allocate_field(f_due,field_u,type_real)
-  END SUBROUTINE allocate_dissip
- 
-  SUBROUTINE init_dissip
-  USE icosa
-  
-  IMPLICIT NONE
-  
-  TYPE(t_field),POINTER :: f_u(:)
-  TYPE(t_field),POINTER :: f_du(:)
-  REAL(rstd),POINTER    :: u(:)
-  REAL(rstd),POINTER    :: du(:)
-  REAL(rstd)            :: dumax,dumaxmax,dumaxm1
-  REAL(rstd)            :: r
-  INTEGER :: i,j,n,ind,it
-  REAL :: sum1,sum2
-
-    tetagdiv=5000
-    CALL getin("tetagdiv",tetagdiv)
-    tetagrot=5000
-    CALL getin("tetagrot",tetagrot)
-    
-    CALL allocate_dissip
-  
-    CALL allocate_field(f_u,field_u,type_real)
-    CALL allocate_field(f_du,field_u,type_real)
-    CALL create_request(field_u,req_dissip,.TRUE.)
-
-    DO ind=1,ndomain
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_begin-1,req_dissip,rup)
-        CALL request_add_point(ind,i+1,jj_begin-1,req_dissip,lup)
-      ENDDO
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j,req_dissip,left)
-        CALL request_add_point(ind,ii_end+1,j-1,req_dissip,lup)
-      ENDDO    
-    
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_end+1,req_dissip,ldown)
-        CALL request_add_point(ind,i-1,jj_end+1,req_dissip,rdown)
-      ENDDO    
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin-1,j,req_dissip,right)
-        CALL request_add_point(ind,ii_begin-1,j+1,req_dissip,rdown)
-      ENDDO   
-
-      DO i=ii_begin+1,ii_end-1
-        CALL request_add_point(ind,i,jj_begin,req_dissip,right)
-        CALL request_add_point(ind,i,jj_end,req_dissip,right)
-      ENDDO
-    
-      DO j=jj_begin+1,jj_end-1
-        CALL request_add_point(ind,ii_begin,j,req_dissip,rup)
-        CALL request_add_point(ind,ii_end,j,req_dissip,rup)
-      ENDDO   
-
-      CALL request_add_point(ind,ii_begin+1,jj_begin,req_dissip,left)
-      CALL request_add_point(ind,ii_begin,jj_begin+1,req_dissip,ldown)
-      CALL request_add_point(ind,ii_begin+1,jj_end,req_dissip,left)
-      CALL request_add_point(ind,ii_end,jj_begin+1,req_dissip,ldown)
-     
-    ENDDO
-
-
-    cdivu=-1
-    crot=-1
-  
-    CALL RANDOM_SEED()
-    
-    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
-          n=(j-1)*iim+i
-          CALL RANDOM_NUMBER(r)
-          u(n+u_right)=r-0.5
-          CALL RANDOM_NUMBER(r)
-          u(n+u_lup)=r-0.5
-          CALL RANDOM_NUMBER(r)
-          u(n+u_ldown)=r-0.5
-       ENDDO
-      ENDDO
-        
-    ENDDO
-  
-
-    CALL transfert_request(f_u,req_dissip)
-    CALL transfert_request(f_u,req_dissip)
-
-    DO it=1,500
-
-      dumaxm1=dumax 
-      dumax=0
-      DO ind=1,ndomain
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        u=f_u(ind)
-        du=f_du(ind)
-        CALL gradiv(u,du)
-      ENDDO
-      CALL transfert_request(f_du,req_dissip)
-      CALL transfert_request(f_du,req_dissip)
-      
-      DO ind=1,ndomain
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        du=f_du(ind)
-        
-        DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-            n=(j-1)*iim+i
-            if (le(n+u_right)>1e-100) dumax=MAX(dumax,ABS(du(n+u_right)))
-            if (le(n+u_lup)>1e-100) dumax=MAX(dumax,ABS(du(n+u_lup)))
-            if (le(n+u_ldown)>1e-100) dumax=MAX(dumax,ABS(du(n+u_ldown)))
-          ENDDO
-        ENDDO
-      ENDDO
-      u=du/dumax
-      PRINT *,"gradiv : it :",it ,": dumax",(dumax+dumaxm1)/2
-
-    ENDDO 
-    PRINT *,"gradiv : dumax",(dumax+dumaxm1)/2
-    
-    cdivu=dumax**(-1./nitergdiv)
-    PRINT *,"cdivu : ",cdivu
-
-    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
-          n=(j-1)*iim+i
-          CALL RANDOM_NUMBER(r)
-          u(n+u_right)=r-0.5
-          CALL RANDOM_NUMBER(r)
-          u(n+u_lup)=r-0.5
-          CALL RANDOM_NUMBER(r)
-          u(n+u_ldown)=r-0.5
-       ENDDO
-      ENDDO
-        
-    ENDDO
-
-    CALL transfert_request(f_u,req_dissip)
-    CALL transfert_request(f_u,req_dissip)
-  
-    DO it=1,500
-
-      dumaxm1=dumax 
-      dumax=0
-      sum1=0 ; sum2=0
-      DO ind=1,ndomain
-        u=f_u(ind)
-        du=f_du(ind)
-        CALL gradrot(u,du,ind,sum1,sum2)
-      ENDDO
-
-      CALL transfert_request(f_du,req_dissip)
-      CALL transfert_request(f_du,req_dissip)
-      
-      DO ind=1,ndomain
-        CALL swap_dimensions(ind)
-        CALL swap_geometry(ind)
-        du=f_du(ind)
-        
-        DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-            n=(j-1)*iim+i
-            if (le(n+u_right)>1e-100) dumax=MAX(dumax,ABS(du(n+u_right)))
-            if (le(n+u_lup)>1e-100) dumax=MAX(dumax,ABS(du(n+u_lup)))
-            if (le(n+u_ldown)>1e-100) dumax=MAX(dumax,ABS(du(n+u_ldown)))
-          ENDDO
-        ENDDO
-      ENDDO
-      u=du/dumax
-      PRINT *,"gradrot : it :",it ,": dumax",(dumax+dumaxm1)/2
-
-    ENDDO 
-    PRINT *,"gradrot : dumax",(dumax+dumaxm1)/2
-  
-    crot=dumax**(-1/nitergrot) 
-    PRINT *,"crot : ",crot
-   
-    idissip=INT(MIN(tetagdiv,tetagrot)/(2.*dt))
-    idissip=MAX(1,idissip)
-    dtdissip=idissip*dt
-    PRINT *,"idissip",idissip," dtdissip ",dtdissip
-
-  END SUBROUTINE init_dissip 
- 
-  
-  SUBROUTINE dissip(f_ue,f_due)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: f_ue(:)
-    TYPE(t_field),POINTER :: f_due(:)
-    REAL(rstd),POINTER         :: ue(:)
-    REAL(rstd),POINTER         :: due(:)
-    REAL(rstd),POINTER         :: gradrot_e(:)
-    REAL(rstd)                 :: du(3*iim*jjm)
-    INTEGER :: ind
-    REAL :: v
-    REAL :: sum1,sum2
-    
-    CALL transfert_request(f_ue,req_dissip)
-    CALL transfert_request(f_ue,req_dissip)
-    sum1=0 ; sum2=0
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      ue=f_ue(ind)
-      due=f_due(ind) 
-      gradrot_e=f_gradrot(ind)
-      CALL gradiv(ue,du)
-      due=due+du/tetagdiv*0.5
-      CALL gradrot(ue,gradrot_e,ind,sum1,sum2)
-      due=due+gradrot_e/tetagrot*0.5 
-    ENDDO
-!    PRINT *,"SUM1 == SUM2 ??  ", sum1,sum2
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      ue=f_ue(ind)
-      due=f_due(ind) 
-      
-!      ue(:)=ue(:)+0.5*due(:)
-    ENDDO
-      
-  END SUBROUTINE dissip
-  
-  SUBROUTINE gradiv(ue,gradivu_e)
-  USE icosa
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN)  :: ue(iim*3*jjm)
-    REAL(rstd),INTENT(OUT) :: gradivu_e(iim*3*jjm)
-    REAL(rstd)             :: divu_i(iim*jjm)
-
-    INTEGER :: i,j,n
-    
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        n=(j-1)*iim+i
-        divu_i(n)=1./Ai(n)*(ne(n,right)*ue(n+u_right)*le(n+u_right)  +  &
-                             ne(n,rup)*ue(n+u_rup)*le(n+u_rup)        +  &  
-                             ne(n,lup)*ue(n+u_lup)*le(n+u_lup)        +  &  
-                             ne(n,left)*ue(n+u_left)*le(n+u_left)     +  &  
-                             ne(n,ldown)*ue(n+u_ldown)*le(n+u_ldown)  +  &  
-                             ne(n,rdown)*ue(n+u_rdown)*le(n+u_rdown))
-      ENDDO
-    ENDDO
-   
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
- 
-        n=(j-1)*iim+i
- 
-        gradivu_e(n+u_right)=-1/de(n+u_right)*(ne(n,right)*divu_i(n)+ ne(n+t_right,left)*divu_i(n+t_right) )       
-
-        gradivu_e(n+u_lup)=-1/de(n+u_lup)*(ne(n,lup)*divu_i(n)+ ne(n+t_lup,rdown)*divu_i(n+t_lup ))       
-    
-        gradivu_e(n+u_ldown)=-1/de(n+u_ldown)*(ne(n,ldown)*divu_i(n)+ne(n+t_ldown,rup)*divu_i(n+t_ldown) )
-
-      ENDDO
-    ENDDO
-
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        n=(j-1)*iim+i
-        gradivu_e(n+u_right)=gradivu_e(n+u_right)*cdivu
-        gradivu_e(n+u_lup)=gradivu_e(n+u_lup)*cdivu
-        gradivu_e(n+u_ldown)=gradivu_e(n+u_ldown)*cdivu
-      ENDDO
-    ENDDO
-
-
-    
-  END SUBROUTINE gradiv
-  
-  
-  SUBROUTINE gradrot(ue,gradrot_e,ind,sum1,sum2)
-  USE icosa
-  IMPLICIT NONE
-    REAL(rstd),INTENT(IN)  :: ue(iim*3*jjm)
-    REAL(rstd),INTENT(OUT) :: gradrot_e(iim*3*jjm)
-    INTEGER,INTENT(IN) :: ind
-    REAL,INTENT(INOUT) ::sum1,sum2
-    REAL :: S
-    REAL(rstd)             :: rot_v(2*iim*jjm)
-
-    INTEGER :: i,j,n
- 
-    DO j=jj_begin-1,jj_end+1
-      DO i=ii_begin-1,ii_end+1
-        n=(j-1)*iim+i
-        
-        rot_v(n+z_up)= 1./Av(n+z_up)*(  ne(n,rup)*ue(n+u_rup)*de(n+u_rup)                       &
-                              + ne(n+t_rup,left)*ue(n+t_rup+u_left)*de(n+t_rup+u_left)          &
-                              - ne(n,lup)*ue(n+u_lup)*de(n+u_lup) ) 
-                              
-        rot_v(n+z_down) = 1./Av(n+z_down)*(   ne(n,ldown)*ue(n+u_ldown)*de(n+u_ldown)                &
-                                  + ne(n+t_ldown,right)*ue(n+t_ldown+u_right)*de(n+t_ldown+u_right)  &
-                                  - ne(n,rdown)*ue(n+u_rdown)*de(n+u_rdown) )
-
-      ENDDO
-    ENDDO                              
-  
-    
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        n=(j-1)*iim+i
-  
-        gradrot_e(n+u_right)=1/le(n+u_right)*ne(n,right)*(rot_v(n+z_rdown)-rot_v(n+z_rup)) 
-        
-        gradrot_e(n+u_lup)=1/le(n+u_lup)*ne(n,lup)*(rot_v(n+z_up)-rot_v(n+z_lup)) 
-        
-        gradrot_e(n+u_ldown)=1/le(n+u_ldown)*ne(n,ldown)*(rot_v(n+z_ldown)-rot_v(n+z_down))
-        
-      ENDDO
-    ENDDO
-
-    S=0
-    DO j=jj_begin,jj_end-1
-      DO i=ii_begin,ii_end-1
-        n=(j-1)*iim+i
-        S=S+rot_v(n+z_rup)**2*Av(n+z_rup)
-      ENDDO
-    ENDDO
-    
-    DO j=jj_begin+1,jj_end
-      DO i=ii_begin,ii_end-1
-        n=(j-1)*iim+i
-        S=S+rot_v(n+z_rdown)**2*Av(n+z_rdown)
-      ENDDO
-    ENDDO
-    
-    sum1=sum1+S
-    
-    DO j=jj_begin+1,jj_end-1
-      DO i=ii_begin,ii_end-1
-        n=(j-1)*iim+i
-        sum2=sum2+gradrot_e(n+u_right)*le(n+u_right)*de(n+u_right)*ue(n+u_right)
-      ENDDO
-    ENDDO
-    
-    DO j=jj_begin,jj_end-1
-      DO i=ii_begin+1,ii_end-1
-        n=(j-1)*iim+i
-        sum2=sum2+gradrot_e(n+u_rup)*le(n+u_rup)*de(n+u_rup)*ue(n+u_rup)
-      ENDDO
-    ENDDO
-
-    DO j=jj_begin,jj_end-1
-      DO i=ii_begin+1,ii_end
-        n=(j-1)*iim+i
-        sum2=sum2+gradrot_e(n+u_lup)*le(n+u_lup)*de(n+u_lup)*ue(n+u_lup)
-      ENDDO
-    ENDDO
-
-! frontière
-      j=jj_begin
-      DO i=ii_begin,ii_end-1
-        n=(j-1)*iim+i
-        if (domain(ind)%own(i,j)) sum2=sum2+gradrot_e(n+u_right)*le(n+u_right)*de(n+u_right)*ue(n+u_right)
-      ENDDO
-     
-      j=jj_end
-      DO i=ii_begin,ii_end-1
-        n=(j-1)*iim+i
-        if (domain(ind)%own(i,j)) sum2=sum2+gradrot_e(n+u_right)*le(n+u_right)*de(n+u_right)*ue(n+u_right)
-      ENDDO
-      
-     i=ii_begin
-     DO j=jj_begin,jj_end-1
-        n=(j-1)*iim+i
-        if (domain(ind)%own(i,j))sum2=sum2+gradrot_e(n+u_rup)*le(n+u_rup)*de(n+u_rup)*ue(n+u_rup)
-     ENDDO
-
-     i=ii_end
-     DO j=jj_begin,jj_end-1
-        n=(j-1)*iim+i
-        if (domain(ind)%own(i,j))sum2=sum2+gradrot_e(n+u_rup)*le(n+u_rup)*de(n+u_rup)*ue(n+u_rup)
-     ENDDO
-
-      
-      
-      
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        n=(j-1)*iim+i
-  
-        gradrot_e(n+u_right)=gradrot_e(n+u_right)*crot        
-        gradrot_e(n+u_lup)=gradrot_e(n+u_lup)*crot
-        gradrot_e(n+u_ldown)=gradrot_e(n+u_ldown)*crot
-        
-      ENDDO
-    ENDDO  
-    
-    
-  END SUBROUTINE 
-
-
-END MODULE dissip_sw_mod
-       
Index: des/icosagcm/trunk/src/face.f90
===================================================================
--- /codes/icosagcm/trunk/src/face.f90	(revision 184)
+++ 	(revision )
@@ -1,10 +1,0 @@
-MODULE face_mod
-USE genmod
-
-
-CONTAINS
-
-
-
-
-END MODULE face_mod
Index: des/icosagcm/trunk/src/icosa_sw.f90
===================================================================
--- /codes/icosagcm/trunk/src/icosa_sw.f90	(revision 184)
+++ 	(revision )
@@ -1,49 +1,0 @@
-PROGRAM ICOSA_SW
-  USE icosa
-  USE timeloop_sw_mod
-  USE dissip_sw_mod
-  USE disvert_mod
-  IMPLICIT NONE
-  
-
-  TYPE(t_field),POINTER :: sum_ne(:)
-  REAL(rstd),POINTER :: pt_sum_ne(:)
-  
-  INTEGER :: ind,i,j,k,n
-  REAL(rstd) :: tot_sum=0
- 
-  CALL compute_metric
-  CALL compute_domain
-  CALL compute_geometry
-  CALL init_transfert
-  
-  CALL allocate_field(sum_ne,field_T,type_real)
-  
-
-  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
-
-  PRINT *," Diff surf",1-tot_sum/(4*Pi*radius*radius)
-
-  
-!  CALL WriteField("Ai",geom%Ai)
-!  CALL WriteField("sum_ne",sum_ne)
- CALL timeloop
-  
-END PROGRAM ICOSA_SW 
Index: des/icosagcm/trunk/src/timeloop_sw.f90
===================================================================
--- /codes/icosagcm/trunk/src/timeloop_sw.f90	(revision 184)
+++ 	(revision )
@@ -1,190 +1,0 @@
-MODULE timeloop_sw_mod
-  USE icosa
-  USE etat0_williamson_mod
-  
-  INTEGER,PARAMETER :: euler=1, leapfrog=2, leapfrog_matsuno=3, adam_bashforth=4
-  
-CONTAINS
-  
-  SUBROUTINE timeloop
-  USE icosa
-  USE caldyn_sw_mod
-  USE dissip_sw_mod
-  USE etat0_mod
-  IMPLICIT NONE
-  TYPE(t_field),POINTER :: f_h(:),f_hm1(:), f_hm2(:)
-  TYPE(t_field),POINTER :: f_u(:),f_um1(:),f_um2(:)
-  TYPE(t_field),POINTER :: f_dh(:),f_dhm1(:), f_dhm2(:)
-  TYPE(t_field),POINTER :: f_du(:),f_dum1(:),f_dum2(:)
-
-  REAL(rstd),POINTER :: h(:) ,hm1(:), hm2(:)
-  REAL(rstd),POINTER :: u(:) , um1(:), um2(:)
-  REAL(rstd),POINTER :: dh(:), dhm1(:), dhm2(:)
-  REAL(rstd),POINTER :: du(:), dum1(:), dum2(:)
-  INTEGER :: ind
-  INTEGER :: it,i,j,n
-  INTEGER :: scheme
-  INTEGER :: matsuno_period
-  
-
-  
-  scheme=leapfrog_matsuno
-  CALL getin('scheme',scheme)
-  
-  matsuno_period=5
-  CALL getin('matsuno_period',matsuno_period)
-  IF (scheme==leapfrog) matsuno_period=itaumax+1
- 
- 
-  CALL allocate_field(f_h,field_t,type_real)
-  CALL allocate_field(f_hm1,field_t,type_real)
-  CALL allocate_field(f_hm2,field_t,type_real)
-  CALL allocate_field(f_dh,field_t,type_real)
-  CALL allocate_field(f_dhm1,field_t,type_real)
-  CALL allocate_field(f_dhm2,field_t,type_real)
-
-  CALL allocate_field(f_u,field_u,type_real)
-  CALL allocate_field(f_um1,field_u,type_real)
-  CALL allocate_field(f_um2,field_u,type_real)
-  CALL allocate_field(f_du,field_u,type_real)
-  CALL allocate_field(f_dum1,field_u,type_real)
-  CALL allocate_field(f_dum2,field_u,type_real)
-
-
-  CALL allocate_caldyn
-  CALL init_dissip
-
-  CALL etat0_williamson(f_h,f_u)
-  
-  DO it=0,itaumax
-    PRINT *,"SW: It No :",It
-
-    CALL caldyn(f_h, f_u, f_dh, f_du)
-    
-
-    IF (scheme==Euler) THEN
-      CALL  euler_scheme
-    ELSE IF (scheme==leapfrog) THEN
-      CALL leapfrog_scheme
-    ELSE IF (scheme==leapfrog_matsuno) THEN
-      CALL  leapfrog_matsuno_scheme
-    ELSE IF (scheme==adam_bashforth) THEN
-      CALL dissip(f_u,f_du)   
-      CALL adam_bashforth_scheme
-    ENDIF
-
-  ENDDO
-  
-  CONTAINS
-
-    SUBROUTINE Euler_scheme
-    IMPLICIT NONE
-      INTEGER :: ind
-      
-      DO ind=1,ndomain
-        h=f_h(ind) ; u=f_u(ind) ; 
-        dh=f_dh(ind) ; du=f_du(ind) ;
-        h(:)=h(:)+dt*dh(:)
-        u(:)=u(:)+dt*du(:)
-      ENDDO
-      
-    END SUBROUTINE Euler_scheme
-    
-    SUBROUTINE leapfrog_scheme
-    IMPLICIT NONE
-      INTEGER :: ind
-
-      DO ind=1,ndomain
-        h=f_h(ind)   ; u=f_u(ind)   ; 
-        hm1=f_hm1(ind) ; um1=f_um1(ind) ; 
-        hm2=f_hm2(ind) ; um2=f_um2(ind) ; 
-        dh=f_dh(ind) ; du=f_du(ind) ;
-
-        IF (it==0) THEN
-          hm2(:)=h(:) ; um2(:)=u(:) 
-
-          h(:)=h(:)+dt*dh(:)
-          u(:)=u(:)+dt*du(:)
-          hm1(:)=h(:) ;  um1(:)=u(:) 
-
-        ELSE
-        
-          h(:)=hm2(:)+2*dt*dh(:)
-          u(:)=um2(:)+2*dt*du(:)
-
-          hm2(:)=hm1(:) ; um2(:)=um1(:) 
-          hm1(:)=h(:) ; um1(:)=u(:) 
-        ENDIF
-          
-      ENDDO
-    END SUBROUTINE leapfrog_scheme  
- 
-    SUBROUTINE leapfrog_matsuno_scheme
-    IMPLICIT NONE
-      INTEGER :: ind
-
-      DO ind=1,ndomain
-        h=f_h(ind)   ; u=f_u(ind)  
-        hm1=f_hm1(ind) ; um1=f_um1(ind)  
-        hm2=f_hm2(ind) ; um2=f_um2(ind) 
-        dh=f_dh(ind) ; du=f_du(ind) ; 
-
-        
-        IF (MOD(it,matsuno_period+1)==0) THEN
-          hm1(:)=h(:) ; um1(:)=u(:) 
-          h(:)=hm1(:)+dt*dh(:)
-          u(:)=um1(:)+dt*du(:)
-
-        ELSE IF (MOD(it,matsuno_period+1)==1) THEN
-
-          h(:)=hm1(:)+dt*dh(:)
-          u(:)=um1(:)+dt*du(:)
-
-          hm2(:)=hm1(:) ;  um2(:)=um1(:) 
-          hm1(:)=h(:) ;  um1(:)=u(:) 
-
-        ELSE 
-
-          h(:)=hm2(:)+2*dt*dh(:)
-          u(:)=um2(:)+2*dt*du(:)
-
-          hm2(:)=hm1(:) ; um2(:)=um1(:) 
-          hm1(:)=h(:) ;  um1(:)=u(:) 
-
-        ENDIF
-      
-      ENDDO
-      
-    END SUBROUTINE leapfrog_matsuno_scheme  
-         
-    SUBROUTINE adam_bashforth_scheme
-    IMPLICIT NONE
-      INTEGER :: ind
-
-      DO ind=1,ndomain
-        h=f_h(ind)   ; u=f_u(ind)   
-        dh=f_dh(ind) ; du=f_du(ind) 
-        dhm1=f_dhm1(ind) ; dum1=f_dum1(ind) 
-        dhm2=f_dhm2(ind) ; dum2=f_dum2(ind) 
-
-        IF (it==0) THEN
-          dhm1(:)=dh(:) ; dum1(:)=du(:) 
-          dhm2(:)=dhm1(:) ; dum2(:)=dum1(:)
-        ENDIF
-              
-        h(:)=h(:)+dt*(23*dh(:)-16*dhm1(:)+5*dhm2(:))/12
-        u(:)=u(:)+dt*(23*du(:)-16*dum1(:)+5*dum2(:))/12
-
-        dhm2(:)=dhm1(:) ; dum2(:)=dum1(:) 
-        dhm1(:)=dh(:) ; dum1(:)=du(:) 
-
-      ENDDO
-     
-      
-    END SUBROUTINE adam_bashforth_scheme
-
-  END SUBROUTINE timeloop
-    
-    
-  
-END MODULE timeloop_sw_mod
