From b1035627016bbd9919a68bab22e58316ec95fab3 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 28 Jun 2018 16:43:45 +0100 Subject: [PATCH] Fixed LXLX gather. To be reviewed. --- base/comm/psb_cspgather.F90 | 18 +++++++++--------- base/comm/psb_dspgather.F90 | 18 +++++++++--------- base/comm/psb_ispgather.F90 | 18 +++++++++--------- base/comm/psb_lspgather.F90 | 18 +++++++++--------- base/comm/psb_sspgather.F90 | 18 +++++++++--------- base/comm/psb_zspgather.F90 | 18 +++++++++--------- 6 files changed, 54 insertions(+), 54 deletions(-) diff --git a/base/comm/psb_cspgather.F90 b/base/comm/psb_cspgather.F90 index 0be6fdf3..d5e9fc81 100644 --- a/base/comm/psb_cspgather.F90 +++ b/base/comm/psb_cspgather.F90 @@ -201,7 +201,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: icomm, minfo, ndx - integer(psb_lpk_), allocatable :: nzbr(:), idisp(:) + integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name integer(psb_ipk_) :: debug_level, debug_unit @@ -256,6 +256,9 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 + ! + ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING + ! do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) @@ -331,11 +334,11 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k type(psb_lc_coo_sparse_mat) :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ - integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl + integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: icomm, minfo, ndx - integer(psb_lpk_), allocatable :: nzbr(:), idisp(:) + integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name integer(psb_ipk_) :: debug_level, debug_unit @@ -390,7 +393,9 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 - + ! + ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING + ! do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo @@ -414,11 +419,6 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k end if call loc_coo%free() ! - ! Is the code below safe? For very large cases - ! the indices in glob_coo will overflow. But then, - ! for very large cases it does not make sense to - ! gather the matrix on a single procecss anyway... - ! 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 144fb363..8836c1d6 100644 --- a/base/comm/psb_dspgather.F90 +++ b/base/comm/psb_dspgather.F90 @@ -201,7 +201,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: icomm, minfo, ndx - integer(psb_lpk_), allocatable :: nzbr(:), idisp(:) + integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name integer(psb_ipk_) :: debug_level, debug_unit @@ -256,6 +256,9 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 + ! + ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING + ! do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) @@ -331,11 +334,11 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k type(psb_ld_coo_sparse_mat) :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ - integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl + integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: icomm, minfo, ndx - integer(psb_lpk_), allocatable :: nzbr(:), idisp(:) + integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name integer(psb_ipk_) :: debug_level, debug_unit @@ -390,7 +393,9 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 - + ! + ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING + ! do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo @@ -414,11 +419,6 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k end if call loc_coo%free() ! - ! Is the code below safe? For very large cases - ! the indices in glob_coo will overflow. But then, - ! for very large cases it does not make sense to - ! gather the matrix on a single procecss anyway... - ! 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_ispgather.F90 b/base/comm/psb_ispgather.F90 index 0fcfaba4..dba3f5ae 100644 --- a/base/comm/psb_ispgather.F90 +++ b/base/comm/psb_ispgather.F90 @@ -201,7 +201,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: icomm, minfo, ndx - integer(psb_lpk_), allocatable :: nzbr(:), idisp(:) + integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name integer(psb_ipk_) :: debug_level, debug_unit @@ -256,6 +256,9 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 + ! + ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING + ! do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) @@ -331,11 +334,11 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn type(psb_@LX@_coo_sparse_mat) :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ - integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl + integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: icomm, minfo, ndx - integer(psb_lpk_), allocatable :: nzbr(:), idisp(:) + integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name integer(psb_ipk_) :: debug_level, debug_unit @@ -390,7 +393,9 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 - + ! + ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING + ! do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo @@ -414,11 +419,6 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn end if call loc_coo%free() ! - ! Is the code below safe? For very large cases - ! the indices in glob_coo will overflow. But then, - ! for very large cases it does not make sense to - ! gather the matrix on a single procecss anyway... - ! 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_lspgather.F90 b/base/comm/psb_lspgather.F90 index aceae019..bb95b5ba 100644 --- a/base/comm/psb_lspgather.F90 +++ b/base/comm/psb_lspgather.F90 @@ -201,7 +201,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: icomm, minfo, ndx - integer(psb_lpk_), allocatable :: nzbr(:), idisp(:) + integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name integer(psb_ipk_) :: debug_level, debug_unit @@ -256,6 +256,9 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 + ! + ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING + ! do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) @@ -331,11 +334,11 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn type(psb_@LX@_coo_sparse_mat) :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ - integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl + integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: icomm, minfo, ndx - integer(psb_lpk_), allocatable :: nzbr(:), idisp(:) + integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name integer(psb_ipk_) :: debug_level, debug_unit @@ -390,7 +393,9 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 - + ! + ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING + ! do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo @@ -414,11 +419,6 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn end if call loc_coo%free() ! - ! Is the code below safe? For very large cases - ! the indices in glob_coo will overflow. But then, - ! for very large cases it does not make sense to - ! gather the matrix on a single procecss anyway... - ! 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 9df3602b..6a20e732 100644 --- a/base/comm/psb_sspgather.F90 +++ b/base/comm/psb_sspgather.F90 @@ -201,7 +201,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: icomm, minfo, ndx - integer(psb_lpk_), allocatable :: nzbr(:), idisp(:) + integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name integer(psb_ipk_) :: debug_level, debug_unit @@ -256,6 +256,9 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 + ! + ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING + ! do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) @@ -331,11 +334,11 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k type(psb_ls_coo_sparse_mat) :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ - integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl + integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: icomm, minfo, ndx - integer(psb_lpk_), allocatable :: nzbr(:), idisp(:) + integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name integer(psb_ipk_) :: debug_level, debug_unit @@ -390,7 +393,9 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 - + ! + ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING + ! do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo @@ -414,11 +419,6 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k end if call loc_coo%free() ! - ! Is the code below safe? For very large cases - ! the indices in glob_coo will overflow. But then, - ! for very large cases it does not make sense to - ! gather the matrix on a single procecss anyway... - ! 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 6939f0ba..bb7044ed 100644 --- a/base/comm/psb_zspgather.F90 +++ b/base/comm/psb_zspgather.F90 @@ -201,7 +201,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: icomm, minfo, ndx - integer(psb_lpk_), allocatable :: nzbr(:), idisp(:) + integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name integer(psb_ipk_) :: debug_level, debug_unit @@ -256,6 +256,9 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 + ! + ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING + ! do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) @@ -331,11 +334,11 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k type(psb_lz_coo_sparse_mat) :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ - integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl + integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: icomm, minfo, ndx - integer(psb_lpk_), allocatable :: nzbr(:), idisp(:) + integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name integer(psb_ipk_) :: debug_level, debug_unit @@ -390,7 +393,9 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k nzg = sum(nzbr) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 - + ! + ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING + ! do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo @@ -414,11 +419,6 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k end if call loc_coo%free() ! - ! Is the code below safe? For very large cases - ! the indices in glob_coo will overflow. But then, - ! for very large cases it does not make sense to - ! gather the matrix on a single procecss anyway... - ! call glob_coo%set_nzeros(nzg) if (present(dupl)) call glob_coo%set_dupl(dupl) call globa%mv_from(glob_coo)