Defined interface msort_unique and used in neigh and cdovr.

base/modules/psb_serial_mod.f90

@@ -462,6 +462,9 @@ module psb_serial_mod
   interface psb_msort
     module procedure imsort
   end interface
+  interface psb_msort_unique
+    module procedure imsort_u
+  end interface
   interface psb_qsort
     module procedure iqsort
   end interface
@@ -529,6 +532,66 @@ contains
     end if
   end subroutine imsort
 
+  subroutine imsort_u(x,nout,dir)
+    use psb_error_mod
+    implicit none 
+    integer, intent(inout)           :: x(:) 
+    integer, intent(out)             :: nout
+    integer, optional, intent(in)    :: dir
+!!$    , flag
+!!$    integer, optional, intent(inout) :: ix(:)
+    
+    integer  :: dir_, flag_, n, err_act
+    
+    character(len=20)  :: name
+
+    name='psb_msort'
+
+    if (present(dir)) then 
+      dir_ = dir
+    else
+      dir_= psb_sort_up_
+    end if
+    select case(dir_) 
+    case( psb_sort_up_, psb_sort_down_)
+      ! OK keep going
+    case default
+      call psb_errpush(30,name,i_err=(/3,dir_,0,0,0/))
+      goto 9999
+    end select
+      
+    n = size(x)
+ 
+!!$    if (present(ix)) then 
+!!$      if (size(ix) < n) then 
+!!$        call psb_errpush(35,name,i_err=(/2,size(ix),0,0,0/))
+!!$        goto 9999
+!!$      end if
+!!$      if (present(flag)) then 
+!!$        flag_ = flag
+!!$      else 
+!!$        flag_ = psb_sort_ovw_idx_
+!!$      end if
+!!$      select case(flag_) 
+!!$      case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
+!!$        ! OK keep going
+!!$      case default
+!!$        call psb_errpush(30,name,i_err=(/4,flag_,0,0,0/))
+!!$        goto 9999
+!!$      end select
+!!$
+!!$      call imsrx(n,x,ix,dir_,flag_)
+!!$    else
+      call imsru(n,x,dir_,nout)
+!!$    end if
+
+9999 continue 
+    if (err_act.eq.psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+  end subroutine imsort_u
+
 
   subroutine iqsort(x,ix,dir,flag)
     use psb_error_mod

base/serial/psb_dneigh.f90

@@ -87,7 +87,7 @@ subroutine psb_dneigh(a,idx,neigh,n,info,lev)
         ntl = ntl+nn
       end if
     end do
-    call imsru(ntl,neigh(ill+1:ill+ntl),psb_sort_up_,nn)
+    call psb_msort_unique(neigh(ill+1:ill+ntl),nn)
     ifl = ill + 1
     ill = ill + nn
   end do

base/serial/psb_zneigh.f90

@@ -87,7 +87,7 @@ subroutine psb_zneigh(a,idx,neigh,n,info,lev)
         ntl = ntl+nn
       end if
     end do
-    call imsru(ntl,neigh(ill+1:ill+ntl),psb_sort_up_,nn)
+    call psb_msort_unique(neigh(ill+1:ill+ntl),nn)
     ifl = ill + 1
     ill = ill + nn
   end do

base/tools/psb_dcdovr.F90

@@ -85,7 +85,7 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info, extype)
        &  ictxt, lovr, lworks,lworkr, n_row,n_col, int_err(5),&
        &  index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo
   Integer :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,&
-       & n_elem_send,tot_recv,tot_elem,cntov_o,nz,&
+       & n_elem_send,tot_recv,tot_elem,cntov_o,&
        & counter_t,n_elem,i_ovr,jj,proc_id,isz, mglob, glx, &
        & idxr, idxs, lx, iszr, iszs, nxch, nsnd, nrcv,lidx,irsv, extype_
 
@@ -427,11 +427,9 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info, extype)
             goto 9999
           end if
 !!$          write(0,*) me,'Iteration: ',j,i_ovr
-
           Do jj=1,n_elem
             works(idxs+tot_elem+jj)=desc_ov%loc_to_glob(blk%ia2(jj))
           End Do
-
           tot_elem=tot_elem+n_elem
         End If
 
@@ -440,19 +438,7 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info, extype)
 
       if (i_ovr <= novr) then 
         if (tot_elem > 1) then 
-          call psb_msort(works(idxs+1:idxs+tot_elem))
+          call psb_msort_unique(works(idxs+1:idxs+tot_elem),i)
-          lx = works(idxs+1)
-          i = 1 
-          j = 1
-          do 
-            j = j + 1 
-            if (j > tot_elem) exit
-            if (works(idxs+j) /= lx) then 
-              i = i + 1
-              works(idxs+i) = works(idxs+j) 
-              lx = works(idxs+i) 
-            end if
-          end do
           tot_elem=i
         endif
         if (debug) write(0,*) me,'Checktmp_o_i Loop Mid2',tmp_ovr_idx(1:10)

base/tools/psb_zcdovr.F90

@@ -92,7 +92,6 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info, extype)
   Integer,allocatable   :: halo(:),works(:),workr(:),t_halo_in(:),&
        & t_halo_out(:),temp(:),maskr(:)
   Integer,allocatable  :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
-
   Logical,Parameter :: debug=.false.
   character(len=20) :: name, ch_err
 
@@ -399,7 +398,6 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info, extype)
         !
         If (i_ovr <= (novr)) Then
           n_elem = psb_sp_get_nnz_row(idx,a)
-
           call psb_ensure_size((idxs+tot_elem+n_elem),works,info)
           if (info /= 0) then
             info=4010
@@ -438,19 +436,7 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info, extype)
 
       if (i_ovr <= novr) then 
         if (tot_elem > 1) then 
-          call psb_msort(works(idxs+1:idxs+tot_elem))
+          call psb_msort_unique(works(idxs+1:idxs+tot_elem),i)
-          lx = works(idxs+1)
-          i = 1 
-          j = 1
-          do 
-            j = j + 1 
-            if (j > tot_elem) exit
-            if (works(idxs+j) /= lx) then 
-              i = i + 1
-              works(idxs+i) = works(idxs+j) 
-              lx = works(idxs+i) 
-            end if
-          end do
           tot_elem=i
         endif
         if (debug) write(0,*) me,'Checktmp_o_i Loop Mid2',tmp_ovr_idx(1:10)