Fixed LXLX gather. To be reviewed.

ILmat
Salvatore Filippone 8 years ago
parent 9194f49f34
commit b103562701

@ -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)

@ -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)

@ -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)

@ -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)

@ -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)

@ -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)

Loading…
Cancel
Save