fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas-3.99:

Browse Source 
base/modules/psb_desc_mod.f90
 base/modules/psb_i_base_vect_mod.f90
 base/modules/psb_i_vect_mod.F90
 base/tools/psb_ccdbldext.F90
 base/tools/psb_dcdbldext.F90
 base/tools/psb_scdbldext.F90
 base/tools/psb_zcdbldext.F90

Fixed bug in desc%clone()
Rewritten bldext to access V_ components of desc_a
psblas-3.2.0
Salvatore Filippone 11 years ago
parent 39c50529eb
commit 65b76f6b70
7 changed files with 97 additions and 76 deletions
Show Stats Download Patch File Download Diff File

13
base/modules/psb_desc_mod.f90
Unescape Escape View File

@ -204,15 +204,16 @@ module psb_desc_mod
integer(psb_ipk_), allocatable :: halo_index(:) integer(psb_ipk_), allocatable :: halo_index(:)
integer(psb_ipk_), allocatable :: ext_index(:) integer(psb_ipk_), allocatable :: ext_index(:)
integer(psb_ipk_), allocatable :: ovrlap_index(:) integer(psb_ipk_), allocatable :: ovrlap_index(:)
integer(psb_ipk_), allocatable :: ovrlap_elem(:,:)
integer(psb_ipk_), allocatable :: ovr_mst_idx(:) integer(psb_ipk_), allocatable :: ovr_mst_idx(:)
integer(psb_ipk_), allocatable :: bnd_elem(:)
type(psb_i_vect_type) :: v_halo_index type(psb_i_vect_type) :: v_halo_index
type(psb_i_vect_type) :: v_ext_index type(psb_i_vect_type) :: v_ext_index
type(psb_i_vect_type) :: v_ovrlap_index type(psb_i_vect_type) :: v_ovrlap_index
type(psb_i_vect_type) :: v_ovr_mst_idx type(psb_i_vect_type) :: v_ovr_mst_idx
integer(psb_ipk_), allocatable :: ovrlap_elem(:,:)
integer(psb_ipk_), allocatable :: bnd_elem(:)
class(psb_indx_map), allocatable :: indxmap class(psb_indx_map), allocatable :: indxmap
integer(psb_ipk_), allocatable :: lprm(:) integer(psb_ipk_), allocatable :: lprm(:)
type(psb_desc_type), pointer :: base_desc => null() type(psb_desc_type), pointer :: base_desc => null()
@ -1053,13 +1054,13 @@ contains
if ((info == psb_success_).and.(allocated(desc%indxmap))) & if ((info == psb_success_).and.(allocated(desc%indxmap))) &
& call desc%indxmap%clone(desc_out%indxmap,info) & call desc%indxmap%clone(desc_out%indxmap,info)
if (info == psb_success_) & if (info == psb_success_) &
& call desc%v_halo_index%clone(desc%v_halo_index,info) & call desc%v_halo_index%clone(desc_out%v_halo_index,info)
if (info == psb_success_) & if (info == psb_success_) &
& call desc%v_ext_index%clone(desc%v_ext_index,info) & call desc%v_ext_index%clone(desc_out%v_ext_index,info)
if (info == psb_success_) & if (info == psb_success_) &
& call desc%v_ovrlap_index%clone(desc%v_ovrlap_index,info) & call desc%v_ovrlap_index%clone(desc_out%v_ovrlap_index,info)
if (info == psb_success_) & if (info == psb_success_) &
& call desc%v_ovr_mst_idx%clone(desc%v_ovr_mst_idx,info) & call desc%v_ovr_mst_idx%clone(desc_out%v_ovr_mst_idx,info)
else else
call desc_out%free(info) call desc_out%free(info)
end if end if

2
base/modules/psb_i_base_vect_mod.f90
Unescape Escape View File

@ -574,7 +574,7 @@ contains
! !
function i_base_get_vect(x) result(res) function i_base_get_vect(x) result(res)
class(psb_i_base_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), allocatable :: res(:) integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
if (.not.allocated(x%v)) return if (.not.allocated(x%v)) return

2
base/modules/psb_i_vect_mod.F90
Unescape Escape View File

@ -151,7 +151,7 @@ contains
function i_vect_get_vect(x) result(res) function i_vect_get_vect(x) result(res)
class(psb_i_vect_type), intent(inout) :: x class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), allocatable :: res(:) integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
if (allocated(x%v)) then if (allocated(x%v)) then

