fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Reset status for csr_impl.

Browse Source
omp-threadsafe
sfilippone 2 years ago
parent ed7862a848
commit c05b32c202
7 changed files with 139 additions and 66 deletions
Show Stats Download Patch File Download Diff File

1
base/internals/psi_bld_tmphalo.f90
Unescape Escape View File

@ -104,6 +104,7 @@ subroutine psi_bld_tmphalo(desc,info)
call desc%indxmap%l2gip(helem(1:nh),info) call desc%indxmap%l2gip(helem(1:nh),info)
if (info == psb_success_) call desc%indxmap%fnd_owner(helem(1:nh),hproc,info) if (info == psb_success_) call desc%indxmap%fnd_owner(helem(1:nh),hproc,info)
!write(0,*) 'bld_tmphalo calling set_owner',hproc(:)
if (info == psb_success_) call desc%indxmap%set_halo_owner(hproc,info) if (info == psb_success_) call desc%indxmap%set_halo_owner(hproc,info)
if (info == psb_success_) call desc%indxmap%xtnd_p_adjcncy(hproc) if (info == psb_success_) call desc%indxmap%xtnd_p_adjcncy(hproc)

2
base/modules/desc/psb_hash_map_mod.F90
Unescape Escape View File

@ -655,7 +655,7 @@ contains
integer(psb_ipk_) :: me, np integer(psb_ipk_) :: me, np
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
logical, allocatable :: mask_(:) logical, allocatable :: mask_(:)
logical :: use_openmp = .true. logical :: use_openmp = .false.
#ifdef OPENMP #ifdef OPENMP
integer(kind = OMP_lock_kind) :: ins_lck integer(kind = OMP_lock_kind) :: ins_lck
#endif #endif

26
base/modules/desc/psb_hash_mod.F90
Unescape Escape View File

@ -388,7 +388,7 @@ contains
info = HashOK info = HashOK
hsize = hash%hsize hsize = hash%hsize
hmask = hash%hmask hmask = hash%hmask
val = -1
hk = iand(psb_hashval(key),hmask) hk = iand(psb_hashval(key),hmask)
if (hk == 0) then if (hk == 0) then
hd = 1 hd = 1
@ -409,6 +409,7 @@ contains
info = HashDuplicate info = HashDuplicate
return return
end if end if
!$OMP CRITICAL
if (hash%table(hk,1) == HashFreeEntry) then if (hash%table(hk,1) == HashFreeEntry) then
if (hash%nk == hash%hsize -1) then if (hash%nk == hash%hsize -1) then
! !
@ -420,19 +421,22 @@ contains
call psb_hash_realloc(hash,info) call psb_hash_realloc(hash,info)
if (info /= HashOk) then if (info /= HashOk) then
info = HashOutOfMemory info = HashOutOfMemory
return !return
else else
call psb_hash_searchinskey(key,val,nextval,hash,info) call psb_hash_searchinskey(key,val,nextval,hash,info)
return !return
end if end if
else else
hash%nk = hash%nk + 1 hash%nk = hash%nk + 1
hash%table(hk,1) = key hash%table(hk,1) = key
hash%table(hk,2) = nextval hash%table(hk,2) = nextval
val = nextval val = nextval
return !return
end if end if
end if end if
!$OMP END CRITICAL
if (info /= HashOk) return
if (val > 0) return
hk = hk - hd hk = hk - hd
if (hk < 0) hk = hk + hsize if (hk < 0) hk = hk + hsize
end do end do
@ -448,7 +452,7 @@ contains
info = HashOK info = HashOK
hsize = hash%hsize hsize = hash%hsize
hmask = hash%hmask hmask = hash%hmask
hk = iand(psb_hashval(key),hmask) hk = iand(psb_hashval(key),hmask)
if (hk == 0) then if (hk == 0) then
hd = 1 hd = 1
@ -460,7 +464,7 @@ contains
info = HashOutOfMemory info = HashOutOfMemory
return return
end if end if
val = -1
hash%nsrch = hash%nsrch + 1 hash%nsrch = hash%nsrch + 1
do do
hash%nacc = hash%nacc + 1 hash%nacc = hash%nacc + 1
@ -469,6 +473,7 @@ contains
info = HashDuplicate info = HashDuplicate
return return
end if end if
!$OMP CRITICAL
if (hash%table(hk,1) == HashFreeEntry) then if (hash%table(hk,1) == HashFreeEntry) then
if (hash%nk == hash%hsize -1) then if (hash%nk == hash%hsize -1) then
! !
@ -480,19 +485,22 @@ contains
call psb_hash_realloc(hash,info) call psb_hash_realloc(hash,info)
if (info /= HashOk) then if (info /= HashOk) then
info = HashOutOfMemory info = HashOutOfMemory
return !return
else else
call psb_hash_searchinskey(key,val,nextval,hash,info) call psb_hash_searchinskey(key,val,nextval,hash,info)
return !return
end if end if
else else
hash%nk = hash%nk + 1 hash%nk = hash%nk + 1
hash%table(hk,1) = key hash%table(hk,1) = key
hash%table(hk,2) = nextval hash%table(hk,2) = nextval
val = nextval val = nextval
return !return
end if end if
end if end if
!$OMP END CRITICAL
if (info /= HashOk) return
if (val > 0) return
hk = hk - hd hk = hk - hd
if (hk < 0) hk = hk + hsize if (hk < 0) hk = hk + hsize
end do end do

