split dswapdata_vect in do_send and do_recv

psblas-caf-ext
Ambra91 8 years ago
parent e3085a5f79
commit 362e0c1368

@ -767,11 +767,11 @@ subroutine psi_dswap_xchg_vect(iictxt,iicomm,flag,beta,y,xchg,info)
do_send = swap_mpi .or. swap_sync .or. swap_send do_send = swap_mpi .or. swap_sync .or. swap_send
do_recv = swap_mpi .or. swap_sync .or. swap_recv do_recv = swap_mpi .or. swap_sync .or. swap_recv
if (.not.(do_send.and.do_recv)) then !if (.not.(do_send.and.do_recv)) then
info = psb_err_internal_error_ ! info = psb_err_internal_error_
call psb_errpush(info,name,a_err='Unimplemented case in xchg_vect') ! call psb_errpush(info,name,a_err='Unimplemented case in xchg_vect')
goto 9999 ! goto 9999
end if !end if
if (.not.allocated(ufg)) then if (.not.allocated(ufg)) then
!write(*,*) 'Allocating events',np !write(*,*) 'Allocating events',np
@ -784,16 +784,19 @@ subroutine psi_dswap_xchg_vect(iictxt,iicomm,flag,beta,y,xchg,info)
goto 9999 goto 9999
end if end if
else else
if(do_send) then
if (last_clear_count>0) & if (last_clear_count>0) &
& event wait(clear,until_count=last_clear_count) & event wait(clear,until_count=last_clear_count)
endif endif
end if
me = this_image() me = this_image()
if (do_send) then
if (psb_size(buffer) < xchg%max_buffer_size) then if (psb_size(buffer) < xchg%max_buffer_size) then
! !
! By construction, max_buffer_size was computed with a collective. ! By construction, max_buffer_size was computed with a collective.
! !
if (allocated(buffer)) deallocate(buffer) if (allocated(buffer)) deallocate(buffer)
if (this_image()==1) write(*,*) '--------Allocating buffer vect',xchg%max_buffer_size
allocate(buffer(xchg%max_buffer_size)[*],stat=info) allocate(buffer(xchg%max_buffer_size)[*],stat=info)
if (allocated(sndbuf)) deallocate(sndbuf) if (allocated(sndbuf)) deallocate(sndbuf)
if (info == 0) allocate(sndbuf(xchg%max_buffer_size),stat=info) if (info == 0) allocate(sndbuf(xchg%max_buffer_size),stat=info)
@ -803,10 +806,12 @@ subroutine psi_dswap_xchg_vect(iictxt,iicomm,flag,beta,y,xchg,info)
goto 9999 goto 9999
end if end if
end if end if
endif
if (.false.) then if (.false.) then
!sync all !sync all
nxch = size(xchg%prcs_xch) nxch = size(xchg%prcs_xch)
myself = this_image() myself = this_image()
if (do_send) then
do ip = 1, nxch do ip = 1, nxch
img = xchg%prcs_xch(ip) + 1 img = xchg%prcs_xch(ip) + 1
p1 = xchg%loc_snd_bnd(ip) p1 = xchg%loc_snd_bnd(ip)
@ -818,7 +823,17 @@ subroutine psi_dswap_xchg_vect(iictxt,iicomm,flag,beta,y,xchg,info)
call y%gth(isz,xchg%loc_snd_idx(p1:p2),buffer(p1:p2)) call y%gth(isz,xchg%loc_snd_idx(p1:p2),buffer(p1:p2))
event post(ufg(myself)[img]) event post(ufg(myself)[img])
end do end do
endif
if (do_recv) then
if (.not.allocated(buffer)) then
!
! No matching send? Something is wrong....
!
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='Coarray buffer allocation')
goto 9999
end if
do ip = 1, nxch do ip = 1, nxch
img = xchg%prcs_xch(ip) + 1 img = xchg%prcs_xch(ip) + 1
event wait(ufg(img)) event wait(ufg(img))
@ -831,14 +846,14 @@ subroutine psi_dswap_xchg_vect(iictxt,iicomm,flag,beta,y,xchg,info)
!write(0,*) myself,'Getting from ',img,'Remote boundaries: ',rp1,rp2 !write(0,*) myself,'Getting from ',img,'Remote boundaries: ',rp1,rp2
call y%sct(isz,xchg%loc_rcv_idx(p1:p2),buffer(rp1:rp2)[img],beta) call y%sct(isz,xchg%loc_rcv_idx(p1:p2),buffer(rp1:rp2)[img],beta)
event post(clear[img]) event post(clear[img])
end do end do
last_clear_count = nxch last_clear_count = nxch
endif
else else
nxch = size(xchg%prcs_xch) nxch = size(xchg%prcs_xch)
myself = this_image() myself = this_image()
if (do_send) then
do ip = 1, nxch do ip = 1, nxch
img = xchg%prcs_xch(ip) + 1 img = xchg%prcs_xch(ip) + 1
p1 = xchg%loc_snd_bnd(ip) p1 = xchg%loc_snd_bnd(ip)
@ -858,13 +873,26 @@ subroutine psi_dswap_xchg_vect(iictxt,iicomm,flag,beta,y,xchg,info)
! Doing event post later should provide more opportunities for ! Doing event post later should provide more opportunities for
! overlap ! overlap
! !
if (.false.) then if (do_events) then
!Version with events !Version with events
do ip= 1, nxch do ip= 1, nxch
img = xchg%prcs_xch(ip) + 1 img = xchg%prcs_xch(ip) + 1
event post(ufg(myself)[img]) event post(ufg(myself)[img])
end do end do
else
!versions with sync images
if (allocated(img_list)) deallocate(img_list)
allocate(img_list(nxch))
do ip= 1, nxch
img = xchg%prcs_xch(ip) + 1
img_list(ip)=img
end do
sync images(img_list)
if (allocated(img_list)) deallocate(img_list)
endif
endif
if (do_recv) then
if (do_events) then
do ip = 1, nxch do ip = 1, nxch
img = xchg%prcs_xch(ip) + 1 img = xchg%prcs_xch(ip) + 1
event wait(ufg(img)) event wait(ufg(img))
@ -879,17 +907,6 @@ subroutine psi_dswap_xchg_vect(iictxt,iicomm,flag,beta,y,xchg,info)
event post(clear[img]) event post(clear[img])
end do end do
else else
!versions with sync images
if (allocated(img_list)) deallocate(img_list)
allocate(img_list(nxch))
do ip= 1, nxch
img = xchg%prcs_xch(ip) + 1
img_list(ip)=img
end do
sync images(img_list)
if (allocated(img_list)) deallocate(img_list)
do ip = 1, nxch do ip = 1, nxch
img = xchg%prcs_xch(ip) + 1 img = xchg%prcs_xch(ip) + 1
!event wait(ufg(img)) !event wait(ufg(img))
@ -904,6 +921,7 @@ subroutine psi_dswap_xchg_vect(iictxt,iicomm,flag,beta,y,xchg,info)
event post(clear[img]) event post(clear[img])
end do end do
endif endif
endif
last_clear_count = nxch last_clear_count = nxch
end if end if

Loading…
Cancel
Save