*** empty log message ***

psblas-3.3.1-1
Salvatore Filippone 11 years ago
parent 3dde8d9335
commit 107fe97402

@ -376,7 +376,13 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
call psb_get_rank(rootrank,ictxt,root) call psb_get_rank(rootrank,ictxt,root)
! root has to gather size information ! root has to gather size information
allocate(displ(np),all_dim(np),ltg(nrow)) allocate(displ(np),all_dim(np),ltg(nrow),stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
do i=1, nrow do i=1, nrow
ltg(i) = i ltg(i) = i
end do end do
@ -397,9 +403,17 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
endif endif
! root has to gather loc_glob from each process ! root has to gather loc_glob from each process
allocate(l_t_g_all(sum(all_dim)),scatterv(sum(all_dim))) allocate(l_t_g_all(sum(all_dim)),scatterv(sum(all_dim)),stat=info)
else
allocate(l_t_g_all(1),scatterv(1),stat=info)
end if
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_integer,l_t_g_all,all_dim,& & psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_integer,rootrank,icomm,info) & displ,psb_mpi_ipk_integer,rootrank,icomm,info)
@ -420,7 +434,14 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
& psb_mpi_r_dpk_,locx,nrow,& & psb_mpi_r_dpk_,locx,nrow,&
& psb_mpi_r_dpk_,rootrank,icomm,info) & psb_mpi_r_dpk_,rootrank,icomm,info)
if (me == root) deallocate(all_dim, l_t_g_all, displ, scatterv) deallocate(all_dim, l_t_g_all, displ, scatterv,stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
end if end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

Loading…
Cancel
Save