diff --git a/base/serial/impl/psb_c_coo_impl.F90 b/base/serial/impl/psb_c_coo_impl.F90 index 8f1f54ae..03939afe 100644 --- a/base/serial/impl/psb_c_coo_impl.F90 +++ b/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' diff --git a/base/serial/impl/psb_d_coo_impl.F90 b/base/serial/impl/psb_d_coo_impl.F90 index 5d50788a..9597c5f5 100644 --- a/base/serial/impl/psb_d_coo_impl.F90 +++ b/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' diff --git a/base/serial/impl/psb_s_coo_impl.F90 b/base/serial/impl/psb_s_coo_impl.F90 index 837eb429..174d3e07 100644 --- a/base/serial/impl/psb_s_coo_impl.F90 +++ b/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' diff --git a/base/serial/impl/psb_z_coo_impl.F90 b/base/serial/impl/psb_z_coo_impl.F90 index 21ae8658..2ccc614a 100644 --- a/base/serial/impl/psb_z_coo_impl.F90 +++ b/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' diff --git a/base/serial/sort/psb_d_qsort_impl.f90 b/base/serial/sort/psb_d_qsort_impl.f90 index 4d6918e7..8e4b1d21 100644 --- a/base/serial/sort/psb_d_qsort_impl.f90 +++ b/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 (mn) .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 diff --git a/base/serial/sort/psb_e_qsort_impl.f90 b/base/serial/sort/psb_e_qsort_impl.f90 index 8be3cd78..c70f8051 100644 --- a/base/serial/sort/psb_e_qsort_impl.f90 +++ b/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 (mn) .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 diff --git a/base/serial/sort/psb_m_qsort_impl.f90 b/base/serial/sort/psb_m_qsort_impl.f90 index 460bff43..6b70c3a0 100644 --- a/base/serial/sort/psb_m_qsort_impl.f90 +++ b/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 (mn) .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 diff --git a/base/serial/sort/psb_s_qsort_impl.f90 b/base/serial/sort/psb_s_qsort_impl.f90 index 44a46e0a..cae32546 100644 --- a/base/serial/sort/psb_s_qsort_impl.f90 +++ b/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 (mn) .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