diff --git a/base/modules/psb_const_mod.F90 b/base/modules/psb_const_mod.F90 index f728e30f..319a9992 100644 --- a/base/modules/psb_const_mod.F90 +++ b/base/modules/psb_const_mod.F90 @@ -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 diff --git a/base/modules/psb_error_impl.F90 b/base/modules/psb_error_impl.F90 index eea493cf..1529b1a1 100644 --- a/base/modules/psb_error_impl.F90 +++ b/base/modules/psb_error_impl.F90 @@ -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 diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90 index c0fe3e98..98620c50 100644 --- a/base/modules/psb_error_mod.F90 +++ b/base/modules/psb_error_mod.F90 @@ -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")') diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index db6c44f1..cd6f03ce 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -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) diff --git a/base/tools/psb_cd_set_bld.f90 b/base/tools/psb_cd_set_bld.f90 index 6cd467e0..10cdad22 100644 --- a/base/tools/psb_cd_set_bld.f90 +++ b/base/tools/psb_cd_set_bld.f90 @@ -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')