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

Put CRITICAL(name) in G2L_INS

Browse Source
omp-threadsafe
sfilippone 2 years ago
parent 0f1603a2e9
commit eb11e5e053
6 changed files with 125 additions and 75 deletions
Show Stats Download Patch File Download Diff File

1
base/modules/desc/psb_gen_block_map_mod.F90
Unescape Escape View File

@ -488,6 +488,7 @@ contains
integer(psb_ipk_) :: iam, np integer(psb_ipk_) :: iam, np
logical :: owned_ logical :: owned_
write(0,*) 'block_g2lv2'
info = 0 info = 0
ctxt = idxmap%get_ctxt() ctxt = idxmap%get_ctxt()
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)

0
base/modules/desc/psb_glist_map_mod.f90 → base/modules/desc/psb_glist_map_mod.F90
Unescape Escape View File

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

@ -207,7 +207,6 @@ contains
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
logical :: owned_ logical :: owned_
info = 0 info = 0
if (present(mask)) then if (present(mask)) then
if (size(mask) < size(idx)) then if (size(mask) < size(idx)) then
info = -1 info = -1
@ -249,7 +248,6 @@ contains
end do end do
end if end if
end subroutine hash_l2gv1 end subroutine hash_l2gv1
subroutine hash_l2gv2(idxin,idxout,idxmap,info,mask,owned) subroutine hash_l2gv2(idxin,idxout,idxmap,info,mask,owned)
@ -334,7 +332,6 @@ contains
info = 0 info = 0
ctxt = idxmap%get_ctxt() ctxt = idxmap%get_ctxt()
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
if (present(mask)) then if (present(mask)) then
if (size(mask) < size(idx)) then if (size(mask) < size(idx)) then
info = -1 info = -1
@ -437,7 +434,6 @@ contains
end if end if
end if end if
end subroutine hash_g2lv1 end subroutine hash_g2lv1
subroutine hash_g2lv2(idxin,idxout,idxmap,info,mask,owned) subroutine hash_g2lv2(idxin,idxout,idxmap,info,mask,owned)
@ -460,7 +456,6 @@ contains
is = size(idxin) is = size(idxin)
im = min(is,size(idxout)) im = min(is,size(idxout))
info = 0 info = 0
ctxt = idxmap%get_ctxt() ctxt = idxmap%get_ctxt()
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -567,7 +562,6 @@ contains
end if end if
end if end if
end subroutine hash_g2lv2 end subroutine hash_g2lv2
@ -688,14 +682,13 @@ contains
if (use_openmp) then if (use_openmp) then
#ifdef OPENMP #ifdef OPENMP
call OMP_init_lock(ins_lck) !call OMP_init_lock(ins_lck)
if (idxmap%is_bld()) then if (idxmap%is_bld()) then
isLoopValid = .true. isLoopValid = .true.
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
if (present(mask)) then if (present(mask)) then
!write(0,*) 'present mask'
mask_ = mask mask_ = mask
else else
allocate(mask_(size(idx))) allocate(mask_(size(idx)))
@ -703,7 +696,6 @@ contains
end if end if
if (present(lidx)) then if (present(lidx)) then
!write(0,*) 'present lidx'
if (present(mask)) then if (present(mask)) then
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) & ! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) &
@ -718,9 +710,9 @@ contains
idx(i) = -1 idx(i) = -1
cycle cycle
endif endif
call OMP_set_lock(ins_lck) !call OMP_set_lock(ins_lck)
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
call OMP_unset_lock(ins_lck) !call OMP_unset_lock(ins_lck)
! At first, we check the index presence in 'idxmap'. Usually ! At first, we check the index presence in 'idxmap'. Usually
! the index is found. If it is not found, we repeat the checking, ! the index is found. If it is not found, we repeat the checking,
@ -728,7 +720,7 @@ contains
call hash_inner_cnv(ip,lip,idxmap%hashvmask,& call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol) & idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) then if (lip < 0) then
call OMP_set_lock(ins_lck) !call OMP_set_lock(ins_lck)
! We check again if the index is already in 'idxmap', this ! We check again if the index is already in 'idxmap', this
! time inside a critical region (we assume that the index ! time inside a critical region (we assume that the index
@ -772,7 +764,7 @@ contains
else else
idx(i) = -1 idx(i) = -1
end if end if
call OMP_unset_lock(ins_lck) !call OMP_unset_lock(ins_lck)
end if end if
else else
idx(i) = lip idx(i) = lip
@ -800,9 +792,9 @@ contains
idx(i) = -1 idx(i) = -1
cycle cycle
endif endif
call OMP_set_lock(ins_lck) !call OMP_set_lock(ins_lck)
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
call OMP_unset_lock(ins_lck) !call OMP_unset_lock(ins_lck)
! At first, we check the index presence in 'idxmap'. Usually ! At first, we check the index presence in 'idxmap'. Usually
! the index is found. If it is not found, we repeat the checking, ! the index is found. If it is not found, we repeat the checking,
@ -810,7 +802,7 @@ contains
call hash_inner_cnv(ip,lip,idxmap%hashvmask,& call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol) & idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) then if (lip < 0) then
call OMP_set_lock(ins_lck) !call OMP_set_lock(ins_lck)
! We check again if the index is already in 'idxmap', this ! We check again if the index is already in 'idxmap', this
! time inside a critical region (we assume that the index ! time inside a critical region (we assume that the index
! is often already existing). ! is often already existing).
@ -851,7 +843,7 @@ contains
else else
idx(i) = -1 idx(i) = -1
end if end if
call OMP_unset_lock(ins_lck) !call OMP_unset_lock(ins_lck)
end if end if
else else
idx(i) = lip idx(i) = lip
@ -865,7 +857,6 @@ contains
end if end if
end if end if
else if (.not.present(lidx)) then else if (.not.present(lidx)) then
!write(0,*) 'not present lidx'
if(present(mask)) then if(present(mask)) then
! $ 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) & ! $ OMP shared(name,me,is,idx,ins_lck,mask,mglob,idxmap,ncol,nrow,laddsz) &
@ -879,9 +870,9 @@ contains
idx(i) = -1 idx(i) = -1
cycle cycle
endif endif
call OMP_set_lock(ins_lck) !call OMP_set_lock(ins_lck)
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
call OMP_unset_lock(ins_lck) !call OMP_unset_lock(ins_lck)
! At first, we check the index presence in 'idxmap'. Usually ! At first, we check the index presence in 'idxmap'. Usually
! the index is found. If it is not found, we repeat the checking, ! the index is found. If it is not found, we repeat the checking,
@ -890,7 +881,7 @@ contains
& idxmap%hashv,idxmap%glb_lc,ncol) & idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) then if (lip < 0) then
call OMP_set_lock(ins_lck) !call OMP_set_lock(ins_lck)
! We check again if the index is already in 'idxmap', this ! We check again if the index is already in 'idxmap', this
! time inside a critical region (we assume that the index ! time inside a critical region (we assume that the index
! is often already existing, so this lock is relatively rare). ! is often already existing, so this lock is relatively rare).
@ -932,7 +923,7 @@ contains
else else
idx(i) = -1 idx(i) = -1
end if end if
call OMP_unset_lock(ins_lck) !call OMP_unset_lock(ins_lck)
end if end if
else else
idx(i) = lip idx(i) = lip
@ -959,9 +950,9 @@ contains
idx(i) = -1 idx(i) = -1
cycle cycle
endif endif
call OMP_set_lock(ins_lck) !call OMP_set_lock(ins_lck)
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
call OMP_unset_lock(ins_lck) !call OMP_unset_lock(ins_lck)
! At first, we check the index presence in 'idxmap'. Usually ! At first, we check the index presence in 'idxmap'. Usually
! the index is found. If it is not found, we repeat the checking, ! the index is found. If it is not found, we repeat the checking,
@ -969,7 +960,7 @@ contains
call hash_inner_cnv(ip,lip,idxmap%hashvmask,& call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol) & idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) then if (lip < 0) then
call OMP_set_lock(ins_lck) !call OMP_set_lock(ins_lck)
! We check again if the index is already in 'idxmap', this ! We check again if the index is already in 'idxmap', this
! time inside a critical region (we assume that the index ! time inside a critical region (we assume that the index
! is often already existing). ! is often already existing).
@ -1011,7 +1002,7 @@ contains
else else
idx(i) = -1 idx(i) = -1
end if end if
call OMP_unset_lock(ins_lck) !call OMP_unset_lock(ins_lck)
end if end if
else else
@ -1032,7 +1023,7 @@ contains
idx = -1 idx = -1
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
@ -1182,7 +1173,6 @@ contains
idx(i) = -1 idx(i) = -1
end if end if
enddo enddo
else if (.not.present(mask)) then else if (.not.present(mask)) then
do i = 1, is do i = 1, is
@ -1227,7 +1217,6 @@ contains
info = psb_success_ info = psb_success_
enddo enddo
end if end if
end if end if
else else

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

