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

Update for new get_rank

Browse Source
This commit is contained in:
Salvatore Filippone
2019-11-20 14:52:54 +00:00
parent 122c154bca
commit cf3fce32c3
2 changed files with 8 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/internals/psi_adjcncy_fnd_owner.F90
+4 -4
View File
@@ -152,7 +152,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
do i = 0, np-1
if (rvsz(i)>0) then
! write(0,*) me, ' First receive from ',i,rvsz(i)
call psb_get_rank(prc,ictxt,i)
prc = psb_get_rank(ictxt,i)
p2ptag = psb_long_swap_tag
!write(0,*) me, ' Posting first receive from ',i,rvsz(i),prc
call mpi_irecv(rmtidx(hidx(i)+1),rvsz(i),&
@@ -163,7 +163,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
do j=1, nadj
if (nidx > 0) then
!call psb_snd(ictxt,idx(1:nidx),adj(j))
call psb_get_rank(prc,ictxt,adj(j))
prc = psb_get_rank(ictxt,adj(j))
p2ptag = psb_long_swap_tag
!write(0,*) me, ' First send to ',adj(j),nidx, prc
call mpi_send(idx,nidx,&
@@ -195,7 +195,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
!write(0,*) me, ' First send to ',adj(j),nidx
if (nidx > 0) then
!call psb_snd(ictxt,idx(1:nidx),adj(j))
call psb_get_rank(prc,ictxt,adj(j))
prc = psb_get_rank(ictxt,adj(j))
p2ptag = psb_int_swap_tag
!write(0,*) me, ' Posting second receive from ',adj(j),nidx, prc
call mpi_irecv(lclidx((j-1)*nidx+1),nidx, &
@@ -210,7 +210,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
do i = 0, np-1
if (rvsz(i)>0) then
!call psb_snd(ictxt,tproc(hidx(i)+1:hidx(i)+rvsz(i)),i)
call psb_get_rank(prc,ictxt,i)
prc = psb_get_rank(ictxt,i)
p2ptag = psb_int_swap_tag
!write(0,*) me, ' Second send to ',i,rvsz(i), prc
call mpi_send(tproc(hidx(i)+1),rvsz(i),&
base/internals/psi_extrct_dl.F90
+4 -11
View File
@@ -145,7 +145,7 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
integer(psb_ipk_) :: i,pointer_dep_list,proc,j,err_act
integer(psb_ipk_) :: err
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_mpk_) :: iictxt, icomm, me, np, minfo
integer(psb_mpk_) :: iictxt, icomm, me, np, dl_mpi, minfo
character name*20
name='psi_extrct_dl'
@@ -266,16 +266,9 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
end if
call psb_sum(iictxt,length_dl(0:np))
icomm = psb_get_mpicomm(iictxt)
allocate(itmp(dl_lda),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
goto 9999
endif
itmp(1:dl_lda) = dep_list(1:dl_lda,me)
dl_mpi = dl_lda
call mpi_allgather(itmp,dl_mpi,psb_mpi_ipk_,&
& dep_list,dl_mpi,psb_mpi_ipk_,icomm,minfo)
icomm = psb_get_mpicomm(iictxt)
call mpi_allgather(itmp,dl_lda,psb_mpi_ipk_,&
& dep_list,dl_lda,psb_mpi_ipk_,icomm,minfo)
info = minfo
if (info == 0) deallocate(itmp,stat=info)
if (info /= psb_success_) then