base/modules/psb_desc_type.f90
 base/tools/psb_map.f90

Added a query to figure out a descriptor for a replicated index space.
Fixed aggregation mapping towards a replicated index space. 
WARNING: the general linear map does not check this yet; have to
figure out what we really want to do.
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent e880b18eb1
commit 54f9133015

@ -452,6 +452,13 @@ contains
end function psb_is_upd_desc end function psb_is_upd_desc
logical function psb_is_repl_desc(desc)
type(psb_desc_type), intent(in) :: desc
psb_is_repl_desc = psb_is_repl_dec(psb_cd_get_dectype(desc))
end function psb_is_repl_desc
logical function psb_is_ovl_desc(desc) logical function psb_is_ovl_desc(desc)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
@ -490,6 +497,13 @@ contains
end function psb_is_upd_dec end function psb_is_upd_dec
logical function psb_is_repl_dec(dectype)
integer :: dectype
psb_is_repl_dec = (dectype == psb_desc_repl_)
end function psb_is_repl_dec
logical function psb_is_asb_dec(dectype) logical function psb_is_asb_dec(dectype)
integer :: dectype integer :: dectype

@ -48,7 +48,7 @@ subroutine psb_s_forward_map(alpha,x,beta,y,desc,info,work)
! !
real(psb_spk_), allocatable :: xt(:) real(psb_spk_), allocatable :: xt(:)
integer :: itsz, i, j,totxch,totsnd,totrcv,& integer :: itsz, i, j,totxch,totsnd,totrcv,&
& map_kind, map_data & map_kind, map_data, nr, ictxt
character(len=20), parameter :: name='psb_forward_map' character(len=20), parameter :: name='psb_forward_map'
info = 0 info = 0
@ -74,7 +74,11 @@ subroutine psb_s_forward_map(alpha,x,beta,y,desc,info,work)
! and a matrix-vector product. ! and a matrix-vector product.
call psb_halo(x,desc%desc_1,info,work=work) call psb_halo(x,desc%desc_1,info,work=work)
if (info == 0) call psb_csmm(alpha,desc%smap%map_fw,x,beta,y,info) if (info == 0) call psb_csmm(alpha,desc%smap%map_fw,x,beta,y,info)
if ((info == 0) .and. psb_is_repl_desc(desc%desc_2)) then
ictxt = psb_cd_get_context(desc%desc_2)
nr = psb_cd_get_global_rows(desc%desc_2)
call psb_sum(ictxt,y(1:nr))
end if
if (info /= 0) then if (info /= 0) then
write(0,*) trim(name),' Error from inner routines',info write(0,*) trim(name),' Error from inner routines',info
info = -1 info = -1
@ -119,7 +123,7 @@ subroutine psb_s_backward_map(alpha,x,beta,y,desc,info,work)
! !
real(psb_spk_), allocatable :: xt(:) real(psb_spk_), allocatable :: xt(:)
integer :: itsz, i, j,totxch,totsnd,totrcv,& integer :: itsz, i, j,totxch,totsnd,totrcv,&
& map_kind, map_data & map_kind, map_data, nr, ictxt
character(len=20), parameter :: name='psb_backward_map' character(len=20), parameter :: name='psb_backward_map'
info = 0 info = 0
@ -144,7 +148,11 @@ subroutine psb_s_backward_map(alpha,x,beta,y,desc,info,work)
! Ok, we just need to call a halo update and a matrix-vector product. ! Ok, we just need to call a halo update and a matrix-vector product.
call psb_halo(x,desc%desc_2,info,work=work) call psb_halo(x,desc%desc_2,info,work=work)
if (info == 0) call psb_csmm(alpha,desc%smap%map_bk,x,beta,y,info) if (info == 0) call psb_csmm(alpha,desc%smap%map_bk,x,beta,y,info)
if ((info == 0) .and. psb_is_repl_desc(desc%desc_1)) then
ictxt = psb_cd_get_context(desc%desc_1)
nr = psb_cd_get_global_rows(desc%desc_1)
call psb_sum(ictxt,y(1:nr))
end if
if (info /= 0) then if (info /= 0) then
write(0,*) trim(name),' Error from inner routines',info write(0,*) trim(name),' Error from inner routines',info
info = -1 info = -1
@ -186,7 +194,7 @@ subroutine psb_d_forward_map(alpha,x,beta,y,desc,info,work)
! !
real(psb_dpk_), allocatable :: xt(:) real(psb_dpk_), allocatable :: xt(:)
integer :: itsz, i, j,totxch,totsnd,totrcv,& integer :: itsz, i, j,totxch,totsnd,totrcv,&
& map_kind, map_data & map_kind, map_data, nr, ictxt
character(len=20), parameter :: name='psb_forward_map' character(len=20), parameter :: name='psb_forward_map'
info = 0 info = 0
@ -212,6 +220,11 @@ subroutine psb_d_forward_map(alpha,x,beta,y,desc,info,work)
! and a matrix-vector product. ! and a matrix-vector product.
call psb_halo(x,desc%desc_1,info,work=work) call psb_halo(x,desc%desc_1,info,work=work)
if (info == 0) call psb_csmm(alpha,desc%dmap%map_fw,x,beta,y,info) if (info == 0) call psb_csmm(alpha,desc%dmap%map_fw,x,beta,y,info)
if ((info == 0) .and. psb_is_repl_desc(desc%desc_2)) then
ictxt = psb_cd_get_context(desc%desc_2)
nr = psb_cd_get_global_rows(desc%desc_2)
call psb_sum(ictxt,y(1:nr))
end if
if (info /= 0) then if (info /= 0) then
write(0,*) trim(name),' Error from inner routines',info write(0,*) trim(name),' Error from inner routines',info
@ -257,7 +270,7 @@ subroutine psb_d_backward_map(alpha,x,beta,y,desc,info,work)
! !
real(psb_dpk_), allocatable :: xt(:) real(psb_dpk_), allocatable :: xt(:)
integer :: itsz, i, j,totxch,totsnd,totrcv,& integer :: itsz, i, j,totxch,totsnd,totrcv,&
& map_kind, map_data & map_kind, map_data, nr, ictxt
character(len=20), parameter :: name='psb_backward_map' character(len=20), parameter :: name='psb_backward_map'
info = 0 info = 0
@ -282,6 +295,11 @@ subroutine psb_d_backward_map(alpha,x,beta,y,desc,info,work)
! Ok, we just need to call a halo update and a matrix-vector product. ! Ok, we just need to call a halo update and a matrix-vector product.
call psb_halo(x,desc%desc_2,info,work=work) call psb_halo(x,desc%desc_2,info,work=work)
if (info == 0) call psb_csmm(alpha,desc%dmap%map_bk,x,beta,y,info) if (info == 0) call psb_csmm(alpha,desc%dmap%map_bk,x,beta,y,info)
if ((info == 0) .and. psb_is_repl_desc(desc%desc_1)) then
ictxt = psb_cd_get_context(desc%desc_1)
nr = psb_cd_get_global_rows(desc%desc_1)
call psb_sum(ictxt,y(1:nr))
end if
if (info /= 0) then if (info /= 0) then
write(0,*) trim(name),' Error from inner routines',info write(0,*) trim(name),' Error from inner routines',info
@ -325,7 +343,7 @@ subroutine psb_c_forward_map(alpha,x,beta,y,desc,info,work)
! !
complex(psb_spk_), allocatable :: xt(:) complex(psb_spk_), allocatable :: xt(:)
integer :: itsz, i, j,totxch,totsnd,totrcv,& integer :: itsz, i, j,totxch,totsnd,totrcv,&
& map_kind, map_data & map_kind, map_data, nr, ictxt
character(len=20), parameter :: name='psb_forward_map' character(len=20), parameter :: name='psb_forward_map'
info = 0 info = 0
@ -350,6 +368,11 @@ subroutine psb_c_forward_map(alpha,x,beta,y,desc,info,work)
! Ok, we just need to call a halo update and a matrix-vector product. ! Ok, we just need to call a halo update and a matrix-vector product.
call psb_halo(x,desc%desc_1,info,work=work) call psb_halo(x,desc%desc_1,info,work=work)
if (info == 0) call psb_csmm(alpha,desc%cmap%map_fw,x,beta,y,info) if (info == 0) call psb_csmm(alpha,desc%cmap%map_fw,x,beta,y,info)
if ((info == 0) .and. psb_is_repl_desc(desc%desc_2)) then
ictxt = psb_cd_get_context(desc%desc_2)
nr = psb_cd_get_global_rows(desc%desc_2)
call psb_sum(ictxt,y(1:nr))
end if
if (info /= 0) then if (info /= 0) then
write(0,*) trim(name),' Error from inner routines',info write(0,*) trim(name),' Error from inner routines',info
@ -393,7 +416,7 @@ subroutine psb_c_backward_map(alpha,x,beta,y,desc,info,work)
! !
complex(psb_spk_), allocatable :: xt(:) complex(psb_spk_), allocatable :: xt(:)
integer :: itsz, i, j,totxch,totsnd,totrcv,& integer :: itsz, i, j,totxch,totsnd,totrcv,&
& map_kind, map_data & map_kind, map_data, nr, ictxt
character(len=20), parameter :: name='psb_backward_map' character(len=20), parameter :: name='psb_backward_map'
info = 0 info = 0
@ -418,6 +441,11 @@ subroutine psb_c_backward_map(alpha,x,beta,y,desc,info,work)
! Ok, we just need to call a halo update and a matrix-vector product. ! Ok, we just need to call a halo update and a matrix-vector product.
call psb_halo(x,desc%desc_2,info,work=work) call psb_halo(x,desc%desc_2,info,work=work)
if (info == 0) call psb_csmm(alpha,desc%cmap%map_bk,x,beta,y,info) if (info == 0) call psb_csmm(alpha,desc%cmap%map_bk,x,beta,y,info)
if ((info == 0) .and. psb_is_repl_desc(desc%desc_1)) then
ictxt = psb_cd_get_context(desc%desc_1)
nr = psb_cd_get_global_rows(desc%desc_1)
call psb_sum(ictxt,y(1:nr))
end if
if (info /= 0) then if (info /= 0) then
write(0,*) trim(name),' Error from inner routines',info write(0,*) trim(name),' Error from inner routines',info
@ -427,7 +455,7 @@ subroutine psb_c_backward_map(alpha,x,beta,y,desc,info,work)
case(psb_map_gen_linear_) case(psb_map_gen_linear_)
call psb_linmap(alpha,x,beta,y,desc%cmap%map_bk,& call psb_linmap(alpha,x,beta,y,desc%cmap%map_bk,&
& desc%desc_bk,desc%desc_1,desc%desc_2) & desc%desc_bk,desc%desc_2,desc%desc_1)
if (info /= 0) then if (info /= 0) then
write(0,*) trim(name),' Error from inner routines',info write(0,*) trim(name),' Error from inner routines',info
@ -462,7 +490,7 @@ subroutine psb_z_forward_map(alpha,x,beta,y,desc,info,work)
! !
complex(psb_dpk_), allocatable :: xt(:) complex(psb_dpk_), allocatable :: xt(:)
integer :: itsz, i, j,totxch,totsnd,totrcv,& integer :: itsz, i, j,totxch,totsnd,totrcv,&
& map_kind, map_data & map_kind, map_data, nr, ictxt
character(len=20), parameter :: name='psb_forward_map' character(len=20), parameter :: name='psb_forward_map'
info = 0 info = 0
@ -487,7 +515,11 @@ subroutine psb_z_forward_map(alpha,x,beta,y,desc,info,work)
! Ok, we just need to call a halo update and a matrix-vector product. ! Ok, we just need to call a halo update and a matrix-vector product.
call psb_halo(x,desc%desc_1,info,work=work) call psb_halo(x,desc%desc_1,info,work=work)
if (info == 0) call psb_csmm(alpha,desc%zmap%map_fw,x,beta,y,info) if (info == 0) call psb_csmm(alpha,desc%zmap%map_fw,x,beta,y,info)
if ((info == 0) .and. psb_is_repl_desc(desc%desc_2)) then
ictxt = psb_cd_get_context(desc%desc_2)
nr = psb_cd_get_global_rows(desc%desc_2)
call psb_sum(ictxt,y(1:nr))
end if
if (info /= 0) then if (info /= 0) then
write(0,*) trim(name),' Error from inner routines',info write(0,*) trim(name),' Error from inner routines',info
info = -1 info = -1
@ -524,13 +556,13 @@ subroutine psb_z_backward_map(alpha,x,beta,y,desc,info,work)
complex(psb_dpk_), intent(in) :: alpha,beta complex(psb_dpk_), intent(in) :: alpha,beta
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
complex(psb_dpk_), intent(out) :: y(:) complex(psb_dpk_), intent(out) :: y(:)
integer, intent(out) :: info integer, intent(out) :: info
complex(psb_dpk_), optional :: work(:) complex(psb_dpk_), optional :: work(:)
! !
complex(psb_dpk_), allocatable :: xt(:) complex(psb_dpk_), allocatable :: xt(:)
integer :: itsz, i, j,totxch,totsnd,totrcv,& integer :: itsz, i, j,totxch,totsnd,totrcv,&
& map_kind, map_data & map_kind, map_data, nr, ictxt
character(len=20), parameter :: name='psb_backward_map' character(len=20), parameter :: name='psb_backward_map'
info = 0 info = 0
@ -555,6 +587,11 @@ subroutine psb_z_backward_map(alpha,x,beta,y,desc,info,work)
! Ok, we just need to call a halo update and a matrix-vector product. ! Ok, we just need to call a halo update and a matrix-vector product.
call psb_halo(x,desc%desc_2,info,work=work) call psb_halo(x,desc%desc_2,info,work=work)
if (info == 0) call psb_csmm(alpha,desc%zmap%map_bk,x,beta,y,info) if (info == 0) call psb_csmm(alpha,desc%zmap%map_bk,x,beta,y,info)
if ((info == 0) .and. psb_is_repl_desc(desc%desc_1)) then
ictxt = psb_cd_get_context(desc%desc_1)
nr = psb_cd_get_global_rows(desc%desc_1)
call psb_sum(ictxt,y(1:nr))
end if
if (info /= 0) then if (info /= 0) then
write(0,*) trim(name),' Error from inner routines',info write(0,*) trim(name),' Error from inner routines',info
@ -564,7 +601,7 @@ subroutine psb_z_backward_map(alpha,x,beta,y,desc,info,work)
case(psb_map_gen_linear_) case(psb_map_gen_linear_)
call psb_linmap(alpha,x,beta,y,desc%zmap%map_bk,& call psb_linmap(alpha,x,beta,y,desc%zmap%map_bk,&
& desc%desc_bk,desc%desc_1,desc%desc_2) & desc%desc_bk,desc%desc_2,desc%desc_1)
if (info /= 0) then if (info /= 0) then
write(0,*) trim(name),' Error from inner routines',info write(0,*) trim(name),' Error from inner routines',info

Loading…
Cancel
Save