First working version

omp-threadsafe
sfilippone 2 years ago
parent 8459ea28f5
commit f068d73ef1

@ -649,7 +649,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 = .false. logical :: use_openmp = .true.
#ifdef OPENMP #ifdef OPENMP
integer(kind = OMP_lock_kind) :: ins_lck integer(kind = OMP_lock_kind) :: ins_lck
#endif #endif
@ -697,6 +697,7 @@ contains
if (present(lidx)) then if (present(lidx)) then
if (present(mask)) then if (present(mask)) then
!$omp critical(hash_g2l_ins)
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) & ! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) &
! $ OMP shared(name,me,is,idx,ins_lck,mask,mglob,idxmap,ncol,nrow,laddsz,lidx) & ! $ OMP shared(name,me,is,idx,ins_lck,mask,mglob,idxmap,ncol,nrow,laddsz,lidx) &
@ -775,11 +776,13 @@ contains
end do end do
! $ OMP END PARALLEL DO ! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then if (.not. isLoopValid) then
goto 9999 goto 9999
end if end if
else else
!$omp critical(hash_g2l_ins)
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) & ! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) &
! $ OMP shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz,lidx) & ! $ OMP shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz,lidx) &
@ -851,6 +854,7 @@ contains
end do end do
! $ OMP END PARALLEL DO ! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then if (.not. isLoopValid) then
goto 9999 goto 9999
@ -862,6 +866,8 @@ contains
! $ OMP shared(name,me,is,idx,ins_lck,mask,mglob,idxmap,ncol,nrow,laddsz) & ! $ OMP shared(name,me,is,idx,ins_lck,mask,mglob,idxmap,ncol,nrow,laddsz) &
! $ OMP private(i,ip,lip,tlip,nxt,info) & ! $ OMP private(i,ip,lip,tlip,nxt,info) &
! $ OMP reduction(.AND.:isLoopValid) ! $ OMP reduction(.AND.:isLoopValid)
!$omp critical(hash_g2l_ins)
do i = 1, is do i = 1, is
info = 0 info = 0
if (mask(i)) then if (mask(i)) then
@ -934,6 +940,7 @@ contains
end do end do
! $ OMP END PARALLEL DO ! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then if (.not. isLoopValid) then
goto 9999 goto 9999
@ -943,6 +950,7 @@ contains
! $ OMP shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz) & ! $ OMP shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz) &
! $ OMP private(i,ip,lip,tlip,nxt,info) & ! $ OMP private(i,ip,lip,tlip,nxt,info) &
! $ OMP reduction(.AND.:isLoopValid) ! $ OMP reduction(.AND.:isLoopValid)
!$omp critical(hash_g2l_ins)
do i = 1, is do i = 1, is
info = 0 info = 0
ip = idx(i) ip = idx(i)
@ -1011,6 +1019,7 @@ contains
end do end do
! $ OMP END PARALLEL DO ! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then if (.not. isLoopValid) then
goto 9999 goto 9999
@ -1024,7 +1033,6 @@ contains
info = -1 info = -1
end if end if
!call OMP_destroy_lock(ins_lck) !call OMP_destroy_lock(ins_lck)
#endif #endif
else if (.not.use_openmp) then else if (.not.use_openmp) then
#ifdef OPENMP #ifdef OPENMP

@ -145,12 +145,12 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
#endif #endif
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) #if defined(OPENMP)
!$omp critical(cSPINS) !$omp critical(cspins)
#endif #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) #if defined(OPENMP)
!$omp end critical(cSPINS) !$omp end critical(cspins)
#endif #endif
if (info /= psb_success_) then if (info /= psb_success_) then

@ -145,12 +145,12 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
#endif #endif
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) #if defined(OPENMP)
!$omp critical(dSPINS) !$omp critical(dspins)
#endif #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) #if defined(OPENMP)
!$omp end critical(dSPINS) !$omp end critical(dspins)
#endif #endif
if (info /= psb_success_) then if (info /= psb_success_) then

@ -145,12 +145,12 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
#endif #endif
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) #if defined(OPENMP)
!$omp critical(sSPINS) !$omp critical(sspins)
#endif #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) #if defined(OPENMP)
!$omp end critical(sSPINS) !$omp end critical(sspins)
#endif #endif
if (info /= psb_success_) then if (info /= psb_success_) then

@ -145,12 +145,12 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
#endif #endif
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) #if defined(OPENMP)
!$omp critical(zSPINS) !$omp critical(zspins)
#endif #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) #if defined(OPENMP)
!$omp end critical(zSPINS) !$omp end critical(zspins)
#endif #endif
if (info /= psb_success_) then if (info /= psb_success_) then

@ -639,7 +639,7 @@ contains
write(psb_out_unit,'("-total time : ",es12.5)') ttot write(psb_out_unit,'("-total time : ",es12.5)') ttot
end if end if
!call a%print('a.mtx',head='Test') call a%print('a.mtx',head='Test')
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -731,7 +731,7 @@ program psb_d_pde3d
if(psb_errstatus_fatal()) goto 9999 if(psb_errstatus_fatal()) goto 9999
name='pde3d90' name='pde3d90'
call psb_set_errverbosity(itwo) call psb_set_errverbosity(itwo)
!call psb_cd_set_large_threshold(2000_psb_ipk_) call psb_cd_set_large_threshold(2000_psb_ipk_)
! !
! Hello world ! Hello world
! !

Loading…
Cancel
Save