program data_ice
  !****************************************************************
  !--- ICE main for testing
  !****************************************************************

  use mpi

  !--- com_cpl defines: impi, com_mpi_init, nlon_a, nlat_a, nlon_o, nlat_o
  use com_cpl

!xxx  !--- Store and retrieve cccma logical records
!xxx  use com_ccdata

  implicit none

  !--- The mpi communicator assigned to the ice
  integer(kind=impi) :: ice_comm

  !--- Integer parameters passed to mpi routines
  integer(kind=impi) :: ierr, rank, nproc, mynode

  !--- misc
  integer :: ix, iy, iz, nwrds, idx, ntime, verbose=1
  integer :: curr_size, curr_tag
  integer(kind=8) :: curr_time
  character(len=32) :: name
  type(cpl_vinfo_t) :: cpl_vinfo

  !--- Buffer and work space used by CCCma io routines
  integer, parameter :: maxx=8392704  !---2049x4096
  real               :: wrk(maxx)
  integer            :: ibuf(8)

  !--- Start MPI
  call mpi_init( ierr )

  !--- Initialize groups for coupler, atm and ocn
  call define_group('ice', ice_comm)

  call mpi_comm_rank( ice_comm, rank, ierr )
  call mpi_comm_size( ice_comm, nproc, ierr )
  write(6,'(a,4i8)')'data_ice: ice_comm, rank, size, ice_master ',ice_comm,rank,nproc,ice_master

  !--- Determine rank in MPI_COMM_WORLD
  call mpi_comm_rank( MPI_COMM_WORLD, mynode, ierr )

  !--- IMPORTANT ---
  !--- ice_master is the rank in MPI_COMM_WORLD not the rank in ice_comm
  !--- IMPORTANT ---

  !--- Initialize ibuf and wrk
  ibuf(1:8) = (/ transfer("GRID",ix), 0, 0, 1, nlon_a+1, nlat_a, 1, 1 /)
  wrk(:) = 0.0

  !--- Loop over time
  do ntime=1,2

    curr_time = ntime

#ifdef couple_ICE_MODEL
    if ( mynode == ice_master ) then
      !--- Send MSG_ice data to the coupler
      cpl_vinfo = find_cpl_vinfo( name="MSG_ice" )
      curr_size = cpl_vinfo%size
      curr_tag  = cpl_vinfo%tag
      ibuf(1:8) = (/ transfer("MSGI",ix), curr_time, curr_tag, 1, 8, 1, 0, 1 /)
      wrk(1:curr_size) = 0.0
      wrk(1) = 1
      call send_data_rec(wrk, ibuf, cpl_master, curr_size, curr_tag)
    endif

    if ( mynode == ice_master .and. n_ice_to_atm_list > 0 ) then
      !--- Send data to the atm
      do idx=1,n_ice_to_atm_list
        name = trim( ice_to_atm_list(idx)%name )
        curr_size = ice_to_atm_list(idx)%size
        curr_tag  = ice_to_atm_list(idx)%tag

        !--- Read data at curr_time for the current variable
        call read_ice_data(trim(name), curr_time, curr_size, curr_tag, ibuf, wrk)

        !--- Send to coupler
        if (verbose>1) then
          write(6,'(3a)')'data_ice: SEND ',trim(name),' to coupler.'
          call flush(6)
        endif
        call send_data_rec(wrk, ibuf, cpl_master, curr_size, curr_tag)
      enddo
    endif

    if ( mynode == ice_master .and. n_atm_to_ice_list > 0 ) then
      !--- Receive data from the atm
      do idx=1,n_atm_to_ice_list
        name = trim( atm_to_ice_list(idx)%name )
        curr_size = atm_to_ice_list(idx)%size
        curr_tag  = atm_to_ice_list(idx)%tag

        !--- Receive from coupler
        if (verbose>1) then
          write(6,'(3a)')'data_ice: RECV ',trim(name),' from coupler.'
          call flush(6)
        endif
        call recv_data_rec(wrk, ibuf, cpl_master, curr_size, curr_tag)
      enddo
    endif

    if ( mynode == ice_master ) then
      !--- Receive MSG_ice data from the coupler
      cpl_vinfo = find_cpl_vinfo( name="MSG_ice" )
      curr_size = cpl_vinfo%size
      curr_tag  = cpl_vinfo%tag
      call recv_data_rec(wrk, ibuf, cpl_master, curr_size, curr_tag)
    endif
#endif

  enddo

  if (verbose>0) then
    write(6,'(a,i4,a)')'data_ice:  Node ',mynode,' is DONE.'
    call flush(6)
  endif

  !--- Stop MPI
  call mpi_finalize( ierr )

end program data_ice

subroutine read_ice_data(name, curr_time, curr_size, curr_tag, ibuf, wrk)

  use mpi
  use com_cpl

  implicit none

  integer, parameter :: maxx=8392704  !---2049x4096

  character(len=*), intent(in) :: name
  integer(kind=8), intent(in) :: curr_time
  integer, intent(in) :: curr_size, curr_tag
  real,    intent(out) :: wrk(maxx)
  integer, intent(out) :: ibuf(8)

  !--- local
  integer :: ix, nwrds

  !--- Initialize ibuf and wrk
  ibuf(1:8) = (/ transfer("GRID",ix), curr_time, curr_tag, 1, nlon_a+1, nlat_a, 1, 1 /)
  nwrds = ibuf(5) * ibuf(6)
  wrk(1:nwrds) = (/ (ix, ix=1,nwrds) /)
  wrk(1) = curr_tag

end subroutine read_ice_data
