[mpich-discuss] question about mpi_win/mpi_put

[Ted Sariyski]

Hi,

I have difficulties to implement mpi_win/mpi_put. What's strange is, 
that when a process N puts data on ROOT, ROOT gets most of the data 
correct, with few exceptions. Attached is a small example, which 
illustrates the problem and here is a short description.

 1. There is an array BP(nBP) of type /DR_boundaryPoint_t = {integer,
    character*32,real(3),real}/.
 2. MPI type /MPI_DR_boundaryPoint_t/ match DR_boundaryPoint_t//
 3. ROOT opens a window /BP_win/ for /nBP/ elements of type
    /MPI_DR_boundaryPoint_t/
 4. ONE puts /BP(3) to root:BP(3)/

ROOT receives the real fields /dist/ and /ori/ correctly, but the 
integer field /bcTag/ is not updated, and the character field /bcName/ 
is messed up.

0: bcTag=   0 dist=  0.9000E+01 bcName=TEST    A ori=  0.6000E+01 
0.9000E+01  0.1200E+02
1: bcTag=  99 dist=  0.9000E+01 bcName=TEST         ori= 0.6000E+01  
0.9000E+01  0.1200E+02

I have no idea what I am doing wrong. Any help will be highly appreciated.
Thanks in advance,
--Ted


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.mpich.org/pipermail/discuss/attachments/20140529/1f6c3de5/attachment.html>
-------------- next part --------------
!>  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