!>  Compile:    mpif90 put.f90
!>  Run:        mpiexec -l -np 2 a.out
program test_put
    use mpi
    implicit none
    !>--user defined type
    type DR_boundaryPoint_t
        real             :: dist = 0.
        real             :: ori(3)=0.
        character(len=12):: bcName = ''
        integer          :: bcTag  = 0
    end type DR_boundaryPoint_t
    integer,parameter        :: nBP = 10,root=0,rank=4
    !>--root will open a window for BP
    type(DR_boundaryPoint_t) :: BP(nBP)
    !>--local
    integer :: ierr=0,myid,nproc,i
    integer,pointer :: NULL0=>null()
    !>--MPI
    integer :: blockcounts(rank),oldtypes(rank),BP_win
    integer :: mpi_DR_boundaryPoint_t,mpi_dr_boundarypoint_t_size
    integer :: info=MPI_INFO_NULL,comm=MPI_COMM_WORLD
    integer(kind=mpi_address_kind) :: offsets(rank)
    integer(kind=mpi_address_kind) :: msize=0,target_displacement
    !>--init mpi
    call mpi_init (ierr)
    call mpi_comm_rank (comm, myid, ierr)
    call mpi_comm_size (comm, nproc, ierr)
    !>--create mpi-type for DR_boundaryPoint_t
    blockcounts(1) =3  ; oldtypes(1) = mpi_real
    blockcounts(2) =1  ; oldtypes(2) = mpi_real
    blockcounts(3) =1  ; oldtypes(3) = mpi_integer
    blockcounts(4) =12 ; oldtypes(4) = mpi_character
    call MPI_GET_ADDRESS(BP(1)%ori   ,offsets(1),ierr)
    call MPI_GET_ADDRESS(BP(1)%dist  ,offsets(2),ierr)
    call MPI_GET_ADDRESS(BP(1)%bcTag ,offsets(3),ierr)
    call MPI_GET_ADDRESS(BP(1)%bcName,offsets(4),ierr)
    !>--get relative address
    offsets = offsets - offsets(1)
    call mpi_type_create_struct(rank,blockcounts,offsets,&
        oldtypes,mpi_DR_boundaryPoint_t,ierr)
    call mpi_type_commit(mpi_DR_boundaryPoint_t,ierr)
    call mpi_type_size(mpi_DR_boundaryPoint_t,mpi_DR_boundaryPoint_t_size,ierr)

    !>--only root opens a window for BP
    if ( myid == root ) then
        msize = nBP   !>--msize is mpi_address_kind
        call mpi_win_create(BP  ,msize,mpi_DR_boundaryPoint_t_size,info,comm,BP_win,ierr)
    else
        msize=0
        allocate(NULL0)
        call mpi_win_create(NULL0,msize,1,info,comm,BP_win,ierr)
    endif
    !>--begin RMA
    call mpi_win_lock(mpi_lock_shared,root,mpi_mode_nocheck,BP_win,ierr)
    !>--proc one puts BP(3) to root
    i=3
    if (myid == 1) then
        BP(i)%bcTag = 99
        BP(i)%dist=i*i
        BP(i)%bcName='TEST'
        BP(i)%ori = (/2*i,3*i,4*i/)
        BP(i)%bcTag = 99

        target_displacement = i -1 !>-- target_displacement is mpi_address_kind
        !>--put BP(i) at root:BP(i)
        call mpi_put(BP(i)     ,1,mpi_DR_boundaryPoint_t,root,&
            target_displacement,1,mpi_DR_boundaryPoint_t,BP_win,ierr)
    endif
    !>--end RMA
    call mpi_win_unlock(root,BP_win,ierr)
    call mpi_barrier(comm, ierr)
    call print_t(BP(i))
    call mpi_finalize(ierr)
contains
    subroutine print_t(obj)
        implicit none
        type(DR_boundaryPoint_t)            :: obj
        integer(kind=4)                     :: i,k,n,ierr,fd=6
        write(fd,'(a,i4,a,e12.4,2a,2(a,3e12.4),a,i6)') 'bcTag=',obj%bcTag,' dist=',obj%dist,&
            ' bcName=',obj%bcName,' ori=',obj%ori
    end subroutine print_t
end program test_put