Cosmetic adjustments to COO and BSRCH

base/serial/impl/psb_c_coo_impl.F90

@@ -3669,7 +3669,7 @@ subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
   integer(psb_ipk_), allocatable :: ias(:),jas(:), ix2(:)
   complex(psb_spk_),  allocatable :: vs(:)
   integer(psb_ipk_) :: nza, nzl,iret
-  integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii
+  integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii, i1, i2
   integer(psb_ipk_) :: debug_level, debug_unit
   character(len=20)    :: name = 'psb_fixcoo'
   logical :: srt_inp, use_buffers
@@ -3759,7 +3759,7 @@ subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
     !$OMP PARALLEL default(none) &
     !$OMP shared(t0,t1,idxaux,ia,ja,val,ias,jas,vs,nthreads,sum,nr,nc,nzin,iaux,kaux,dupl,err) &
     !$OMP private(s,i,j,k,ithread,idxstart,idxend,work,nxt_val,old_val,saved_elem, &
-    !$OMP first_elem,last_elem,nzl,iret,act_row) reduction(max: info)
+    !$OMP first_elem,last_elem,nzl,iret,act_row,i1,i2) reduction(max: info)
 
     !$OMP SINGLE
     nthreads = omp_get_num_threads()
@@ -3783,7 +3783,7 @@ subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
     call psi_exscan(nr+1,iaux,info,shift=ione)
     !$OMP BARRIER
     !$OMP SINGLE
-    t0 = omp_get_wtime()
+    !t0 = omp_get_wtime()
     !$OMP END SINGLE
     
     ! ------------------ Sorting and buffers -------------------
@@ -3793,7 +3793,6 @@ subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
     do j=idxstart,idxend
       idxaux(j) = iaux(j)
     end do
-
     ! Here we sort data inside the auxiliary buffers
     do i=1,nzin
       act_row = ia(i)
@@ -3807,8 +3806,8 @@ subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
 
     !$OMP BARRIER
     !$OMP SINGLE
-    t1 = omp_get_wtime()
-    write(0,*) 'Srt&Cpy :',t1-t0
+    !t1 = omp_get_wtime()
+    !write(0,*) ithread,'Srt&Cpy :',t1-t0
     !$OMP END SINGLE
     ! Let's sort column indices and values. After that we will store
     ! the number of unique values in 'kaux'

base/serial/impl/psb_d_coo_impl.F90

@@ -3669,7 +3669,7 @@ subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
   integer(psb_ipk_), allocatable :: ias(:),jas(:), ix2(:)
   real(psb_dpk_),  allocatable :: vs(:)
   integer(psb_ipk_) :: nza, nzl,iret
-  integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii
+  integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii, i1, i2
   integer(psb_ipk_) :: debug_level, debug_unit
   character(len=20)    :: name = 'psb_fixcoo'
   logical :: srt_inp, use_buffers
@@ -3759,7 +3759,7 @@ subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
     !$OMP PARALLEL default(none) &
     !$OMP shared(t0,t1,idxaux,ia,ja,val,ias,jas,vs,nthreads,sum,nr,nc,nzin,iaux,kaux,dupl,err) &
     !$OMP private(s,i,j,k,ithread,idxstart,idxend,work,nxt_val,old_val,saved_elem, &
-    !$OMP first_elem,last_elem,nzl,iret,act_row) reduction(max: info)
+    !$OMP first_elem,last_elem,nzl,iret,act_row,i1,i2) reduction(max: info)
 
     !$OMP SINGLE
     nthreads = omp_get_num_threads()
@@ -3783,7 +3783,7 @@ subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
     call psi_exscan(nr+1,iaux,info,shift=ione)
     !$OMP BARRIER
     !$OMP SINGLE
-    t0 = omp_get_wtime()
+    !t0 = omp_get_wtime()
     !$OMP END SINGLE
     
     ! ------------------ Sorting and buffers -------------------
@@ -3793,7 +3793,6 @@ subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
     do j=idxstart,idxend
       idxaux(j) = iaux(j)
     end do
