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

Additional OpenMP tweaks, to be redesigned in the future.

Browse Source
repackage
sfilippone 2 weeks ago
parent 772533b6f1
commit 30810f804e
9 changed files with 37 additions and 73 deletions
Show Stats Download Patch File Download Diff File

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

@ -722,7 +722,7 @@ contains
idx(i) = lip idx(i) = lip
info = psb_success_ info = psb_success_
else else
! $ o m p critical(hash_g2l_ins) !$omp critical(hash_g2l_ins)
tlip = lip tlip = lip
nxt = lidx(i) nxt = lidx(i)
if (nxt <= nrow) then if (nxt <= nrow) then
@ -758,7 +758,7 @@ contains
end if end if
end if end if
endif endif
! $ o m p end critical(hash_g2l_ins) !$omp end critical(hash_g2l_ins)
end if end if
else else
idx(i) = -1 idx(i) = -1
@ -785,7 +785,7 @@ contains
idx(i) = lip idx(i) = lip
info = psb_success_ info = psb_success_
else else
! $ o m p critical(hash_g2l_ins) !$omp critical(hash_g2l_ins)
tlip = lip tlip = lip
nxt = lidx(i) nxt = lidx(i)
if (nxt <= nrow) then if (nxt <= nrow) then
@ -821,7 +821,7 @@ contains
end if end if
end if end if
endif endif
! $ o m p end critical(hash_g2l_ins) !$omp end critical(hash_g2l_ins)
end if end if
enddo enddo
! $ o m p end parallel do ! $ o m p end parallel do
@ -848,7 +848,7 @@ contains
idx(i) = lip idx(i) = lip
info = psb_success_ info = psb_success_
else else
! $ o m p critical(hash_g2l_ins) !$omp critical(hash_g2l_ins)
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
nxt = ncol + 1 nxt = ncol + 1
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,& call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
@ -879,7 +879,7 @@ contains
isLoopValid = .false. isLoopValid = .false.
end if end if
end if end if
! $ o m p end critical(hash_g2l_ins) !$omp end critical(hash_g2l_ins)
end if end if
else else
idx(i) = -1 idx(i) = -1
@ -906,7 +906,7 @@ contains
idx(i) = lip idx(i) = lip
info = psb_success_ info = psb_success_
else else
! $ o m p critical(hash_g2l_ins) !$omp critical(hash_g2l_ins)
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
nxt = ncol + 1 nxt = ncol + 1
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,& call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
@ -937,7 +937,7 @@ contains
isLoopValid = .false. isLoopValid = .false.
end if end if
end if end if
! $ o m p end critical(hash_g2l_ins) !$omp end critical(hash_g2l_ins)
end if end if
enddo enddo
! $ o m p end parallel do ! $ o m p end parallel do

10
base/serial/impl/psb_c_coo_impl.F90
Unescape Escape View File

@ -2947,13 +2947,15 @@ contains
info = psb_success_ info = psb_success_
#if defined(OPENMP) #if defined(OPENMP)
! Disabling OpenMP parallel do for the time being.
! Will need to redesign the entire code stack
! The logic here is different from the one used for ! The logic here is different from the one used for
! the serial version: each element is stored in data ! the serial version: each element is stored in data
! structures but the invalid ones are stored as '-1' values. ! structures but the invalid ones are stored as '-1' values.
! These values will be filtered in a future fixing process. ! These values will be filtered in a future fixing process.
!$OMP PARALLEL DO default(none) schedule(STATIC) & ! $ O M P PARALLEL DO default(none) schedule(STATIC) &
!$OMP shared(nz,imin,imax,jmin,jmax,ia,ja,val,ia1,ia2,aspk,nza) & ! $ O M P shared(nz,imin,imax,jmin,jmax,ia,ja,val,ia1,ia2,aspk,nza) &
!$OMP private(ir,ic,i) ! $ O M P private(ir,ic,i)
do i=1,nz do i=1,nz
ir = ia(i) ir = ia(i)
ic = ja(i) ic = ja(i)
@ -2967,7 +2969,7 @@ contains
aspk(nza+i) = -1 aspk(nza+i) = -1
end if end if
end do end do
!$OMP END PARALLEL DO ! $ O M P END PARALLEL DO
nza = nza + nz nza = nza + nz
#else #else
do i=1, nz do i=1, nz

4
base/serial/impl/psb_d_coo_impl.F90
Unescape Escape View File

