fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Remote get works, remote indirect put does not (yet).

Browse Source
psblas-caf-xp
sfilippone 9 years ago
parent 333ebbbb2f
commit 53f914dc7e
2 changed files with 22 additions and 20 deletions
Show Stats Download Patch File Download Diff File

20
base/internals/psi_desc_impl.f90
Unescape Escape View File

@ -138,11 +138,11 @@ subroutine psi_cnv_v2xch(ictxt, vidx_in, xch_idx,info)
if (vidx_in(ip) == -1) exit if (vidx_in(ip) == -1) exit
xch_idx%prcs_xch(ixch) = vidx_in(ip) xch_idx%prcs_xch(ixch) = vidx_in(ip)
nerv = vidx_in(ip+psb_n_elem_recv_) 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) = & 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) & vidx_in(ip+psb_n_elem_recv_+1:ip+psb_n_elem_recv_+nerv)
nesd = vidx_in(ip+nerv+psb_n_elem_send_) 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) = & 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) & 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 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) sync images(img)
buf_rmt_rcv_bnd(me*2 - 1 : me*2)[img]= xch_idx%loc_rcv_bnd(ixch:ixch+1) 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) 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:',& !!$ 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) !!$ & 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:',& !!$ 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) !!$ & 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_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) 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 post(snd_done(me)[img])
event wait(snd_done(img)) event wait(snd_done(img))
if (this_image() == 2) write(*,*) img,nesd,'Send idx on 2:',& !!$ 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 !!$ & 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:',& !!$ 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 !!$ & 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) = & 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) & 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) = & xch_idx%rmt_snd_idx(xch_idx%loc_snd_bnd(ixch):xch_idx%loc_snd_bnd(ixch)+nesd-1) = &

22
test/kernel/pdgenspmv.f90
Unescape Escape View File

@ -67,6 +67,7 @@ program pdgenspmv
integer(psb_ipk_) :: times integer(psb_ipk_) :: times
integer(psb_ipk_), parameter :: iwarm=2 integer(psb_ipk_), parameter :: iwarm=2
logical :: indirect_remote_get
! other variables ! other variables
integer(psb_ipk_) :: info, i integer(psb_ipk_) :: info, i
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -154,7 +155,8 @@ program pdgenspmv
call psb_barrier(ictxt) call psb_barrier(ictxt)
th = psb_wtime() - tt1 th = psb_wtime() - tt1
call psb_amx(ictxt,th) call psb_amx(ictxt,th)
indirect_remote_get = .false.
if (.true.) then if (.true.) then
associate(xchg => desc_a%halo_xch) associate(xchg => desc_a%halo_xch)
! FIXME: cache flush needed here ! FIXME: cache flush needed here
@ -165,19 +167,19 @@ program pdgenspmv
do i=1,iwarm do i=1,iwarm
! Sync images ! Sync images
sync images(xchg%prcs_xch+1) sync images(xchg%prcs_xch+1)
if (.false.) then if (indirect_remote_get) then
do ip = 1, nxch do ip = 1, nxch
img = xchg%prcs_xch(ip) + 1 img = xchg%prcs_xch(ip) + 1
p1 = xchg%loc_rcv_bnd(ip) p1 = xchg%loc_rcv_bnd(ip)
p2 = xchg%loc_rcv_bnd(ip+1)-1 p2 = xchg%loc_rcv_bnd(ip+1)-1
!!$ if (this_image()==2) write(0,*) this_image(),'Boundaries ',& !!$ if (this_image()==2) write(0,*) this_image(),'Boundaries ',&
!!$ & p1,p2,' :',xchg%loc_rcv_idx(p1:p2),':',xchg%rmt_rcv_idx(p1:p2) !!$ & 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] !!$ 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] temp(p1:p2) = xvc(xchg%rmt_rcv_idx(p1:p2))[img]
!!$ xvc(xchg%loc_rcv_idx(p1:p2)) = temp(p1:p2) xvc(xchg%loc_rcv_idx(p1:p2)) = temp(p1:p2)
!!$ if (this_image()==2) write(0,*) this_image(),' :x: ',ip,' : ',& !!$ 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)),' : ',xv%v%v(xchg%loc_rcv_idx(p1:p2))
end do end do
!!$ if (this_image()==2) write(0,*) this_image(),' :x: ',& !!$ if (this_image()==2) write(0,*) this_image(),' :x: ',&
!!$ &xvc(nrl+1:ncl),' : ',xv%v%v(nrl+1:ncl) !!$ &xvc(nrl+1:ncl),' : ',xv%v%v(nrl+1:ncl)
@ -188,8 +190,8 @@ program pdgenspmv
p1 = xchg%loc_snd_bnd(ip) p1 = xchg%loc_snd_bnd(ip)
p2 = xchg%loc_snd_bnd(ip+1)-1 p2 = xchg%loc_snd_bnd(ip+1)-1
!xvc(xchg%loc_rcv_idx(p1:p2)) = xvc(xchg%rmt_rcv_idx(p1:p2))[img] !xvc(xchg%loc_rcv_idx(p1:p2)) = xvc(xchg%rmt_rcv_idx(p1:p2))[img]
write(0,*) this_image(),'Boundaries ',& !!$ write(0,*) this_image(),'Boundaries ',&
& p1,p2,' :',xchg%loc_snd_idx(p1:p2),':',xchg%rmt_snd_idx(p1:p2) !!$ & p1,p2,' :',xchg%loc_snd_idx(p1:p2),':',xchg%rmt_snd_idx(p1:p2)
temp(p1:p2) = xvc(xchg%loc_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) xvc(xchg%rmt_snd_idx(p1:p2))[img] = temp(p1:p2)
end do end do
@ -208,7 +210,7 @@ program pdgenspmv
!!$ event post(ready[img]) !!$ event post(ready[img])
!!$ end do !!$ end do
!!$ event wait(ready, until_count=nxch) !!$ event wait(ready, until_count=nxch)
if (.true.) then if (indirect_remote_get) then
do ip = 1, nxch do ip = 1, nxch
img = xchg%prcs_xch(ip) + 1 img = xchg%prcs_xch(ip) + 1
sync images (img) sync images (img)

Write Preview
Loading…
Cancel
Save