-
     ! Here we sort data inside the auxiliary buffers
     do i=1,nzin
       act_row = ia(i)
@@ -3807,8 +3806,8 @@ subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
 
     !$OMP BARRIER
     !$OMP SINGLE
-    t1 = omp_get_wtime()
-    write(0,*) 'Srt&Cpy :',t1-t0
+    !t1 = omp_get_wtime()
+    !write(0,*) ithread,'Srt&Cpy :',t1-t0
     !$OMP END SINGLE
     ! Let's sort column indices and values. After that we will store
     ! the number of unique values in 'kaux'

base/serial/impl/psb_s_coo_impl.F90

@@ -3669,7 +3669,7 @@ subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
   integer(psb_ipk_), allocatable :: ias(:),jas(:), ix2(:)
   real(psb_spk_),  allocatable :: vs(:)
   integer(psb_ipk_) :: nza, nzl,iret
-  integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii
+  integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii, i1, i2
   integer(psb_ipk_) :: debug_level, debug_unit
   character(len=20)    :: name = 'psb_fixcoo'
   logical :: srt_inp, use_buffers
@@ -3759,7 +3759,7 @@ subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
     !$OMP PARALLEL default(none) &
     !$OMP shared(t0,t1,idxaux,ia,ja,val,ias,jas,vs,nthreads,sum,nr,nc,nzin,iaux,kaux,dupl,err) &
     !$OMP private(s,i,j,k,ithread,idxstart,idxend,work,nxt_val,old_val,saved_elem, &
-    !$OMP first_elem,last_elem,nzl,iret,act_row) reduction(max: info)
+    !$OMP first_elem,last_elem,nzl,iret,act_row,i1,i2) reduction(max: info)
 
     !$OMP SINGLE
     nthreads = omp_get_num_threads()
@@ -3783,7 +3783,7 @@ subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
     call psi_exscan(nr+1,iaux,info,shift=ione)
     !$OMP BARRIER
     !$OMP SINGLE
-    t0 = omp_get_wtime()
+    !t0 = omp_get_wtime()
     !$OMP END SINGLE
     
     ! ------------------ Sorting and buffers -------------------
@@ -3793,7 +3793,6 @@ subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
     do j=idxstart,idxend
       idxaux(j) = iaux(j)
     end do
-
     ! Here we sort data inside the auxiliary buffers
     do i=1,nzin
       act_row = ia(i)
@@ -3807,8 +3806,8 @@ subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
 
     !$OMP BARRIER
     !$OMP SINGLE
-    t1 = omp_get_wtime()
-    write(0,*) 'Srt&Cpy :',t1-t0
+    !t1 = omp_get_wtime()
+    !write(0,*) ithread,'Srt&Cpy :',t1-t0
     !$OMP END SINGLE
     ! Let's sort column indices and values. After that we will store
     ! the number of unique values in 'kaux'

base/serial/impl/psb_z_coo_impl.F90

@@ -3669,7 +3669,7 @@ subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
   integer(psb_ipk_), allocatable :: ias(:),jas(:), ix2(:)
   complex(psb_dpk_),  allocatable :: vs(:)
   integer(psb_ipk_) :: nza, nzl,iret
-  integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii
+  integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii, i1, i2
   integer(psb_ipk_) :: debug_level, debug_unit
   character(len=20)    :: name = 'psb_fixcoo'
   logical :: srt_inp, use_buffers
@@ -3759,7 +3759,7 @@ subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
     !$OMP PARALLEL default(none) &
     !$OMP shared(t0,t1,idxaux,ia,ja,val,ias,jas,vs,nthreads,sum,nr,nc,nzin,iaux,kaux,dupl,err) &
     !$OMP private(s,i,j,k,ithread,idxstart,idxend,work,nxt_val,old_val,saved_elem, &
-    !$OMP first_elem,last_elem,nzl,iret,act_row) reduction(max: info)
+    !$OMP first_elem,last_elem,nzl,iret,act_row,i1,i2) reduction(max: info)
 
     !$OMP SINGLE
     nthreads = omp_get_num_threads()
