Change interface of X_REMAP to include isrc/nrsrc

new-context
Salvatore Filippone 4 years ago
parent 2090a011db
commit fb422be9f4

@ -432,7 +432,7 @@ Module psb_c_tools_mod
end interface end interface
interface psb_remap interface psb_remap
subroutine psb_c_remap(np_remap, desc_in, a_in, desc_out, a_out, info) subroutine psb_c_remap(np_remap, desc_in, a_in, desc_out, isrc, nrsrc, a_out, info)
import import
implicit none implicit none
!....parameters... !....parameters...
@ -441,6 +441,7 @@ Module psb_c_tools_mod
type(psb_cspmat_type), intent(inout) :: a_in type(psb_cspmat_type), intent(inout) :: a_in
type(psb_cspmat_type), intent(out) :: a_out type(psb_cspmat_type), intent(out) :: a_out
type(psb_desc_type), intent(out) :: desc_out type(psb_desc_type), intent(out) :: desc_out
integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_remap end subroutine psb_c_remap
end interface psb_remap end interface psb_remap

@ -432,7 +432,7 @@ Module psb_d_tools_mod
end interface end interface
interface psb_remap interface psb_remap
subroutine psb_d_remap(np_remap, desc_in, a_in, desc_out, a_out, info) subroutine psb_d_remap(np_remap, desc_in, a_in, desc_out, isrc, nrsrc, a_out, info)
import import
implicit none implicit none
!....parameters... !....parameters...
@ -441,6 +441,7 @@ Module psb_d_tools_mod
type(psb_dspmat_type), intent(inout) :: a_in type(psb_dspmat_type), intent(inout) :: a_in
type(psb_dspmat_type), intent(out) :: a_out type(psb_dspmat_type), intent(out) :: a_out
type(psb_desc_type), intent(out) :: desc_out type(psb_desc_type), intent(out) :: desc_out
integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_remap end subroutine psb_d_remap
end interface psb_remap end interface psb_remap

@ -432,7 +432,7 @@ Module psb_s_tools_mod
end interface end interface
interface psb_remap interface psb_remap
subroutine psb_s_remap(np_remap, desc_in, a_in, desc_out, a_out, info) subroutine psb_s_remap(np_remap, desc_in, a_in, desc_out, isrc, nrsrc, a_out, info)
import import
implicit none implicit none
!....parameters... !....parameters...
@ -441,6 +441,7 @@ Module psb_s_tools_mod
type(psb_sspmat_type), intent(inout) :: a_in type(psb_sspmat_type), intent(inout) :: a_in
type(psb_sspmat_type), intent(out) :: a_out type(psb_sspmat_type), intent(out) :: a_out
type(psb_desc_type), intent(out) :: desc_out type(psb_desc_type), intent(out) :: desc_out
integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_remap end subroutine psb_s_remap
end interface psb_remap end interface psb_remap

@ -432,7 +432,7 @@ Module psb_z_tools_mod
end interface end interface
interface psb_remap interface psb_remap
subroutine psb_z_remap(np_remap, desc_in, a_in, desc_out, a_out, info) subroutine psb_z_remap(np_remap, desc_in, a_in, desc_out, isrc, nrsrc, a_out, info)
import import
implicit none implicit none
!....parameters... !....parameters...
@ -441,6 +441,7 @@ Module psb_z_tools_mod
type(psb_zspmat_type), intent(inout) :: a_in type(psb_zspmat_type), intent(inout) :: a_in
type(psb_zspmat_type), intent(out) :: a_out type(psb_zspmat_type), intent(out) :: a_out
type(psb_desc_type), intent(out) :: desc_out type(psb_desc_type), intent(out) :: desc_out
integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_remap end subroutine psb_z_remap
end interface psb_remap end interface psb_remap

