Update for new get_rank

fnd_owner
Salvatore Filippone 5 years ago
parent 122c154bca
commit cf3fce32c3

@ -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),&

@ -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'
@ -267,15 +267,8 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
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)
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

Loading…
Cancel
Save