39
base/tools/psb_ccdbldext.F90
Unescape Escape View File

@ -90,11 +90,11 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
integer(psb_mpik_) :: icomm, ictxt, me, np, minfo integer(psb_mpik_) :: icomm, ictxt, me, np, minfo
integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
integer(psb_ipk_),allocatable :: halo(:),works(:),workr(:),t_halo_in(:),& integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),works(:),workr(:),&
& t_halo_out(:),temp(:),maskr(:) & t_halo_in(:), t_halo_out(:),temp(:),maskr(:)
integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:) integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -203,11 +203,11 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
If (debug_level >= psb_debug_outer_)& If (debug_level >= psb_debug_outer_)&
& Write(debug_unit,*) me,' ',trim(name),':ovr_est done',novr,lovr & Write(debug_unit,*) me,' ',trim(name),':ovr_est done',novr,lovr
index_dim = size(desc_a%halo_index) index_dim = max(desc_a%v_halo_index%get_nrows(),1_psb_ipk_)
elem_dim = size(desc_a%halo_index) elem_dim = index_dim
l_tmp_ovr_idx = novr*(3*Max(2*index_dim,1)+1) l_tmp_ovr_idx = novr*(3*Max(2*index_dim,1)+1)
l_tmp_halo = novr*(3*Size(desc_a%halo_index)) l_tmp_halo = novr*(3*index_dim)
desc_ov%base_desc => desc_a desc_ov%base_desc => desc_a
@ -228,13 +228,18 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
& t_halo_out(l_tmp_halo), temp(lworkr),stat=info) & t_halo_out(l_tmp_halo), temp(lworkr),stat=info)
if (info == psb_success_) allocate(orig_ovr(l_tmp_ovr_idx),& if (info == psb_success_) allocate(orig_ovr(l_tmp_ovr_idx),&
& tmp_ovr_idx(l_tmp_ovr_idx), & & tmp_ovr_idx(l_tmp_ovr_idx), &
& tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info) & tmp_halo(l_tmp_halo),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999 goto 9999
end if end if
halo(:) = desc_a%halo_index(:)
halo = desc_a%v_halo_index%get_vect()
if (.not.allocated(halo)) halo = (/ -ione /)
ovrlap = desc_a%v_ovrlap_index%get_vect()
if (.not.allocated(ovrlap)) ovrlap = (/ -ione /)
tmp_ovr_idx(:) = -1 tmp_ovr_idx(:) = -1
orig_ovr(:) = -1 orig_ovr(:) = -1
tmp_halo(:) = -1 tmp_halo(:) = -1
@ -246,14 +251,14 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
cntov_o = 1 cntov_o = 1
! Init overlap with desc_a%ovrlap (if any) ! Init overlap with desc_a%ovrlap (if any)
counter = 1 counter = 1
Do While (desc_a%ovrlap_index(counter) /= -1) Do While (ovrlap(counter) /= -1)
proc = desc_a%ovrlap_index(counter+psb_proc_id_) proc = ovrlap(counter+psb_proc_id_)
n_elem_recv = desc_a%ovrlap_index(counter+psb_n_elem_recv_) n_elem_recv = ovrlap(counter+psb_n_elem_recv_)
n_elem_send = desc_a%ovrlap_index(counter+n_elem_recv+psb_n_elem_send_) n_elem_send = ovrlap(counter+n_elem_recv+psb_n_elem_send_)
Do j=0,n_elem_recv-1 Do j=0,n_elem_recv-1
idx = desc_a%ovrlap_index(counter+psb_elem_recv_+j) idx = ovrlap(counter+psb_elem_recv_+j)
call desc_ov%indxmap%l2g(idx,gidx,info) call desc_ov%indxmap%l2g(idx,gidx,info)
If (gidx < 0) then If (gidx < 0) then
info=-3 info=-3
@ -467,7 +472,8 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
! accumulated RECV requests, we have an all-to-all to build ! accumulated RECV requests, we have an all-to-all to build
! matchings SENDs. ! matchings SENDs.
! !
call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1,psb_mpi_def_integer,icomm,minfo) call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1, &
& psb_mpi_def_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall') call psb_errpush(info,name,a_err='mpi_alltoall')
@ -611,7 +617,6 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
End If End If
End Do End Do
select case(extype_) select case(extype_)
case(psb_ovt_xhal_) case(psb_ovt_xhal_)
! !

