psblas3:

clenaup and checks for repeated indices in vl into cdall.

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

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        

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")')

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)

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