fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 12:52:14 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
clenaup and checks for repeated indices in vl into cdall.
This commit is contained in:
Salvatore Filippone
2010-05-26 08:38:52 +00:00
parent 1c6b259541
commit d3949b9ad3
5 changed files with 58 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_const_mod.F90
+1
View File
@@ -133,6 +133,7 @@ module psb_const_mod
integer, parameter, public :: psb_err_invalid_args_combination_=110
integer, parameter, public :: psb_err_invalid_pid_arg_=115
integer, parameter, public :: psb_err_iarg_n_mbgtian_=120
integer, parameter, public :: psb_err_dupl_cd_vl=123
integer, parameter, public :: psb_err_duplicate_coo=130
integer, parameter, public :: psb_err_invalid_input_format_=134
integer, parameter, public :: psb_err_unsupported_format_=135
base/modules/psb_error_impl.F90
+28 -14
View File
@@ -12,15 +12,16 @@ subroutine psb_errcomm(ictxt, err)
end subroutine psb_errcomm
! handles the occurence of an error in a serial routine
subroutine psb_serror()
use psb_error_mod!, psb_protect_name => psb_serror
use psb_const_mod
use psb_error_mod
implicit none
integer :: err_c
character(len=20) :: r_name
character(len=40) :: a_e_d
integer :: i_e_d(5)
if(error_status > 0) then
if(verbosity_level > 1) then
if(psb_get_errstatus() > 0) then
if(psb_get_errverbosity() > 1) then
do while (psb_get_numerr() > izero)
write(0,'(50("="))')
@@ -44,9 +45,10 @@ end subroutine psb_serror
! handles the occurence of an error in a parallel routine
subroutine psb_perror(ictxt)
use psb_error_mod!, psb_protect_name => psb_perror
use psb_const_mod
use psb_error_mod
use psb_penv_mod
implicit none
integer, intent(in) :: ictxt
integer :: err_c
character(len=20) :: r_name
@@ -55,21 +57,27 @@ subroutine psb_perror(ictxt)
integer :: iam, np
#if defined(SERIAL_MPI)
me = -1
iam = -1
#else
call psb_info(ictxt,iam,np)
#endif
if(error_status > 0) then
if(verbosity_level > 1) then
if(psb_get_errstatus() > 0) then
if(psb_get_errverbosity() > 1) then
do while (psb_get_numerr() > izero)
write(0,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,iam)
! write(0,'(50("="))')
end do
#if defined(HAVE_FLUSH_SUB)
call flush(0)
#endif
#if defined(HAVE_FLUSH_STMT)
flush(0)
#endif
#if defined(SERIAL_MPI)
stop
#else
@@ -78,10 +86,16 @@ subroutine psb_perror(ictxt)
else
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,iam)
do while (psb_get_numerr() > 0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
#if defined(HAVE_FLUSH_SUB)
call flush(0)
#endif
#if defined(HAVE_FLUSH_STMT)
flush(0)
#endif
#if defined(SERIAL_MPI)
stop
#else
@@ -90,7 +104,7 @@ subroutine psb_perror(ictxt)
end if
end if
if(error_status > izero) then
if(psb_get_errstatus() > izero) then
#if defined(SERIAL_MPI)
stop
#else
base/modules/psb_error_mod.F90
+3
View File
@@ -342,6 +342,9 @@ contains
case(psb_err_iarg_n_mbgtian_)
write (error_unit,'("input argument n. ",i0," must be greater than input argument n. ",i0)')i_e_d(1:2)
write (error_unit,'("current values are ",i0," < ",i0)') i_e_d(3:4)
case(psb_err_dupl_cd_vl)
write (error_unit,'("there are duplicated entries in vl (input to cdall)")')
! ... coo format error ...
! ... coo format error ...
case(psb_err_duplicate_coo)
write (error_unit,'("there are duplicated elements in coo format")')
base/tools/psb_cd_inloc.f90
+21 -6
View File
@@ -67,6 +67,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
info=psb_success_
err=0
name = 'psb_cd_inloc'
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@@ -220,12 +221,16 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
end if
!
! Now sort the input items, and eliminate duplicates
! Now sort the input items, and check for duplicates
! (unlikely, but possible)
!
call psb_msort_unique(vl,nlu)
loc_row = nlu
if (loc_row /= nlu) then
info = psb_err_dupl_cd_vl
call psb_errpush(info,name)
goto 9999
end if
call psb_nullify_desc(desc)
!
@@ -327,6 +332,9 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
!
! We have to decide whether we have a "large" index space.
! Note: in what follows, we use the original V, not the sorted VL
! to make sure indices are processed in the order the user expects
! them.
!
if (islarge) then
!
@@ -350,7 +358,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
j = 1
itmpov = 0
do k=1, loc_row
i = vl(k)
i = v(k)
desc%idxmap%loc_to_glob(k) = i
if (check_) then
@@ -422,7 +430,14 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
j = 1
itmpov = 0
do k=1, loc_row
i = vl(k)
i = v(k)
if (desc%idxmap%glob_to_loc(i) > 0) then
info = psb_err_dupl_cd_vl
call psb_errpush(info,name)
goto 9999
end if
desc%idxmap%loc_to_glob(k) = i
desc%idxmap%glob_to_loc(i) = k
@@ -455,7 +470,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
end if
call psi_bld_tmpovrl(temp_ovrlap,desc,info)
if (info == psb_success_) deallocate(temp_ovrlap,vl,stat=info)
if ((info == psb_success_).and.(allocated(tmpgidx)))&
& deallocate(tmpgidx,stat=info)
base/tools/psb_cd_set_bld.f90
+5
View File
@@ -82,6 +82,11 @@ subroutine psb_cd_set_bld(desc,info)
nc = psb_cd_get_local_cols(desc)
if (info == psb_success_)&
& call psb_hash_init(nc,desc%idxmap%hash,info)
if (info == HashDuplicate) then
info = psb_err_dupl_cd_vl
call psb_errpush(info,name,a_err='hashInit')
goto 9999
end if
if (info == psb_success_) call psi_bld_g2lmap(desc,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='hashInit')