39
base/tools/psb_dcdbldext.F90
Unescape Escape View File

@ -90,11 +90,11 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
integer(psb_mpik_) :: icomm, ictxt, me, np, minfo integer(psb_mpik_) :: icomm, ictxt, me, np, minfo
integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
integer(psb_ipk_),allocatable :: halo(:),works(:),workr(:),t_halo_in(:),& integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),works(:),workr(:),&
& t_halo_out(:),temp(:),maskr(:) & t_halo_in(:), t_halo_out(:),temp(:),maskr(:)
integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:) integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -203,11 +203,11 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
If (debug_level >= psb_debug_outer_)& If (debug_level >= psb_debug_outer_)&
& Write(debug_unit,*) me,' ',trim(name),':ovr_est done',novr,lovr & Write(debug_unit,*) me,' ',trim(name),':ovr_est done',novr,lovr
index_dim = size(desc_a%halo_index) index_dim = max(desc_a%v_halo_index%get_nrows(),1_psb_ipk_)
elem_dim = size(desc_a%halo_index) elem_dim = index_dim
l_tmp_ovr_idx = novr*(3*Max(2*index_dim,1)+1) l_tmp_ovr_idx = novr*(3*Max(2*index_dim,1)+1)
l_tmp_halo = novr*(3*Size(desc_a%halo_index)) l_tmp_halo = novr*(3*index_dim)
desc_ov%base_desc => desc_a desc_ov%base_desc => desc_a
@ -228,13 +228,18 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
& t_halo_out(l_tmp_halo), temp(lworkr),stat=info) & t_halo_out(l_tmp_halo), temp(lworkr),stat=info)
if (info == psb_success_) allocate(orig_ovr(l_tmp_ovr_idx),& if (info == psb_success_) allocate(orig_ovr(l_tmp_ovr_idx),&
& tmp_ovr_idx(l_tmp_ovr_idx), & & tmp_ovr_idx(l_tmp_ovr_idx), &
& tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info) & tmp_halo(l_tmp_halo),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999 goto 9999
end if end if
halo(:) = desc_a%halo_index(:)
halo = desc_a%v_halo_index%get_vect()
if (.not.allocated(halo)) halo = (/ -ione /)
ovrlap = desc_a%v_ovrlap_index%get_vect()
if (.not.allocated(ovrlap)) ovrlap = (/ -ione /)
tmp_ovr_idx(:) = -1 tmp_ovr_idx(:) = -1
orig_ovr(:) = -1 orig_ovr(:) = -1
tmp_halo(:) = -1 tmp_halo(:) = -1
@ -246,14 +251,14 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
cntov_o = 1 cntov_o = 1
! Init overlap with desc_a%ovrlap (if any) ! Init overlap with desc_a%ovrlap (if any)
counter = 1 counter = 1
Do While (desc_a%ovrlap_index(counter) /= -1) Do While (ovrlap(counter) /= -1)
proc = desc_a%ovrlap_index(counter+psb_proc_id_) proc = ovrlap(counter+psb_proc_id_)
n_elem_recv = desc_a%ovrlap_index(counter+psb_n_elem_recv_) n_elem_recv = ovrlap(counter+psb_n_elem_recv_)
n_elem_send = desc_a%ovrlap_index(counter+n_elem_recv+psb_n_elem_send_) n_elem_send = ovrlap(counter+n_elem_recv+psb_n_elem_send_)
Do j=0,n_elem_recv-1 Do j=0,n_elem_recv-1
idx = desc_a%ovrlap_index(counter+psb_elem_recv_+j) idx = ovrlap(counter+psb_elem_recv_+j)
call desc_ov%indxmap%l2g(idx,gidx,info) call desc_ov%indxmap%l2g(idx,gidx,info)
If (gidx < 0) then If (gidx < 0) then
info=-3 info=-3
@ -467,7 +472,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
! accumulated RECV requests, we have an all-to-all to build ! accumulated RECV requests, we have an all-to-all to build
! matchings SENDs. ! matchings SENDs.
! !
call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1,psb_mpi_def_integer,icomm,minfo) call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1, &
& psb_mpi_def_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall') call psb_errpush(info,name,a_err='mpi_alltoall')
@ -611,7 +617,6 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
End If End If
End Do End Do
select case(extype_) select case(extype_)
case(psb_ovt_xhal_) case(psb_ovt_xhal_)
! !

