MODULE xios_mod

#ifdef CPP_USING_XIOS
   USE xios
#endif

   USE prec, ONLY: rstd
   USE field_mod, ONLY: t_field, field_T, field_U, field_Z
   USE cellset_mod, ONLY: t_cellset
   USE domain_mod, ONLY: t_domain, domain, ndomain, mesh_loc
   USE grid_param, ONLY: grid_type, grid_unst, grid_ico
   IMPLICIT NONE
   PRIVATE
   SAVE
   LOGICAL, SAVE :: using_xios

   INTEGER :: ncell_i, ncell_v, ncell_e
!!$OMP THREADPRIVATE(ncell_i, ncell_v, ncell_e)

   PUBLIC :: &
      xios_fieldgroup, xios_field, xios_timestep, &
      xios_set_attr, xios_set_file_attr, xios_set_fieldgroup_attr, &
      xios_set_filegroup_attr, xios_set_axis_attr, xios_get_axis_attr, &
      xios_update_calendar, xios_set_context, xios_set_context_input, &
      using_xios, xios_init, &
      xios_send_field, xios_set_field_attr, xios_read_var, &
      xios_is_active_field, xios_is_valid_field, &
      xios_get_handle, xios_add_child, &
      xios_init_write_field, xios_init_write_field_input, &
      xios_write_field_finalize, &
      xios_write_field, xios_read_field, &
      xios_set_domain_attr, xios_get_domain_attr

#ifdef CPP_USING_XIOS

   PUBLIC :: OPERATOR(+), OPERATOR(-), OPERATOR(*)

CONTAINS

   SUBROUTINE xios_init
      USE mpipara, ONLY: comm_icosa
      TYPE(xios_context) :: ctx_hdl

      using_xios = .TRUE.
      CALL xios_context_initialize("icosagcm", comm_icosa)
      CALL xios_context_initialize("icosagcm_input", comm_icosa)
      CALL xios_set_context

   END SUBROUTINE xios_init

   SUBROUTINE xios_init_write_field
      USE disvert_mod, ONLY: presnivs
      USE time_mod, ONLY: dt, itau_out
      USE grid_param, ONLY: llm, nqtot, max_primal_deg, max_dual_deg
      USE domain_mod
      USE dimensions
      USE spherical_geom_mod
      USE geometry
      USE mpi_mod
      USE time_mod
      USE metric, ONLY: vup, vdown, cell_glo, ncell_glo_tot => ncell_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 :: l

      CALL xios_set_context