@ -36,7 +36,7 @@
! desc_in - type(psb_desc_type). The communication descriptor to be cloned. ! desc_in - type(psb_desc_type). The communication descriptor to be cloned.
! desc_out - type(psb_desc_type). The output communication descriptor. ! desc_out - type(psb_desc_type). The output communication descriptor.
! info - integer. Return code. ! info - integer. Return code.
subroutine psb_c_remap(np_remap, desc_in, a_in, desc_out, a_out, info) subroutine psb_c_remap(np_remap, desc_in, a_in, desc_out, isrc, nrsrc, a_out, info)
use psb_base_mod, psb_protect_name => psb_c_remap use psb_base_mod, psb_protect_name => psb_c_remap
@ -47,6 +47,7 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
type(psb_cspmat_type), intent(inout) :: a_in type(psb_cspmat_type), intent(inout) :: a_in
type(psb_cspmat_type), intent(out) :: a_out type(psb_cspmat_type), intent(out) :: a_out
type(psb_desc_type), intent(out) :: desc_out type(psb_desc_type), intent(out) :: desc_out
integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -54,7 +55,7 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
integer(psb_ipk_) :: np, me, ictxt, err_act integer(psb_ipk_) :: np, me, ictxt, err_act
integer(psb_ipk_) :: rnp, rme, newctxt integer(psb_ipk_) :: rnp, rme, newctxt
integer(psb_ipk_) :: ipdest, ipd, id1, id2, imd, i, nsrc integer(psb_ipk_) :: ipdest, ipd, id1, id2, imd, i, nsrc
integer(psb_ipk_), allocatable :: newnl(:), isrc(:), nzsrc(:), ids(:) integer(psb_ipk_), allocatable :: newnl(:), nzsrc(:), ids(:)
type(psb_lc_coo_sparse_mat) :: acoo_snd, acoo_rcv type(psb_lc_coo_sparse_mat) :: acoo_snd, acoo_rcv
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -183,6 +184,7 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
call a_in%cp_to(acoo_snd) call a_in%cp_to(acoo_snd)
nzsnd = acoo_snd%get_nzeros() nzsnd = acoo_snd%get_nzeros()
call psb_snd(ictxt,nzsnd,ipd) call psb_snd(ictxt,nzsnd,ipd)
call psb_snd(ictxt,desc_in%get_local_rows(),ipd)
! Convert to global numbering ! Convert to global numbering
call psb_loc_to_glob(acoo_snd%ia(1:nzsnd),desc_in,info) call psb_loc_to_glob(acoo_snd%ia(1:nzsnd),desc_in,info)
call psb_loc_to_glob(acoo_snd%ja(1:nzsnd),desc_in,info) call psb_loc_to_glob(acoo_snd%ja(1:nzsnd),desc_in,info)
@ -194,9 +196,11 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
if (rme>=0) then if (rme>=0) then
! prepare to receive ! prepare to receive
nzsrc = isrc nzsrc = isrc
nrsrc = isrc
nzl = 0 nzl = 0
do ip=1, nsrc do ip=1, nsrc
call psb_rcv(ictxt,nzsrc(ip),isrc(ip)) call psb_rcv(ictxt,nzsrc(ip),isrc(ip))
call psb_rcv(ictxt,nrsrc(ip),isrc(ip))
nzl = nzl + nzsrc(ip) nzl = nzl + nzsrc(ip)
end do end do
call acoo_rcv%allocate(newnl(rme+1),newnl(rme+1),nzl) call acoo_rcv%allocate(newnl(rme+1),newnl(rme+1),nzl)