39
base/tools/psb_scdbldext.F90
Unescape Escape View File

@ -90,11 +90,11 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
integer(psb_mpik_) :: icomm, ictxt, me, np, minfo integer(psb_mpik_) :: icomm, ictxt, me, np, minfo
integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
integer(psb_ipk_),allocatable :: halo(:),works(:),workr(:),t_halo_in(:),& integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),works(:),workr(:),&
& t_halo_out(:),temp(:),maskr(:) & t_halo_in(:), t_halo_out(:),temp(:),maskr(:)
integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:) integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -203,11 +203,11 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
If (debug_level >= psb_debug_outer_)& If (debug_level >= psb_debug_outer_)&
& Write(debug_unit,*) me,' ',trim(name),':ovr_est done',novr,lovr & Write(debug_unit,*) me,' ',trim(name),':ovr_est done',novr,lovr
index_dim = size(desc_a%halo_index) index_dim = max(desc_a%v_halo_index%get_nrows(),1_psb_ipk_)
elem_dim = size(desc_a%halo_index) elem_dim = index_dim
l_tmp_ovr_idx = novr*(3*Max(2*index_dim,1)+1) l_tmp_ovr_idx = novr*(3*Max(2*index_dim,1)+1)
l_tmp_halo = novr*(3*Size(desc_a%halo_index)) l_tmp_halo = novr*(3*index_dim)
desc_ov%base_desc => desc_a desc_ov%base_desc => desc_a
@ -228,13 +228,18 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
& t_halo_out(l_tmp_halo), temp(lworkr),stat=info) & t_halo_out(l_tmp_halo), temp(lworkr),stat=info)
if (info == psb_success_) allocate(orig_ovr(l_tmp_ovr_idx),& if (info == psb_success_) allocate(orig_ovr(l_tmp_ovr_idx),&
& tmp_ovr_idx(l_tmp_ovr_idx), & & tmp_ovr_idx(l_tmp_ovr_idx), &
& tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info) & tmp_halo(l_tmp_halo),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999 goto 9999
end if end if
halo(:) = desc_a%halo_index(:)
halo = desc_a%v_halo_index%get_vect()
if (.not.allocated(halo)) halo = (/ -ione /)
ovrlap = desc_a%v_ovrlap_index%get_vect()
if (.not.allocated(ovrlap)) ovrlap = (/ -ione /)
tmp_ovr_idx(:) = -1 tmp_ovr_idx(:) = -1
orig_ovr(:) = -1 orig_ovr(:) = -1
tmp_halo(:) = -1 tmp_halo(:) = -1
@ -246,14 +251,14 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
cntov_o = 1 cntov_o = 1
! Init overlap with desc_a%ovrlap (if any) ! Init overlap with desc_a%ovrlap (if any)
counter = 1 counter = 1
Do While (desc_a%ovrlap_index(counter) /= -1) Do While (ovrlap(counter) /= -1)
proc = desc_a%ovrlap_index(counter+psb_proc_id_) proc = ovrlap(counter+psb_proc_id_)
n_elem_recv = desc_a%ovrlap_index(counter+psb_n_elem_recv_) n_elem_recv = ovrlap(counter+psb_n_elem_recv_)
n_elem_send = desc_a%ovrlap_index(counter+n_elem_recv+psb_n_elem_send_) n_elem_send = ovrlap(counter+n_elem_recv+psb_n_elem_send_)
Do j=0,n_elem_recv-1 Do j=0,n_elem_recv-1
idx = desc_a%ovrlap_index(counter+psb_elem_recv_+j) idx = ovrlap(counter+psb_elem_recv_+j)
call desc_ov%indxmap%l2g(idx,gidx,info) call desc_ov%indxmap%l2g(idx,gidx,info)
If (gidx < 0) then If (gidx < 0) then
info=-3 info=-3
@ -467,7 +472,8 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
! accumulated RECV requests, we have an all-to-all to build ! accumulated RECV requests, we have an all-to-all to build
! matchings SENDs. ! matchings SENDs.
! !
call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1,psb_mpi_def_integer,icomm,minfo) call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1, &
& psb_mpi_def_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall') call psb_errpush(info,name,a_err='mpi_alltoall')
@ -611,7 +617,6 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
End If End If
End Do End Do
select case(extype_) select case(extype_)
case(psb_ovt_xhal_) case(psb_ovt_xhal_)
! !