44
base/serial/impl/psb_c_csr_impl.F90
Unescape Escape View File

@ -152,6 +152,7 @@ contains
!$omp parallel do private(i,j, acc) schedule(static) !$omp parallel do private(i,j, acc) schedule(static)
do i=1,m do i=1,m
acc = czero acc = czero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -163,6 +164,7 @@ contains
!$omp parallel do private(i,j, acc) !$omp parallel do private(i,j, acc)
do i=1,m do i=1,m
acc = czero acc = czero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -174,6 +176,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = czero acc = czero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -189,6 +192,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = czero acc = czero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -200,6 +204,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = czero acc = czero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -211,6 +216,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = czero acc = czero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -225,6 +231,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = czero acc = czero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -236,6 +243,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = czero acc = czero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -247,6 +255,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = czero acc = czero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -261,6 +270,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = czero acc = czero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -272,6 +282,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = czero acc = czero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -283,6 +294,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = czero acc = czero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -2862,6 +2874,8 @@ subroutine psb_c_cp_csr_from_coo(a,b,info)
integer(psb_ipk_), Parameter :: maxtry=8 integer(psb_ipk_), Parameter :: maxtry=8
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name='c_cp_csr_from_coo' character(len=20) :: name='c_cp_csr_from_coo'
logical :: use_openmp = .false.
#if defined(OPENMP) #if defined(OPENMP)
integer(psb_ipk_), allocatable :: sum(:) integer(psb_ipk_), allocatable :: sum(:)
integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s,j integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s,j
@ -2983,21 +2997,22 @@ subroutine psb_c_cp_csr_from_coo(a,b,info)
!$OMP END PARALLEL !$OMP END PARALLEL
#else #else
do k=1,nza do k=1,nza
i = itemp(k) i = itemp(k)
a%irp(i) = a%irp(i) + 1 a%irp(i) = a%irp(i) + 1
end do end do
ip = 1 ip = 1
do i=1,nr do i=1,nr
ncl = a%irp(i) ncl = a%irp(i)
a%irp(i) = ip a%irp(i) = ip
ip = ip + ncl ip = ip + ncl
end do end do
a%irp(nr+1) = ip a%irp(nr+1) = ip
#endif #endif
call a%set_host() call a%set_host()
end subroutine psb_c_cp_csr_from_coo end subroutine psb_c_cp_csr_from_coo
@ -3113,6 +3128,7 @@ subroutine psb_c_mv_csr_from_coo(a,b,info)
integer(psb_ipk_), Parameter :: maxtry=8 integer(psb_ipk_), Parameter :: maxtry=8
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name='mv_from_coo' character(len=20) :: name='mv_from_coo'
logical :: use_openmp = .false.
#if defined(OPENMP) #if defined(OPENMP)
integer(psb_ipk_), allocatable :: sum(:) integer(psb_ipk_), allocatable :: sum(:)
@ -3120,7 +3136,6 @@ subroutine psb_c_mv_csr_from_coo(a,b,info)
integer(psb_ipk_) :: nxt_val,old_val,saved_elem integer(psb_ipk_) :: nxt_val,old_val,saved_elem
#endif #endif
info = psb_success_ info = psb_success_
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
@ -3214,6 +3229,7 @@ subroutine psb_c_mv_csr_from_coo(a,b,info)
!$OMP END PARALLEL !$OMP END PARALLEL
#else #else
do k=1,nza do k=1,nza
i = itemp(k) i = itemp(k)
a%irp(i) = a%irp(i) + 1 a%irp(i) = a%irp(i) + 1

