fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-19 20:32:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

Implement psi_exscan and use in _from_coo

Browse Source
This commit is contained in:
sfilippone
2023-04-18 17:00:22 +02:00
parent dbd55321f8
commit 02dd204351
22 changed files with 1554 additions and 526 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/serial/impl/psb_c_csc_impl.f90 → base/serial/impl/psb_c_csc_impl.F90
+27 -7
View File
@@ -2189,6 +2189,9 @@ subroutine psb_c_mv_csc_from_coo(a,b,info)
use psb_error_mod
use psb_c_base_mat_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_c_mv_csc_from_coo
#if defined(OPENMP)
use omp_lib
#endif
implicit none
class(psb_c_csc_sparse_mat), intent(inout) :: a
@@ -2223,18 +2226,35 @@ subroutine psb_c_mv_csc_from_coo(a,b,info)
call psb_realloc(nc+1,a%icp,info)
call b%free()
#if defined(OPENMP)
!$OMP PARALLEL default(none) &
!$OMP shared(nr,a,itemp,nza) &
!$OMP private(i,info)
!$OMP WORKSHARE
a%icp(:) = 0
!$OMP END WORKSHARE
!$OMP DO schedule(STATIC) &
!$OMP private(k)
do k=1,nza
i = itemp(k)
!$OMP ATOMIC UPDATE
a%icp(i+1) = a%icp(i+1) + 1
!$OMP END ATOMIC
end do
!$OMP END DO
!$OMP END PARALLEL
#else
a%icp(:) = 0
do k=1,nza
i = itemp(k)
a%icp(i) = a%icp(i) + 1
end do
ip = 1
do i=1,nc
nrl = a%icp(i)
a%icp(i) = ip
ip = ip + nrl
end do
a%icp(nc+1) = ip
#endif
call psi_exscan(nc+1,a%icp,info,shift=ione,ibase=ione)
call a%set_host()
base/serial/impl/psb_c_csr_impl.F90
+6 -120
View File
@@ -2876,12 +2876,6 @@ subroutine psb_c_cp_csr_from_coo(a,b,info)
character(len=20) :: name='c_cp_csr_from_coo'
logical :: use_openmp = .false.
#if defined(OPENMP)
integer(psb_ipk_), allocatable :: suma(:)
integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s,j
integer(psb_ipk_) :: nxt_val,old_val,saved_elem,maxthreads
#endif
info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@@ -2927,8 +2921,8 @@ subroutine psb_c_cp_csr_from_coo(a,b,info)
#if defined(OPENMP)
!$OMP PARALLEL default(none) &
!$OMP shared(suma,nthreads,nr,a,itemp,nza) &
!$OMP private(ithread,work,i,first_idx,last_idx,s)
!$OMP shared(nr,a,itemp,nza) &
!$OMP private(i,info)
!$OMP WORKSHARE
a%irp(:) = 0
@@ -2943,51 +2937,6 @@ subroutine psb_c_cp_csr_from_coo(a,b,info)
!$OMP END ATOMIC
end do
!$OMP END DO
!$OMP SINGLE
nthreads = omp_get_num_threads()
allocate(suma(nthreads+1))
suma(:) = 0
!suma(1) = 1
!$OMP END SINGLE
ithread = omp_get_thread_num()
work = (nr+1)/nthreads
if (ithread < MOD((nr+1),nthreads)) then
work = work + 1
first_idx = ithread*work + 1
else
first_idx = ithread*work + MOD((nr+1),nthreads) + 1
end if
last_idx = min(first_idx + work - 1,nr+1)
s = 0
if (first_idx<=last_idx) then
suma(ithread+2) = suma(ithread+2) + a%irp(first_idx)
do i=first_idx+1,last_idx
suma(ithread+2) = suma(ithread+2) + a%irp(i)
a%irp(i) = a%irp(i)+a%irp(i-1)
end do
end if
!$OMP BARRIER
!$OMP SINGLE
do i=2,nthreads+1
suma(i) = suma(i) + suma(i-1)
end do
!$OMP END SINGLE
!$OMP BARRIER
!$OMP DO SCHEDULE(STATIC)
do i=1,nr+1
a%irp(i) = suma(ithread+1) + a%irp(i) +1
end do
!$OMP END DO
!$OMP SINGLE
a%irp(1) = 1
!$OMP END SINGLE
!$OMP END PARALLEL
#else
a%irp(:) = 0
@@ -2995,14 +2944,8 @@ subroutine psb_c_cp_csr_from_coo(a,b,info)
i = itemp(k)
a%irp(i) = a%irp(i) + 1
end do
ip = 1
do i=1,nr
ncl = a%irp(i)
a%irp(i) = ip
ip = ip + ncl
end do
a%irp(nr+1) = ip
#endif
call psi_exscan(nr+1,a%irp,info,shift=ione,ibase=ione)
call a%set_host()
@@ -3122,12 +3065,6 @@ subroutine psb_c_mv_csr_from_coo(a,b,info)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name='mv_from_coo'
#if defined(OPENMP)
integer(psb_ipk_), allocatable :: suma(:)
integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s
integer(psb_ipk_) :: nxt_val,old_val,saved_elem
#endif
info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@@ -3153,8 +3090,8 @@ subroutine psb_c_mv_csr_from_coo(a,b,info)
#if defined(OPENMP)
!$OMP PARALLEL default(none) &
!$OMP shared(suma,nthreads,nr,a,itemp,nza) &
!$OMP private(ithread,work,i,first_idx,last_idx,s)
!$OMP shared(nr,a,itemp,nza) &
!$OMP private(i,info)
!$OMP WORKSHARE
a%irp(:) = 0
@@ -3169,51 +3106,6 @@ subroutine psb_c_mv_csr_from_coo(a,b,info)
!$OMP END ATOMIC
end do
!$OMP END DO
!$OMP SINGLE
nthreads = omp_get_num_threads()
allocate(suma(nthreads+1))
suma(:) = 0
!suma(1) = 1
!$OMP END SINGLE
ithread = omp_get_thread_num()
work = (nr+1)/nthreads
if (ithread < MOD((nr+1),nthreads)) then
work = work + 1
first_idx = ithread*work + 1
else
first_idx = ithread*work + MOD((nr+1),nthreads) + 1
end if
last_idx = min(first_idx + work - 1,nr+1)
s = 0
if (first_idx<=last_idx) then
suma(ithread+2) = suma(ithread+2) + a%irp(first_idx)
do i=first_idx+1,last_idx
suma(ithread+2) = suma(ithread+2) + a%irp(i)
a%irp(i) = a%irp(i)+a%irp(i-1)
end do
end if
!$OMP BARRIER
!$OMP SINGLE
do i=2,nthreads+1
suma(i) = suma(i) + suma(i-1)
end do
!$OMP END SINGLE
!$OMP BARRIER
!$OMP DO SCHEDULE(STATIC)
do i=1,nr+1
a%irp(i) = suma(ithread+1) + a%irp(i) +1
end do
!$OMP END DO
!$OMP SINGLE
a%irp(1) = 1
!$OMP END SINGLE
!$OMP END PARALLEL
#else
a%irp(:) = 0
@@ -3221,14 +3113,8 @@ subroutine psb_c_mv_csr_from_coo(a,b,info)
i = itemp(k)
a%irp(i) = a%irp(i) + 1
end do
ip = 1
do i=1,nr
ncl = a%irp(i)
a%irp(i) = ip
ip = ip + ncl
end do
a%irp(nr+1) = ip
#endif
call psi_exscan(nr+1,a%irp,info,shift=ione,ibase=ione)
!write(0,*) name,' Check:',a%irp(nr+1),all(a%irp(1:nr) < a%irp(nr+1))
!write(0,*) name,a%irp(:)
base/serial/impl/psb_d_csc_impl.f90 → base/serial/impl/psb_d_csc_impl.F90
+27 -7
View File
@@ -2189,6 +2189,9 @@ subroutine psb_d_mv_csc_from_coo(a,b,info)
use psb_error_mod
use psb_d_base_mat_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_d_mv_csc_from_coo
#if defined(OPENMP)
use omp_lib
#endif
implicit none
class(psb_d_csc_sparse_mat), intent(inout) :: a
@@ -2223,18 +2226,35 @@ subroutine psb_d_mv_csc_from_coo(a,b,info)
call psb_realloc(nc+1,a%icp,info)
call b%free()
#if defined(OPENMP)
!$OMP PARALLEL default(none) &
!$OMP shared(nr,a,itemp,nza) &
!$OMP private(i,info)
!$OMP WORKSHARE
a%icp(:) = 0
!$OMP END WORKSHARE
!$OMP DO schedule(STATIC) &
!$OMP private(k)
do k=1,nza
i = itemp(k)
!$OMP ATOMIC UPDATE
a%icp(i+1) = a%icp(i+1) + 1
!$OMP END ATOMIC
end do
!$OMP END DO
!$OMP END PARALLEL
#else
a%icp(:) = 0
do k=1,nza
i = itemp(k)
a%icp(i) = a%icp(i) + 1
end do
ip = 1
do i=1,nc
nrl = a%icp(i)
a%icp(i) = ip
ip = ip + nrl
end do
a%icp(nc+1) = ip
#endif
call psi_exscan(nc+1,a%icp,info,shift=ione,ibase=ione)
call a%set_host()
base/serial/impl/psb_d_csr_impl.F90
+6 -120
View File
@@ -2876,12 +2876,6 @@ subroutine psb_d_cp_csr_from_coo(a,b,info)
character(len=20) :: name='d_cp_csr_from_coo'
logical :: use_openmp = .false.
#if defined(OPENMP)
integer(psb_ipk_), allocatable :: suma(:)
integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s,j
integer(psb_ipk_) :: nxt_val,old_val,saved_elem,maxthreads
#endif
info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@@ -2927,8 +2921,8 @@ subroutine psb_d_cp_csr_from_coo(a,b,info)
#if defined(OPENMP)
!$OMP PARALLEL default(none) &
!$OMP shared(suma,nthreads,nr,a,itemp,nza) &
!$OMP private(ithread,work,i,first_idx,last_idx,s)
!$OMP shared(nr,a,itemp,nza) &
!$OMP private(i,info)
!$OMP WORKSHARE
a%irp(:) = 0
@@ -2943,51 +2937,6 @@ subroutine psb_d_cp_csr_from_coo(a,b,info)
!$OMP END ATOMIC
end do
!$OMP END DO
!$OMP SINGLE
nthreads = omp_get_num_threads()
allocate(suma(nthreads+1))
suma(:) = 0
!suma(1) = 1
!$OMP END SINGLE
ithread = omp_get_thread_num()
work = (nr+1)/nthreads
if (ithread < MOD((nr+1),nthreads)) then
work = work + 1
first_idx = ithread*work + 1
else
first_idx = ithread*work + MOD((nr+1),nthreads) + 1
end if
last_idx = min(first_idx + work - 1,nr+1)
s = 0
if (first_idx<=last_idx) then
suma(ithread+2) = suma(ithread+2) + a%irp(first_idx)
do i=first_idx+1,last_idx
suma(ithread+2) = suma(ithread+2) + a%irp(i)
a%irp(i) = a%irp(i)+a%irp(i-1)
end do
end if
!$OMP BARRIER
!$OMP SINGLE
do i=2,nthreads+1
suma(i) = suma(i) + suma(i-1)
end do
!$OMP END SINGLE
!$OMP BARRIER
!$OMP DO SCHEDULE(STATIC)
do i=1,nr+1
a%irp(i) = suma(ithread+1) + a%irp(i) +1
end do
!$OMP END DO
!$OMP SINGLE
a%irp(1) = 1
!$OMP END SINGLE
!$OMP END PARALLEL
#else
a%irp(:) = 0
@@ -2995,14 +2944,8 @@ subroutine psb_d_cp_csr_from_coo(a,b,info)
i = itemp(k)
a%irp(i) = a%irp(i) + 1
end do
ip = 1
do i=1,nr
ncl = a%irp(i)
a%irp(i) = ip
ip = ip + ncl
end do
a%irp(nr+1) = ip
#endif
call psi_exscan(nr+1,a%irp,info,shift=ione,ibase=ione)
call a%set_host()
@@ -3122,12 +3065,6 @@ subroutine psb_d_mv_csr_from_coo(a,b,info)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name='mv_from_coo'
#if defined(OPENMP)
integer(psb_ipk_), allocatable :: suma(:)
integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s
integer(psb_ipk_) :: nxt_val,old_val,saved_elem
#endif
info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@@ -3153,8 +3090,8 @@ subroutine psb_d_mv_csr_from_coo(a,b,info)
#if defined(OPENMP)
!$OMP PARALLEL default(none) &
!$OMP shared(suma,nthreads,nr,a,itemp,nza) &
!$OMP private(ithread,work,i,first_idx,last_idx,s)
!$OMP shared(nr,a,itemp,nza) &
!$OMP private(i,info)
!$OMP WORKSHARE
a%irp(:) = 0
@@ -3169,51 +3106,6 @@ subroutine psb_d_mv_csr_from_coo(a,b,info)
!$OMP END ATOMIC
end do
!$OMP END DO
!$OMP SINGLE
nthreads = omp_get_num_threads()
allocate(suma(nthreads+1))
suma(:) = 0
!suma(1) = 1
!$OMP END SINGLE
ithread = omp_get_thread_num()
work = (nr+1)/nthreads
if (ithread < MOD((nr+1),nthreads)) then
work = work + 1
first_idx = ithread*work + 1
else
first_idx = ithread*work + MOD((nr+1),nthreads) + 1
end if
last_idx = min(first_idx + work - 1,nr+1)
s = 0
if (first_idx<=last_idx) then
suma(ithread+2) = suma(ithread+2) + a%irp(first_idx)
do i=first_idx+1,last_idx
suma(ithread+2) = suma(ithread+2) + a%irp(i)
a%irp(i) = a%irp(i)+a%irp(i-1)
end do
end if
!$OMP BARRIER
!$OMP SINGLE
do i=2,nthreads+1
suma(i) = suma(i) + suma(i-1)
end do
!$OMP END SINGLE
!$OMP BARRIER
!$OMP DO SCHEDULE(STATIC)
do i=1,nr+1
a%irp(i) = suma(ithread+1) + a%irp(i) +1
end do
!$OMP END DO
!$OMP SINGLE
a%irp(1) = 1
!$OMP END SINGLE
!$OMP END PARALLEL
#else
a%irp(:) = 0
@@ -3221,14 +3113,8 @@ subroutine psb_d_mv_csr_from_coo(a,b,info)
i = itemp(k)
a%irp(i) = a%irp(i) + 1
end do
ip = 1
do i=1,nr
ncl = a%irp(i)
a%irp(i) = ip
ip = ip + ncl
end do
a%irp(nr+1) = ip
#endif
call psi_exscan(nr+1,a%irp,info,shift=ione,ibase=ione)
!write(0,*) name,' Check:',a%irp(nr+1),all(a%irp(1:nr) < a%irp(nr+1))
!write(0,*) name,a%irp(:)
base/serial/impl/psb_s_csc_impl.f90 → base/serial/impl/psb_s_csc_impl.F90
+27 -7
View File
@@ -2189,6 +2189,9 @@ subroutine psb_s_mv_csc_from_coo(a,b,info)
use psb_error_mod
use psb_s_base_mat_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_s_mv_csc_from_coo
#if defined(OPENMP)
use omp_lib
#endif
implicit none
class(psb_s_csc_sparse_mat), intent(inout) :: a
@@ -2223,18 +2226,35 @@ subroutine psb_s_mv_csc_from_coo(a,b,info)
call psb_realloc(nc+1,a%icp,info)
call b%free()
#if defined(OPENMP)
!$OMP PARALLEL default(none) &
!$OMP shared(nr,a,itemp,nza) &
!$OMP private(i,info)
!$OMP WORKSHARE
a%icp(:) = 0
!$OMP END WORKSHARE
!$OMP DO schedule(STATIC) &
!$OMP private(k)
do k=1,nza
i = itemp(k)
!$OMP ATOMIC UPDATE
a%icp(i+1) = a%icp(i+1) + 1
!$OMP END ATOMIC
end do
!$OMP END DO
!$OMP END PARALLEL
#else
a%icp(:) = 0
do k=1,nza
i = itemp(k)
a%icp(i) = a%icp(i) + 1
end do
ip = 1
do i=1,nc
nrl = a%icp(i)
a%icp(i) = ip
ip = ip + nrl
end do
a%icp(nc+1) = ip
#endif
call psi_exscan(nc+1,a%icp,info,shift=ione,ibase=ione)
call a%set_host()
base/serial/impl/psb_s_csr_impl.F90
+6 -120
View File
@@ -2876,12 +2876,6 @@ subroutine psb_s_cp_csr_from_coo(a,b,info)
character(len=20) :: name='s_cp_csr_from_coo'
logical :: use_openmp = .false.
#if defined(OPENMP)
integer(psb_ipk_), allocatable :: suma(:)
integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s,j
integer(psb_ipk_) :: nxt_val,old_val,saved_elem,maxthreads
#endif
info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@@ -2927,8 +2921,8 @@ subroutine psb_s_cp_csr_from_coo(a,b,info)
#if defined(OPENMP)
!$OMP PARALLEL default(none) &
!$OMP shared(suma,nthreads,nr,a,itemp,nza) &
!$OMP private(ithread,work,i,first_idx,last_idx,s)
!$OMP shared(nr,a,itemp,nza) &
!$OMP private(i,info)
!$OMP WORKSHARE
a%irp(:) = 0
@@ -2943,51 +2937,6 @@ subroutine psb_s_cp_csr_from_coo(a,b,info)
!$OMP END ATOMIC
end do
!$OMP END DO
!$OMP SINGLE
nthreads = omp_get_num_threads()
allocate(suma(nthreads+1))
suma(:) = 0
!suma(1) = 1
!$OMP END SINGLE
ithread = omp_get_thread_num()
work = (nr+1)/nthreads
if (ithread < MOD((nr+1),nthreads)) then
work = work + 1
first_idx = ithread*work + 1
else
first_idx = ithread*work + MOD((nr+1),nthreads) + 1
end if
last_idx = min(first_idx + work - 1,nr+1)
s = 0
if (first_idx<=last_idx) then
suma(ithread+2) = suma(ithread+2) + a%irp(first_idx)
do i=first_idx+1,last_idx
suma(ithread+2) = suma(ithread+2) + a%irp(i)
a%irp(i) = a%irp(i)+a%irp(i-1)
end do
end if
!$OMP BARRIER
!$OMP SINGLE
do i=2,nthreads+1
suma(i) = suma(i) + suma(i-1)
end do
!$OMP END SINGLE
!$OMP BARRIER
!$OMP DO SCHEDULE(STATIC)
do i=1,nr+1
a%irp(i) = suma(ithread+1) + a%irp(i) +1
end do
!$OMP END DO
!$OMP SINGLE
a%irp(1) = 1
!$OMP END SINGLE
!$OMP END PARALLEL
#else
a%irp(:) = 0
@@ -2995,14 +2944,8 @@ subroutine psb_s_cp_csr_from_coo(a,b,info)
i = itemp(k)
a%irp(i) = a%irp(i) + 1
end do
ip = 1
do i=1,nr
ncl = a%irp(i)
a%irp(i) = ip
ip = ip + ncl
end do
a%irp(nr+1) = ip
#endif
call psi_exscan(nr+1,a%irp,info,shift=ione,ibase=ione)
call a%set_host()
@@ -3122,12 +3065,6 @@ subroutine psb_s_mv_csr_from_coo(a,b,info)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name='mv_from_coo'
#if defined(OPENMP)
integer(psb_ipk_), allocatable :: suma(:)
integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s
integer(psb_ipk_) :: nxt_val,old_val,saved_elem
#endif
info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@@ -3153,8 +3090,8 @@ subroutine psb_s_mv_csr_from_coo(a,b,info)
#if defined(OPENMP)
!$OMP PARALLEL default(none) &
!$OMP shared(suma,nthreads,nr,a,itemp,nza) &
!$OMP private(ithread,work,i,first_idx,last_idx,s)
!$OMP shared(nr,a,itemp,nza) &
!$OMP private(i,info)
!$OMP WORKSHARE
a%irp(:) = 0
@@ -3169,51 +3106,6 @@ subroutine psb_s_mv_csr_from_coo(a,b,info)
!$OMP END ATOMIC
end do
!$OMP END DO
!$OMP SINGLE
nthreads = omp_get_num_threads()
allocate(suma(nthreads+1))
suma(:) = 0
!suma(1) = 1
!$OMP END SINGLE
ithread = omp_get_thread_num()
work = (nr+1)/nthreads
if (ithread < MOD((nr+1),nthreads)) then
work = work + 1
first_idx = ithread*work + 1
else
first_idx = ithread*work + MOD((nr+1),nthreads) + 1
end if
last_idx = min(first_idx + work - 1,nr+1)
s = 0
if (first_idx<=last_idx) then
suma(ithread+2) = suma(ithread+2) + a%irp(first_idx)
do i=first_idx+1,last_idx
suma(ithread+2) = suma(ithread+2) + a%irp(i)
a%irp(i) = a%irp(i)+a%irp(i-1)
end do
end if
!$OMP BARRIER
!$OMP SINGLE
do i=2,nthreads+1
suma(i) = suma(i) + suma(i-1)
end do
!$OMP END SINGLE
!$OMP BARRIER
!$OMP DO SCHEDULE(STATIC)
do i=1,nr+1
a%irp(i) = suma(ithread+1) + a%irp(i) +1
end do
!$OMP END DO
!$OMP SINGLE
a%irp(1) = 1
!$OMP END SINGLE
!$OMP END PARALLEL
#else
a%irp(:) = 0
@@ -3221,14 +3113,8 @@ subroutine psb_s_mv_csr_from_coo(a,b,info)
i = itemp(k)
a%irp(i) = a%irp(i) + 1
end do
ip = 1
do i=1,nr
ncl = a%irp(i)
a%irp(i) = ip
ip = ip + ncl
end do
a%irp(nr+1) = ip
#endif
call psi_exscan(nr+1,a%irp,info,shift=ione,ibase=ione)
!write(0,*) name,' Check:',a%irp(nr+1),all(a%irp(1:nr) < a%irp(nr+1))
!write(0,*) name,a%irp(:)
base/serial/impl/psb_z_csc_impl.f90 → base/serial/impl/psb_z_csc_impl.F90
+27 -7
View File
@@ -2189,6 +2189,9 @@ subroutine psb_z_mv_csc_from_coo(a,b,info)
use psb_error_mod
use psb_z_base_mat_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_z_mv_csc_from_coo
#if defined(OPENMP)
use omp_lib
#endif
implicit none
class(psb_z_csc_sparse_mat), intent(inout) :: a
@@ -2223,18 +2226,35 @@ subroutine psb_z_mv_csc_from_coo(a,b,info)
call psb_realloc(nc+1,a%icp,info)
call b%free()
#if defined(OPENMP)
!$OMP PARALLEL default(none) &
!$OMP shared(nr,a,itemp,nza) &
!$OMP private(i,info)
!$OMP WORKSHARE
a%icp(:) = 0
!$OMP END WORKSHARE
!$OMP DO schedule(STATIC) &
!$OMP private(k)
do k=1,nza
i = itemp(k)
!$OMP ATOMIC UPDATE
a%icp(i+1) = a%icp(i+1) + 1
!$OMP END ATOMIC
end do
!$OMP END DO
!$OMP END PARALLEL
#else
a%icp(:) = 0
do k=1,nza
i = itemp(k)
a%icp(i) = a%icp(i) + 1
end do
ip = 1
do i=1,nc
nrl = a%icp(i)
a%icp(i) = ip
ip = ip + nrl
end do
a%icp(nc+1) = ip
#endif
call psi_exscan(nc+1,a%icp,info,shift=ione,ibase=ione)
call a%set_host()
base/serial/impl/psb_z_csr_impl.F90
+6 -120
View File
@@ -2876,12 +2876,6 @@ subroutine psb_z_cp_csr_from_coo(a,b,info)
character(len=20) :: name='z_cp_csr_from_coo'
logical :: use_openmp = .false.
#if defined(OPENMP)
integer(psb_ipk_), allocatable :: suma(:)
integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s,j
integer(psb_ipk_) :: nxt_val,old_val,saved_elem,maxthreads
#endif
info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@@ -2927,8 +2921,8 @@ subroutine psb_z_cp_csr_from_coo(a,b,info)
#if defined(OPENMP)
!$OMP PARALLEL default(none) &
!$OMP shared(suma,nthreads,nr,a,itemp,nza) &
!$OMP private(ithread,work,i,first_idx,last_idx,s)
!$OMP shared(nr,a,itemp,nza) &
!$OMP private(i,info)
!$OMP WORKSHARE
a%irp(:) = 0
@@ -2943,51 +2937,6 @@ subroutine psb_z_cp_csr_from_coo(a,b,info)
!$OMP END ATOMIC
end do
!$OMP END DO
!$OMP SINGLE
nthreads = omp_get_num_threads()
allocate(suma(nthreads+1))
suma(:) = 0
!suma(1) = 1
!$OMP END SINGLE
ithread = omp_get_thread_num()
work = (nr+1)/nthreads
if (ithread < MOD((nr+1),nthreads)) then
work = work + 1
first_idx = ithread*work + 1
else
first_idx = ithread*work + MOD((nr+1),nthreads) + 1
end if
last_idx = min(first_idx + work - 1,nr+1)
s = 0
if (first_idx<=last_idx) then
suma(ithread+2) = suma(ithread+2) + a%irp(first_idx)
do i=first_idx+1,last_idx
suma(ithread+2) = suma(ithread+2) + a%irp(i)
a%irp(i) = a%irp(i)+a%irp(i-1)
end do
end if
!$OMP BARRIER
!$OMP SINGLE
do i=2,nthreads+1
suma(i) = suma(i) + suma(i-1)
end do
!$OMP END SINGLE
!$OMP BARRIER
!$OMP DO SCHEDULE(STATIC)
do i=1,nr+1
a%irp(i) = suma(ithread+1) + a%irp(i) +1
end do
!$OMP END DO
!$OMP SINGLE
a%irp(1) = 1
!$OMP END SINGLE
!$OMP END PARALLEL
#else
a%irp(:) = 0
@@ -2995,14 +2944,8 @@ subroutine psb_z_cp_csr_from_coo(a,b,info)
i = itemp(k)
a%irp(i) = a%irp(i) + 1
end do
ip = 1
do i=1,nr
ncl = a%irp(i)
a%irp(i) = ip
ip = ip + ncl
end do
a%irp(nr+1) = ip
#endif
call psi_exscan(nr+1,a%irp,info,shift=ione,ibase=ione)
call a%set_host()
@@ -3122,12 +3065,6 @@ subroutine psb_z_mv_csr_from_coo(a,b,info)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name='mv_from_coo'
#if defined(OPENMP)
integer(psb_ipk_), allocatable :: suma(:)
integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s
integer(psb_ipk_) :: nxt_val,old_val,saved_elem
#endif
info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@@ -3153,8 +3090,8 @@ subroutine psb_z_mv_csr_from_coo(a,b,info)
#if defined(OPENMP)
!$OMP PARALLEL default(none) &
!$OMP shared(suma,nthreads,nr,a,itemp,nza) &
!$OMP private(ithread,work,i,first_idx,last_idx,s)
!$OMP shared(nr,a,itemp,nza) &
!$OMP private(i,info)
!$OMP WORKSHARE
a%irp(:) = 0
@@ -3169,51 +3106,6 @@ subroutine psb_z_mv_csr_from_coo(a,b,info)
!$OMP END ATOMIC
end do
!$OMP END DO
!$OMP SINGLE
nthreads = omp_get_num_threads()
allocate(suma(nthreads+1))
suma(:) = 0
!suma(1) = 1
!$OMP END SINGLE
ithread = omp_get_thread_num()
work = (nr+1)/nthreads
if (ithread < MOD((nr+1),nthreads)) then
work = work + 1
first_idx = ithread*work + 1
else
first_idx = ithread*work + MOD((nr+1),nthreads) + 1
end if
last_idx = min(first_idx + work - 1,nr+1)
s = 0
if (first_idx<=last_idx) then
suma(ithread+2) = suma(ithread+2) + a%irp(first_idx)
do i=first_idx+1,last_idx
suma(ithread+2) = suma(ithread+2) + a%irp(i)
a%irp(i) = a%irp(i)+a%irp(i-1)
end do
end if
!$OMP BARRIER
!$OMP SINGLE
do i=2,nthreads+1
suma(i) = suma(i) + suma(i-1)
end do
!$OMP END SINGLE
!$OMP BARRIER
!$OMP DO SCHEDULE(STATIC)
do i=1,nr+1
a%irp(i) = suma(ithread+1) + a%irp(i) +1
end do
!$OMP END DO
!$OMP SINGLE
a%irp(1) = 1
!$OMP END SINGLE
!$OMP END PARALLEL
#else
a%irp(:) = 0
@@ -3221,14 +3113,8 @@ subroutine psb_z_mv_csr_from_coo(a,b,info)
i = itemp(k)
a%irp(i) = a%irp(i) + 1
end do
ip = 1
do i=1,nr
ncl = a%irp(i)
a%irp(i) = ip
ip = ip + ncl
end do
a%irp(nr+1) = ip
#endif
call psi_exscan(nr+1,a%irp,info,shift=ione,ibase=ione)
!write(0,*) name,' Check:',a%irp(nr+1),all(a%irp(1:nr) < a%irp(nr+1))
!write(0,*) name,a%irp(:)