Index: codes/icosagcm/trunk/src/xios_mod.F90
===================================================================
--- codes/icosagcm/trunk/src/xios_mod.F90	(revision 482)
+++ codes/icosagcm/trunk/src/xios_mod.F90	(revision 483)
@@ -12,6 +12,8 @@
   INTEGER,SAVE :: ncell_v
 !$OMP THREADPRIVATE(ncell_v)
-
-  PRIVATE ncell_i,ncell_v
+  INTEGER,SAVE :: ncell_e
+!$OMP THREADPRIVATE(ncell_e)
+
+  PRIVATE ncell_i,ncell_v,ncell_e
 
 #ifdef CPP_USING_XIOS
@@ -44,5 +46,5 @@
  USE mpi_mod
  USE time_mod
- USE metric, ONLY : vup,vdown
+ USE metric, ONLY : vup,vdown, cell_glo
  IMPLICIT NONE
   TYPE(xios_context) :: ctx_hdl
@@ -51,6 +53,7 @@
   REAL(rstd) :: lev_valuep1(llm+1)
   INTEGER :: ncell, ncell_tot, ncell_glo(0:mpi_size-1), displ
-  INTEGER :: ind, i,j,k,l
+  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
 
@@ -64,4 +67,5 @@
    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) ;
    
    ncell=0
@@ -86,5 +90,5 @@
    ncell_tot=sum(ncell_glo(:))
    
-   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:5,ncell), bounds_lat(0:5,ncell)) 
+   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:5,ncell), bounds_lat(0:5,ncell), ind_glo(ncell)) 
    
    ncell=0
@@ -104,4 +108,5 @@
              bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
            ENDDO
+           ind_glo(ncell)=domain(ind)%assign_cell_glo(i,j)-1 
          ENDIF
        ENDDO
@@ -109,11 +114,73 @@
    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)
+   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) 
+   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
@@ -219,15 +286,28 @@
    IF (Field(1)%field_type==field_T) THEN
      IF (field(1)%ndim==2) THEN
-        CALL xios_write_field_scalar(name,field,1)
+        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_scalar(name,field,size(field(1)%rval3d,2))
+        CALL xios_write_field_U(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)
-        ENDDO
+        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
@@ -262,12 +342,23 @@
    IF (Field(1)%field_type==field_T) THEN
      IF (field(1)%ndim==2) THEN
-        CALL xios_read_field_scalar(name,field,1)
+        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))
+        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
+!        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"
@@ -294,5 +385,5 @@
 
  
- SUBROUTINE xios_write_field_scalar(name,field,nlev,iq)
+ SUBROUTINE xios_write_field_scalar(name,field,nlev,nq)
  USE genmod
  USE mpipara
@@ -308,7 +399,7 @@
    TYPE(t_field), POINTER :: field(:)
    INTEGER,INTENT(IN) :: nlev
-   INTEGER,INTENT(IN),OPTIONAL :: iq
-   
-   REAL(rstd) :: field_tmp(ncell_i,nlev)
+   INTEGER,INTENT(IN) :: nq
+   
+   REAL(rstd) :: field_tmp(ncell_i,nlev,nq)
    TYPE(t_domain),POINTER :: d
    INTEGER :: n,i,j,ij,ind
@@ -325,5 +416,5 @@
              n=n+1
              ij=d%iim*(j-1)+i
-             field_tmp(n,1)=field(ind)%rval2d(ij)
+             field_tmp(n,1,1)=field(ind)%rval2d(ij)
            ENDIF
          ENDDO
@@ -340,5 +431,5 @@
              n=n+1
              ij=d%iim*(j-1)+i
-             field_tmp(n,:)=field(ind)%rval3d(ij,:)
+             field_tmp(n,:,1)=field(ind)%rval3d(ij,:)
            ENDIF
          ENDDO
@@ -355,5 +446,5 @@
              n=n+1
              ij=d%iim*(j-1)+i
-             field_tmp(n,:)=field(ind)%rval4d(ij,:,iq)
+             field_tmp(n,:,:)=field(ind)%rval4d(ij,:,:)
            ENDIF
          ENDDO
@@ -367,5 +458,5 @@
 
 
- SUBROUTINE xios_read_field_scalar(name,field,nlev,iq)
+ SUBROUTINE xios_read_field_scalar(name,field,nlev,nq)
  USE genmod
  USE mpipara
@@ -381,7 +472,7 @@
    TYPE(t_field), POINTER :: field(:)
    INTEGER,INTENT(IN) :: nlev
-   INTEGER,INTENT(IN),OPTIONAL :: iq
-   
-   REAL(rstd) :: field_tmp(ncell_i,nlev)
+   INTEGER,INTENT(IN) :: nq
+   
+   REAL(rstd) :: field_tmp(ncell_i,nlev,nq)
    TYPE(t_domain),POINTER :: d
    INTEGER :: n,i,j,ij,ind
@@ -400,5 +491,5 @@
              n=n+1
              ij=d%iim*(j-1)+i
-             field(ind)%rval2d(ij)=field_tmp(n,1)
+             field(ind)%rval2d(ij)=field_tmp(n,1,1)
            ENDIF
          ENDDO
@@ -415,5 +506,5 @@
              n=n+1
              ij=d%iim*(j-1)+i
-             field(ind)%rval3d(ij,:)=field_tmp(n,:)
+             field(ind)%rval3d(ij,:)=field_tmp(n,:,1)
            ENDIF
          ENDDO
@@ -430,5 +521,5 @@
              n=n+1
              ij=d%iim*(j-1)+i
-             field(ind)%rval4d(ij,:,iq)=field_tmp(n,:)
+             field(ind)%rval4d(ij,:,:)=field_tmp(n,:,:)
            ENDIF
          ENDDO
@@ -438,4 +529,189 @@
  
  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 
+
 
 
@@ -673,4 +949,5 @@
 END INTERFACE  xios_send_field
 
+INTEGER,PARAMETER :: xios_timestep=1
 
 CONTAINS  
@@ -724,7 +1001,8 @@
   END SUBROUTINE xios_set_context
   
-  SUBROUTINE xios_set_fieldgroup_attr(name,enabled)
+  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
 
@@ -733,4 +1011,11 @@
     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)
@@ -740,4 +1025,10 @@
   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  
 