44
base/serial/impl/psb_d_csr_impl.F90
Unescape Escape View File

@ -152,6 +152,7 @@ contains
!$omp parallel do private(i,j, acc) schedule(static) !$omp parallel do private(i,j, acc) schedule(static)
do i=1,m do i=1,m
acc = dzero acc = dzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -163,6 +164,7 @@ contains
!$omp parallel do private(i,j, acc) !$omp parallel do private(i,j, acc)
do i=1,m do i=1,m
acc = dzero acc = dzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -174,6 +176,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = dzero acc = dzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -189,6 +192,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = dzero acc = dzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -200,6 +204,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = dzero acc = dzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -211,6 +216,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = dzero acc = dzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -225,6 +231,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = dzero acc = dzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -236,6 +243,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = dzero acc = dzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -247,6 +255,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = dzero acc = dzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -261,6 +270,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = dzero acc = dzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -272,6 +282,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = dzero acc = dzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -283,6 +294,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = dzero acc = dzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -2862,6 +2874,8 @@ subroutine psb_d_cp_csr_from_coo(a,b,info)
integer(psb_ipk_), Parameter :: maxtry=8 integer(psb_ipk_), Parameter :: maxtry=8
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name='d_cp_csr_from_coo' character(len=20) :: name='d_cp_csr_from_coo'
logical :: use_openmp = .false.
#if defined(OPENMP) #if defined(OPENMP)
integer(psb_ipk_), allocatable :: sum(:) integer(psb_ipk_), allocatable :: sum(:)
integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s,j integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s,j
@ -2983,21 +2997,22 @@ subroutine psb_d_cp_csr_from_coo(a,b,info)
!$OMP END PARALLEL !$OMP END PARALLEL
#else #else
do k=1,nza do k=1,nza
i = itemp(k) i = itemp(k)
a%irp(i) = a%irp(i) + 1 a%irp(i) = a%irp(i) + 1
end do end do
ip = 1 ip = 1
do i=1,nr do i=1,nr
ncl = a%irp(i) ncl = a%irp(i)
a%irp(i) = ip a%irp(i) = ip
ip = ip + ncl ip = ip + ncl
end do end do
a%irp(nr+1) = ip a%irp(nr+1) = ip
#endif #endif
call a%set_host() call a%set_host()
end subroutine psb_d_cp_csr_from_coo end subroutine psb_d_cp_csr_from_coo
@ -3113,6 +3128,7 @@ subroutine psb_d_mv_csr_from_coo(a,b,info)
integer(psb_ipk_), Parameter :: maxtry=8 integer(psb_ipk_), Parameter :: maxtry=8
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name='mv_from_coo' character(len=20) :: name='mv_from_coo'
logical :: use_openmp = .false.
#if defined(OPENMP) #if defined(OPENMP)
integer(psb_ipk_), allocatable :: sum(:) integer(psb_ipk_), allocatable :: sum(:)
@ -3120,7 +3136,6 @@ subroutine psb_d_mv_csr_from_coo(a,b,info)
integer(psb_ipk_) :: nxt_val,old_val,saved_elem integer(psb_ipk_) :: nxt_val,old_val,saved_elem
#endif #endif
info = psb_success_ info = psb_success_
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
@ -3214,6 +3229,7 @@ subroutine psb_d_mv_csr_from_coo(a,b,info)
!$OMP END PARALLEL !$OMP END PARALLEL
#else #else
do k=1,nza do k=1,nza
i = itemp(k) i = itemp(k)
a%irp(i) = a%irp(i) + 1 a%irp(i) = a%irp(i) + 1