39
base/tools/psb_zcdbldext.F90
Unescape Escape View File

@ -90,11 +90,11 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
integer(psb_mpik_) :: icomm, ictxt, me, np, minfo integer(psb_mpik_) :: icomm, ictxt, me, np, minfo
integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
integer(psb_ipk_),allocatable :: halo(:),works(:),workr(:),t_halo_in(:),& integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),works(:),workr(:),&
& t_halo_out(:),temp(:),maskr(:) & t_halo_in(:), t_halo_out(:),temp(:),maskr(:)
integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:) integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -203,11 +203,11 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
If (debug_level >= psb_debug_outer_)& If (debug_level >= psb_debug_outer_)&
& Write(debug_unit,*) me,' ',trim(name),':ovr_est done',novr,lovr & Write(debug_unit,*) me,' ',trim(name),':ovr_est done',novr,lovr
index_dim = size(desc_a%halo_index) index_dim = max(desc_a%v_halo_index%get_nrows(),1_psb_ipk_)
elem_dim = size(desc_a%halo_index) elem_dim = index_dim
l_tmp_ovr_idx = novr*(3*Max(2*index_dim,1)+1) l_tmp_ovr_idx = novr*(3*Max(2*index_dim,1)+1)
l_tmp_halo = novr*(3*Size(desc_a%halo_index)) l_tmp_halo = novr*(3*index_dim)
desc_ov%base_desc => desc_a desc_ov%base_desc => desc_a
@ -228,13 +228,18 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
& t_halo_out(l_tmp_halo), temp(lworkr),stat=info) & t_halo_out(l_tmp_halo), temp(lworkr),stat=info)
if (info == psb_success_) allocate(orig_ovr(l_tmp_ovr_idx),& if (info == psb_success_) allocate(orig_ovr(l_tmp_ovr_idx),&
& tmp_ovr_idx(l_tmp_ovr_idx), & & tmp_ovr_idx(l_tmp_ovr_idx), &
& tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info) & tmp_halo(l_tmp_halo),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999 goto 9999
end if end if
halo(:) = desc_a%halo_index(:)
halo = desc_a%v_halo_index%get_vect()
if (.not.allocated(halo)) halo = (/ -ione /)
ovrlap = desc_a%v_ovrlap_index%get_vect()
if (.not.allocated(ovrlap)) ovrlap = (/ -ione /)
tmp_ovr_idx(:) = -1 tmp_ovr_idx(:) = -1
orig_ovr(:) = -1 orig_ovr(:) = -1
tmp_halo(:) = -1 tmp_halo(:) = -1
@ -246,14 +251,14 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
cntov_o = 1 cntov_o = 1
! Init overlap with desc_a%ovrlap (if any) ! Init overlap with desc_a%ovrlap (if any)
counter = 1 counter = 1
Do While (desc_a%ovrlap_index(counter) /= -1) Do While (ovrlap(counter) /= -1)
proc = desc_a%ovrlap_index(counter+psb_proc_id_) proc = ovrlap(counter+psb_proc_id_)
n_elem_recv = desc_a%ovrlap_index(counter+psb_n_elem_recv_) n_elem_recv = ovrlap(counter+psb_n_elem_recv_)
n_elem_send = desc_a%ovrlap_index(counter+n_elem_recv+psb_n_elem_send_) n_elem_send = ovrlap(counter+n_elem_recv+psb_n_elem_send_)
Do j=0,n_elem_recv-1 Do j=0,n_elem_recv-1
idx = desc_a%ovrlap_index(counter+psb_elem_recv_+j) idx = ovrlap(counter+psb_elem_recv_+j)
call desc_ov%indxmap%l2g(idx,gidx,info) call desc_ov%indxmap%l2g(idx,gidx,info)
If (gidx < 0) then If (gidx < 0) then
info=-3 info=-3
@ -467,7 +472,8 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
! accumulated RECV requests, we have an all-to-all to build ! accumulated RECV requests, we have an all-to-all to build
! matchings SENDs. ! matchings SENDs.
! !
call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1,psb_mpi_def_integer,icomm,minfo) call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1, &
& psb_mpi_def_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall') call psb_errpush(info,name,a_err='mpi_alltoall')
@ -611,7 +617,6 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
End If End If
End Do End Do
select case(extype_) select case(extype_)
case(psb_ovt_xhal_) case(psb_ovt_xhal_)
! !

Write Preview
Loading…
Cancel
Save