#include "MAPL_ErrLog.h" #include "unused_dummy.H" module pFIO_RDMAReferenceMod use, intrinsic :: iso_c_binding, only: c_sizeof use, intrinsic :: iso_fortran_env, only: INT64 use MAPL_ExceptionHandling use pFIO_UtilitiesMod use pFIO_AbstractDataReferenceMod use mpi implicit none private public :: RDMAReference type,extends(AbstractDataReference) :: RDMAReference integer :: win integer :: comm integer :: mem_rank integer(kind=INT64) :: msize_word logical :: RDMA_allocated = .false. contains procedure :: get_length procedure :: serialize procedure :: deserialize procedure :: allocate procedure :: deallocate procedure :: fence end type RDMAReference interface RDMAReference module procedure new_RDMAReference end interface RDMAReference contains function new_RDMAReference(type_kind,msize_word,comm, rank, rc) result(reference) type (RDMAReference) :: reference integer, intent(in) :: type_kind integer(kind=INT64), intent(in) :: msize_word integer, intent(in) :: comm integer, intent(in) :: rank integer, optional, intent(out) :: rc integer :: status reference%msize_word = msize_word reference%type_kind = type_kind call Mpi_comm_dup(Comm,reference%comm,status) _VERIFY(status) reference%mem_rank = rank call reference%allocate(rc=status) _VERIFY(status) _RETURN(_SUCCESS) end function new_RDMAReference integer function get_length(this) result(length) class (RDMAReference), intent(in) :: this integer(kind=INT64) :: long_dummy integer :: size_msize size_msize = size(transfer(long_dummy,[1])) length = this%get_length_base() + size_msize + & 4 ! win, comm, mem_rank, allocated end function get_length subroutine serialize(this, buffer, rc) class (RDMAReference), intent(in) :: this integer, allocatable :: buffer(:) integer, optional, intent(out) :: rc integer, allocatable :: tmp_buff(:) integer :: n, status if(allocated(buffer)) deallocate(buffer) allocate(buffer(this%get_length())) call this%serialize_base(tmp_buff, status) _VERIFY(status) n = this%get_length_base() buffer(1:n) = tmp_buff(:) buffer(n+1) = this%win buffer(n+2) = this%comm buffer(n+3) = this%mem_rank buffer(n+4:n+4) = serialize_intrinsic(this%RDMA_allocated) buffer(n+5:) = transfer(this%msize_word, [1]) _RETURN(_SUCCESS) end subroutine serialize subroutine deserialize(this, buffer, rc) class (RDMAReference), intent(inout) :: this integer, intent(in) :: buffer(:) integer, optional, intent(out) :: rc integer(kind=INT64) :: long_dummy integer :: size_msize,n, n1, status size_msize = size(transfer(long_dummy,[1])) n = size(buffer) n1 = n - size_msize + 1 this%msize_word = transfer(buffer(n1:n), this%msize_word) call deserialize_intrinsic(buffer(n1-1:n1-1), this%RDMA_allocated) call deserialize_intrinsic(buffer(n1-2:n1-2), this%mem_rank) call deserialize_intrinsic(buffer(n1-3:n1-3), this%comm) call deserialize_intrinsic(buffer(n1-4:n1-4), this%win) call this%deserialize_base(buffer(1:n1-5), rc=status) _VERIFY(status) _RETURN(_SUCCESS) end subroutine deserialize subroutine allocate(this, rc) class (RDMAReference), intent(inout) :: this integer, optional, intent(out) :: rc integer(kind=MPI_ADDRESS_KIND) :: windowsize integer :: disp_unit,status, Rank integer(kind=MPI_ADDRESS_KIND) :: n_bytes integer :: int_size #if !defined (SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) integer(kind=MPI_ADDRESS_KIND) :: baseaddr #endif int_size = c_sizeof(int_size) disp_unit = int_size n_bytes = this%msize_word * int_size call MPI_Comm_rank(this%comm,Rank,status) _VERIFY(status) windowsize = 0_MPI_ADDRESS_KIND if (Rank == this%mem_rank) windowsize = n_bytes #if defined (SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) call MPI_Win_allocate(windowsize, disp_unit, MPI_INFO_NULL, this%comm, & this%base_address, this%win, status) _VERIFY(status) #else call MPI_Win_allocate(windowsize, disp_unit, MPI_INFO_NULL, this%comm, & baseaddr, this%win, status) _VERIFY(status) this%base_address = transfer(baseaddr, this%base_address) #endif call MPI_Win_fence(0, this%win, status) _VERIFY(status) this%RDMA_allocated = .true. _RETURN(_SUCCESS) end subroutine allocate subroutine deallocate(this, rc) class (RDMAReference), intent(inout) :: this integer, optional, intent(out) :: rc integer :: status if ( .not. this%RDMA_allocated ) then _RETURN(_SUCCESS) endif call MPI_Win_fence(0, this%win, status) _VERIFY(status) call MPI_Win_free(this%win,status) _VERIFY(status) call MPi_comm_free(this%comm, status) _VERIFY(status) this%RDMA_allocated = .false. _RETURN(_SUCCESS) end subroutine deallocate subroutine fence(this, rc) class(RDMAReference),intent(inout) :: this integer, optional, intent(out) :: rc integer :: status if( this%RDMA_allocated ) then call Mpi_Win_fence(0, this%win, status) _VERIFY(status) endif _RETURN(_SUCCESS) end subroutine fence end module pFIO_RDMAReferenceMod