@ -36,7 +36,7 @@
! desc_in - type(psb_desc_type). The communication descriptor to be cloned. ! desc_in - type(psb_desc_type). The communication descriptor to be cloned.
! desc_out - type(psb_desc_type). The output communication descriptor. ! desc_out - type(psb_desc_type). The output communication descriptor.
! info - integer. Return code. ! info - integer. Return code.
subroutine psb_d_remap(np_remap, desc_in, a_in, desc_out, a_out, info) subroutine psb_d_remap(np_remap, desc_in, a_in, desc_out, isrc, nrsrc, a_out, info)
use psb_base_mod, psb_protect_name => psb_d_remap use psb_base_mod, psb_protect_name => psb_d_remap
@ -47,6 +47,7 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
type(psb_dspmat_type), intent(inout) :: a_in type(psb_dspmat_type), intent(inout) :: a_in
type(psb_dspmat_type), intent(out) :: a_out type(psb_dspmat_type), intent(out) :: a_out
type(psb_desc_type), intent(out) :: desc_out type(psb_desc_type), intent(out) :: desc_out
integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -54,7 +55,7 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
integer(psb_ipk_) :: np, me, ictxt, err_act integer(psb_ipk_) :: np, me, ictxt, err_act
integer(psb_ipk_) :: rnp, rme, newctxt integer(psb_ipk_) :: rnp, rme, newctxt
integer(psb_ipk_) :: ipdest, ipd, id1, id2, imd, i, nsrc integer(psb_ipk_) :: ipdest, ipd, id1, id2, imd, i, nsrc
integer(psb_ipk_), allocatable :: newnl(:), isrc(:), nzsrc(:), ids(:) integer(psb_ipk_), allocatable :: newnl(:), nzsrc(:), ids(:)
type(psb_ld_coo_sparse_mat) :: acoo_snd, acoo_rcv type(psb_ld_coo_sparse_mat) :: acoo_snd, acoo_rcv
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -183,6 +184,7 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
call a_in%cp_to(acoo_snd) call a_in%cp_to(acoo_snd)
nzsnd = acoo_snd%get_nzeros() nzsnd = acoo_snd%get_nzeros()
call psb_snd(ictxt,nzsnd,ipd) call psb_snd(ictxt,nzsnd,ipd)
call psb_snd(ictxt,desc_in%get_local_rows(),ipd)
! Convert to global numbering ! Convert to global numbering
call psb_loc_to_glob(acoo_snd%ia(1:nzsnd),desc_in,info) call psb_loc_to_glob(acoo_snd%ia(1:nzsnd),desc_in,info)
call psb_loc_to_glob(acoo_snd%ja(1:nzsnd),desc_in,info) call psb_loc_to_glob(acoo_snd%ja(1:nzsnd),desc_in,info)
@ -194,9 +196,11 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
if (rme>=0) then if (rme>=0) then
! prepare to receive ! prepare to receive
nzsrc = isrc nzsrc = isrc
nrsrc = isrc
nzl = 0 nzl = 0
do ip=1, nsrc do ip=1, nsrc
call psb_rcv(ictxt,nzsrc(ip),isrc(ip)) call psb_rcv(ictxt,nzsrc(ip),isrc(ip))
call psb_rcv(ictxt,nrsrc(ip),isrc(ip))
nzl = nzl + nzsrc(ip) nzl = nzl + nzsrc(ip)
end do end do
call acoo_rcv%allocate(newnl(rme+1),newnl(rme+1),nzl) call acoo_rcv%allocate(newnl(rme+1),newnl(rme+1),nzl)

@ -36,7 +36,7 @@
! desc_in - type(psb_desc_type). The communication descriptor to be cloned. ! desc_in - type(psb_desc_type). The communication descriptor to be cloned.
! desc_out - type(psb_desc_type). The output communication descriptor. ! desc_out - type(psb_desc_type). The output communication descriptor.
! info - integer. Return code. ! info - integer. Return code.
subroutine psb_s_remap(np_remap, desc_in, a_in, desc_out, a_out, info) subroutine psb_s_remap(np_remap, desc_in, a_in, desc_out, isrc, nrsrc, a_out, info)
use psb_base_mod, psb_protect_name => psb_s_remap use psb_base_mod, psb_protect_name => psb_s_remap
@ -47,6 +47,7 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
type(psb_sspmat_type), intent(inout) :: a_in type(psb_sspmat_type), intent(inout) :: a_in
type(psb_sspmat_type), intent(out) :: a_out type(psb_sspmat_type), intent(out) :: a_out
type(psb_desc_type), intent(out) :: desc_out type(psb_desc_type), intent(out) :: desc_out
integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -54,7 +55,7 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
integer(psb_ipk_) :: np, me, ictxt, err_act integer(psb_ipk_) :: np, me, ictxt, err_act
integer(psb_ipk_) :: rnp, rme, newctxt integer(psb_ipk_) :: rnp, rme, newctxt
integer(psb_ipk_) :: ipdest, ipd, id1, id2, imd, i, nsrc integer(psb_ipk_) :: ipdest, ipd, id1, id2, imd, i, nsrc
integer(psb_ipk_), allocatable :: newnl(:), isrc(:), nzsrc(:), ids(:) integer(psb_ipk_), allocatable :: newnl(:), nzsrc(:), ids(:)
type(psb_ls_coo_sparse_mat) :: acoo_snd, acoo_rcv type(psb_ls_coo_sparse_mat) :: acoo_snd, acoo_rcv
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -183,6 +184,7 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
call a_in%cp_to(acoo_snd) call a_in%cp_to(acoo_snd)
nzsnd = acoo_snd%get_nzeros() nzsnd = acoo_snd%get_nzeros()
call psb_snd(ictxt,nzsnd,ipd) call psb_snd(ictxt,nzsnd,ipd)
call psb_snd(ictxt,desc_in%get_local_rows(),ipd)
! Convert to global numbering ! Convert to global numbering
call psb_loc_to_glob(acoo_snd%ia(1:nzsnd),desc_in,info) call psb_loc_to_glob(acoo_snd%ia(1:nzsnd),desc_in,info)
call psb_loc_to_glob(acoo_snd%ja(1:nzsnd),desc_in,info) call psb_loc_to_glob(acoo_snd%ja(1:nzsnd),desc_in,info)
@ -194,9 +196,11 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
if (rme>=0) then if (rme>=0) then
! prepare to receive ! prepare to receive
nzsrc = isrc nzsrc = isrc
nrsrc = isrc
nzl = 0 nzl = 0
do ip=1, nsrc do ip=1, nsrc
call psb_rcv(ictxt,nzsrc(ip),isrc(ip)) call psb_rcv(ictxt,nzsrc(ip),isrc(ip))
call psb_rcv(ictxt,nrsrc(ip),isrc(ip))
nzl = nzl + nzsrc(ip) nzl = nzl + nzsrc(ip)
end do end do
call acoo_rcv%allocate(newnl(rme+1),newnl(rme+1),nzl) call acoo_rcv%allocate(newnl(rme+1),newnl(rme+1),nzl)

