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

Fixed horrible bug! we had copied the INTEGER stuff.

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 66d29c233f
commit c60b070f12
1 changed files with 26 additions and 26 deletions
Show Stats Download Patch File Download Diff File

52
src/internals/psi_dswaptran.f90
Unescape Escape View File

@ -37,8 +37,8 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, intent(in) :: flag, n
integer, intent(out) :: info
integer :: y(:,:), beta
integer, target :: work(:)
real(kind(1.d0)) :: y(:,:), beta
real(kind(1.d0)), target :: work(:)
type(psb_desc_type) :: desc_a
integer, optional :: data
@ -55,7 +55,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: int_err(5)
integer :: blacs_pnum, krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
integer, pointer, dimension(:) :: sndbuf, rcvbuf
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
interface psi_gth
@ -203,8 +203,8 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& mpi_integer,sndbuf,sdsz,&
& bsdidx,mpi_integer,icomm,iret)
& mpi_double_precision,sndbuf,sdsz,&
& bsdidx,mpi_double_precision,icomm,iret)
if(iret.ne.mpi_success) then
int_err(1) = iret
info=400
@ -241,20 +241,20 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call igesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I receive
snd_pt = brvidx(proc_to_comm)
call igerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
snd_pt = bsdidx(proc_to_comm)
call igerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call igesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+psb_elem_recv_
@ -302,7 +302,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
snd_pt = brvidx(proc_to_comm)
call mpi_irecv(sndbuf(rcv_pt),sdsz(proc_to_comm),&
& mpi_integer,prcid(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),&
& p2ptag, icomm,rvhd(proc_to_comm),iret)
if(iret.ne.mpi_success) then
int_err(1) = iret
@ -331,7 +331,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
call mpi_send(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_integer,prcid(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
if(iret.ne.mpi_success) then
int_err(1) = iret
@ -436,7 +436,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call igesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -452,7 +452,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
snd_pt = bsdidx(proc_to_comm)
call igerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
idx_pt = point_to_proc+nerv+psb_elem_send_
call psi_sct(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& sndbuf(snd_pt:snd_pt+n*nesd-1),beta,y)
@ -535,8 +535,8 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer, intent(in) :: flag
integer, intent(out) :: info
integer :: y(:), beta
integer, target :: work(:)
real(kind(1.d0)) :: y(:), beta
real(kind(1.d0)), target :: work(:)
type(psb_desc_type) :: desc_a
integer, optional :: data
@ -553,7 +553,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: int_err(5)
integer :: blacs_pnum, krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
integer, pointer, dimension(:) :: sndbuf, rcvbuf
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
interface psi_gth
@ -701,8 +701,8 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& mpi_integer,sndbuf,sdsz,&
& bsdidx,mpi_integer,icomm,iret)
& mpi_double_precision,sndbuf,sdsz,&
& bsdidx,mpi_double_precision,icomm,iret)
if(iret.ne.mpi_success) then
int_err(1) = iret
info=400
@ -739,20 +739,20 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call igesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I receive
snd_pt = brvidx(proc_to_comm)
call igerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
snd_pt = bsdidx(proc_to_comm)
call igerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call igesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+psb_elem_recv_
@ -800,7 +800,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
snd_pt = brvidx(proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),sdsz(proc_to_comm),&
& mpi_integer,prcid(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),&
& p2ptag, icomm,rvhd(proc_to_comm),iret)
if(iret.ne.mpi_success) then
int_err(1) = iret
@ -829,7 +829,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
call mpi_send(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_integer,prcid(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
if(iret.ne.mpi_success) then
int_err(1) = iret
@ -934,7 +934,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call igesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -950,7 +950,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
snd_pt = bsdidx(proc_to_comm)
call igerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_sct(nesd,d_idx(idx_pt:idx_pt+nesd-1),&

Write Preview
Loading…
Cancel
Save