@@ -3783,7 +3783,7 @@ subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
     call psi_exscan(nr+1,iaux,info,shift=ione)
     !$OMP BARRIER
     !$OMP SINGLE
-    t0 = omp_get_wtime()
+    !t0 = omp_get_wtime()
     !$OMP END SINGLE
     
     ! ------------------ Sorting and buffers -------------------
@@ -3793,7 +3793,6 @@ subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
     do j=idxstart,idxend
       idxaux(j) = iaux(j)
     end do
-
     ! Here we sort data inside the auxiliary buffers
     do i=1,nzin
       act_row = ia(i)
@@ -3807,8 +3806,8 @@ subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
 
     !$OMP BARRIER
     !$OMP SINGLE
-    t1 = omp_get_wtime()
-    write(0,*) 'Srt&Cpy :',t1-t0
+    !t1 = omp_get_wtime()
+    !write(0,*) ithread,'Srt&Cpy :',t1-t0
     !$OMP END SINGLE
     ! Let's sort column indices and values. After that we will store
     ! the number of unique values in 'kaux'

base/serial/sort/psb_d_qsort_impl.f90

@@ -44,8 +44,8 @@ function  psb_dbsrch(key,n,v,dir,find) result(ipos)
   use psb_sort_mod, psb_protect_name => psb_dbsrch
   implicit none
   integer(psb_ipk_) :: ipos, n
-real(psb_dpk_) :: key
-real(psb_dpk_) :: v(:)
+  real(psb_dpk_) :: key
+  real(psb_dpk_) :: v(:)
   integer(psb_ipk_), optional :: dir, find
 
   integer(psb_ipk_) :: lb, ub, m, i, k, dir_, find_
@@ -95,40 +95,37 @@ real(psb_dpk_) :: v(:)
       if ((m>n) .or. (m<1)) then
         m = n
         do while (m>=1)
-          if (v(m)<=key) then
-            ipos = m
-            exit
-          end if
+          if (v(m)<=key) exit
           m = m - 1
         end do
       else
         do while (m<n)
-          if (v(m)<=key) then
+          if (v(m+1)<=key) then
             m=m+1
           else
             exit
           end if
         end do
       end if
+      ipos = min(m,n)
     case (psb_find_first_ge_ )
       if ((m>n) .or. (m<1)) then
         m = 1
         do while (m<=n)
-          if (v(m)>=key) then
-            ipos = m
-            exit
-          end if
+          if (v(m)>=key) exit
           m = m + 1 
         end do
       else
-        do while (m>n)
-          if (v(m)>=key) then
+        do while (m>1)
+          if (v(m-1)>=key) then
             m=m-1
           else
             exit
           end if
         end do
       end if
+      ipos = max(m,1)
+
     case default
       write(0,*) 'Wrong FIND'
     end select

base/serial/sort/psb_e_qsort_impl.f90

@@ -44,8 +44,8 @@ function  psb_ebsrch(key,n,v,dir,find) result(ipos)
   use psb_sort_mod, psb_protect_name => psb_ebsrch
   implicit none
   integer(psb_ipk_) :: ipos, n
-integer(psb_epk_) :: key
-integer(psb_epk_) :: v(:)
+  integer(psb_epk_) :: key
+  integer(psb_epk_) :: v(:)
   integer(psb_ipk_), optional :: dir, find
 
   integer(psb_ipk_) :: lb, ub, m, i, k, dir_, find_
@@ -95,40 +95,37 @@ integer(psb_epk_) :: v(:)
       if ((m>n) .or. (m<1)) then
         m = n
         do while (m>=1)
-          if (v(m)<=key) then
-            ipos = m
-            exit
-          end if
+          if (v(m)<=key) exit
           m = m - 1
         end do
       else
         do while (m<n)
-          if (v(m)<=key) then
+          if (v(m+1)<=key) then
             m=m+1
           else
             exit
           end if
         end do
       end if
