From 122bfdf7f813c5626205cdf7a483d195c837b40e Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 14 Jun 2019 16:44:54 +0100 Subject: [PATCH] New second descriptor for gather. --- base/comm/psb_cspgather.F90 | 31 ++++++++++++++++++---------- base/comm/psb_dspgather.F90 | 31 ++++++++++++++++++---------- base/comm/psb_sspgather.F90 | 31 ++++++++++++++++++---------- base/comm/psb_zspgather.F90 | 31 ++++++++++++++++++---------- base/modules/comm/psb_c_comm_mod.f90 | 15 +++++++------- base/modules/comm/psb_d_comm_mod.f90 | 15 +++++++------- base/modules/comm/psb_s_comm_mod.f90 | 15 +++++++------- base/modules/comm/psb_z_comm_mod.f90 | 15 +++++++------- 8 files changed, 112 insertions(+), 72 deletions(-) diff --git a/base/comm/psb_cspgather.F90 b/base/comm/psb_cspgather.F90 index 00155a58..be1ddbe0 100644 --- a/base/comm/psb_cspgather.F90 +++ b/base/comm/psb_cspgather.F90 @@ -30,7 +30,7 @@ ! ! ! File: psb_cspgather.f90 -subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) +subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc,desc_c) use psb_desc_mod use psb_error_mod use psb_penv_mod @@ -43,14 +43,17 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep #ifdef MPI_H include 'mpif.h' #endif - type(psb_cspmat_type), intent(inout) :: loca - type(psb_cspmat_type), intent(inout) :: globa - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: root, dupl - logical, intent(in), optional :: keepnum,keeploc - - type(psb_c_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_cspmat_type), intent(inout) :: loca + type(psb_cspmat_type), intent(inout) :: globa + type(psb_desc_type), intent(in), target :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root, dupl + logical, intent(in), optional :: keepnum,keeploc + type(psb_desc_type), intent(in), optional, target :: desc_c + ! + type(psb_c_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_desc_type), pointer :: p_desc_c + integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ @@ -80,11 +83,17 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep else keeploc_ = .true. end if + if (present(desc_c)) then + p_desc_c => desc_c + else + p_desc_c => desc_a + end if + call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() - ncg = desc_a%get_global_rows() + ncg = p_desc_c%get_global_cols() allocate(nzbr(np), idisp(np),stat=info) if (info /= psb_success_) then @@ -102,7 +111,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep end if nzl = loc_coo%get_nzeros() call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I') - call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') + call psb_loc_to_glob(loc_coo%ja(1:nzl),p_desc_c,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl call psb_sum(ictxt,nzbr(1:np)) diff --git a/base/comm/psb_dspgather.F90 b/base/comm/psb_dspgather.F90 index 0d373fdf..59d0d080 100644 --- a/base/comm/psb_dspgather.F90 +++ b/base/comm/psb_dspgather.F90 @@ -30,7 +30,7 @@ ! ! ! File: psb_dspgather.f90 -subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) +subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc,desc_c) use psb_desc_mod use psb_error_mod use psb_penv_mod @@ -43,14 +43,17 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep #ifdef MPI_H include 'mpif.h' #endif - type(psb_dspmat_type), intent(inout) :: loca - type(psb_dspmat_type), intent(inout) :: globa - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: root, dupl - logical, intent(in), optional :: keepnum,keeploc - - type(psb_d_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_dspmat_type), intent(inout) :: loca + type(psb_dspmat_type), intent(inout) :: globa + type(psb_desc_type), intent(in), target :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root, dupl + logical, intent(in), optional :: keepnum,keeploc + type(psb_desc_type), intent(in), optional, target :: desc_c + ! + type(psb_d_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_desc_type), pointer :: p_desc_c + integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ @@ -80,11 +83,17 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep else keeploc_ = .true. end if + if (present(desc_c)) then + p_desc_c => desc_c + else + p_desc_c => desc_a + end if + call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() - ncg = desc_a%get_global_rows() + ncg = p_desc_c%get_global_cols() allocate(nzbr(np), idisp(np),stat=info) if (info /= psb_success_) then @@ -102,7 +111,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep end if nzl = loc_coo%get_nzeros() call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I') - call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') + call psb_loc_to_glob(loc_coo%ja(1:nzl),p_desc_c,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl call psb_sum(ictxt,nzbr(1:np)) diff --git a/base/comm/psb_sspgather.F90 b/base/comm/psb_sspgather.F90 index f0f828bd..b974a2e7 100644 --- a/base/comm/psb_sspgather.F90 +++ b/base/comm/psb_sspgather.F90 @@ -30,7 +30,7 @@ ! ! ! File: psb_sspgather.f90 -subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) +subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc,desc_c) use psb_desc_mod use psb_error_mod use psb_penv_mod @@ -43,14 +43,17 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep #ifdef MPI_H include 'mpif.h' #endif - type(psb_sspmat_type), intent(inout) :: loca - type(psb_sspmat_type), intent(inout) :: globa - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: root, dupl - logical, intent(in), optional :: keepnum,keeploc - - type(psb_s_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_sspmat_type), intent(inout) :: loca + type(psb_sspmat_type), intent(inout) :: globa + type(psb_desc_type), intent(in), target :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root, dupl + logical, intent(in), optional :: keepnum,keeploc + type(psb_desc_type), intent(in), optional, target :: desc_c + ! + type(psb_s_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_desc_type), pointer :: p_desc_c + integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ @@ -80,11 +83,17 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep else keeploc_ = .true. end if + if (present(desc_c)) then + p_desc_c => desc_c + else + p_desc_c => desc_a + end if + call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() - ncg = desc_a%get_global_rows() + ncg = p_desc_c%get_global_cols() allocate(nzbr(np), idisp(np),stat=info) if (info /= psb_success_) then @@ -102,7 +111,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep end if nzl = loc_coo%get_nzeros() call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I') - call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') + call psb_loc_to_glob(loc_coo%ja(1:nzl),p_desc_c,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl call psb_sum(ictxt,nzbr(1:np)) diff --git a/base/comm/psb_zspgather.F90 b/base/comm/psb_zspgather.F90 index 0505420d..7bcb72e7 100644 --- a/base/comm/psb_zspgather.F90 +++ b/base/comm/psb_zspgather.F90 @@ -30,7 +30,7 @@ ! ! ! File: psb_zspgather.f90 -subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) +subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc,desc_c) use psb_desc_mod use psb_error_mod use psb_penv_mod @@ -43,14 +43,17 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep #ifdef MPI_H include 'mpif.h' #endif - type(psb_zspmat_type), intent(inout) :: loca - type(psb_zspmat_type), intent(inout) :: globa - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: root, dupl - logical, intent(in), optional :: keepnum,keeploc - - type(psb_z_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_zspmat_type), intent(inout) :: loca + type(psb_zspmat_type), intent(inout) :: globa + type(psb_desc_type), intent(in), target :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root, dupl + logical, intent(in), optional :: keepnum,keeploc + type(psb_desc_type), intent(in), optional, target :: desc_c + ! + type(psb_z_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_desc_type), pointer :: p_desc_c + integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ @@ -80,11 +83,17 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep else keeploc_ = .true. end if + if (present(desc_c)) then + p_desc_c => desc_c + else + p_desc_c => desc_a + end if + call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() - ncg = desc_a%get_global_rows() + ncg = p_desc_c%get_global_cols() allocate(nzbr(np), idisp(np),stat=info) if (info /= psb_success_) then @@ -102,7 +111,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep end if nzl = loc_coo%get_nzeros() call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I') - call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') + call psb_loc_to_glob(loc_coo%ja(1:nzl),p_desc_c,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl call psb_sum(ictxt,nzbr(1:np)) diff --git a/base/modules/comm/psb_c_comm_mod.f90 b/base/modules/comm/psb_c_comm_mod.f90 index e14d6673..f2a9f72f 100644 --- a/base/modules/comm/psb_c_comm_mod.f90 +++ b/base/modules/comm/psb_c_comm_mod.f90 @@ -151,15 +151,16 @@ module psb_c_comm_mod end interface psb_scatter interface psb_gather - subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) + subroutine psb_csp_allgather(globa, loca, desc_a, info, root,dupl,keepnum,keeploc,desc_c) import implicit none - type(psb_cspmat_type), intent(inout) :: loca - type(psb_cspmat_type), intent(out) :: globa - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: root,dupl - logical, intent(in), optional :: keepnum,keeploc + type(psb_cspmat_type), intent(inout) :: loca + type(psb_cspmat_type), intent(out) :: globa + type(psb_desc_type), intent(in), target :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root,dupl + logical, intent(in), optional :: keepnum,keeploc + type(psb_desc_type), intent(in), optional, target :: desc_c end subroutine psb_csp_allgather subroutine psb_cgatherm(globx, locx, desc_a, info, root) import diff --git a/base/modules/comm/psb_d_comm_mod.f90 b/base/modules/comm/psb_d_comm_mod.f90 index 7c532dad..5e3a4607 100644 --- a/base/modules/comm/psb_d_comm_mod.f90 +++ b/base/modules/comm/psb_d_comm_mod.f90 @@ -151,15 +151,16 @@ module psb_d_comm_mod end interface psb_scatter interface psb_gather - subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) + subroutine psb_dsp_allgather(globa, loca, desc_a, info, root,dupl,keepnum,keeploc,desc_c) import implicit none - type(psb_dspmat_type), intent(inout) :: loca - type(psb_dspmat_type), intent(out) :: globa - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: root,dupl - logical, intent(in), optional :: keepnum,keeploc + type(psb_dspmat_type), intent(inout) :: loca + type(psb_dspmat_type), intent(out) :: globa + type(psb_desc_type), intent(in), target :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root,dupl + logical, intent(in), optional :: keepnum,keeploc + type(psb_desc_type), intent(in), optional, target :: desc_c end subroutine psb_dsp_allgather subroutine psb_dgatherm(globx, locx, desc_a, info, root) import diff --git a/base/modules/comm/psb_s_comm_mod.f90 b/base/modules/comm/psb_s_comm_mod.f90 index 82c848b7..3c9c31c5 100644 --- a/base/modules/comm/psb_s_comm_mod.f90 +++ b/base/modules/comm/psb_s_comm_mod.f90 @@ -151,15 +151,16 @@ module psb_s_comm_mod end interface psb_scatter interface psb_gather - subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) + subroutine psb_ssp_allgather(globa, loca, desc_a, info, root,dupl,keepnum,keeploc,desc_c) import implicit none - type(psb_sspmat_type), intent(inout) :: loca - type(psb_sspmat_type), intent(out) :: globa - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: root,dupl - logical, intent(in), optional :: keepnum,keeploc + type(psb_sspmat_type), intent(inout) :: loca + type(psb_sspmat_type), intent(out) :: globa + type(psb_desc_type), intent(in), target :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root,dupl + logical, intent(in), optional :: keepnum,keeploc + type(psb_desc_type), intent(in), optional, target :: desc_c end subroutine psb_ssp_allgather subroutine psb_sgatherm(globx, locx, desc_a, info, root) import diff --git a/base/modules/comm/psb_z_comm_mod.f90 b/base/modules/comm/psb_z_comm_mod.f90 index e4a6e9ea..822b6897 100644 --- a/base/modules/comm/psb_z_comm_mod.f90 +++ b/base/modules/comm/psb_z_comm_mod.f90 @@ -151,15 +151,16 @@ module psb_z_comm_mod end interface psb_scatter interface psb_gather - subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) + subroutine psb_zsp_allgather(globa, loca, desc_a, info, root,dupl,keepnum,keeploc,desc_c) import implicit none - type(psb_zspmat_type), intent(inout) :: loca - type(psb_zspmat_type), intent(out) :: globa - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: root,dupl - logical, intent(in), optional :: keepnum,keeploc + type(psb_zspmat_type), intent(inout) :: loca + type(psb_zspmat_type), intent(out) :: globa + type(psb_desc_type), intent(in), target :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root,dupl + logical, intent(in), optional :: keepnum,keeploc + type(psb_desc_type), intent(in), optional, target :: desc_c end subroutine psb_zsp_allgather subroutine psb_zgatherm(globx, locx, desc_a, info, root) import