@ -2892,10 +2892,8 @@ subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
call psb_inner_ins(nz,ia,ja,val,nzaold,a%ia,a%ja,a%val,isza,& call psb_inner_ins(nz,ia,ja,val,nzaold,a%ia,a%ja,a%val,isza,&
& imin,imax,jmin,jmax,info) & imin,imax,jmin,jmax,info)
#if !defined(OPENMP) #if !defined(OPENMP)
!$omp critical
nza = nzaold nza = nzaold
call a%set_nzeros(nza) call a%set_nzeros(nza)
!$omp end critical
#endif #endif
call a%set_sorted(.false.) call a%set_sorted(.false.)
@ -2949,6 +2947,8 @@ contains
info = psb_success_ info = psb_success_
#if defined(OPENMP) #if defined(OPENMP)
! Disabling OpenMP parallel do for the time being.
! Will need to redesign the entire code stack
! The logic here is different from the one used for ! The logic here is different from the one used for
! the serial version: each element is stored in data ! the serial version: each element is stored in data
! structures but the invalid ones are stored as '-1' values. ! structures but the invalid ones are stored as '-1' values.

10
base/serial/impl/psb_s_coo_impl.F90
Unescape Escape View File

@ -2947,13 +2947,15 @@ contains
info = psb_success_ info = psb_success_
#if defined(OPENMP) #if defined(OPENMP)
! Disabling OpenMP parallel do for the time being.
! Will need to redesign the entire code stack
! The logic here is different from the one used for ! The logic here is different from the one used for
! the serial version: each element is stored in data ! the serial version: each element is stored in data
! structures but the invalid ones are stored as '-1' values. ! structures but the invalid ones are stored as '-1' values.
! These values will be filtered in a future fixing process. ! These values will be filtered in a future fixing process.
!$OMP PARALLEL DO default(none) schedule(STATIC) & ! $ O M P PARALLEL DO default(none) schedule(STATIC) &
!$OMP shared(nz,imin,imax,jmin,jmax,ia,ja,val,ia1,ia2,aspk,nza) & ! $ O M P shared(nz,imin,imax,jmin,jmax,ia,ja,val,ia1,ia2,aspk,nza) &
!$OMP private(ir,ic,i) ! $ O M P private(ir,ic,i)
do i=1,nz do i=1,nz
ir = ia(i) ir = ia(i)
ic = ja(i) ic = ja(i)
@ -2967,7 +2969,7 @@ contains
aspk(nza+i) = -1 aspk(nza+i) = -1
end if end if
end do end do
!$OMP END PARALLEL DO ! $ O M P END PARALLEL DO
nza = nza + nz nza = nza + nz
#else #else
do i=1, nz do i=1, nz

10
base/serial/impl/psb_z_coo_impl.F90
Unescape Escape View File

@ -2947,13 +2947,15 @@ contains
info = psb_success_ info = psb_success_
#if defined(OPENMP) #if defined(OPENMP)
! Disabling OpenMP parallel do for the time being.
! Will need to redesign the entire code stack
! The logic here is different from the one used for ! The logic here is different from the one used for
! the serial version: each element is stored in data ! the serial version: each element is stored in data
! structures but the invalid ones are stored as '-1' values. ! structures but the invalid ones are stored as '-1' values.
! These values will be filtered in a future fixing process. ! These values will be filtered in a future fixing process.
!$OMP PARALLEL DO default(none) schedule(STATIC) & ! $ O M P PARALLEL DO default(none) schedule(STATIC) &
!$OMP shared(nz,imin,imax,jmin,jmax,ia,ja,val,ia1,ia2,aspk,nza) & ! $ O M P shared(nz,imin,imax,jmin,jmax,ia,ja,val,ia1,ia2,aspk,nza) &
!$OMP private(ir,ic,i) ! $ O M P private(ir,ic,i)
do i=1,nz do i=1,nz
ir = ia(i) ir = ia(i)
ic = ja(i) ic = ja(i)
@ -2967,7 +2969,7 @@ contains
aspk(nza+i) = -1 aspk(nza+i) = -1
end if end if
end do end do
!$OMP END PARALLEL DO ! $ O M P END PARALLEL DO
nza = nza + nz nza = nza + nz
#else #else
do i=1, nz do i=1, nz

2
base/tools/psb_cspins.F90
Unescape Escape View File

@ -134,7 +134,7 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
& a_err='allocate',i_err=(/info/)) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
#if defined(OPENMP) #if 0 && defined(OPENMP)
block block
logical :: is_in_parallel logical :: is_in_parallel
is_in_parallel = omp_in_parallel() is_in_parallel = omp_in_parallel()

54
base/tools/psb_dspins.F90
Unescape Escape View File

