diff --git a/base/internals/psi_dswapdata.f90 b/base/internals/psi_dswapdata.f90 index 9af8113e..b11a2a55 100644 --- a/base/internals/psi_dswapdata.f90 +++ b/base/internals/psi_dswapdata.f90 @@ -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) - 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 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 diff --git a/base/internals/psi_dswaptran.f90 b/base/internals/psi_dswaptran.f90 index a665075c..c2d2e47e 100644 --- a/base/internals/psi_dswaptran.f90 +++ b/base/internals/psi_dswaptran.f90 @@ -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(iret /= mpi_success) then - int_err(1) = iret - info=400 - call psb_errpush(info,name,i_err=int_err) - goto 9999 + 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 + 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 diff --git a/base/internals/psi_iswapdata.f90 b/base/internals/psi_iswapdata.f90 index 34a9e69e..de2898c3 100644 --- a/base/internals/psi_iswapdata.f90 +++ b/base/internals/psi_iswapdata.f90 @@ -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) - 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 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 diff --git a/base/internals/psi_iswaptran.f90 b/base/internals/psi_iswaptran.f90 index 43a80f1f..45390765 100644 --- a/base/internals/psi_iswaptran.f90 +++ b/base/internals/psi_iswaptran.f90 @@ -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 diff --git a/base/internals/psi_zswapdata.f90 b/base/internals/psi_zswapdata.f90 index 421b3de5..c14713a2 100644 --- a/base/internals/psi_zswapdata.f90 +++ b/base/internals/psi_zswapdata.f90 @@ -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 diff --git a/base/internals/psi_zswaptran.f90 b/base/internals/psi_zswaptran.f90 index 2d93de38..6faf503d 100644 --- a/base/internals/psi_zswaptran.f90 +++ b/base/internals/psi_zswaptran.f90 @@ -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(iret /= mpi_success) then - int_err(1) = iret - info=400 - call psb_errpush(info,name,i_err=int_err) - goto 9999 + 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 + 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)