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

Fix OpenMP version of hash_map and hash

Browse Source
repack-csga
Salvatore Filippone 8 months ago
parent 188dee6842
commit fa86c91411
2 changed files with 261 additions and 346 deletions
Show Stats Download Patch File Download Diff File

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

@ -363,6 +363,9 @@ contains
else if (idxmap%is_valid()) then else if (idxmap%is_valid()) then
!$omp parallel do default(none) schedule(dynamic) &
!$omp shared(mask,is,idx,mglob,idxmap,nrm,ncol,nrow,owned_) &
!$omp private(i,ip,lip,tlip,info)
do i = 1, is do i = 1, is
if (mask(i)) then if (mask(i)) then
ip = idx(i) ip = idx(i)
@ -388,7 +391,7 @@ contains
endif endif
end if end if
enddo enddo
!$omp end parallel do
else else
write(0,*) 'Hash status: invalid ',idxmap%get_state() write(0,*) 'Hash status: invalid ',idxmap%get_state()
idx(1:is) = -1 idx(1:is) = -1
@ -404,6 +407,9 @@ contains
else if (idxmap%is_valid()) then else if (idxmap%is_valid()) then
!$omp parallel do default(none) schedule(dynamic) &
!$omp shared(is,idx,mglob,idxmap,nrm,ncol,nrow,owned_) &
!$omp private(i,ip,lip,tlip,info)
do i = 1, is do i = 1, is
ip = idx(i) ip = idx(i)
if ((ip < 1 ).or.(ip>mglob)) then if ((ip < 1 ).or.(ip>mglob)) then
@ -427,14 +433,12 @@ contains
idx(i) = lip idx(i) = lip
endif endif
enddo enddo
!$omp end parallel do
else else
write(0,*) 'Hash status: invalid ',idxmap%get_state() write(0,*) 'Hash status: invalid ',idxmap%get_state()
idx(1:is) = -1 idx(1:is) = -1
info = -1 info = -1
end if end if
end if end if
end subroutine hash_g2lv1 end subroutine hash_g2lv1
@ -493,6 +497,9 @@ contains
else if (idxmap%is_valid()) then else if (idxmap%is_valid()) then
!$omp parallel do default(none) schedule(dynamic) &
!$omp shared(mask,is,idxin,idxout,mglob,idxmap,nrm,ncol,nrow,owned_) &
!$omp private(i,ip,lip,tlip,info)
do i = 1, is do i = 1, is
if (mask(i)) then if (mask(i)) then
ip = idxin(i) ip = idxin(i)
@ -518,6 +525,7 @@ contains
endif endif
end if end if
enddo enddo
!$omp end parallel do
else else
write(0,*) 'Hash status: invalid ',idxmap%get_state() write(0,*) 'Hash status: invalid ',idxmap%get_state()
idxout(1:is) = -1 idxout(1:is) = -1
@ -533,6 +541,9 @@ contains
else if (idxmap%is_valid()) then else if (idxmap%is_valid()) then
!$omp parallel do default(none) schedule(dynamic) &
!$omp shared(is,idxin,idxout,mglob,idxmap,nrm,ncol,nrow,owned_) &
!$omp private(i,ip,lip,tlip,info)
do i = 1, is do i = 1, is
ip = idxin(i) ip = idxin(i)
if ((ip < 1 ).or.(ip>mglob)) then if ((ip < 1 ).or.(ip>mglob)) then
@ -556,14 +567,12 @@ contains
idxout(i) = lip idxout(i) = lip
endif endif
enddo enddo
!$omp end parallel do
else else
write(0,*) 'Hash status: invalid ',idxmap%get_state() write(0,*) 'Hash status: invalid ',idxmap%get_state()
idxout(1:is) = -1 idxout(1:is) = -1
info = -1 info = -1
end if end if
end if end if
end subroutine hash_g2lv2 end subroutine hash_g2lv2
@ -649,7 +658,7 @@ contains
& err_act & err_act
integer(psb_lpk_) :: mglob, ip, nxt, tlip integer(psb_lpk_) :: mglob, ip, nxt, tlip
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np integer(psb_ipk_) :: me, np,ith
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
logical, allocatable :: mask_(:) logical, allocatable :: mask_(:)
!!$ logical :: use_openmp = .true. !!$ logical :: use_openmp = .true.
@ -683,363 +692,243 @@ contains
mglob = idxmap%get_gr() mglob = idxmap%get_gr()
nrow = idxmap%get_lr() nrow = idxmap%get_lr()
!write(0,*) me,name,' before loop ',psb_errstatus_fatal() !write(0,*) me,name,' before loop ',psb_errstatus_fatal()
#ifdef OPENMP #if defined(OPENMP)
!call OMP_init_lock(ins_lck)
if (idxmap%is_bld()) then
isLoopValid = .true. isLoopValid = .true.
ncol = idxmap%get_lc() if (idxmap%is_bld()) then
if (present(mask)) then
mask_ = mask
else
allocate(mask_(size(idx)))
mask_ = .true.
end if
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 shared(lidx,mask,name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz) &
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) & !$omp private(i,ip,lip,tlip,nxt,info) &
! $ OMP shared(name,me,is,idx,ins_lck,mask,mglob,idxmap,ncol,nrow,laddsz,lidx) & !$omp reduction(.AND.:isLoopValid)
! $ OMP private(i,ip,lip,tlip,nxt,info) &
! $ OMP reduction(.AND.:isLoopValid)
do i = 1, is do i = 1, is
info = 0
if (.not. isLoopValid) cycle
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
cycle cycle
endif endif
!call OMP_set_lock(ins_lck)
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
!call OMP_unset_lock(ins_lck)
! At first, we check the index presence in 'idxmap'. Usually
! the index is found. If it is not found, we repeat the checking,
! but inside a critical region.
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) idx(i) = lip
info = psb_success_
! We check again if the index is already in 'idxmap', this else
! time inside a critical region (we assume that the index !$omp critical(hash_g2l_ins)
! is often already existing). tlip = lip
ncol = idxmap%get_lc()
nxt = lidx(i) nxt = lidx(i)
call hash_inner_cnv(ip,lip,idxmap%hashvmask,& if (nxt <= nrow) then
& idxmap%hashv,idxmap%glb_lc,ncol) idx(i) = -1
else
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
& idxmap%glb_lc,ncol)
if (lip > 0) then if (lip > 0) then
idx(i) = lip idx(i) = lip
else if (lip < 0) then else
! Index not found call psb_hash_searchinskey(ip,lip,nxt,idxmap%hash,info)
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) if (info >=0) then
lip = tlip if (nxt == lip) then
call psb_ensure_size(nxt,idxmap%loc_to_glob,info,&
if (info >= 0) then
! 'nxt' is not equal to 'tlip' when the key is already inside
! the hash map. In that case 'tlip' is the value corresponding
! to the existing mapping.
if (nxt == tlip) then
ncol = MAX(ncol,nxt)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz) & pad=-1_psb_lpk_,addsz=laddsz)
if (info /= psb_success_) then if (info /= psb_success_) then
!write(0,*) 'Error spot 1' info=1
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err='psb_ensure_size',i_err=(/info/)) & a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false. isLoopValid = .false.
idx(i) = -1
else
idx(i) = lip
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol)
end if
end if end if
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(max(ncol,nxt))
endif
idx(i) = lip
info = psb_success_
else else
idx(i) = -1 call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='SearchInsKeyVal',i_err=(/info/))
isLoopValid = .false.
end if end if
!call OMP_unset_lock(ins_lck)
end if end if
else endif
idx(i) = lip !$omp end critical(hash_g2l_ins)
end if end if
else else
idx(i) = -1 idx(i) = -1
end if end if
enddo
!$omp end parallel do
end do else if (.not.present(mask)) then
! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then
goto 9999
end if
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(lidx,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
if (.not. isLoopValid) cycle
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
cycle cycle
endif endif
!call OMP_set_lock(ins_lck)
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
!call OMP_unset_lock(ins_lck)
! At first, we check the index presence in 'idxmap'. Usually
! the index is found. If it is not found, we repeat the checking,
! but inside a critical region.
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) idx(i) = lip
! We check again if the index is already in 'idxmap', this info = psb_success_
! time inside a critical region (we assume that the index else
! is often already existing). !$omp critical(hash_g2l_ins)
ncol = idxmap%get_lc() tlip = lip
nxt = lidx(i) nxt = lidx(i)
call hash_inner_cnv(ip,lip,idxmap%hashvmask,& if (nxt <= nrow) then
& idxmap%hashv,idxmap%glb_lc,ncol) idx(i) = -1
else
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
& idxmap%glb_lc,ncol)
if (lip > 0) then if (lip > 0) then
idx(i) = lip idx(i) = lip
else if (lip < 0) then else
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) call psb_hash_searchinskey(ip,lip,nxt,idxmap%hash,info)
lip = tlip if (info >=0) then
if (nxt == lip) then
if (info >= 0) then call psb_ensure_size(nxt,idxmap%loc_to_glob,info,&
! 'nxt' is not equal to 'tlip' when the key is already inside
! the hash map. In that case 'tlip' is the value corresponding
! to the existing mapping.
if (nxt == tlip) then
ncol = MAX(ncol,nxt)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz) & pad=-1_psb_lpk_,addsz=laddsz)
if (info /= psb_success_) then if (info /= psb_success_) then
!write(0,*) 'Error spot 2' info=1
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err='psb_ensure_size',i_err=(/info/)) & a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false. isLoopValid = .false.
idx(i) = -1
else
idx(i) = lip
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol)
end if
end if end if
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(max(ncol,nxt))
endif
idx(i) = lip
info = psb_success_
else else
idx(i) = -1 call psb_errpush(psb_err_from_subroutine_ai_,name,&
end if & a_err='SearchInsKeyVal',i_err=(/info/))
!call OMP_unset_lock(ins_lck) isLoopValid = .false.
end if end if
else
idx(i) = lip
end if end if
endif
end do
! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins) !$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then
goto 9999
end if end if
enddo
!$omp end parallel do
end if end if
else if (.not.present(lidx)) then else if (.not.present(lidx)) then
if(present(mask)) then
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) &
! $ OMP shared(name,me,is,idx,ins_lck,mask,mglob,idxmap,ncol,nrow,laddsz) &
! $ OMP private(i,ip,lip,tlip,nxt,info) &
! $ OMP reduction(.AND.:isLoopValid)
!$omp critical(hash_g2l_ins) if (present(mask)) then
!$omp parallel do default(none) schedule(dynamic) &
!$omp shared(mask,name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz) &
!$omp private(i,ip,lip,tlip,nxt,info) &
!$omp reduction(.AND.:isLoopValid)
do i = 1, is do i = 1, is
info = 0
if (.not. isLoopValid) cycle
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
cycle cycle
endif endif
!call OMP_set_lock(ins_lck)
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
!call OMP_unset_lock(ins_lck)
! At first, we check the index presence in 'idxmap'. Usually
! the index is found. If it is not found, we repeat the checking,
! but inside a critical region.
!write(0,*) me,name,' b hic 1 ',psb_errstatus_fatal()
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)
!write(0,*) me,name,' a hic 1 ',psb_errstatus_fatal() if (lip > 0) then
if (lip < 0) then idx(i) = lip
!call OMP_set_lock(ins_lck) info = psb_success_
! We check again if the index is already in 'idxmap', this else
! time inside a critical region (we assume that the index !$omp critical(hash_g2l_ins)
! is often already existing, so this lock is relatively rare).
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
nxt = ncol + 1 nxt = ncol + 1
!write(0,*) me,name,' b hic 2 ',psb_errstatus_fatal() call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
call hash_inner_cnv(ip,lip,idxmap%hashvmask,& & idxmap%glb_lc,ncol)
& idxmap%hashv,idxmap%glb_lc,ncol)
!write(0,*) me,name,' a hic 2 ',psb_errstatus_fatal()
if (lip > 0) then if (lip > 0) then
idx(i) = lip idx(i) = lip
else if (lip < 0) then else
! Index not found call psb_hash_searchinskey(ip,lip,nxt,idxmap%hash,info)
!write(0,*) me,name,' b hsik ',psb_errstatus_fatal() if (info >=0) then
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) if (nxt == lip) then
if (psb_errstatus_fatal()) write(0,*) me,name,' a hsik ',info,omp_get_thread_num() call psb_ensure_size(nxt,idxmap%loc_to_glob,info,&
!write(0,*) me,name,' a hsik ',psb_errstatus_fatal()
lip = tlip
if (info >= 0) then
!write(0,*) 'Error before spot 3', info
! 'nxt' is not equal to 'tlip' when the key is already inside
! the hash map. In that case 'tlip' is the value corresponding
! to the existing mapping.
if (nxt == tlip) then
ncol = MAX(ncol,nxt)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz) & pad=-1_psb_lpk_,addsz=laddsz)
if (psb_errstatus_fatal()) write(0,*) me,name,' a esz ',info,omp_get_thread_num()
if (info /= psb_success_) then if (info /= psb_success_) then
!write(0,*) 'Error spot 3', info info=1
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err='psb_ensure_size',i_err=(/info/)) & a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false. isLoopValid = .false.
idx(i) = -1
else
idx(i) = lip
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol)
end if
end if end if
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(nxt)
endif
idx(i) = lip
info = psb_success_
else else
idx(i) = -1 call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='SearchInsKeyVal',i_err=(/info/))
isLoopValid = .false.
end if end if
!call OMP_unset_lock(ins_lck)
end if end if
else !$omp end critical(hash_g2l_ins)
idx(i) = lip
end if end if
else else
idx(i) = -1 idx(i) = -1
end if end if
enddo
!$omp end parallel do
end do else if (.not.present(mask)) then
! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then !$omp parallel do default(none) schedule(dynamic) &
goto 9999 !$omp shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz) &
end if !$omp private(i,ip,lip,tlip,nxt,info) &
else !$omp reduction(.AND.:isLoopValid)
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) &
! $ OMP shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz) &
! $ OMP private(i,ip,lip,tlip,nxt,info) &
! $ OMP reduction(.AND.:isLoopValid)
!$omp critical(hash_g2l_ins)
do i = 1, is do i = 1, is
info = 0
if (.not. isLoopValid) cycle
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
cycle cycle
endif endif
!call OMP_set_lock(ins_lck)
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
!call OMP_unset_lock(ins_lck)
! At first, we check the index presence in 'idxmap'. Usually
! the index is found. If it is not found, we repeat the checking,
! but inside a critical region.
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) idx(i) = lip
! We check again if the index is already in 'idxmap', this info = psb_success_
! time inside a critical region (we assume that the index else
! is often already existing). !$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,& call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
& idxmap%hashv,idxmap%glb_lc,ncol) & idxmap%glb_lc,ncol)
if (lip > 0) then if (lip > 0) then
idx(i) = lip idx(i) = lip
else if (lip < 0) then else
! Index not found call psb_hash_searchinskey(ip,lip,nxt,idxmap%hash,info)
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) if (info >=0) then
lip = tlip if (nxt == lip) then
call psb_ensure_size(nxt,idxmap%loc_to_glob,info,&
if (info >= 0) then
! 'nxt' is not equal to 'tlip' when the key is already inside
! the hash map. In that case 'tlip' is the value corresponding
! to the existing mapping.
if (nxt == tlip) then
ncol = MAX(ncol,nxt)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz) & pad=-1_psb_lpk_,addsz=laddsz)
if (info /= psb_success_) then if (info /= psb_success_) then
!write(0,*) 'Error spot 4' info=1
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err='psb_ensure_size',i_err=(/info/)) & a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false. isLoopValid = .false.
idx(i) = -1
else
idx(i) = lip
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol)
end if
end if end if
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(nxt)
endif
idx(i) = lip
info = psb_success_
else else
idx(i) = -1 call psb_errpush(psb_err_from_subroutine_ai_,name,&
end if & a_err='SearchInsKeyVal',i_err=(/info/))
!call OMP_unset_lock(ins_lck) isLoopValid = .false.
end if end if
else
idx(i) = lip
end if end if
end do
! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins) !$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then
goto 9999
end if end if
enddo
!$omp end parallel do
end if end if
end if end if
else else
@ -1047,7 +936,7 @@ contains
idx = -1 idx = -1
info = -1 info = -1
end if end if
!call OMP_destroy_lock(ins_lck) if (.not. isLoopValid) goto 9999
#else #else
!!$ else if (.not.use_openmp) then !!$ else if (.not.use_openmp) then
isLoopValid = .true. isLoopValid = .true.
@ -1066,13 +955,13 @@ 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
tlip = lip
nxt = lidx(i) nxt = lidx(i)
if (nxt <= nrow) then if (nxt <= nrow) then
idx(i) = -1 idx(i) = -1
cycle cycle
endif endif
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
if (info >=0) then if (info >=0) then
if (nxt == tlip) then if (nxt == tlip) then
ncol = max(ncol,nxt) ncol = max(ncol,nxt)
@ -1747,6 +1636,9 @@ contains
! for a width of psb_hash_bits ! for a width of psb_hash_bits
! !
if (present(mask)) then if (present(mask)) then
!$omp parallel do default(none) schedule(dynamic) &
!$omp shared(n,hashv,hashmask,x,glb_lc,nrm,mask) &
!$omp private(i,key,idx,ih,nh,tmp,lb,ub,lm)
do i=1, n do i=1, n
if (mask(i)) then if (mask(i)) then
key = x(i) key = x(i)
@ -1784,7 +1676,11 @@ contains
end if end if
end if end if
end do end do
!$omp end parallel do
else else
!$omp parallel do default(none) schedule(dynamic) &
!$omp shared(n,hashv,hashmask,x,glb_lc,nrm) &
!$omp private(i,key,idx,ih,nh,tmp,lb,ub,lm)
do i=1, n do i=1, n
key = x(i) key = x(i)
ih = iand(key,hashmask) ih = iand(key,hashmask)
@ -1820,6 +1716,7 @@ contains
x(i) = tmp x(i) = tmp
end if end if
end do end do
!$omp end parallel do
end if end if
end subroutine hash_inner_cnv1 end subroutine hash_inner_cnv1
@ -1842,6 +1739,9 @@ contains
! for a width of psb_hash_bits ! for a width of psb_hash_bits
! !
if (present(mask)) then if (present(mask)) then
!$omp parallel do default(none) schedule(dynamic) &
!$omp shared(n,hashv,hashmask,x,y,glb_lc,nrm,mask,psb_err_unit) &
!$omp private(i,key,idx,ih,nh,tmp,lb,ub,lm)
do i=1, n do i=1, n
if (mask(i)) then if (mask(i)) then
key = x(i) key = x(i)
@ -1882,9 +1782,12 @@ contains
end if end if
end if end if
end do end do
!$omp end parallel do
else else
!$omp parallel do default(none) schedule(dynamic) &
!$omp shared(n,hashv,hashmask,x,y,glb_lc,nrm,psb_err_unit) &
!$omp private(i,key,idx,ih,nh,tmp,lb,ub,lm)
do i=1, n do i=1, n
key = x(i) key = x(i)
ih = iand(key,hashmask) ih = iand(key,hashmask)
@ -1923,6 +1826,7 @@ contains
y(i) = tmp y(i) = tmp
end if end if
end do end do
!$omp end parallel do
end if end if
end subroutine hash_inner_cnv2 end subroutine hash_inner_cnv2

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