@ -36,7 +36,7 @@
! desc_in - type(psb_desc_type). The communication descriptor to be cloned. ! desc_in - type(psb_desc_type). The communication descriptor to be cloned.
! desc_out - type(psb_desc_type). The output communication descriptor. ! desc_out - type(psb_desc_type). The output communication descriptor.
! info - integer. Return code. ! info - integer. Return code.
subroutine psb_z_remap(np_remap, desc_in, a_in, desc_out, a_out, info) subroutine psb_z_remap(np_remap, desc_in, a_in, desc_out, isrc, nrsrc, a_out, info)
use psb_base_mod, psb_protect_name => psb_z_remap use psb_base_mod, psb_protect_name => psb_z_remap
@ -47,6 +47,7 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
type(psb_zspmat_type), intent(inout) :: a_in type(psb_zspmat_type), intent(inout) :: a_in
type(psb_zspmat_type), intent(out) :: a_out type(psb_zspmat_type), intent(out) :: a_out
type(psb_desc_type), intent(out) :: desc_out type(psb_desc_type), intent(out) :: desc_out
integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -54,7 +55,7 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
integer(psb_ipk_) :: np, me, ictxt, err_act integer(psb_ipk_) :: np, me, ictxt, err_act
integer(psb_ipk_) :: rnp, rme, newctxt integer(psb_ipk_) :: rnp, rme, newctxt
integer(psb_ipk_) :: ipdest, ipd, id1, id2, imd, i, nsrc integer(psb_ipk_) :: ipdest, ipd, id1, id2, imd, i, nsrc
integer(psb_ipk_), allocatable :: newnl(:), isrc(:), nzsrc(:), ids(:) integer(psb_ipk_), allocatable :: newnl(:), nzsrc(:), ids(:)
type(psb_lz_coo_sparse_mat) :: acoo_snd, acoo_rcv type(psb_lz_coo_sparse_mat) :: acoo_snd, acoo_rcv
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -183,6 +184,7 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
call a_in%cp_to(acoo_snd) call a_in%cp_to(acoo_snd)
nzsnd = acoo_snd%get_nzeros() nzsnd = acoo_snd%get_nzeros()
call psb_snd(ictxt,nzsnd,ipd) call psb_snd(ictxt,nzsnd,ipd)
call psb_snd(ictxt,desc_in%get_local_rows(),ipd)
! Convert to global numbering ! Convert to global numbering
call psb_loc_to_glob(acoo_snd%ia(1:nzsnd),desc_in,info) call psb_loc_to_glob(acoo_snd%ia(1:nzsnd),desc_in,info)
call psb_loc_to_glob(acoo_snd%ja(1:nzsnd),desc_in,info) call psb_loc_to_glob(acoo_snd%ja(1:nzsnd),desc_in,info)
@ -194,9 +196,11 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, desc_out, a_out, info)
if (rme>=0) then if (rme>=0) then
! prepare to receive ! prepare to receive
nzsrc = isrc nzsrc = isrc
nrsrc = isrc
nzl = 0 nzl = 0
do ip=1, nsrc do ip=1, nsrc
call psb_rcv(ictxt,nzsrc(ip),isrc(ip)) call psb_rcv(ictxt,nzsrc(ip),isrc(ip))
call psb_rcv(ictxt,nrsrc(ip),isrc(ip))
nzl = nzl + nzsrc(ip) nzl = nzl + nzsrc(ip)
end do end do
call acoo_rcv%allocate(newnl(rme+1),newnl(rme+1),nzl) call acoo_rcv%allocate(newnl(rme+1),newnl(rme+1),nzl)

Loading…
Cancel
Save