44
base/serial/impl/psb_s_csr_impl.F90
Unescape Escape View File

@ -152,6 +152,7 @@ contains
!$omp parallel do private(i,j, acc) schedule(static) !$omp parallel do private(i,j, acc) schedule(static)
do i=1,m do i=1,m
acc = szero acc = szero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -163,6 +164,7 @@ contains
!$omp parallel do private(i,j, acc) !$omp parallel do private(i,j, acc)
do i=1,m do i=1,m
acc = szero acc = szero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -174,6 +176,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = szero acc = szero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -189,6 +192,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = szero acc = szero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -200,6 +204,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = szero acc = szero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -211,6 +216,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = szero acc = szero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -225,6 +231,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = szero acc = szero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -236,6 +243,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = szero acc = szero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -247,6 +255,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = szero acc = szero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -261,6 +270,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = szero acc = szero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -272,6 +282,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = szero acc = szero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -283,6 +294,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = szero acc = szero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -2862,6 +2874,8 @@ subroutine psb_s_cp_csr_from_coo(a,b,info)
integer(psb_ipk_), Parameter :: maxtry=8 integer(psb_ipk_), Parameter :: maxtry=8
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name='s_cp_csr_from_coo' character(len=20) :: name='s_cp_csr_from_coo'
logical :: use_openmp = .false.
#if defined(OPENMP) #if defined(OPENMP)
integer(psb_ipk_), allocatable :: sum(:) integer(psb_ipk_), allocatable :: sum(:)
integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s,j integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s,j
@ -2983,21 +2997,22 @@ subroutine psb_s_cp_csr_from_coo(a,b,info)
!$OMP END PARALLEL !$OMP END PARALLEL
#else #else
do k=1,nza do k=1,nza
i = itemp(k) i = itemp(k)
a%irp(i) = a%irp(i) + 1 a%irp(i) = a%irp(i) + 1
end do end do
ip = 1 ip = 1
do i=1,nr do i=1,nr
ncl = a%irp(i) ncl = a%irp(i)
a%irp(i) = ip a%irp(i) = ip
ip = ip + ncl ip = ip + ncl
end do end do
a%irp(nr+1) = ip a%irp(nr+1) = ip
#endif #endif
call a%set_host() call a%set_host()
end subroutine psb_s_cp_csr_from_coo end subroutine psb_s_cp_csr_from_coo
@ -3113,6 +3128,7 @@ subroutine psb_s_mv_csr_from_coo(a,b,info)
integer(psb_ipk_), Parameter :: maxtry=8 integer(psb_ipk_), Parameter :: maxtry=8
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name='mv_from_coo' character(len=20) :: name='mv_from_coo'
logical :: use_openmp = .false.
#if defined(OPENMP) #if defined(OPENMP)
integer(psb_ipk_), allocatable :: sum(:) integer(psb_ipk_), allocatable :: sum(:)
@ -3120,7 +3136,6 @@ subroutine psb_s_mv_csr_from_coo(a,b,info)
integer(psb_ipk_) :: nxt_val,old_val,saved_elem integer(psb_ipk_) :: nxt_val,old_val,saved_elem
#endif #endif
info = psb_success_ info = psb_success_
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
@ -3214,6 +3229,7 @@ subroutine psb_s_mv_csr_from_coo(a,b,info)
!$OMP END PARALLEL !$OMP END PARALLEL
#else #else
do k=1,nza do k=1,nza
i = itemp(k) i = itemp(k)
a%irp(i) = a%irp(i) + 1 a%irp(i) = a%irp(i) + 1