@ -383,12 +383,12 @@ contains
integer(psb_lpk_), intent(out) :: val integer(psb_lpk_), intent(out) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: hsize,hmask, hk, hd integer(psb_ipk_) :: hsize,hmask, hk, hd, i
logical :: redo
info = HashOK info = HashOK
hsize = hash%hsize hsize = hash%hsize
hmask = hash%hmask hmask = hash%hmask
val = -1
hk = iand(psb_hashval(key),hmask) hk = iand(psb_hashval(key),hmask)
if (hk == 0) then if (hk == 0) then
hd = 1 hd = 1
@ -400,21 +400,21 @@ contains
info = HashOutOfMemory info = HashOutOfMemory
return return
end if end if
val = -1
!$omp atomic
hash%nsrch = hash%nsrch + 1 hash%nsrch = hash%nsrch + 1
!$omp end atomic
do do
!$omp atomic
hash%nacc = hash%nacc + 1 hash%nacc = hash%nacc + 1
!$omp end atomic
if (hash%table(hk,1) == key) then if (hash%table(hk,1) == key) then
val = hash%table(hk,2) val = hash%table(hk,2)
info = HashDuplicate info = HashDuplicate
!write(0,*) 'In searchinskey 1 : ', info, HashDuplicate
return return
end if end if
redo = .false.
!$omp critical(hashsearchins) !$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
! !
@ -426,30 +426,31 @@ contains
call psb_hash_realloc(hash,info) call psb_hash_realloc(hash,info)
if (info /= HashOk) then if (info /= HashOk) then
info = HashOutOfMemory info = HashOutOfMemory
!return
else else
call psb_hash_searchinskey(key,val,nextval,hash,info) redo = .true.
!return
end if end if
else else
hash%nk = hash%nk + 1 hash%nk = hash%nk + 1
hash%table(hk,1) = key hash%table(hk,1) = key
hash%table(hk,2) = nextval hash%table(hk,2) = nextval
val = nextval val = nextval
!return info = HashOk
end if
end if end if
else if (hash%table(hk,1) == key) then
val = hash%table(hk,2)
info = HashDuplicate
else
info = HashNotFound
end if end if
!$omp end critical(hashsearchins) !$omp end critical(hashsearchins)
if (info /= HashOk) then if (redo) then
write(0,*) 'In searchinskey 2: ', info call psb_hash_searchinskey(key,val,nextval,hash,info)
return return
end if end if
if (val > 0) return if (val > 0) exit
hk = hk - hd hk = hk - hd
if (hk < 0) hk = hk + hsize if (hk < 0) hk = hk + hsize
end do end do
!write(0,*) 'In searchinskey 3: ', info
end subroutine psb_hash_lsearchinskey end subroutine psb_hash_lsearchinskey
recursive subroutine psb_hash_isearchinskey(key,val,nextval,hash,info) recursive subroutine psb_hash_isearchinskey(key,val,nextval,hash,info)
@ -459,6 +460,7 @@ contains
integer(psb_ipk_) :: hsize,hmask, hk, hd integer(psb_ipk_) :: hsize,hmask, hk, hd
logical :: redo logical :: redo
info = HashOK info = HashOK
hsize = hash%hsize hsize = hash%hsize
hmask = hash%hmask hmask = hash%hmask
@ -475,16 +477,21 @@ contains
return return
end if end if
val = -1 val = -1
val = -1
!$omp atomic
hash%nsrch = hash%nsrch + 1 hash%nsrch = hash%nsrch + 1
!$omp end atomic
do do
!$omp atomic
hash%nacc = hash%nacc + 1 hash%nacc = hash%nacc + 1
!$omp end atomic
if (hash%table(hk,1) == key) then if (hash%table(hk,1) == key) then
val = hash%table(hk,2) val = hash%table(hk,2)
info = HashDuplicate info = HashDuplicate
return return
end if end if
redo = .false. redo = .false.
!$OMP CRITICAL !$omp critical(hashsearchins)
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
! !
@ -496,24 +503,28 @@ contains
call psb_hash_realloc(hash,info) call psb_hash_realloc(hash,info)
if (info /= HashOk) then if (info /= HashOk) then
info = HashOutOfMemory info = HashOutOfMemory
!return
else else
redo = .true. redo = .true.
!!$ call psb_hash_searchinskey(key,val,nextval,hash,info)
!!$ return
end if end if
else else
hash%nk = hash%nk + 1 hash%nk = hash%nk + 1
hash%table(hk,1) = key hash%table(hk,1) = key
hash%table(hk,2) = nextval hash%table(hk,2) = nextval
val = nextval val = nextval
!return info = HashOk
end if end if
else if (hash%table(hk,1) == key) then
val = hash%table(hk,2)
info = HashDuplicate
else
info = HashNotFound
end if
!$omp end critical(hashsearchins)
if (redo) then
call psb_hash_searchinskey(key,val,nextval,hash,info)
return
end if end if
!$OMP END CRITICAL if (val > 0) exit
if (redo) call psb_hash_searchinskey(key,val,nextval,hash,info)
if (info /= HashOk) 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
@ -551,7 +562,7 @@ contains
end if end if
if (hash%table(hk,1) == HashFreeEntry) then if (hash%table(hk,1) == HashFreeEntry) then
val = HashFreeEntry val = HashFreeEntry
! !$ info = HashNotFound info = HashNotFound
return return
end if end if
hk = hk - hd hk = hk - hd
@ -591,7 +602,7 @@ contains
end if end if
if (hash%table(hk,1) == HashFreeEntry) then if (hash%table(hk,1) == HashFreeEntry) then
val = HashFreeEntry val = HashFreeEntry
! !$ info = HashNotFound info = HashNotFound
return return
end if end if
hk = hk - hd hk = hk - hd

Write Preview
Loading…
Cancel
Save