!$OMP BARRIER
!$OMP MASTER
      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); 
      CALL xios_set_axis_attr("presnivs_mb", n_glo=llm, value=presnivs/100., unit="mb"); 
      CALL set_xios_boundaries("i", max_primal_deg, .TRUE., mesh_loc%primal_own, ncell_i)
      CALL set_xios_boundaries("v", max_dual_deg, .FALSE., mesh_loc%dual_own, ncell_v)
      CALL set_xios_boundaries("u", 2, .FALSE., mesh_loc%edge_own, ncell_e)

      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 set_xios_boundaries(name, max_deg, group, cells, ncell)
      USE mpi_mod, ONLY: MPI_INTEGER
      USE mpipara, ONLY: comm_icosa, mpi_size, mpi_rank
      CHARACTER(*), INTENT(IN)  :: name
      INTEGER, INTENT(IN)  :: max_deg
      LOGICAL, INTENT(IN)  :: group
      TYPE(t_cellset), INTENT(IN)  :: cells(:)
      INTEGER, INTENT(OUT) :: ncell
      ! Note : The F2003 compiler takes care of deallocating ALLOCATABLE local arrays
      REAL(rstd), ALLOCATABLE :: lon(:), lat(:), bounds_lon(:, :), bounds_lat(:, :)
      INTEGER, ALLOCATABLE :: ind_glo(:)
      INTEGER :: ncell_glo(0:mpi_size - 1)
      INTEGER :: i, ind, n_beg, n_end, ierr, l, ncell_tot, displ
      LOGICAL :: has_ind_glo
      ncell = SUM(cells%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)
      END DO
      ncell_tot = sum(ncell_glo(:))

      IF (ALLOCATED(cells(1)%ind_glo)) THEN
         has_ind_glo = .TRUE.
         ALLOCATE (ind_glo(ncell))
      ELSE
         has_ind_glo = .FALSE.
      END IF
      ALLOCATE (lon(ncell), lat(ncell))
      ALLOCATE (bounds_lon(max_deg, ncell), bounds_lat(max_deg, ncell))

      n_beg = 0
      DO ind = 1, ndomain
         n_end = n_beg + cells(ind)%ncell
         IF (has_ind_glo) ind_glo(n_beg + 1:n_end) = cells(ind)%ind_glo(:)
         lon(n_beg + 1:n_end) = cells(ind)%lon(:)
         lat(n_beg + 1:n_end) = cells(ind)%lat(:)
         bounds_lon(:, n_beg + 1:n_end) = cells(ind)%bnds_lon(:, :)
         bounds_lat(:, n_beg + 1:n_end) = cells(ind)%bnds_lat(:, :)
         n_beg = n_end
      END DO

      IF (group) THEN
         CALL xios_set_domaingroup_attr(name, ni_glo=ncell_tot, ibegin=displ, ni=ncell)
         CALL xios_set_domaingroup_attr(name, data_dim=1, type='unstructured', nvertex=max_deg)
         IF (has_ind_glo) CALL xios_set_domaingroup_attr(name, i_index=ind_glo)
         CALL xios_set_domaingroup_attr(name, lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
      ELSE
         CALL xios_set_domain_attr(name, ni_glo=ncell_tot, ibegin=displ, ni=ncell)
         IF (has_ind_glo) CALL xios_set_domain_attr(name, i_index=ind_glo)
         CALL xios_set_domain_attr(name, data_dim=1, type='unstructured', nvertex=max_deg)
         CALL xios_set_domain_attr(name, lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
      END IF

   END SUBROUTINE set_xios_boundaries

   SUBROUTINE xios_init_write_field_input
      USE disvert_mod, ONLY: presnivs
      USE time_mod, ONLY: dt, itau_out
      USE grid_param, ONLY: llm, nqtot
      USE mpi_mod, ONLY: MPI_INTEGER
      USE icosa, ONLY: getin
      USE mpipara, ONLY: comm_icosa, mpi_rank, mpi_size
      USE spherical_geom_mod, ONLY: xyz2lonlat
      USE genmod
      USE dimensions
      USE geometry
      USE metric, ONLY: vup, vdown, cell_glo, ncell_glo_tot => ncell_glo
      TYPE(xios_context) :: ctx_hdl
      TYPE(xios_duration)      :: dtime
      INTEGER :: ncell, ncell_tot, ncell_glo(0:mpi_size - 1), displ
      INTEGER :: ind, i, j, k, l, ij, ierr
      REAL(rstd), ALLOCATABLE    :: lon(:), lat(:), bounds_lon(:, :), bounds_lat(:, :)
      INTEGER, ALLOCATABLE      :: ind_glo(:)
      TYPE(t_domain), POINTER :: d
      INTEGER, ALLOCATABLE :: cell_glo_tot(:)
      INTEGER, ALLOCATABLE :: ind_glo_tot(:)
      CHARACTER(len=255) :: etat0_type
      LOGICAL :: read_metric_

      CALL xios_set_context_input
!$OMP BARRIER
!$OMP MASTER

      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
            END DO
         END DO
      END DO
      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)
      END DO

      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
                  END DO
                  ind_glo(ncell) = domain(ind)%assign_cell_glo(i, j) - 1
               END IF
            END DO
         END DO
      END DO

      CALL xios_set_domain_attr("i", ni_glo=ncell_tot, ibegin=displ, ni=ncell)
      CALL xios_set_domain_attr("i", data_dim=1, type='unstructured', nvertex=6, i_index=ind_glo)
      CALL xios_set_domain_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)

      dtime%second = 1
      CALL xios_set_timestep(dtime)
!$OMP END MASTER

      CALL getin('etat0', etat0_type)
      CALL getin('read_metric', read_metric_)

!$OMP MASTER

      CALL xios_set_file_attr('start', enabled=.FALSE.)
      IF (TRIM(etat0_type) == 'start_file' .AND. read_metric_) THEN
         CALL xios_set_file_attr('start', enabled=.TRUE.)
      END IF

      CALL xios_close_context_definition()
