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

91
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,13 +696,12 @@ 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) &
!$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) &
!$OMP private(i,ip,lip,tlip,nxt,info) & ! $ OMP private(i,ip,lip,tlip,nxt,info) &
!$OMP reduction(.AND.:isLoopValid) ! $ OMP reduction(.AND.:isLoopValid)
do i = 1, is do i = 1, is
info = 0 info = 0
if (mask(i)) then if (mask(i)) then
@ -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
@ -782,17 +774,17 @@ contains
end if end if
end do end do
!$OMP END PARALLEL DO ! $ OMP END PARALLEL DO
if (.not. isLoopValid) then if (.not. isLoopValid) then
goto 9999 goto 9999
end if end if
else else
!$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) &
!$OMP private(i,ip,lip,tlip,nxt,info) & ! $ OMP private(i,ip,lip,tlip,nxt,info) &
!$OMP reduction(.AND.:isLoopValid) ! $ OMP reduction(.AND.:isLoopValid)
do i = 1, is do i = 1, is
info = 0 info = 0
ip = idx(i) ip = idx(i)
@ -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,26 +843,25 @@ 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
end if end if
end do end do
!$OMP END PARALLEL DO ! $ OMP END PARALLEL DO
if (.not. isLoopValid) then if (.not. isLoopValid) then
goto 9999 goto 9999
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) &
!$OMP private(i,ip,lip,tlip,nxt,info) & ! $ OMP private(i,ip,lip,tlip,nxt,info) &
!$OMP reduction(.AND.:isLoopValid) ! $ OMP reduction(.AND.:isLoopValid)
do i = 1, is do i = 1, is
info = 0 info = 0
if (mask(i)) then if (mask(i)) then
@ -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
@ -942,16 +933,16 @@ contains
end if end if
end do end do
!$OMP END PARALLEL DO ! $ OMP END PARALLEL DO
if (.not. isLoopValid) then if (.not. isLoopValid) then
goto 9999 goto 9999
end if end if
else else
!$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) & ! $ 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)
do i = 1, is do i = 1, is
info = 0 info = 0
ip = idx(i) ip = idx(i)
@ -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
@ -1019,7 +1010,7 @@ contains
end if end if
end do end do
!$OMP END PARALLEL DO ! $ OMP END PARALLEL DO
if (.not. isLoopValid) then if (.not. isLoopValid) then
goto 9999 goto 9999
@ -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
@ -1139,9 +1130,9 @@ contains
else if (.not.present(lidx)) then else if (.not.present(lidx)) then
if (present(mask)) then if (present(mask)) then
do i = 1, is do i = 1, is
if (mask(i)) then if (mask(i)) then
ip = idx(i) ip = idx(i)
if ((ip < 1 ).or.(ip>mglob)) then if ((ip < 1 ).or.(ip>mglob)) then
idx(i) = -1 idx(i) = -1
@ -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

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

@ -409,34 +409,39 @@ contains
info = HashDuplicate info = HashDuplicate
return return
end if end if
!$OMP CRITICAL !$omp critical(hashsearchins)
if (hash%table(hk,1) == HashFreeEntry) then if (hash%table(hk,1) == key) then
if (hash%nk == hash%hsize -1) then val = hash%table(hk,2)
! info = HashDuplicate
! Note: because of the way we allocate things at CDALL else
! time this is really unlikely; if we get here, we if (hash%table(hk,1) == HashFreeEntry) then
! have at least as many halo indices as internals, which if (hash%nk == hash%hsize -1) then
! means we're already in trouble. But we try to keep going. !
! ! Note: because of the way we allocate things at CDALL
call psb_hash_realloc(hash,info) ! time this is really unlikely; if we get here, we
if (info /= HashOk) then ! have at least as many halo indices as internals, which
info = HashOutOfMemory ! means we're already in trouble. But we try to keep going.
!return !
call psb_hash_realloc(hash,info)
if (info /= HashOk) then
info = HashOutOfMemory
!return
else
call psb_hash_searchinskey(key,val,nextval,hash,info)
!return
end if
else else
call psb_hash_searchinskey(key,val,nextval,hash,info) hash%nk = hash%nk + 1
hash%table(hk,1) = key
hash%table(hk,2) = nextval
val = nextval
!return !return
end if end if
else
hash%nk = hash%nk + 1
hash%table(hk,1) = key
hash%table(hk,2) = nextval
val = nextval
!return
end if end if
end if end if
!$OMP END CRITICAL !$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
if (hk < 0) hk = hk + hsize if (hk < 0) hk = hk + hsize
end do end do

59
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
@ -644,7 +643,20 @@ contains
if (mask(i)) then if (mask(i)) then
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 defined(OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then 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
@ -692,7 +719,20 @@ contains
if (mask(i)) then if (mask(i)) then
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