MODULE transfer_unstructured_mod
   USE mpi
   USE data_unstructured_mod
   IMPLICIT NONE
   SAVE
   PRIVATE

   LOGICAL :: transfer_initialized = .FALSE.
   PUBLIC :: update_halo

CONTAINS

   SUBROUTINE init_halo_transfer(halo, rank, num, cells)
      TYPE(Halo_transfer) :: halo
      INTEGER :: ranks, total, rank(:), num(:), cells(:)
      ranks = SIZE(rank)
      total = SIZE(cells)
      IF (total /= SUM(num)) STOP 'init_halo_transfer : SIZE(cells)<>SUM(num)'
      halo%ranks = ranks
      ALLOCATE (halo%rank(ranks))
      ALLOCATE (halo%num(ranks))
      ALLOCATE (halo%cells(total))
      ALLOCATE (halo%buf2(llm + 1, total))
      halo%rank = rank
      halo%num = num
      halo%cells = cells
   END SUBROUTINE init_halo_transfer

   SUBROUTINE init_transfer(index, &
                            send_num, send_size, send_rank, send_len, send_list, &
                            recv_num, recv_size, recv_rank, recv_len, recv_list) &
      BIND(C, name='dynamico_init_transfer')
      INTEGER(C_INT), VALUE :: index, send_num, send_size, recv_num, recv_size
      INTEGER(C_INT) :: send_rank(send_num), send_len(send_num), send_list(send_size), &
                        recv_rank(recv_num), recv_len(recv_num), recv_list(recv_size)
      IF (debug_on) PRINT *, 'init_transfer', index, &
         send_num, send_size, '/', send_rank, '/', send_len, '/', &
         recv_num, recv_size, '/', recv_rank, '/', recv_len, '/'
      CALL init_halo_transfer(send_info(index), send_rank, send_len, send_list)
      CALL init_halo_transfer(recv_info(index), recv_rank, recv_len, recv_list)
      transfer_initialized = .TRUE.
   END SUBROUTINE init_transfer

   !-------------------------------------------------------------------------------------------------!

   SUBROUTINE copy_in(lldata, ndata, llbuf, nbuf, cells, data, buf)
      INTEGER :: ndata, lldata, nbuf, llbuf, cells(nbuf), i
      REAL(C_DOUBLE) :: data(lldata, ndata), buf(llbuf, nbuf)
      !$OMP DO
      DO i = 1, nbuf
         buf(1:lldata, i) = data(1:lldata, cells(i))
      END DO
      !$OMP END DO
   END SUBROUTINE copy_in

   SUBROUTINE copy_out(lldata, ndata, llbuf, nbuf, cells, data, buf)
      INTEGER :: ndata, lldata, nbuf, llbuf, cells(nbuf), i
      REAL(C_DOUBLE) :: data(lldata, ndata), buf(llbuf, nbuf)
      !$OMP DO SCHEDULE(STATIC)
      DO i = 1, nbuf
         data(1:lldata, cells(i)) = buf(1:lldata, i)
      END DO
      !$OMP END DO
   END SUBROUTINE copy_out

   SUBROUTINE update_halo(index, data)
      INTEGER :: index ! transfer_XXX, cf data_unstructured.F90
      REAL(C_DOUBLE) :: data(:, :)
      TYPE(Halo_transfer), POINTER :: halo
      REAL(C_DOUBLE), POINTER :: buf(:, :)
      INTEGER :: req(send_info(index)%ranks + recv_info(index)%ranks), &
                 status(MPI_STATUS_SIZE, send_info(index)%ranks + recv_info(index)%ranks)
      INTEGER :: llbuf, num, i, istart, ireq, ierr
      IF (.NOT. transfer_initialized) RETURN
      CALL enter_trace(id_halo, 0)
      halo => send_info(index)
      buf => halo%buf2
      llbuf = SIZE(buf, 1)
      CALL copy_in(SIZE(data, 1), SIZE(data, 2), llbuf, SIZE(buf, 2), halo%cells, data, buf)

      !$OMP MASTER
      ireq = 0
      istart = 1
      DO i = 1, halo%ranks
         num = halo%num(i)
         ireq = ireq + 1
         call MPI_ISEND(buf(1, istart), llbuf*num, MPI_REAL8, halo%rank(i), &
                        42, MPI_COMM_WORLD, req(ireq), ierr)
         istart = istart + num
      END DO
      !$OMP END MASTER
      halo => recv_info(index)
      buf => halo%buf2
      llbuf = SIZE(buf, 1)
      !$OMP MASTER
      istart = 1
      DO i = 1, halo%ranks
         num = halo%num(i)
         ireq = ireq + 1
         call MPI_IRECV(buf(1, istart), llbuf*num, MPI_REAL8, halo%rank(i), &
                        42, MPI_COMM_WORLD, req(ireq), ierr)
         istart = istart + num
      END DO
      CALL MPI_WAITALL(ireq, req, status, ierr)
      !$OMP END MASTER
      !$OMP BARRIER

      CALL copy_out(SIZE(data, 1), SIZE(data, 2), SIZE(buf, 1), SIZE(buf, 2), halo%cells, data, buf)
      CALL enter_trace(id_halo, 0)
   END SUBROUTINE update_halo

   SUBROUTINE update_halo_c(index, lldata, ndata, data) BIND(C, name='dynamico_update_halo')
      INTEGER, VALUE :: index, lldata, ndata
      REAL(C_DOUBLE) :: data(lldata, ndata)
      CALL update_halo(index, data)
   END SUBROUTINE update_halo_c

END MODULE transfer_unstructured_mod
