fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 04:42:08 +00:00
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
This commit is contained in:
Salvatore Filippone
2013-08-28 10:48:51 +00:00
parent 39c50529eb
commit 65b76f6b70
7 changed files with 97 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_desc_mod.f90
+7 -6
View File
@@ -204,14 +204,15 @@ module psb_desc_mod
integer(psb_ipk_), allocatable :: halo_index(:)
integer(psb_ipk_), allocatable :: ext_index(:)
integer(psb_ipk_), allocatable :: ovrlap_index(:)
integer(psb_ipk_), allocatable :: ovrlap_elem(:,:)
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_ext_index
type(psb_i_vect_type) :: v_ovrlap_index
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
integer(psb_ipk_), allocatable :: lprm(:)
@@ -1053,13 +1054,13 @@ contains
if ((info == psb_success_).and.(allocated(desc%indxmap))) &
& call desc%indxmap%clone(desc_out%indxmap,info)
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_) &
& 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_) &
& 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_) &
& 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
call desc_out%free(info)
end if
base/modules/psb_i_base_vect_mod.f90
+1 -1
View File
@@ -574,7 +574,7 @@ contains
!
function i_base_get_vect(x) result(res)
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_) :: info
if (.not.allocated(x%v)) return
base/modules/psb_i_vect_mod.F90
+1 -1
View File
@@ -151,7 +151,7 @@ contains
function i_vect_get_vect(x) result(res)
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_) :: info
if (allocated(x%v)) then
base/tools/psb_ccdbldext.F90
+22 -17
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_
integer(psb_mpik_) :: icomm, ictxt, me, np, minfo
integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
integer(psb_ipk_),allocatable :: halo(:),works(:),workr(:),t_halo_in(:),&
& t_halo_out(:),temp(:),maskr(:)
integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),works(:),workr(:),&
& t_halo_in(:), t_halo_out(:),temp(:),maskr(:)
integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ierr(5)
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_)&
& Write(debug_unit,*) me,' ',trim(name),':ovr_est done',novr,lovr
index_dim = size(desc_a%halo_index)
elem_dim = size(desc_a%halo_index)
index_dim = max(desc_a%v_halo_index%get_nrows(),1_psb_ipk_)
elem_dim = index_dim
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
@@ -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)
if (info == psb_success_) allocate(orig_ovr(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
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
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
orig_ovr(:) = -1
tmp_halo(:) = -1
@@ -246,14 +251,14 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
cntov_o = 1
! Init overlap with desc_a%ovrlap (if any)
counter = 1
Do While (desc_a%ovrlap_index(counter) /= -1)
proc = desc_a%ovrlap_index(counter+psb_proc_id_)
n_elem_recv = desc_a%ovrlap_index(counter+psb_n_elem_recv_)
n_elem_send = desc_a%ovrlap_index(counter+n_elem_recv+psb_n_elem_send_)
Do While (ovrlap(counter) /= -1)
proc = ovrlap(counter+psb_proc_id_)
n_elem_recv = ovrlap(counter+psb_n_elem_recv_)
n_elem_send = ovrlap(counter+n_elem_recv+psb_n_elem_send_)
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)
If (gidx < 0) then
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
! 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
info=psb_err_from_subroutine_
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 Do
select case(extype_)
case(psb_ovt_xhal_)
!
base/tools/psb_dcdbldext.F90
+22 -17
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_
integer(psb_mpik_) :: icomm, ictxt, me, np, minfo
integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
integer(psb_ipk_),allocatable :: halo(:),works(:),workr(:),t_halo_in(:),&
& t_halo_out(:),temp(:),maskr(:)
integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),works(:),workr(:),&
& t_halo_in(:), t_halo_out(:),temp(:),maskr(:)
integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ierr(5)
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_)&
& Write(debug_unit,*) me,' ',trim(name),':ovr_est done',novr,lovr
index_dim = size(desc_a%halo_index)
elem_dim = size(desc_a%halo_index)
index_dim = max(desc_a%v_halo_index%get_nrows(),1_psb_ipk_)
elem_dim = index_dim
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
@@ -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)
if (info == psb_success_) allocate(orig_ovr(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
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
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
orig_ovr(:) = -1
tmp_halo(:) = -1
@@ -246,14 +251,14 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
cntov_o = 1
! Init overlap with desc_a%ovrlap (if any)
counter = 1
Do While (desc_a%ovrlap_index(counter) /= -1)
proc = desc_a%ovrlap_index(counter+psb_proc_id_)
n_elem_recv = desc_a%ovrlap_index(counter+psb_n_elem_recv_)
n_elem_send = desc_a%ovrlap_index(counter+n_elem_recv+psb_n_elem_send_)
Do While (ovrlap(counter) /= -1)
proc = ovrlap(counter+psb_proc_id_)
n_elem_recv = ovrlap(counter+psb_n_elem_recv_)
n_elem_send = ovrlap(counter+n_elem_recv+psb_n_elem_send_)
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)
If (gidx < 0) then
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
! 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
info=psb_err_from_subroutine_
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 Do
select case(extype_)
case(psb_ovt_xhal_)
!
base/tools/psb_scdbldext.F90
+22 -17
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_
integer(psb_mpik_) :: icomm, ictxt, me, np, minfo
integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
integer(psb_ipk_),allocatable :: halo(:),works(:),workr(:),t_halo_in(:),&
& t_halo_out(:),temp(:),maskr(:)
integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),works(:),workr(:),&
& t_halo_in(:), t_halo_out(:),temp(:),maskr(:)
integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ierr(5)
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_)&
& Write(debug_unit,*) me,' ',trim(name),':ovr_est done',novr,lovr
index_dim = size(desc_a%halo_index)
elem_dim = size(desc_a%halo_index)
index_dim = max(desc_a%v_halo_index%get_nrows(),1_psb_ipk_)
elem_dim = index_dim
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
@@ -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)
if (info == psb_success_) allocate(orig_ovr(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
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
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
orig_ovr(:) = -1
tmp_halo(:) = -1
@@ -246,14 +251,14 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
cntov_o = 1
! Init overlap with desc_a%ovrlap (if any)
counter = 1
Do While (desc_a%ovrlap_index(counter) /= -1)
proc = desc_a%ovrlap_index(counter+psb_proc_id_)
n_elem_recv = desc_a%ovrlap_index(counter+psb_n_elem_recv_)
n_elem_send = desc_a%ovrlap_index(counter+n_elem_recv+psb_n_elem_send_)
Do While (ovrlap(counter) /= -1)
proc = ovrlap(counter+psb_proc_id_)
n_elem_recv = ovrlap(counter+psb_n_elem_recv_)
n_elem_send = ovrlap(counter+n_elem_recv+psb_n_elem_send_)
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)
If (gidx < 0) then
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
! 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
info=psb_err_from_subroutine_
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 Do
select case(extype_)
case(psb_ovt_xhal_)
!
base/tools/psb_zcdbldext.F90
+22 -17
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_
integer(psb_mpik_) :: icomm, ictxt, me, np, minfo
integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
integer(psb_ipk_),allocatable :: halo(:),works(:),workr(:),t_halo_in(:),&
& t_halo_out(:),temp(:),maskr(:)
integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),works(:),workr(:),&
& t_halo_in(:), t_halo_out(:),temp(:),maskr(:)
integer(psb_mpik_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ierr(5)
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_)&
& Write(debug_unit,*) me,' ',trim(name),':ovr_est done',novr,lovr
index_dim = size(desc_a%halo_index)
elem_dim = size(desc_a%halo_index)
index_dim = max(desc_a%v_halo_index%get_nrows(),1_psb_ipk_)
elem_dim = index_dim
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
@@ -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)
if (info == psb_success_) allocate(orig_ovr(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
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
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
orig_ovr(:) = -1
tmp_halo(:) = -1
@@ -246,14 +251,14 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
cntov_o = 1
! Init overlap with desc_a%ovrlap (if any)
counter = 1
Do While (desc_a%ovrlap_index(counter) /= -1)
proc = desc_a%ovrlap_index(counter+psb_proc_id_)
n_elem_recv = desc_a%ovrlap_index(counter+psb_n_elem_recv_)
n_elem_send = desc_a%ovrlap_index(counter+n_elem_recv+psb_n_elem_send_)
Do While (ovrlap(counter) /= -1)
proc = ovrlap(counter+psb_proc_id_)
n_elem_recv = ovrlap(counter+psb_n_elem_recv_)
n_elem_send = ovrlap(counter+n_elem_recv+psb_n_elem_send_)
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)
If (gidx < 0) then
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
! 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
info=psb_err_from_subroutine_
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 Do
select case(extype_)
case(psb_ovt_xhal_)
!