@ -78,10 +78,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
integer(psb_lpk_), allocatable :: lila(:),ljla(:) integer(psb_lpk_), allocatable :: lila(:),ljla(:)
real(psb_dpk_), allocatable :: lval(:) real(psb_dpk_), allocatable :: lval(:)
character(len=20) :: name character(len=20) :: name
logical, parameter :: do_timings=.true.
integer(psb_ipk_), save :: bph1=-1, bph2=-1, bph3=-1
integer(psb_ipk_), save :: bph11=-1, bph12=-1, bph13=-1
info = psb_success_ info = psb_success_
name = 'psb_dspins' name = 'psb_dspins'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -123,18 +120,6 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
else else
local_ = .false. local_ = .false.
endif endif
if ((do_timings).and.(bph1==-1)) &
& bph1 = psb_get_timer_idx("SPI: g2l1 ")
if ((do_timings).and.(bph2==-1)) &
& bph2 = psb_get_timer_idx("SPI: g2li1")
if ((do_timings).and.(bph3==-1)) &
& bph3 = psb_get_timer_idx("SPI: cspu1")
if ((do_timings).and.(bph11==-1)) &
& bph11 = psb_get_timer_idx("SPI: g2l2 ")
if ((do_timings).and.(bph12==-1)) &
& bph12 = psb_get_timer_idx("SPI: g2li2")
if ((do_timings).and.(bph13==-1)) &
& bph13 = psb_get_timer_idx("SPI: cspu2")
if (desc_a%is_bld()) then if (desc_a%is_bld()) then
@ -153,18 +138,9 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
block block
logical :: is_in_parallel logical :: is_in_parallel
is_in_parallel = omp_in_parallel() is_in_parallel = omp_in_parallel()
!write(0,*) 'IN PARALLEL:',is_in_parallel if (is_in_parallel) then
if (is_in_parallel) then !$omp parallel private(ila,jla,nrow,ncol,nnl,k)
!$omp single
if (do_timings) call psb_tic(bph1)
!$omp end single
!$omp parallel private(ila,jla,nrow,ncol,nnl,k,lila,ljla,lval)
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
!$omp barrier
!$omp single
if (do_timings) call psb_toc(bph1)
if (do_timings) call psb_tic(bph2)
!$omp end single
!$omp critical(spins) !$omp critical(spins)
if (info == 0) call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,& if (info == 0) call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,&
& mask=(ila(1:nz)>0)) & mask=(ila(1:nz)>0))
@ -175,10 +151,6 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
& a_err='psb_cdins',i_err=(/info/)) & a_err='psb_cdins',i_err=(/info/))
goto 9998 goto 9998
end if end if
!$omp single
if (do_timings) call psb_toc(bph2)
if (do_timings) call psb_tic(bph3)
!$omp end single
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
!write(0,*) me,' Before csput',psb_errstatus_fatal() !write(0,*) me,' Before csput',psb_errstatus_fatal()
@ -214,16 +186,10 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
call psb_errpush(info,name) call psb_errpush(info,name)
end if end if
9998 continue 9998 continue
!$omp single
if (do_timings) call psb_toc(bph3)
!$omp end single
!write(0,*) me,' after csput',psb_errstatus_fatal() !write(0,*) me,' after csput',psb_errstatus_fatal()
!$omp end parallel !$omp end parallel
else if (.not.is_in_parallel) then else
if (do_timings) call psb_tic(bph11)
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
if (do_timings) call psb_toc(bph11)
if (do_timings) call psb_tic(bph12)
!write(0,*) me,' Before g2l_ins ',psb_errstatus_fatal() !write(0,*) me,' Before g2l_ins ',psb_errstatus_fatal()
if (info == 0) call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,& if (info == 0) call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,&
& mask=(ila(1:nz)>0)) & mask=(ila(1:nz)>0))
@ -233,8 +199,6 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
& a_err='psb_cdins',i_err=(/info/)) & a_err='psb_cdins',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (do_timings) call psb_toc(bph12)
if (do_timings) call psb_tic(bph13)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
!write(0,*) me,' Before csput',psb_errstatus_fatal() !write(0,*) me,' Before csput',psb_errstatus_fatal()
@ -270,22 +234,16 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
if (do_timings) call psb_toc(bph13)
end if end if
end block end block
#else #else
!write(0,*) me,' Before g2l ',psb_errstatus_fatal() !write(0,*) me,' Before g2l ',psb_errstatus_fatal()
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
#if defined(OPENMP)
!$omp critical(g2lins)
#endif
if (info == 0) call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,& if (info == 0) call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,&
& mask=(ila(1:nz)>0)) & mask=(ila(1:nz)>0))
#if defined(OPENMP)
!$omp endcritical(g2lins)
#endif
!write(0,*) me,' after g2l_ins ',psb_errstatus_fatal(),info !write(0,*) me,' after g2l_ins ',psb_errstatus_fatal(),info
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&

2
base/tools/psb_sspins.F90
Unescape Escape View File

@ -134,7 +134,7 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
& a_err='allocate',i_err=(/info/)) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
#if defined(OPENMP) #if 0 && defined(OPENMP)
block block
logical :: is_in_parallel logical :: is_in_parallel
is_in_parallel = omp_in_parallel() is_in_parallel = omp_in_parallel()

2
base/tools/psb_zspins.F90
Unescape Escape View File

@ -134,7 +134,7 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
& a_err='allocate',i_err=(/info/)) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
#if defined(OPENMP) #if 0 && defined(OPENMP)
block block
logical :: is_in_parallel logical :: is_in_parallel
is_in_parallel = omp_in_parallel() is_in_parallel = omp_in_parallel()

Write Preview
Loading…
Cancel
Save