+      ipos = min(m,n)
     case (psb_find_first_ge_ )
       if ((m>n) .or. (m<1)) then
         m = 1
         do while (m<=n)
-          if (v(m)>=key) then
-            ipos = m
-            exit
-          end if
+          if (v(m)>=key) exit
           m = m + 1 
         end do
       else
-        do while (m>n)
-          if (v(m)>=key) then
+        do while (m>1)
+          if (v(m-1)>=key) then
             m=m-1
           else
             exit
           end if
         end do
       end if
+      ipos = max(m,1)
+
     case default
       write(0,*) 'Wrong FIND'
     end select

base/serial/sort/psb_m_qsort_impl.f90

@@ -44,8 +44,8 @@ function  psb_mbsrch(key,n,v,dir,find) result(ipos)
   use psb_sort_mod, psb_protect_name => psb_mbsrch
   implicit none
   integer(psb_ipk_) :: ipos, n
-integer(psb_mpk_) :: key
-integer(psb_mpk_) :: v(:)
+  integer(psb_mpk_) :: key
+  integer(psb_mpk_) :: v(:)
   integer(psb_ipk_), optional :: dir, find
 
   integer(psb_ipk_) :: lb, ub, m, i, k, dir_, find_
@@ -95,40 +95,37 @@ integer(psb_mpk_) :: v(:)
       if ((m>n) .or. (m<1)) then
         m = n
         do while (m>=1)
-          if (v(m)<=key) then
-            ipos = m
-            exit
-          end if
+          if (v(m)<=key) exit
           m = m - 1
         end do
       else
         do while (m<n)
-          if (v(m)<=key) then
+          if (v(m+1)<=key) then
             m=m+1
           else
             exit
           end if
         end do
       end if
+      ipos = min(m,n)
     case (psb_find_first_ge_ )
       if ((m>n) .or. (m<1)) then
         m = 1
         do while (m<=n)
-          if (v(m)>=key) then
-            ipos = m
-            exit
-          end if
+          if (v(m)>=key) exit
           m = m + 1 
         end do
       else
-        do while (m>n)
-          if (v(m)>=key) then
+        do while (m>1)
+          if (v(m-1)>=key) then
             m=m-1
           else
             exit
           end if
         end do
       end if
+      ipos = max(m,1)
+
     case default
       write(0,*) 'Wrong FIND'
     end select

base/serial/sort/psb_s_qsort_impl.f90

@@ -44,8 +44,8 @@ function  psb_sbsrch(key,n,v,dir,find) result(ipos)
   use psb_sort_mod, psb_protect_name => psb_sbsrch
   implicit none
   integer(psb_ipk_) :: ipos, n
-real(psb_spk_) :: key
-real(psb_spk_) :: v(:)
+  real(psb_spk_) :: key
+  real(psb_spk_) :: v(:)
   integer(psb_ipk_), optional :: dir, find
 
   integer(psb_ipk_) :: lb, ub, m, i, k, dir_, find_
@@ -95,40 +95,37 @@ real(psb_spk_) :: v(:)
       if ((m>n) .or. (m<1)) then
         m = n
         do while (m>=1)
-          if (v(m)<=key) then
-            ipos = m
-            exit
-          end if
+          if (v(m)<=key) exit
           m = m - 1
         end do
       else
         do while (m<n)
-          if (v(m)<=key) then
+          if (v(m+1)<=key) then
             m=m+1
           else
             exit
           end if
         end do
       end if
+      ipos = min(m,n)
     case (psb_find_first_ge_ )
       if ((m>n) .or. (m<1)) then
         m = 1
         do while (m<=n)
-          if (v(m)>=key) then
-            ipos = m
-            exit
-          end if
+          if (v(m)>=key) exit
           m = m + 1 
         end do
       else
-        do while (m>n)
-          if (v(m)>=key) then
+        do while (m>1)
+          if (v(m-1)>=key) then
             m=m-1
           else
             exit
           end if
         end do
       end if
+      ipos = max(m,1)
+
     case default
       write(0,*) 'Wrong FIND'
     end select