fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Updated error tests on spgather.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 83743b55db
commit b16706e3ea
6 changed files with 79 additions and 58 deletions
Show Stats Download Patch File Download Diff File

24
base/comm/psb_cspgather.F90
Unescape Escape View File

@ -219,6 +219,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_lpk_), allocatable :: lnzbr(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -250,10 +251,9 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
nrg = desc_a%get_global_rows() nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows() ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),lnzbr(np),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_; ierr(1) = 3*np
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
@ -270,13 +270,15 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
#if defined(HAVE_ISO_FORTRAN_ENV) #if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))&
& .or.(sum(lnzbr) > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
@ -367,6 +369,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_lpk_), allocatable :: lnzbr(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -398,10 +401,9 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nrg = desc_a%get_global_rows() nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows() ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),lnzbr(np),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_; ierr(1) = 3*np
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
@ -418,13 +420,15 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
#if defined(HAVE_ISO_FORTRAN_ENV) #if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))&
& .or.(sum(lnzbr) > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if

17
base/comm/psb_dspgather.F90
Unescape Escape View File

@ -219,6 +219,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_lpk_), allocatable :: lnzbr(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -250,10 +251,9 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
nrg = desc_a%get_global_rows() nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows() ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),lnzbr(np),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_; ierr(1) = 3*np
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
@ -270,13 +270,15 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
#if defined(HAVE_ISO_FORTRAN_ENV) #if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))&
& .or.(sum(lnzbr) > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
@ -399,10 +401,9 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nrg = desc_a%get_global_rows() nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows() ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),lnzbr(np),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_; ierr(1) = 3*np
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if

24
base/comm/psb_ispgather.F90
Unescape Escape View File

@ -219,6 +219,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_lpk_), allocatable :: lnzbr(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -250,10 +251,9 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nrg = desc_a%get_global_rows() nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows() ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),lnzbr(np),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_; ierr(1) = 3*np
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
@ -270,13 +270,15 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
#if defined(HAVE_ISO_FORTRAN_ENV) #if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))&
& .or.(sum(lnzbr) > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
@ -367,6 +369,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_lpk_), allocatable :: lnzbr(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -398,10 +401,9 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
nrg = desc_a%get_global_rows() nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows() ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),lnzbr(np),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_; ierr(1) = 3*np
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
@ -418,13 +420,15 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
#if defined(HAVE_ISO_FORTRAN_ENV) #if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))&
& .or.(sum(lnzbr) > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if

24
base/comm/psb_lspgather.F90
Unescape Escape View File

@ -219,6 +219,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_lpk_), allocatable :: lnzbr(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -250,10 +251,9 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nrg = desc_a%get_global_rows() nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows() ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),lnzbr(np),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_; ierr(1) = 3*np
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
@ -270,13 +270,15 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
#if defined(HAVE_ISO_FORTRAN_ENV) #if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))&
& .or.(sum(lnzbr) > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
@ -367,6 +369,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_lpk_), allocatable :: lnzbr(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -398,10 +401,9 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
nrg = desc_a%get_global_rows() nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows() ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),lnzbr(np),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_; ierr(1) = 3*np
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
@ -418,13 +420,15 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
#if defined(HAVE_ISO_FORTRAN_ENV) #if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))&
& .or.(sum(lnzbr) > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if

24
base/comm/psb_sspgather.F90
Unescape Escape View File

@ -219,6 +219,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_lpk_), allocatable :: lnzbr(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -250,10 +251,9 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
nrg = desc_a%get_global_rows() nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows() ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),lnzbr(np),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_; ierr(1) = 3*np
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
@ -270,13 +270,15 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
#if defined(HAVE_ISO_FORTRAN_ENV) #if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))&
& .or.(sum(lnzbr) > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
@ -367,6 +369,7 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_lpk_), allocatable :: lnzbr(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -398,10 +401,9 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nrg = desc_a%get_global_rows() nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows() ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),lnzbr(np),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_; ierr(1) = 3*np
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
@ -418,13 +420,15 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
#if defined(HAVE_ISO_FORTRAN_ENV) #if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))&
& .or.(sum(lnzbr) > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if

24
base/comm/psb_zspgather.F90
Unescape Escape View File

@ -219,6 +219,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_lpk_), allocatable :: lnzbr(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -250,10 +251,9 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
nrg = desc_a%get_global_rows() nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows() ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),lnzbr(np),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_; ierr(1) = 3*np
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
@ -270,13 +270,15 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
#if defined(HAVE_ISO_FORTRAN_ENV) #if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))&
& .or.(sum(lnzbr) > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
@ -367,6 +369,7 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_mpk_) :: ictxt,np,me integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_lpk_), allocatable :: lnzbr(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -398,10 +401,9 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nrg = desc_a%get_global_rows() nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows() ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),lnzbr(np),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_; ierr(1) = 3*np
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
@ -418,13 +420,15 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if
#if defined(HAVE_ISO_FORTRAN_ENV) #if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))&
& .or.(sum(lnzbr) > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999 call psb_errpush(info,name); goto 9999
end if end if

Write Preview
Loading…
Cancel
Save