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

New error message for gather.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent b103562701
commit 83743b55db
8 changed files with 263 additions and 37 deletions
Show Stats Download Patch File Download Diff File

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

@ -31,6 +31,9 @@
!
! File: psb_cspgather.f90
subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -89,7 +92,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
if (keepnum_) then
nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
@ -113,6 +116,17 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if (nrg > HUGE(1_psb_mpk_)) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
if (info == psb_success_) call psb_realloc(nzg,glbia,info)
if (info == psb_success_) call psb_realloc(nzg,glbja,info)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
@ -175,6 +189,9 @@ end subroutine psb_csp_allgather
subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -254,6 +271,16 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
if (info /= psb_success_) goto 9999
!
@ -298,8 +325,6 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
goto 9999
end if
call psb_erractionrestore(err_act)
return
@ -312,6 +337,9 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
end subroutine psb_lcsp_allgather
subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -391,11 +419,19 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
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

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

@ -31,6 +31,9 @@
!
! File: psb_dspgather.f90
subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -89,7 +92,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
if (keepnum_) then
nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
@ -113,6 +116,17 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if (nrg > HUGE(1_psb_mpk_)) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
if (info == psb_success_) call psb_realloc(nzg,glbia,info)
if (info == psb_success_) call psb_realloc(nzg,glbja,info)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
@ -175,6 +189,9 @@ end subroutine psb_dsp_allgather
subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -254,6 +271,16 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
if (info /= psb_success_) goto 9999
!
@ -298,8 +325,6 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
goto 9999
end if
call psb_erractionrestore(err_act)
return
@ -312,6 +337,9 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
end subroutine psb_ldsp_allgather
subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -339,6 +367,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_lpk_), allocatable :: lnzbr(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit
@ -390,12 +419,22 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nzbr(:) = 0
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
lnzbr = nzbr
nzg = sum(nzbr)
if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
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_
call psb_errpush(info,name); goto 9999
end if
#endif
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

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

@ -31,6 +31,9 @@
!
! File: psb_ispgather.f90
subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -89,7 +92,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
if (keepnum_) then
nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
@ -113,6 +116,17 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if (nrg > HUGE(1_psb_mpk_)) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
if (info == psb_success_) call psb_realloc(nzg,glbia,info)
if (info == psb_success_) call psb_realloc(nzg,glbja,info)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
@ -175,6 +189,9 @@ end subroutine psb_isp_allgather
subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -254,6 +271,16 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
if (info /= psb_success_) goto 9999
!
@ -298,8 +325,6 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
goto 9999
end if
call psb_erractionrestore(err_act)
return
@ -312,6 +337,9 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
end subroutine psb_@LX@sp_allgather
subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -391,11 +419,19 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
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

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

@ -31,6 +31,9 @@
!
! File: psb_lspgather.f90
subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -89,7 +92,7 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
if (keepnum_) then
nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
@ -113,6 +116,17 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if (nrg > HUGE(1_psb_mpk_)) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
if (info == psb_success_) call psb_realloc(nzg,glbia,info)
if (info == psb_success_) call psb_realloc(nzg,glbja,info)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
@ -175,6 +189,9 @@ end subroutine psb_lsp_allgather
subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -254,6 +271,16 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
if (info /= psb_success_) goto 9999
!
@ -298,8 +325,6 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
goto 9999
end if
call psb_erractionrestore(err_act)
return
@ -312,6 +337,9 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
end subroutine psb_@LX@sp_allgather
subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -391,11 +419,19 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
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

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

@ -31,6 +31,9 @@
!
! File: psb_sspgather.f90
subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -89,7 +92,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
if (keepnum_) then
nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
@ -113,6 +116,17 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if (nrg > HUGE(1_psb_mpk_)) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
if (info == psb_success_) call psb_realloc(nzg,glbia,info)
if (info == psb_success_) call psb_realloc(nzg,glbja,info)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
@ -175,6 +189,9 @@ end subroutine psb_ssp_allgather
subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -254,6 +271,16 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
if (info /= psb_success_) goto 9999
!
@ -298,8 +325,6 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
goto 9999
end if
call psb_erractionrestore(err_act)
return
@ -312,6 +337,9 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
end subroutine psb_lssp_allgather
subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -391,11 +419,19 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
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

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

@ -31,6 +31,9 @@
!
! File: psb_zspgather.f90
subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -89,7 +92,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
if (keepnum_) then
nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
@ -113,6 +116,17 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if (nrg > HUGE(1_psb_mpk_)) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
if (info == psb_success_) call psb_realloc(nzg,glbia,info)
if (info == psb_success_) call psb_realloc(nzg,glbja,info)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
@ -175,6 +189,9 @@ end subroutine psb_zsp_allgather
subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -254,6 +271,16 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
if (info /= psb_success_) goto 9999
!
@ -298,8 +325,6 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
goto 9999
end if
call psb_erractionrestore(err_act)
return
@ -312,6 +337,9 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
end subroutine psb_lzsp_allgather
subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
@ -391,11 +419,19 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (nzg <0) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#if defined(HAVE_ISO_FORTRAN_ENV)
if ((nrg > HUGE(1_psb_mpk_)).or.(nzg > HUGE(1_psb_mpk_))) then
info = psb_err_mpi_int_ovflw_
call psb_errpush(info,name); goto 9999
end if
#endif
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

1
base/modules/psb_const_mod.F90
Unescape Escape View File

@ -255,6 +255,7 @@ module psb_const_mod
integer(psb_ipk_), parameter, public :: psb_err_wrong_ins_=298
integer(psb_ipk_), parameter, public :: psb_err_iarg_mbeeiarra_i_=300
integer(psb_ipk_), parameter, public :: psb_err_bad_int_cnv_=301
integer(psb_ipk_), parameter, public :: psb_err_mpi_int_ovflw_=302
integer(psb_ipk_), parameter, public :: psb_err_mpi_error_=400
integer(psb_ipk_), parameter, public :: psb_err_parm_differs_among_procs_=550
integer(psb_ipk_), parameter, public :: psb_err_entry_out_of_bounds_=551

8
base/modules/psb_error_mod.F90
Unescape Escape View File

@ -701,12 +701,18 @@ contains
& trim(r_name)
case(psb_err_bad_int_cnv_)
allocate(achmsg(3))
allocate(achmsg(2))
achmsg(1) = tmpmsg
write(achmsg(2),&
& '("Bad integer conversion from ",i0,"to ",i0)') &
& e_e_d(1),e_e_d(2)
case(psb_err_mpi_int_ovflw_)
allocate(achmsg(2))
achmsg(1) = tmpmsg
write(achmsg(2),&
& '("Size argument to MPI overflow.")')
case(psb_err_iarg_mbeeiarra_i_)
allocate(achmsg(3))
achmsg(1) = tmpmsg

Write Preview
Loading…
Cancel
Save