!$OMP END MASTER
!$OMP BARRIER

   END SUBROUTINE xios_init_write_field_input

   SUBROUTINE xios_write_field(name, field)
      USE field_mod
      CHARACTER(LEN=*), INTENT(IN) :: name
      TYPE(t_field), POINTER :: field(:)
      TYPE(t_cellset), POINTER :: cells(:)
      INTEGER :: ncells

!$OMP BARRIER
!$OMP MASTER

      SELECT CASE (field(1)%field_type)
      CASE (field_T)
         cells => mesh_loc%primal_own
         ncells = ncell_i
      CASE (field_U)
         cells => mesh_loc%edge_own
         ncells = ncell_e
      CASE (field_Z)
         cells => mesh_loc%dual_own
         ncells = ncell_v
      END SELECT

      IF (field(1)%ndim > 4) THEN
         PRINT *, "xios_write_field : dimension > 4 are not supported for now"
      ELSE
         CALL xios_write_field_gen(name, field, cells, &
                                   ncells, field(1)%dim3, field(1)%dim4)
      END IF

!$OMP END MASTER
!$OMP BARRIER

   END SUBROUTINE xios_write_field

   SUBROUTINE xios_read_field(name, field)
      USE field_mod
      CHARACTER(LEN=*), INTENT(IN) :: name
      TYPE(t_field), POINTER :: field(:)
      TYPE(t_cellset), POINTER :: cells(:)
      INTEGER :: ncells

!$OMP BARRIER
!$OMP MASTER

      SELECT CASE (field(1)%field_type)
      CASE (field_T)
         cells => mesh_loc%primal_own
         ncells = ncell_i
      CASE (field_U)
         cells => mesh_loc%edge_own
         ncells = ncell_e
      CASE (field_Z)
         cells => mesh_loc%dual_own
         ncells = ncell_v
      END SELECT

      IF (field(1)%ndim > 4) THEN
         PRINT *, "xios_read_field : dimension > 4 are not supported for now"
      ELSE
         CALL xios_read_field_hex(name, field, cells, &
                                  ncells, field(1)%dim3, field(1)%dim4)
      END IF

