Additional OpenMP tweaks, to be redesigned in the future.

repackage
sfilippone 2 weeks ago
parent 772533b6f1
commit 30810f804e

@ -2947,6 +2947,8 @@ contains
info = psb_success_
#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 serial version: each element is stored in data
! structures but the invalid ones are stored as '-1' values.

@ -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,&
& imin,imax,jmin,jmax,info)
#if !defined(OPENMP)
!$omp critical
nza = nzaold
call a%set_nzeros(nza)
!$omp end critical
#endif
call a%set_sorted(.false.)
@ -2949,6 +2947,8 @@ contains
info = psb_success_
#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 serial version: each element is stored in data
! structures but the invalid ones are stored as '-1' values.

@ -2947,6 +2947,8 @@ contains
info = psb_success_
#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 serial version: each element is stored in data
! structures but the invalid ones are stored as '-1' values.

@ -2947,6 +2947,8 @@ contains
info = psb_success_
#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 serial version: each element is stored in data
! structures but the invalid ones are stored as '-1' values.

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

@ -78,9 +78,6 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
integer(psb_lpk_), allocatable :: lila(:),ljla(:)
real(psb_dpk_), allocatable :: lval(:)
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_
name = 'psb_dspins'
@ -123,18 +120,6 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
else
local_ = .false.
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
@ -153,18 +138,9 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
block
logical :: is_in_parallel
is_in_parallel = omp_in_parallel()
!write(0,*) 'IN PARALLEL:',is_in_parallel
if (is_in_parallel) then
!$omp single
if (do_timings) call psb_tic(bph1)
!$omp end single
!$omp parallel private(ila,jla,nrow,ncol,nnl,k,lila,ljla,lval)
!$omp parallel private(ila,jla,nrow,ncol,nnl,k)
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)
if (info == 0) call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,&
& 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/))
goto 9998
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()
ncol = desc_a%get_local_cols()
!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)
end if
9998 continue
!$omp single
if (do_timings) call psb_toc(bph3)
!$omp end single
!write(0,*) me,' after csput',psb_errstatus_fatal()
!$omp end parallel
else if (.not.is_in_parallel) then
if (do_timings) call psb_tic(bph11)
else
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()
if (info == 0) call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,&
& 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/))
goto 9999
end if
if (do_timings) call psb_toc(bph12)
if (do_timings) call psb_tic(bph13)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
!write(0,*) me,' Before csput',psb_errstatus_fatal()
@ -270,21 +234,15 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
call psb_errpush(info,name)
goto 9999
end if
if (do_timings) call psb_toc(bph13)
end if
end block
#else
!write(0,*) me,' Before g2l ',psb_errstatus_fatal()
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,&
& mask=(ila(1:nz)>0))
#if defined(OPENMP)
!$omp endcritical(g2lins)
#endif
!write(0,*) me,' after g2l_ins ',psb_errstatus_fatal(),info
if (info /= psb_success_) then

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

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

Loading…
Cancel
Save