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

Fixed INTEGER vs. DOUBLE PRECISION

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent f8e0e297cc
commit 29a42262dd
1 changed files with 30 additions and 30 deletions
Show Stats Download Patch File Download Diff File

60
src/internals/psi_iswaptran.f90
Unescape Escape View File

@ -1,4 +1,4 @@
subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod use psb_error_mod
use psb_descriptor_type use psb_descriptor_type
@ -7,8 +7,8 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, intent(in) :: flag, n integer, intent(in) :: flag, n
integer, intent(out) :: info integer, intent(out) :: info
real(kind(1.d0)) :: y(:,:), beta integer :: y(:,:), beta
real(kind(1.d0)), target :: work(:) integer, target :: work(:)
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer, optional :: data integer, optional :: data
@ -25,7 +25,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: int_err(5) integer :: int_err(5)
integer :: blacs_pnum, krecvid, ksendid integer :: blacs_pnum, krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv logical :: swap_mpi, swap_sync, swap_send, swap_recv
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
interface psi_gth interface psi_gth
@ -171,8 +171,8 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& mpi_double_precision,sndbuf,sdsz,& & mpi_integer,sndbuf,sdsz,&
& bsdidx,mpi_double_precision,icomm,iret) & bsdidx,mpi_integer,icomm,iret)
if(iret.ne.mpi_success) then if(iret.ne.mpi_success) then
int_err(1) = iret int_err(1) = iret
info=400 info=400
@ -209,20 +209,20 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm) rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),& call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1)) & y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call dgesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0) call igesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I receive ! Then I receive
snd_pt = brvidx(proc_to_comm) snd_pt = brvidx(proc_to_comm)
call dgerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0) call igerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then else if (proc_to_comm .gt. myrow) then
! First I receive ! First I receive
snd_pt = bsdidx(proc_to_comm) snd_pt = bsdidx(proc_to_comm)
call dgerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0) call igerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I send ! Then I send
idx_pt = point_to_proc+psb_elem_recv_ idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm) rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),& call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1)) & y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call dgesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0) call igesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then else if (proc_to_comm .eq. myrow) then
! I send to myself ! I send to myself
idx_pt = point_to_proc+psb_elem_recv_ idx_pt = point_to_proc+psb_elem_recv_
@ -270,7 +270,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
p2ptag = krecvid(icontxt,proc_to_comm,myrow) p2ptag = krecvid(icontxt,proc_to_comm,myrow)
snd_pt = brvidx(proc_to_comm) snd_pt = brvidx(proc_to_comm)
call mpi_irecv(sndbuf(rcv_pt),sdsz(proc_to_comm),& call mpi_irecv(sndbuf(rcv_pt),sdsz(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),& & mpi_integer,prcid(proc_to_comm),&
& p2ptag, icomm,rvhd(proc_to_comm),iret) & p2ptag, icomm,rvhd(proc_to_comm),iret)
if(iret.ne.mpi_success) then if(iret.ne.mpi_success) then
int_err(1) = iret int_err(1) = iret
@ -299,7 +299,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
if(proc_to_comm .ne. myrow) then if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow) p2ptag=ksendid(icontxt,proc_to_comm,myrow)
call mpi_send(rcvbuf(rcv_pt),rvsz(proc_to_comm),& call mpi_send(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),& & mpi_integer,prcid(proc_to_comm),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
if(iret.ne.mpi_success) then if(iret.ne.mpi_success) then
int_err(1) = iret int_err(1) = iret
@ -404,7 +404,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm) rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),& call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1)) & y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call dgesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0) call igesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3 point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_) proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -420,7 +420,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then if(proc_to_comm.ne.myrow) then
snd_pt = bsdidx(proc_to_comm) snd_pt = bsdidx(proc_to_comm)
call dgerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0) call igerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
idx_pt = point_to_proc+nerv+psb_elem_send_ idx_pt = point_to_proc+nerv+psb_elem_send_
call psi_sct(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),& call psi_sct(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& sndbuf(snd_pt:snd_pt+n*nesd-1),beta,y) & sndbuf(snd_pt:snd_pt+n*nesd-1),beta,y)
@ -447,7 +447,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
return return
end if end if
return return
end subroutine psi_dswaptranm end subroutine psi_iswaptranm
@ -455,7 +455,7 @@ end subroutine psi_dswaptranm
subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
use psb_error_mod use psb_error_mod
use psb_descriptor_type use psb_descriptor_type
@ -464,8 +464,8 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer, intent(in) :: flag integer, intent(in) :: flag
integer, intent(out) :: info integer, intent(out) :: info
real(kind(1.d0)) :: y(:), beta integer :: y(:), beta
real(kind(1.d0)), target :: work(:) integer, target :: work(:)
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer, optional :: data integer, optional :: data
@ -482,7 +482,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: int_err(5) integer :: int_err(5)
integer :: blacs_pnum, krecvid, ksendid integer :: blacs_pnum, krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv logical :: swap_mpi, swap_sync, swap_send, swap_recv
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
interface psi_gth interface psi_gth
@ -628,8 +628,8 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& mpi_double_precision,sndbuf,sdsz,& & mpi_integer,sndbuf,sdsz,&
& bsdidx,mpi_double_precision,icomm,iret) & bsdidx,mpi_integer,icomm,iret)
if(iret.ne.mpi_success) then if(iret.ne.mpi_success) then
int_err(1) = iret int_err(1) = iret
info=400 info=400
@ -666,20 +666,20 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm) rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),& call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1)) & y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call dgesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0) call igesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I receive ! Then I receive
snd_pt = brvidx(proc_to_comm) snd_pt = brvidx(proc_to_comm)
call dgerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0) call igerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then else if (proc_to_comm .gt. myrow) then
! First I receive ! First I receive
snd_pt = bsdidx(proc_to_comm) snd_pt = bsdidx(proc_to_comm)
call dgerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0) call igerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I send ! Then I send
idx_pt = point_to_proc+psb_elem_recv_ idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm) rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),& call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1)) & y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call dgesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0) call igesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then else if (proc_to_comm .eq. myrow) then
! I send to myself ! I send to myself
idx_pt = point_to_proc+psb_elem_recv_ idx_pt = point_to_proc+psb_elem_recv_
@ -727,7 +727,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
p2ptag = krecvid(icontxt,proc_to_comm,myrow) p2ptag = krecvid(icontxt,proc_to_comm,myrow)
snd_pt = brvidx(proc_to_comm) snd_pt = brvidx(proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),sdsz(proc_to_comm),& call mpi_irecv(sndbuf(snd_pt),sdsz(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),& & mpi_integer,prcid(proc_to_comm),&
& p2ptag, icomm,rvhd(proc_to_comm),iret) & p2ptag, icomm,rvhd(proc_to_comm),iret)
if(iret.ne.mpi_success) then if(iret.ne.mpi_success) then
int_err(1) = iret int_err(1) = iret
@ -756,7 +756,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
if(proc_to_comm .ne. myrow) then if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow) p2ptag=ksendid(icontxt,proc_to_comm,myrow)
call mpi_send(rcvbuf(rcv_pt),rvsz(proc_to_comm),& call mpi_send(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),& & mpi_integer,prcid(proc_to_comm),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
if(iret.ne.mpi_success) then if(iret.ne.mpi_success) then
int_err(1) = iret int_err(1) = iret
@ -861,7 +861,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm) rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),& call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1)) & y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call dgesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0) call igesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3 point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_) proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -877,7 +877,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then if(proc_to_comm.ne.myrow) then
snd_pt = bsdidx(proc_to_comm) snd_pt = bsdidx(proc_to_comm)
call dgerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0) call igerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
idx_pt = point_to_proc+psb_elem_recv_ idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm) rcv_pt = brvidx(proc_to_comm)
call psi_sct(nesd,d_idx(idx_pt:idx_pt+nesd-1),& call psi_sct(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
@ -905,4 +905,4 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
return return
end if end if
return return
end subroutine psi_dswaptranv end subroutine psi_iswaptranv

Write Preview
Loading…
Cancel
Save