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

Fixed send_routine calls in psi_dswapdata.f90

Browse Source
psblas3-type-indexed
Alessandro Fanfarillo 12 years ago
parent 957c70a6dd
commit e5beba8137
1 changed files with 68 additions and 67 deletions
Show Stats Download Patch File Download Diff File

135
base/internals/psi_dswapdata.F90
Unescape Escape View File

@ -1930,7 +1930,8 @@ subroutine psi_dswapidx_vect_mptx(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,to
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if(beta==0) then if(beta==0) then
call send_routine(y%v,sendtypes(i),prcid(i),p2ptag,icomm, iret) !call send_routine(y%v,sendtypes(i),prcid(i),p2ptag,icomm, iret)
iret = send(y%get_clocv(),sendtypes(i),prcid(i),p2ptag,icomm)
else else
if (usersend) then if (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,& call mpi_rsend(sndbuf(snd_pt),nesd,&
@ -2066,72 +2067,72 @@ subroutine psi_dswapidx_vect_mptx(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,to
end if end if
return return
contains !contains
subroutine receive_routine(v,recvtype,procSender,tag,communicator, rvhd,info) ! subroutine receive_routine(v,recvtype,procSender,tag,communicator, rvhd,info)
use iso_c_binding ! use iso_c_binding
real(c_double), intent(in), target :: v(*) ! real(c_double), intent(in), target :: v(*)
integer, intent(in) :: recvtype ! integer, intent(in) :: recvtype
integer :: communicator ! integer :: communicator
integer :: procSender,tag,rvhd ! integer :: procSender,tag,rvhd
integer, intent(out) :: info ! integer, intent(out) :: info
type(c_ptr) :: cptr ! type(c_ptr) :: cptr
integer :: isz ! integer :: isz
interface ! interface
function receive(v,recvtype,procSender,tag,communicator,handle) & ! function receive(v,recvtype,procSender,tag,communicator,handle) &
& result(res) bind(c,name='receiveRoutine') ! & result(res) bind(c,name='receiveRoutine')
use iso_c_binding ! use iso_c_binding
!real(c_double) :: v(*) ! !real(c_double) :: v(*)
type(c_ptr), value :: v ! type(c_ptr), value :: v
integer(c_int),value :: recvtype ! integer(c_int),value :: recvtype
integer(c_int),value :: communicator ! integer(c_int),value :: communicator
integer(c_int),value :: procSender ! integer(c_int),value :: procSender
integer(c_int),value :: tag ! integer(c_int),value :: tag
integer(c_int) :: handle ! integer(c_int) :: handle
integer(c_int) :: res ! integer(c_int) :: res
end function receive ! end function receive
end interface ! end interface
cptr = c_loc(v) ! cptr = c_loc(v)
info = receive(cptr,recvtype,procSender,tag,communicator,rvhd) ! info = receive(cptr,recvtype,procSender,tag,communicator,rvhd)
!!$ call mpi_type_size(recvtype,isz,info) !!!$ call mpi_type_size(recvtype,isz,info)
!!$ WRITE(0,*) 'Recving from ',procSender,tag,recvtype,isz,v(1) !!!$ WRITE(0,*) 'Recving from ',procSender,tag,recvtype,isz,v(1)
!!$ call mpi_irecv(v,1,recvtype,procSender,tag,communicator,rvhd,info) !!!$ call mpi_irecv(v,1,recvtype,procSender,tag,communicator,rvhd,info)
end subroutine receive_routine ! end subroutine receive_routine
subroutine send_routine(v,sendtype,procToSend,tag,communicator,info) ! subroutine send_routine(v,sendtype,procToSend,tag,communicator,info)
use iso_c_binding ! use iso_c_binding
real(c_double), intent(in), target :: v(*) ! real(c_double), intent(in), target :: v(*)
integer, intent(in) :: sendtype ! integer, intent(in) :: sendtype
integer :: communicator ! integer :: communicator
integer :: procToSend,tag ! integer :: procToSend,tag
integer, intent(out) :: info ! integer, intent(out) :: info
type(c_ptr) :: cptr ! type(c_ptr) :: cptr
integer :: isz ! integer :: isz
interface ! interface
function send(v,sendtype,procToSend,tag,communicator) & ! function send(v,sendtype,procToSend,tag,communicator) &
& result(res) bind(c,name='sendRoutine') ! & result(res) bind(c,name='sendRoutine')
use iso_c_binding ! use iso_c_binding
!real(c_double) :: v(*) ! !real(c_double) :: v(*)
type(c_ptr), value :: v ! type(c_ptr), value :: v
integer(c_int),value :: sendtype ! integer(c_int),value :: sendtype
integer(c_int),value :: communicator ! integer(c_int),value :: communicator
integer(c_int),value :: procToSend ! integer(c_int),value :: procToSend
integer(c_int),value :: tag ! integer(c_int),value :: tag
integer(c_int) :: res ! integer(c_int) :: res
end function send ! end function send
end interface ! end interface
cptr = c_loc(v) ! cptr = c_loc(v)
info = send(cptr,sendtype,procToSend,tag,communicator) ! info = send(cptr,sendtype,procToSend,tag,communicator)
!!$ call mpi_type_size(sendtype,isz,info) !!!$ call mpi_type_size(sendtype,isz,info)
!!$ WRITE(0,*) 'Sending to ',procToSend,tag,sendtype,isz,v(1) !!!$ WRITE(0,*) 'Sending to ',procToSend,tag,sendtype,isz,v(1)
!!$ call mpi_send(v,1,sendtype,procToSend,tag,communicator,info) !!!$ call mpi_send(v,1,sendtype,procToSend,tag,communicator,info)
end subroutine send_routine ! end subroutine send_routine
end subroutine psi_dswapidx_vect_mptx end subroutine psi_dswapidx_vect_mptx

Write Preview
Loading…
Cancel
Save