From 53f914dc7ee853a4f838653dd25786453df55923 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Wed, 16 Aug 2017 15:35:12 +0100 Subject: [PATCH] Remote get works, remote indirect put does not (yet). --- base/internals/psi_desc_impl.f90 | 20 ++++++++++---------- test/kernel/pdgenspmv.f90 | 22 ++++++++++++---------- 2 files changed, 22 insertions(+), 20 deletions(-) diff --git a/base/internals/psi_desc_impl.f90 b/base/internals/psi_desc_impl.f90 index 1d465878..00534dcb 100644 --- a/base/internals/psi_desc_impl.f90 +++ b/base/internals/psi_desc_impl.f90 @@ -138,11 +138,11 @@ subroutine psi_cnv_v2xch(ictxt, vidx_in, xch_idx,info) if (vidx_in(ip) == -1) exit xch_idx%prcs_xch(ixch) = vidx_in(ip) nerv = vidx_in(ip+psb_n_elem_recv_) - write(*,*) 'Check on receive option ',ip,nerv,xch_idx%loc_rcv_bnd(ixch) +!!$ write(*,*) 'Check on receive option ',ip,nerv,xch_idx%loc_rcv_bnd(ixch) xch_idx%loc_rcv_idx(xch_idx%loc_rcv_bnd(ixch):xch_idx%loc_rcv_bnd(ixch)+nerv-1) = & & vidx_in(ip+psb_n_elem_recv_+1:ip+psb_n_elem_recv_+nerv) nesd = vidx_in(ip+nerv+psb_n_elem_send_) - write(*,*) 'Check on send option ',ip,nesd,xch_idx%loc_snd_bnd(ixch) +!!$ write(*,*) 'Check on send option ',ip,nesd,xch_idx%loc_snd_bnd(ixch) xch_idx%loc_snd_idx(xch_idx%loc_snd_bnd(ixch):xch_idx%loc_snd_bnd(ixch)+nesd-1) = & & vidx_in(ip+nerv+psb_n_elem_send_+1:ip+nerv+psb_n_elem_send_+nesd) xch_idx%loc_rcv_bnd(ixch+1) = xch_idx%loc_rcv_bnd(ixch) + nerv @@ -152,18 +152,18 @@ subroutine psi_cnv_v2xch(ictxt, vidx_in, xch_idx,info) sync images(img) buf_rmt_rcv_bnd(me*2 - 1 : me*2)[img]= xch_idx%loc_rcv_bnd(ixch:ixch+1) buf_rmt_snd_bnd(me*2 - 1 : me*2)[img]= xch_idx%loc_snd_bnd(ixch:ixch+1) - if (img == 2) write(*,*) this_image(),nesd,'Send idx to 2:',& - & xch_idx%loc_snd_idx(xch_idx%loc_snd_bnd(ixch):xch_idx%loc_snd_bnd(ixch)+nesd-1) - if (img == 2) write(*,*) this_image(),nerv,'Recv idx fr 2:',& - & xch_idx%loc_rcv_idx(xch_idx%loc_rcv_bnd(ixch):xch_idx%loc_rcv_bnd(ixch)+nerv-1) +!!$ if (img == 2) write(*,*) this_image(),nesd,'Send idx to 2:',& +!!$ & xch_idx%loc_snd_idx(xch_idx%loc_snd_bnd(ixch):xch_idx%loc_snd_bnd(ixch)+nesd-1) +!!$ if (img == 2) write(*,*) this_image(),nerv,'Recv idx fr 2:',& +!!$ & xch_idx%loc_rcv_idx(xch_idx%loc_rcv_bnd(ixch):xch_idx%loc_rcv_bnd(ixch)+nerv-1) buf_rmt_rcv_idx(1:nesd)[img] = xch_idx%loc_snd_idx(xch_idx%loc_snd_bnd(ixch):xch_idx%loc_snd_bnd(ixch)+nesd-1) buf_rmt_snd_idx(1:nerv)[img] = xch_idx%loc_rcv_idx(xch_idx%loc_rcv_bnd(ixch):xch_idx%loc_rcv_bnd(ixch)+nerv-1) event post(snd_done(me)[img]) event wait(snd_done(img)) - if (this_image() == 2) write(*,*) img,nesd,'Send idx on 2:',& - & buf_rmt_snd_idx(1:nesd),':',xch_idx%loc_rcv_bnd(ixch),xch_idx%loc_rcv_bnd(ixch)+nerv-1 - if (this_image() == 2) write(*,*) img,nerv,'Recv idx on 2:',& - & buf_rmt_rcv_idx(1:nerv),':',xch_idx%loc_snd_bnd(ixch),xch_idx%loc_snd_bnd(ixch)+nesd-1 +!!$ if (this_image() == 2) write(*,*) img,nesd,'Send idx on 2:',& +!!$ & buf_rmt_snd_idx(1:nesd),':',xch_idx%loc_rcv_bnd(ixch),xch_idx%loc_rcv_bnd(ixch)+nerv-1 +!!$ if (this_image() == 2) write(*,*) img,nerv,'Recv idx on 2:',& +!!$ & buf_rmt_rcv_idx(1:nerv),':',xch_idx%loc_snd_bnd(ixch),xch_idx%loc_snd_bnd(ixch)+nesd-1 xch_idx%rmt_rcv_idx(xch_idx%loc_rcv_bnd(ixch):xch_idx%loc_rcv_bnd(ixch)+nerv-1) = & & buf_rmt_rcv_idx(1:nerv) xch_idx%rmt_snd_idx(xch_idx%loc_snd_bnd(ixch):xch_idx%loc_snd_bnd(ixch)+nesd-1) = & diff --git a/test/kernel/pdgenspmv.f90 b/test/kernel/pdgenspmv.f90 index 5518f58f..e7e69465 100644 --- a/test/kernel/pdgenspmv.f90 +++ b/test/kernel/pdgenspmv.f90 @@ -67,6 +67,7 @@ program pdgenspmv integer(psb_ipk_) :: times integer(psb_ipk_), parameter :: iwarm=2 + logical :: indirect_remote_get ! other variables integer(psb_ipk_) :: info, i character(len=20) :: name,ch_err @@ -154,7 +155,8 @@ program pdgenspmv call psb_barrier(ictxt) th = psb_wtime() - tt1 call psb_amx(ictxt,th) - + + indirect_remote_get = .false. if (.true.) then associate(xchg => desc_a%halo_xch) ! FIXME: cache flush needed here @@ -165,19 +167,19 @@ program pdgenspmv do i=1,iwarm ! Sync images sync images(xchg%prcs_xch+1) - if (.false.) then + if (indirect_remote_get) then do ip = 1, nxch img = xchg%prcs_xch(ip) + 1 p1 = xchg%loc_rcv_bnd(ip) p2 = xchg%loc_rcv_bnd(ip+1)-1 -!!$ if (this_image()==2) write(0,*) this_image(),'Boundaries ',& -!!$ & p1,p2,' :',xchg%loc_rcv_idx(p1:p2),':',xchg%rmt_rcv_idx(p1:p2) +!!$ if (this_image()==2) write(0,*) this_image(),'Boundaries ',& +!!$ & p1,p2,' :',xchg%loc_rcv_idx(p1:p2),':',xchg%rmt_rcv_idx(p1:p2) !!$ xvc(xchg%loc_rcv_idx(p1:p2)) = xvc(xchg%rmt_rcv_idx(p1:p2))[img] temp(p1:p2) = xvc(xchg%rmt_rcv_idx(p1:p2))[img] -!!$ xvc(xchg%loc_rcv_idx(p1:p2)) = temp(p1:p2) -!!$ if (this_image()==2) write(0,*) this_image(),' :x: ',ip,' : ',& -!!$ &xvc(xchg%loc_rcv_idx(p1:p2)),' : ',xv%v%v(xchg%loc_rcv_idx(p1:p2)) + xvc(xchg%loc_rcv_idx(p1:p2)) = temp(p1:p2) +!!$ if (this_image()==2) write(0,*) this_image(),' :x: ',ip,' : ',& +!!$ &xvc(xchg%loc_rcv_idx(p1:p2)),' : ',xv%v%v(xchg%loc_rcv_idx(p1:p2)) end do !!$ if (this_image()==2) write(0,*) this_image(),' :x: ',& !!$ &xvc(nrl+1:ncl),' : ',xv%v%v(nrl+1:ncl) @@ -188,8 +190,8 @@ program pdgenspmv p1 = xchg%loc_snd_bnd(ip) p2 = xchg%loc_snd_bnd(ip+1)-1 !xvc(xchg%loc_rcv_idx(p1:p2)) = xvc(xchg%rmt_rcv_idx(p1:p2))[img] - write(0,*) this_image(),'Boundaries ',& - & p1,p2,' :',xchg%loc_snd_idx(p1:p2),':',xchg%rmt_snd_idx(p1:p2) +!!$ write(0,*) this_image(),'Boundaries ',& +!!$ & p1,p2,' :',xchg%loc_snd_idx(p1:p2),':',xchg%rmt_snd_idx(p1:p2) temp(p1:p2) = xvc(xchg%loc_snd_idx(p1:p2)) xvc(xchg%rmt_snd_idx(p1:p2))[img] = temp(p1:p2) end do @@ -208,7 +210,7 @@ program pdgenspmv !!$ event post(ready[img]) !!$ end do !!$ event wait(ready, until_count=nxch) - if (.true.) then + if (indirect_remote_get) then do ip = 1, nxch img = xchg%prcs_xch(ip) + 1 sync images (img)