From 107fe97402eb845b3b3eab0712f7c054e00ed818 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 30 Jun 2014 12:23:02 +0000 Subject: [PATCH] *** empty log message *** --- base/comm/psb_dscatter.F90 | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/base/comm/psb_dscatter.F90 b/base/comm/psb_dscatter.F90 index 6a19999d..f7c17fe6 100644 --- a/base/comm/psb_dscatter.F90 +++ b/base/comm/psb_dscatter.F90 @@ -376,7 +376,13 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot) call psb_get_rank(rootrank,ictxt,root) ! 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 ltg(i) = i end do @@ -397,9 +403,17 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot) endif ! 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 + call mpi_gatherv(ltg,nrow,& & psb_mpi_ipk_integer,l_t_g_all,all_dim,& & displ,psb_mpi_ipk_integer,rootrank,icomm,info) @@ -419,8 +433,15 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot) call mpi_scatterv(scatterv,all_dim,displ,& & psb_mpi_r_dpk_,locx,nrow,& & psb_mpi_r_dpk_,rootrank,icomm,info) + + 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 + - if (me == root) deallocate(all_dim, l_t_g_all, displ, scatterv) end if call psb_erractionrestore(err_act)