@ -409,7 +409,11 @@ contains
info = HashDuplicate info = HashDuplicate
return return
end if end if
!$OMP CRITICAL !$omp critical(hashsearchins)
if (hash%table(hk,1) == key) then
val = hash%table(hk,2)
info = HashDuplicate
else
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
! !
@ -434,7 +438,8 @@ contains
!return !return
end if end if
end if end if
!$OMP END CRITICAL end if
!$omp end critical(hashsearchins)
if (info /= HashOk) return if (info /= HashOk) return
if (val > 0) return if (val > 0) return
hk = hk - hd hk = hk - hd

57
base/modules/desc/psb_list_map_mod.f90 → base/modules/desc/psb_list_map_mod.F90
Unescape Escape View File

@ -349,7 +349,6 @@ contains
logical :: owned_ logical :: owned_
info = 0 info = 0
if (present(mask)) then if (present(mask)) then
if (size(mask) < size(idxin)) then if (size(mask) < size(idxin)) then
info = -1 info = -1
@ -645,6 +644,19 @@ contains
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idxin(i)) ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then if (ix < 0) then
#if defined(OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
ix = lidx(i)
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) info = -4
idxmap%local_cols = max(ix,idxmap%local_cols)
idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix
end if
!$OMP END CRITICAL(LISTINS)
#else
ix = lidx(i) ix = lidx(i)
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz) call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if ((ix <= idxmap%local_rows).or.(info /= 0)) then if ((ix <= idxmap%local_rows).or.(info /= 0)) then
@ -654,6 +666,7 @@ contains
idxmap%local_cols = max(ix,idxmap%local_cols) idxmap%local_cols = max(ix,idxmap%local_cols)
idxmap%loc_to_glob(ix) = idxin(i) idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix idxmap%glob_to_loc(idxin(i)) = ix
#endif
end if end if
idxout(i) = ix idxout(i) = ix
else else
@ -668,6 +681,19 @@ contains
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idxin(i)) ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then if (ix < 0) then
#if defined(OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
ix = lidx(i)
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) info = -4
idxmap%local_cols = max(ix,idxmap%local_cols)
idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix
end if
!$OMP END CRITICAL(LISTINS)
#else
ix = lidx(i) ix = lidx(i)
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz) call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if ((ix <= idxmap%local_rows).or.(info /= 0)) then if ((ix <= idxmap%local_rows).or.(info /= 0)) then
@ -677,6 +703,7 @@ contains
idxmap%local_cols = max(ix,idxmap%local_cols) idxmap%local_cols = max(ix,idxmap%local_cols)
idxmap%loc_to_glob(ix) = idxin(i) idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix idxmap%glob_to_loc(idxin(i)) = ix
#endif
end if end if
idxout(i) = ix idxout(i) = ix
else else
@ -693,6 +720,19 @@ contains
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idxin(i)) ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then if (ix < 0) then
#if defined(OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
ix = idxmap%local_cols + 1
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) info = -4
idxmap%local_cols = ix
idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix
end if
!$OMP END CRITICAL(LISTINS)
#else
ix = idxmap%local_cols + 1 ix = idxmap%local_cols + 1
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz) call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) then if (info /= 0) then
@ -702,6 +742,7 @@ contains
idxmap%local_cols = ix idxmap%local_cols = ix
idxmap%loc_to_glob(ix) = idxin(i) idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix idxmap%glob_to_loc(idxin(i)) = ix
#endif
end if end if
idxout(i) = ix idxout(i) = ix
else else
@ -716,6 +757,19 @@ contains
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idxin(i)) ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then if (ix < 0) then
#if defined(OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
ix = idxmap%local_cols + 1
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) info = -4
idxmap%local_cols = ix
idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix
end if
!$OMP END CRITICAL(LISTINS)
#else
ix = idxmap%local_cols + 1 ix = idxmap%local_cols + 1
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz) call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) then if (info /= 0) then
@ -725,6 +779,7 @@ contains
idxmap%local_cols = ix idxmap%local_cols = ix
idxmap%loc_to_glob(ix) = idxin(i) idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix idxmap%glob_to_loc(idxin(i)) = ix
#endif
end if end if
idxout(i) = ix idxout(i) = ix
else else

0
base/modules/desc/psb_repl_map_mod.f90 → base/modules/desc/psb_repl_map_mod.F90
Unescape Escape View File

Write Preview
Loading…
Cancel
Save