fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-19 20:32:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fixed to avoid calls when number of elements to be sent/received is 0;

Browse Source 
this may happen with unsymmetric patterns.
This commit is contained in:
Salvatore Filippone
2007-03-02 11:51:36 +00:00
parent 2f0cfece0e
commit 2968c06cfb
6 changed files with 479 additions and 350 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/internals/psi_dswapdata.f90
+78 -60
View File
@@ -165,7 +165,8 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
end if
end if
idxr = max(idxr,1)
idxs = max(idxs,1)
if((idxr+idxs) < size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
@@ -224,11 +225,15 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm > me) then
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
end if
rcv_pt = rcv_pt + n*nerv
@@ -249,13 +254,13 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
if (nerv>0) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -275,24 +280,24 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (nesd>0) then
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),n*nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,iret)
end if
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),n*nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,iret)
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -308,8 +313,8 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
int_err(1) = iret
@@ -332,8 +337,9 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -350,7 +356,8 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -581,7 +588,8 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
end if
idxr = max(idxr,1)
idxs = max(idxs,1)
if((idxr+idxs) < size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
@@ -638,11 +646,15 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm > me) then
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
@@ -661,11 +673,13 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
if (nerv>0) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -685,21 +699,23 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,iret)
end if
if (nesd>0) then
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,iret)
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
@@ -715,7 +731,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
int_err(1) = iret
@@ -737,7 +753,8 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -752,7 +769,8 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
base/internals/psi_dswaptran.f90
+78 -55
View File
@@ -161,6 +161,8 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
end if
idxr = max(idxr,1)
idxs = max(idxs,1)
if((idxr+idxs) < size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
@@ -223,11 +225,15 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm > me) then
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
@@ -246,11 +252,13 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
if (nesd>0) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -267,23 +275,25 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_precision,prcid(i),&
if (nerv>0) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,iret)
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
@@ -300,7 +310,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
int_err(1) = iret
@@ -322,7 +332,8 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -338,7 +349,8 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -564,6 +576,8 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
idxr = max(idxr,1)
idxs = max(idxs,1)
if((idxr+idxs) < size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
@@ -625,11 +639,15 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm > me) then
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
@@ -648,12 +666,13 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
if (nesd>0) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -670,23 +689,25 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag, icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag, icomm,iret)
end if
if (nerv>0) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag, icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag, icomm,iret)
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
@@ -702,7 +723,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
int_err(1) = iret
@@ -724,7 +745,8 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -740,7 +762,8 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
base/internals/psi_iswapdata.f90
+81 -63
View File
@@ -150,7 +150,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
bsdidx(proc_to_comm) = snd_pt
sdsz(proc_to_comm) = n*nesd
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -165,7 +165,8 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
end if
end if
idxr = max(idxr,1)
idxs = max(idxs,1)
if((idxr+idxs) < size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
@@ -222,15 +223,19 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm > me) then
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -241,7 +246,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
else if (swap_send .and. swap_recv) then
! First I post all the non blocking receives
pnti = 1
snd_pt = 1
rcv_pt = 1
@@ -249,13 +254,13 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_integer,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
if (nerv>0) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_integer,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -275,24 +280,24 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (nesd>0) then
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),n*nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,iret)
end if
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),n*nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,iret)
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -309,7 +314,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
int_err(1) = iret
@@ -332,7 +337,8 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
@@ -350,7 +356,8 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -581,7 +588,8 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
end if
idxr = max(idxr,1)
idxs = max(idxs,1)
if((idxr+idxs) < size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
@@ -638,11 +646,15 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm > me) then
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
@@ -661,11 +673,13 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_integer,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
if (nerv>0) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_integer,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -685,21 +699,23 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,iret)
end if
if (nesd>0) then
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,iret)
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
@@ -714,8 +730,8 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
int_err(1) = iret
@@ -737,7 +753,8 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -752,7 +769,8 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
base/internals/psi_iswaptran.f90
+80 -58
View File
@@ -161,6 +161,8 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
end if
idxr = max(idxr,1)
idxs = max(idxs,1)
if((idxr+idxs) < size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
@@ -223,11 +225,15 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm > me) then
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
@@ -246,11 +252,13 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
if (nesd>0) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -267,23 +275,25 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),n*nerv,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,iret)
end if
if (nerv>0) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),n*nerv,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,iret)
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
@@ -300,7 +310,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
int_err(1) = iret
@@ -322,7 +332,8 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -338,7 +349,8 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -346,9 +358,8 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
end if
if (do_recv) then
pnti = 1
snd_pt = 1
rcv_pt = 1
@@ -564,6 +575,8 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
idxr = max(idxr,1)
idxs = max(idxs,1)
if((idxr+idxs) < size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
@@ -625,11 +638,15 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm > me) then
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
@@ -648,12 +665,13 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
if (nesd>0) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -670,23 +688,25 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_integer,prcid(i),&
& p2ptag, icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_integer,prcid(i),&
& p2ptag, icomm,iret)
end if
if (nerv>0) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_integer,prcid(i),&
& p2ptag, icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_integer,prcid(i),&
& p2ptag, icomm,iret)
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
@@ -701,8 +721,8 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
int_err(1) = iret
@@ -724,7 +744,8 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -740,7 +761,8 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
base/internals/psi_zswapdata.f90
+74 -58
View File
@@ -225,11 +225,15 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm > me) then
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
end if
rcv_pt = rcv_pt + n*nerv
@@ -250,13 +254,13 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
if (nerv > 0) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
endif
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -276,24 +280,24 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),n*nesd,&
& mpi_double_complex,prcid(i),&
if (nesd>0) then
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),n*nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,iret)
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -310,7 +314,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
int_err(1) = iret
@@ -333,7 +337,8 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
@@ -351,7 +356,8 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -450,7 +456,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
use psi_gthsct_mod
use mpi
implicit none
integer, intent(in) :: flag
integer, intent(out) :: info
complex(kind(1.d0)) :: y(:), beta
@@ -581,7 +587,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
end if
end if
idxr = max(idxr,1)
idxs = max(idxs,1)
if((idxr+idxs) < size(work)) then
@@ -640,11 +646,15 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm > me) then
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
@@ -663,11 +673,13 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
if (nerv>0) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
endif
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -687,21 +699,23 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,iret)
end if
if (nesd>0) then
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,iret)
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
@@ -717,7 +731,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
int_err(1) = iret
@@ -739,7 +753,8 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -754,7 +769,8 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
base/internals/psi_zswaptran.f90
+88 -56
View File
@@ -161,6 +161,8 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
end if
idxr = max(idxr,1)
idxs = max(idxs,1)
if((idxr+idxs) < size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
@@ -223,11 +225,15 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm > me) then
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
@@ -246,11 +252,16 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
if (nesd>0) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
end do
@@ -264,23 +275,25 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,iret)
end if
if (nerv>0) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,iret)
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
@@ -297,7 +310,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
int_err(1) = iret
@@ -309,7 +322,9 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
pnti = pnti + nerv + nesd + 3
end do
else if (swap_send) then
pnti = 1
snd_pt = 1
rcv_pt = 1
@@ -317,10 +332,12 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
end do
else if (swap_recv) then
@@ -332,7 +349,8 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -340,7 +358,6 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
end if
if (do_recv) then
pnti = 1
@@ -558,6 +575,8 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
idxr = max(idxr,1)
idxs = max(idxs,1)
if((idxr+idxs) < size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
@@ -619,11 +638,15 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm > me) then
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
@@ -642,12 +665,13 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
if (nesd>0) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -664,23 +688,25 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag, icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag, icomm,iret)
end if
if (nerv>0) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag, icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag, icomm,iret)
end if
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
if(iret /= mpi_success) then
int_err(1) = iret
info=400
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
end if
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
@@ -696,7 +722,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
int_err(1) = iret
@@ -718,7 +744,8 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -734,7 +761,8 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_rcv(ictxt,sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd
pnti = pnti + nerv + nesd + 3
@@ -770,6 +798,10 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
else
deallocate(rvhd,prcid,stat=info)
end if
if(info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
if(albf) deallocate(sndbuf,rcvbuf,stat=info)
if(info /= 0) then
call psb_errpush(4000,name)