From 7674f6a83164b2e7c2d54f8d368043024492b571 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 16 Mar 2012 21:42:52 +0000 Subject: [PATCH] psblas3: base/comm/psb_cspgather.F90 base/comm/psb_dspgather.F90 base/comm/psb_sspgather.F90 base/comm/psb_zspgather.F90 Was missing loc_to_glob on gather. --- base/comm/psb_cspgather.F90 | 24 +++++++++++++++--------- base/comm/psb_dspgather.F90 | 24 +++++++++++++++--------- base/comm/psb_sspgather.F90 | 24 +++++++++++++++--------- base/comm/psb_zspgather.F90 | 24 +++++++++++++++--------- 4 files changed, 60 insertions(+), 36 deletions(-) diff --git a/base/comm/psb_cspgather.F90 b/base/comm/psb_cspgather.F90 index ee207f0c..31b3fd02 100644 --- a/base/comm/psb_cspgather.F90 +++ b/base/comm/psb_cspgather.F90 @@ -1,8 +1,9 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) use psb_descriptor_type use psb_error_mod - use psb_mat_mod use psb_penv_mod + use psb_mat_mod + use psb_tools_mod #ifdef MPI_MOD use mpi #endif @@ -20,7 +21,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep type(psb_c_coo_sparse_mat) :: loc_coo, glob_coo integer(psb_mpik_) :: ictxt,np,me, icomm, minfo integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg - integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k + integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpik_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) @@ -59,9 +60,18 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_errpush(info,name,i_err=ierr,a_err='integer') goto 9999 end if - call loca%mv_to(loc_coo) + + + if (keeploc_) then + call loca%cp_to(loc_coo) + else + call loca%mv_to(loc_coo) + 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') nzbr(:) = 0 - nzbr(me+1) = loc_coo%get_nzeros() + nzbr(me+1) = nzl call psb_sum(ictxt,nzbr(1:np)) nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) @@ -86,11 +96,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep goto 9999 end if - if (keeploc_) then - call loca%mv_from(loc_coo) - else - call loc_coo%free() - end if + call loc_coo%free() call glob_coo%set_nzeros(nzg) if (present(dupl)) call glob_coo%set_dupl(dupl) call globa%mv_from(glob_coo) diff --git a/base/comm/psb_dspgather.F90 b/base/comm/psb_dspgather.F90 index a5c1fe7a..bb667b9c 100644 --- a/base/comm/psb_dspgather.F90 +++ b/base/comm/psb_dspgather.F90 @@ -1,8 +1,9 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) use psb_descriptor_type use psb_error_mod - use psb_mat_mod use psb_penv_mod + use psb_mat_mod + use psb_tools_mod #ifdef MPI_MOD use mpi #endif @@ -20,7 +21,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep type(psb_d_coo_sparse_mat) :: loc_coo, glob_coo integer(psb_mpik_) :: ictxt,np,me, icomm, minfo integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg - integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k + integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpik_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) @@ -59,9 +60,18 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_errpush(info,name,i_err=ierr,a_err='integer') goto 9999 end if - call loca%mv_to(loc_coo) + + + if (keeploc_) then + call loca%cp_to(loc_coo) + else + call loca%mv_to(loc_coo) + 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') nzbr(:) = 0 - nzbr(me+1) = loc_coo%get_nzeros() + nzbr(me+1) = nzl call psb_sum(ictxt,nzbr(1:np)) nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) @@ -86,11 +96,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep goto 9999 end if - if (keeploc_) then - call loca%mv_from(loc_coo) - else - call loc_coo%free() - end if + call loc_coo%free() call glob_coo%set_nzeros(nzg) if (present(dupl)) call glob_coo%set_dupl(dupl) call globa%mv_from(glob_coo) diff --git a/base/comm/psb_sspgather.F90 b/base/comm/psb_sspgather.F90 index ea2a832e..f7e872ae 100644 --- a/base/comm/psb_sspgather.F90 +++ b/base/comm/psb_sspgather.F90 @@ -1,8 +1,9 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) use psb_descriptor_type use psb_error_mod - use psb_mat_mod use psb_penv_mod + use psb_mat_mod + use psb_tools_mod #ifdef MPI_MOD use mpi #endif @@ -20,7 +21,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep type(psb_s_coo_sparse_mat) :: loc_coo, glob_coo integer(psb_mpik_) :: ictxt,np,me, icomm, minfo integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg - integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k + integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpik_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) @@ -59,9 +60,18 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_errpush(info,name,i_err=ierr,a_err='integer') goto 9999 end if - call loca%mv_to(loc_coo) + + + if (keeploc_) then + call loca%cp_to(loc_coo) + else + call loca%mv_to(loc_coo) + 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') nzbr(:) = 0 - nzbr(me+1) = loc_coo%get_nzeros() + nzbr(me+1) = nzl call psb_sum(ictxt,nzbr(1:np)) nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) @@ -86,11 +96,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep goto 9999 end if - if (keeploc_) then - call loca%mv_from(loc_coo) - else - call loc_coo%free() - end if + call loc_coo%free() call glob_coo%set_nzeros(nzg) if (present(dupl)) call glob_coo%set_dupl(dupl) call globa%mv_from(glob_coo) diff --git a/base/comm/psb_zspgather.F90 b/base/comm/psb_zspgather.F90 index 55f378ae..2ac09ea6 100644 --- a/base/comm/psb_zspgather.F90 +++ b/base/comm/psb_zspgather.F90 @@ -1,8 +1,9 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) use psb_descriptor_type use psb_error_mod - use psb_mat_mod use psb_penv_mod + use psb_mat_mod + use psb_tools_mod #ifdef MPI_MOD use mpi #endif @@ -20,7 +21,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep type(psb_z_coo_sparse_mat) :: loc_coo, glob_coo integer(psb_mpik_) :: ictxt,np,me, icomm, minfo integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg - integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k + integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpik_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) @@ -59,9 +60,18 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_errpush(info,name,i_err=ierr,a_err='integer') goto 9999 end if - call loca%mv_to(loc_coo) + + + if (keeploc_) then + call loca%cp_to(loc_coo) + else + call loca%mv_to(loc_coo) + 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') nzbr(:) = 0 - nzbr(me+1) = loc_coo%get_nzeros() + nzbr(me+1) = nzl call psb_sum(ictxt,nzbr(1:np)) nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) @@ -86,11 +96,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep goto 9999 end if - if (keeploc_) then - call loca%mv_from(loc_coo) - else - call loc_coo%free() - end if + call loc_coo%free() call glob_coo%set_nzeros(nzg) if (present(dupl)) call glob_coo%set_dupl(dupl) call globa%mv_from(glob_coo)