44
base/serial/impl/psb_z_csr_impl.F90
Unescape Escape View File

@ -152,6 +152,7 @@ contains
!$omp parallel do private(i,j, acc) schedule(static) !$omp parallel do private(i,j, acc) schedule(static)
do i=1,m do i=1,m
acc = zzero acc = zzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -163,6 +164,7 @@ contains
!$omp parallel do private(i,j, acc) !$omp parallel do private(i,j, acc)
do i=1,m do i=1,m
acc = zzero acc = zzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -174,6 +176,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = zzero acc = zzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -189,6 +192,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = zzero acc = zzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -200,6 +204,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = zzero acc = zzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -211,6 +216,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = zzero acc = zzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -225,6 +231,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = zzero acc = zzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -236,6 +243,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = zzero acc = zzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -247,6 +255,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = zzero acc = zzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -261,6 +270,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = zzero acc = zzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -272,6 +282,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = zzero acc = zzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -283,6 +294,7 @@ contains
!$omp parallel do private(i,j,acc) !$omp parallel do private(i,j,acc)
do i=1,m do i=1,m
acc = zzero acc = zzero
!$omp simd
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -2862,6 +2874,8 @@ subroutine psb_z_cp_csr_from_coo(a,b,info)
integer(psb_ipk_), Parameter :: maxtry=8 integer(psb_ipk_), Parameter :: maxtry=8
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name='z_cp_csr_from_coo' character(len=20) :: name='z_cp_csr_from_coo'
logical :: use_openmp = .false.
#if defined(OPENMP) #if defined(OPENMP)
integer(psb_ipk_), allocatable :: sum(:) integer(psb_ipk_), allocatable :: sum(:)
integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s,j integer(psb_ipk_) :: first_idx,last_idx,work,ithread,nthreads,s,j
@ -2983,21 +2997,22 @@ subroutine psb_z_cp_csr_from_coo(a,b,info)
!$OMP END PARALLEL !$OMP END PARALLEL
#else #else
do k=1,nza do k=1,nza
i = itemp(k) i = itemp(k)
a%irp(i) = a%irp(i) + 1 a%irp(i) = a%irp(i) + 1
end do end do
ip = 1 ip = 1
do i=1,nr do i=1,nr
ncl = a%irp(i) ncl = a%irp(i)
a%irp(i) = ip a%irp(i) = ip
ip = ip + ncl ip = ip + ncl
end do end do
a%irp(nr+1) = ip a%irp(nr+1) = ip
#endif #endif
call a%set_host() call a%set_host()
end subroutine psb_z_cp_csr_from_coo end subroutine psb_z_cp_csr_from_coo
@ -3113,6 +3128,7 @@ subroutine psb_z_mv_csr_from_coo(a,b,info)
integer(psb_ipk_), Parameter :: maxtry=8 integer(psb_ipk_), Parameter :: maxtry=8
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name='mv_from_coo' character(len=20) :: name='mv_from_coo'
logical :: use_openmp = .false.
#if defined(OPENMP) #if defined(OPENMP)
integer(psb_ipk_), allocatable :: sum(:) integer(psb_ipk_), allocatable :: sum(:)
@ -3120,7 +3136,6 @@ subroutine psb_z_mv_csr_from_coo(a,b,info)
integer(psb_ipk_) :: nxt_val,old_val,saved_elem integer(psb_ipk_) :: nxt_val,old_val,saved_elem
#endif #endif
info = psb_success_ info = psb_success_
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
@ -3214,6 +3229,7 @@ subroutine psb_z_mv_csr_from_coo(a,b,info)
!$OMP END PARALLEL !$OMP END PARALLEL
#else #else
do k=1,nza do k=1,nza
i = itemp(k) i = itemp(k)
a%irp(i) = a%irp(i) + 1 a%irp(i) = a%irp(i) + 1

Write Preview
Loading…
Cancel
Save