!$OMP END MASTER
!$OMP BARRIER

   END SUBROUTINE xios_read_field

   SUBROUTINE xios_write_field_gen(name, field, cells, ncell_tot, nlev, nq)
      CHARACTER(LEN=*), INTENT(IN) :: name
      TYPE(t_field) :: field(:)
      TYPE(t_cellset), TARGET :: cells(:)
      INTEGER, INTENT(IN) :: ncell_tot, nlev, nq
      REAL(rstd) :: field_tmp(ncell_tot, nlev, nq)
      TYPE(t_cellset), POINTER :: cellset
      INTEGER :: ind, n_beg, n, ij, sgn
      LOGICAL :: signed

      IF (ALLOCATED(cells(1)%sgn)) THEN
         signed = .TRUE.
      ELSE
         signed = .FALSE.
         sgn = 1
      END IF

      n_beg = 0
      DO ind = 1, ndomain
         cellset => cells(ind)
         DO n = 1, cellset%ncell
            ij = cellset%ij(n)
            IF (signed) sgn = cellset%sgn(n)
            SELECT CASE (grid_type)
            CASE (grid_ico)
               SELECT CASE (field(1)%ndim)
               CASE (2)
                  field_tmp(n_beg + n, 1, 1) = sgn*field(ind)%rval2d(ij)
               CASE (3)
                  field_tmp(n_beg + n, :, 1) = sgn*field(ind)%rval3d(ij, :)
               CASE (4)
                  field_tmp(n_beg + n, :, :) = sgn*field(ind)%rval4d(ij, :, :)
               END SELECT
            CASE (grid_unst)
               SELECT CASE (field(1)%ndim)
               CASE (2)
                  field_tmp(n_beg + n, 1, 1) = sgn*field(ind)%rval2d(ij)
               CASE (3)
                  field_tmp(n_beg + n, :, 1) = sgn*field(ind)%rval3d(:, ij)
               CASE (4)
                  field_tmp(n_beg + n, :, :) = sgn*field(ind)%rval4d(:, ij, :)
               END SELECT
            END SELECT
         END DO
         n_beg = n_beg + cellset%ncell
      END DO
      CALL xios_send_field(name, field_tmp)

   END SUBROUTINE xios_write_field_gen

   SUBROUTINE xios_read_field_hex(name, field, cells, ncell_tot, nlev, nq)
      CHARACTER(LEN=*), INTENT(IN) :: name
      TYPE(t_field), POINTER :: field(:)
      TYPE(t_cellset), TARGET :: cells(:)
      INTEGER, INTENT(IN) :: ncell_tot, nlev, nq

      REAL(rstd) :: field_tmp(ncell_tot, nlev, nq)
      TYPE(t_cellset), POINTER :: cellset
      INTEGER :: ind, n_beg, n, ij, sgn
      LOGICAL :: signed

      CALL xios_recv_field(name, field_tmp)

      IF (ALLOCATED(cells(1)%sgn)) THEN
         signed = .TRUE.
      ELSE
         signed = .FALSE.
         sgn = 1
      END IF

      n_beg = 0
      DO ind = 1, ndomain
         cellset => cells(ind)
         DO n = 1, cellset%ncell
            ij = cellset%ij(n)
            IF (signed) sgn = cellset%sgn(n)
            SELECT CASE (field(1)%ndim)
            CASE (2)
               field(ind)%rval2d(ij) = sgn*field_tmp(n_beg + n, 1, 1)
            CASE (3)
               field(ind)%rval3d(ij, :) = sgn*field_tmp(n_beg + n, :, 1)
            CASE (4)
               field(ind)%rval4d(ij, :, :) = sgn*field_tmp(n_beg + n, :, :)
            END SELECT
         END DO
         n_beg = n_beg + cellset%ncell
      END DO
   END SUBROUTINE xios_read_field_hex

   SUBROUTINE xios_read_var(name, field)
      USE prec
      USE transfert_mod
      CHARACTER(LEN=*), INTENT(IN) :: name
      REAL(rstd), INTENT(OUT) :: field
      !$OMP MASTER
      CALL xios_recv_field(name, field)
      !$OMP END MASTER
      CALL bcast_omp(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)
                  END IF
               END DO
            END DO
         END DO
      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)
                  END IF
               END DO
            END DO
         END DO
      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, :, :)
                  END IF
               END DO
            END DO
         END DO
      END IF

   END SUBROUTINE xios_read_field_scalar

   SUBROUTINE xios_write_field_U(handle, 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
      TYPE(xios_field) :: handle
      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))
                     END IF
                  END DO
               END DO
            END DO
         END DO

      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), :)
                     END IF
                  END DO
               END DO
            END DO
         END DO

      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), :, :)
                     END IF
                  END DO
               END DO
            END DO
         END DO

      END IF

      CALL xios_send_field(handle, 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)
                     END IF
                  END DO
               END DO
            END DO
         END DO

      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)
                     END IF
                  END DO
               END DO
            END DO
         END DO

      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)
                     END IF
                  END DO
               END DO
            END DO
         END DO

      END IF

   END SUBROUTINE xios_read_field_u

   SUBROUTINE xios_write_field_vort(handle, 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
      TYPE(xios_field) :: handle
      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)
               END DO
            END DO

            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)
               END DO
            END DO

         END DO

      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, :)
               END DO
            END DO

            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, :)
               END DO
            END DO

         END DO

      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)
               END DO
            END DO

            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)
               END DO
            END DO

         END DO

      END IF

      CALL xios_send_field(handle, 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)
               END DO
            END DO

            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)
               END DO
            END DO

         END DO

      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, :)
               END DO
            END DO

            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, :)
               END DO
            END DO

         END DO

      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, :)
               END DO
            END DO

            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, :)
               END DO
            END DO

         END DO

      END IF

   END SUBROUTINE xios_read_field_vort

   FUNCTION xios_is_active_field(field_id)
      USE transfert_omp_mod
      IMPLICIT NONE
      LOGICAL ::  xios_is_active_field
      CHARACTER(LEN=*) :: field_id

      !$OMP MASTER
      xios_is_active_field = xios_field_is_active(field_id)
      !$OMP END MASTER
      CALL bcast_omp(xios_is_active_field)
   END FUNCTION xios_is_active_field

   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

   SUBROUTINE xios_set_context_input
      IMPLICIT NONE
      TYPE(xios_context) :: ctx_hdl

!$OMP MASTER
      CALL xios_get_handle("icosagcm_input", ctx_hdl)
      CALL xios_set_current_context(ctx_hdl)
!$OMP END MASTER

   END SUBROUTINE xios_set_context_input

