diff --git a/base/modules/psb_serial_mod.f90 b/base/modules/psb_serial_mod.f90 index 49bf3391..d3484551 100644 --- a/base/modules/psb_serial_mod.f90 +++ b/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 diff --git a/base/serial/psb_dneigh.f90 b/base/serial/psb_dneigh.f90 index 6a1afb59..f4bf4bdb 100644 --- a/base/serial/psb_dneigh.f90 +++ b/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 diff --git a/base/serial/psb_zneigh.f90 b/base/serial/psb_zneigh.f90 index ef3ec432..202e7fde 100644 --- a/base/serial/psb_zneigh.f90 +++ b/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 diff --git a/base/tools/psb_dcdovr.F90 b/base/tools/psb_dcdovr.F90 index 5ef862d4..41ccad06 100644 --- a/base/tools/psb_dcdovr.F90 +++ b/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,20 +438,8 @@ 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)) - 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 + call psb_msort_unique(works(idxs+1:idxs+tot_elem),i) + tot_elem=i endif if (debug) write(0,*) me,'Checktmp_o_i Loop Mid2',tmp_ovr_idx(1:10) sdsz(proc+1) = tot_elem diff --git a/base/tools/psb_zcdovr.F90 b/base/tools/psb_zcdovr.F90 index 9930529a..36580bb1 100644 --- a/base/tools/psb_zcdovr.F90 +++ b/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,20 +436,8 @@ 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)) - 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 + call psb_msort_unique(works(idxs+1:idxs+tot_elem),i) + tot_elem=i endif if (debug) write(0,*) me,'Checktmp_o_i Loop Mid2',tmp_ovr_idx(1:10) sdsz(proc+1) = tot_elem