#else

!!!! Wrapper XIOS

   INTERFACE xios_send_field
      MODULE PROCEDURE xios_send_field_scalar, xios_send_field_1d, xios_send_field_2d, xios_send_field_3d
   END INTERFACE xios_send_field

   INTERFACE xios_recv_field
      MODULE PROCEDURE xios_recv_field_scalar, xios_recv_field_1d, xios_recv_field_2d, xios_recv_field_3d
   END INTERFACE xios_recv_field

   INTERFACE xios_set_attr
      MODULE PROCEDURE xios_set_fieldgroup_attr_hdl, xios_set_field_attr_hdl
   END INTERFACE xios_set_attr

   INTERFACE xios_get_handle
      MODULE PROCEDURE xios_get_field_handle, xios_get_fieldgroup_handle
   END INTERFACE xios_get_handle

   INTERFACE xios_add_child
      MODULE PROCEDURE xios_fieldgroup_add_child
   END INTERFACE xios_add_child

   REAL, PARAMETER :: xios_timestep = 1.
   REAL, PARAMETER :: xios_second = 1.

   TYPE xios_fieldgroup
   END TYPE xios_fieldgroup

   TYPE xios_field
   END TYPE

CONTAINS

   SUBROUTINE xios_init
      using_xios = .FALSE.
   END SUBROUTINE xios_init

   SUBROUTINE xios_send_field_scalar(name, field)
      CHARACTER(LEN=*), INTENT(IN) :: name
      REAL, INTENT(IN) :: field
   END SUBROUTINE xios_send_field_scalar

   SUBROUTINE xios_send_field_1d(name, field)
      CHARACTER(LEN=*), INTENT(IN) :: name
      REAL, INTENT(IN) :: field(:)
   END SUBROUTINE xios_send_field_1d

   SUBROUTINE xios_send_field_2d(name, field)
      CHARACTER(LEN=*), INTENT(IN) :: name
      REAL, INTENT(IN) :: field(:, :)
   END SUBROUTINE xios_send_field_2d

   SUBROUTINE xios_send_field_3d(name, field)
      CHARACTER(LEN=*), INTENT(IN) :: name
      REAL, INTENT(IN) :: field(:, :, :)
   END SUBROUTINE xios_send_field_3d

   SUBROUTINE xios_recv_field_scalar(name, field)
      CHARACTER(LEN=*), INTENT(IN) :: name
      REAL, INTENT(OUT) :: field
      field = 0.
   END SUBROUTINE xios_recv_field_scalar

   SUBROUTINE xios_recv_field_1d(name, field)
      CHARACTER(LEN=*), INTENT(IN) :: name
      REAL, INTENT(OUT) :: field(:)
      field = 0.
   END SUBROUTINE xios_recv_field_1d

   SUBROUTINE xios_recv_field_2d(name, field)
      CHARACTER(LEN=*), INTENT(IN) :: name
      REAL, INTENT(OUT) :: field(:, :)
      field = 0.
   END SUBROUTINE xios_recv_field_2d

   SUBROUTINE xios_recv_field_3d(name, field)
      CHARACTER(LEN=*), INTENT(IN) :: name
      REAL, INTENT(OUT) :: field(:, :, :)
      field = 0.
   END SUBROUTINE xios_recv_field_3d

   SUBROUTINE xios_write_field(name, field)
      USE field_mod
      CHARACTER(LEN=*), INTENT(IN) :: name
      TYPE(t_field), POINTER :: field(:)
   END SUBROUTINE xios_write_field

   SUBROUTINE xios_init_write_field_input
   END SUBROUTINE xios_init_write_field_input

   SUBROUTINE xios_read_field(name, field)
      USE field_mod
      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
      field = 0
   END SUBROUTINE

   FUNCTION xios_is_active_field(field_id)
      USE transfert_omp_mod
      LOGICAL ::  xios_is_active_field
      CHARACTER(LEN=*) :: field_id
      xios_is_active_field = .TRUE.
   END FUNCTION xios_is_active_field

   FUNCTION xios_is_valid_field(field_id)
      USE transfert_omp_mod
      IMPLICIT NONE
      LOGICAL ::  xios_is_valid_field
      CHARACTER(LEN=*) :: field_id
      xios_is_valid_field = .TRUE.
   END FUNCTION xios_is_valid_field

   SUBROUTINE xios_update_calendar(step)
      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_context_input
   END SUBROUTINE xios_set_context_input

   SUBROUTINE xios_set_fieldgroup_attr(name, enabled, read_access, freq_op)
      CHARACTER(LEN=*) :: name
      LOGICAL, OPTIONAL          :: enabled, read_access
      REAL, 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, mode, enabled, output_freq)
      CHARACTER(LEN=*) :: id
      CHARACTER(LEN=*), OPTIONAL :: name, mode
      LOGICAL, OPTIONAL          :: enabled
      REAL, 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, axis_ref)
      CHARACTER(LEN=*) :: id
      INTEGER, OPTIONAL          :: n_glo
      REAL, OPTIONAL             :: value(:)
      CHARACTER(LEN=*), OPTIONAL :: axis_ref
   END SUBROUTINE xios_set_axis_attr

   SUBROUTINE xios_get_field_handle(id, hdl)
      CHARACTER(LEN=*) :: id
      TYPE(xios_field)          :: hdl
   END SUBROUTINE xios_get_field_handle

   SUBROUTINE xios_get_fieldgroup_handle(id, hdl)
      CHARACTER(LEN=*) :: id
      TYPE(xios_fieldgroup)          :: hdl
   END SUBROUTINE xios_get_fieldgroup_handle

   SUBROUTINE xios_fieldgroup_add_child(fieldgroup_hdl, field_hdl, id)
      TYPE(xios_fieldgroup)     :: fieldgroup_hdl
      TYPE(xios_field)          :: field_hdl
      CHARACTER(LEN=*), OPTIONAL :: id
   END SUBROUTINE xios_fieldgroup_add_child

   SUBROUTINE xios_set_generate_rectilinear_domain_attr(id, bounds_lon_start, bounds_lon_end, bounds_lat_start, bounds_lat_end)
      CHARACTER(LEN=*) :: id
      REAL, OPTIONAL :: bounds_lon_start
      REAL, OPTIONAL :: bounds_lon_end
      REAL, OPTIONAL :: bounds_lat_start
      REAL, OPTIONAL :: bounds_lat_end
   END SUBROUTINE xios_set_generate_rectilinear_domain_attr

   SUBROUTINE xios_get_domain_attr(id, ni_glo, nj_glo, ni, nj, ibegin, jbegin)
      CHARACTER(LEN=*) :: id
      INTEGER, OPTIONAL :: ni_glo
      INTEGER, OPTIONAL :: nj_glo
      INTEGER, OPTIONAL :: ni
      INTEGER, OPTIONAL :: nj
      INTEGER, OPTIONAL :: ibegin
      INTEGER, OPTIONAL :: jbegin
   END SUBROUTINE xios_get_domain_attr

   SUBROUTINE xios_set_domain_attr(id, ni_glo, nj_glo)
      CHARACTER(LEN=*) :: id
      INTEGER, OPTIONAL :: ni_glo
      INTEGER, OPTIONAL :: nj_glo
   END SUBROUTINE xios_set_domain_attr

   SUBROUTINE xios_set_fieldgroup_attr_hdl(field_group, name, enabled, read_access)
      TYPE(xios_fieldgroup) :: field_group
      CHARACTER(LEN=*), OPTIONAL :: name
      LOGICAL, OPTIONAL          :: enabled
      LOGICAL, OPTIONAL          :: read_access
   END SUBROUTINE xios_set_fieldgroup_attr_hdl

   SUBROUTINE xios_set_field_attr_hdl(field, name, enabled, field_ref)
      TYPE(xios_field) :: field
      CHARACTER(LEN=*), OPTIONAL :: name
      LOGICAL, OPTIONAL          :: enabled
      CHARACTER(LEN=*), OPTIONAL :: field_ref
   END SUBROUTINE xios_set_field_attr_hdl

   SUBROUTINE xios_set_field_attr(field_id, enabled, read_access, field_ref)
      CHARACTER(LEN=*), INTENT(IN) ::field_id
      LOGICAL, OPTIONAL, INTENT(IN) :: enabled
      LOGICAL, OPTIONAL, INTENT(IN) :: read_access
      CHARACTER(LEN=*), OPTIONAL :: field_ref
   END SUBROUTINE xios_set_field_attr

#endif

END MODULE xios_mod
