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

Improved inner_cnv, halfway g2lv1_ins

Browse Source
fix-hash
sfilippone 1 year ago
parent e811a8efeb
commit b2cdfc8a1b
1 changed files with 180 additions and 186 deletions
Show Stats Download Patch File Download Diff File

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

@ -41,7 +41,7 @@
! local counterpart, so that the local storage will be proportional to ! local counterpart, so that the local storage will be proportional to
! N_COL. ! N_COL.
! The idea is that glb_lc(:,1) will hold sorted global indices, and ! The idea is that glb_lc(:,1) will hold sorted global indices, and
! glb_lc(:,2) the corresponding local indices, so that we may do a binary search. ! glb_lc(:,2) the corresponding local indices, so that we may do a search.
! To cut down the search time we partition glb_lc into a set of lists ! To cut down the search time we partition glb_lc into a set of lists
! addressed by hashv(:) based on the value of the lowest ! addressed by hashv(:) based on the value of the lowest
! PSB_HASH_BITS bits of the global index. ! PSB_HASH_BITS bits of the global index.
@ -695,7 +695,7 @@ contains
integer(kind = OMP_lock_kind) :: ins_lck integer(kind = OMP_lock_kind) :: ins_lck
#endif #endif
logical, volatile :: isLoopValid logical, volatile :: isLoopValid
logical, parameter :: do_timings=.true. logical, parameter :: do_timings=.false.
integer(psb_ipk_), save :: ins_phase1=-1, ins_phase2=-1, ins_phase3=-1, ins_phase4=-1 integer(psb_ipk_), save :: ins_phase1=-1, ins_phase2=-1, ins_phase3=-1, ins_phase4=-1
integer(psb_ipk_), save :: ins_phase11=-1, ins_phase12=-1 integer(psb_ipk_), save :: ins_phase11=-1, ins_phase12=-1
@ -1101,22 +1101,19 @@ contains
else if (.not.present(lidx)) then else if (.not.present(lidx)) then
if (present(mask)) then if (present(mask)) then
#if 0 call psb_tic(ins_phase1)
ncol = idxmap%get_lc()
call hash_inner_cnv(is,idx,idxmap%hashvmask,idxmap%hashv,&
& idxmap%glb_lc,nrm=ncol, mask=mask)
call psb_toc(ins_phase1)
call psb_tic(ins_phase2)
do i = 1, is do i = 1, is
if (mask(i)) then if (mask(i).and.(idx(i)<0)) then
ip = idx(i)
if ((ip < 1 ).or.(ip>mglob)) then
idx(i) = -1
cycle
endif
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
nxt = ncol + 1 nxt = ncol + 1
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,& ip = idx(i)
& idxmap%glb_lc,ncol) call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
if (lip < 0) then lip = tlip
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
end if
if (info >=0) then if (info >=0) then
if (nxt == lip) then if (nxt == lip) then
@ -1141,24 +1138,22 @@ contains
end if end if
idx(i) = lip idx(i) = lip
info = psb_success_ info = psb_success_
else
idx(i) = -1
end if end if
enddo enddo
#else call psb_toc(ins_phase2)
call psb_tic(ins_phase1) else if (.not.present(mask)) then
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
call hash_inner_cnv(is,idx,idxmap%hashvmask,idxmap%hashv,& call hash_inner_cnv(is,idx,idxmap%hashvmask,idxmap%hashv,&
& idxmap%glb_lc,nrm=ncol, mask=mask) & idxmap%glb_lc,nrm=ncol)
call psb_toc(ins_phase1)
call psb_tic(ins_phase2)
do i = 1, is do i = 1, is
if (mask(i).and.(idx(i)<0)) then if (idx(i)<0) then
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
nxt = ncol + 1 nxt = ncol + 1
ip = idx(i) if (lip < 0) then
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip lip = tlip
end if
if (info >=0) then if (info >=0) then
if (nxt == lip) then if (nxt == lip) then
@ -1166,71 +1161,28 @@ contains
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_) & pad=-1_psb_lpk_)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*)'Problem 7:',info,lip,size(idxmap%loc_to_glob) write(0,*)'Problem 8:',info,lip,size(idxmap%loc_to_glob)
info = lip info = lip
ch_err='psb_ensure_size'
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=ch_err,i_err=(/info,izero,izero,izero,izero/))
isLoopValid = .false. isLoopValid = .false.
end if end if
idxmap%loc_to_glob(nxt) = ip idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol) call idxmap%set_lc(ncol)
endif endif
info = psb_success_ info = psb_success_
else else
ch_err='SearchInsKeyVal'
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='SearchInsKeyVal',i_err=(/info/)) & a_err=ch_err,i_err=(/info,izero,izero,izero,izero/))
isLoopValid = .false. isLoopValid = .false.
end if end if
idx(i) = lip idx(i) = lip
info = psb_success_ info = psb_success_
end if end if
enddo enddo
call psb_toc(ins_phase2)
#endif
else if (.not.present(mask)) then
do i = 1, is
ncol = idxmap%get_lc()
ip = idx(i)
if ((ip < 1 ).or.(ip>mglob)) then
idx(i) = -1
cycle
endif
nxt = ncol + 1
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
& idxmap%glb_lc,ncol)
if (lip < 0) then
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
end if
if (info >=0) then
if (nxt == lip) then
ncol = nxt
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_)
if (info /= psb_success_) then
write(0,*)'Problem 8:',info,lip,size(idxmap%loc_to_glob)
info = lip
ch_err='psb_ensure_size'
call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err=ch_err,i_err=(/info,izero,izero,izero,izero/))
isLoopValid = .false.
end if
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol)
endif
info = psb_success_
else
ch_err='SearchInsKeyVal'
call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err=ch_err,i_err=(/info,izero,izero,izero,izero/))
isLoopValid = .false.
end if
idx(i) = lip
info = psb_success_
enddo
end if end if
end if end if
@ -1598,7 +1550,7 @@ contains
! !
! When a large descriptor is assembled the indices ! When a large descriptor is assembled the indices
! are kept in a (hashed) list of ordered lists. ! are kept in a (hashed) list of ordered lists.
! Thus we first hash the index, then we do a binary search on the ! Thus we first hash the index, then we do a search on the
! ordered sublist. The hashing is based on the low-order bits ! ordered sublist. The hashing is based on the low-order bits
! for a width of psb_hash_bits ! for a width of psb_hash_bits
! !
@ -1607,24 +1559,31 @@ contains
ih = iand(key,hashmask) ih = iand(key,hashmask)
idx = hashv(ih) idx = hashv(ih)
nh = hashv(ih+1) - hashv(ih) nh = hashv(ih+1) - hashv(ih)
tmp = -1
if (nh > 0) then if (nh > 0) then
tmp = -1 if (nh <= 8) then
lb = idx do lm=idx,idx+nh-1
ub = idx+nh-1 if (key == glb_lc(lm,1)) then
do tmp = lm
if (lb>ub) exit exit
lm = (lb+ub)/2 end if
if (key == glb_lc(lm,1)) then end do
tmp = lm else
exit lb = idx
else if (key<glb_lc(lm,1)) then ub = idx+nh-1
ub = lm - 1 do
else if (lb>ub) exit
lb = lm + 1 lm = (lb+ub)/2
end if if (key == glb_lc(lm,1)) then
end do tmp = lm
else exit
tmp = -1 else if (key<glb_lc(lm,1)) then
ub = lm - 1
else
lb = lm + 1
end if
end do
end if
end if end if
if (tmp > 0) then if (tmp > 0) then
x = glb_lc(tmp,2) x = glb_lc(tmp,2)
@ -1647,7 +1606,7 @@ contains
! !
! When a large descriptor is assembled the indices ! When a large descriptor is assembled the indices
! are kept in a (hashed) list of ordered lists. ! are kept in a (hashed) list of ordered lists.
! Thus we first hash the index, then we do a binary search on the ! Thus we first hash the index, then we do a search on the
! ordered sublist. The hashing is based on the low-order bits ! ordered sublist. The hashing is based on the low-order bits
! for a width of psb_hash_bits ! for a width of psb_hash_bits
! !
@ -1656,24 +1615,31 @@ contains
ih = iand(key,hashmask) ih = iand(key,hashmask)
idx = hashv(ih) idx = hashv(ih)
nh = hashv(ih+1) - hashv(ih) nh = hashv(ih+1) - hashv(ih)
tmp = -1
if (nh > 0) then if (nh > 0) then
tmp = -1 if (nh <= 8) then
lb = idx do lm=idx,idx+nh-1
ub = idx+nh-1 if (key == glb_lc(lm,1)) then
do tmp = lm
if (lb>ub) exit exit
lm = (lb+ub)/2 end if
if (key == glb_lc(lm,1)) then end do
tmp = lm else
exit lb = idx
else if (key<glb_lc(lm,1)) then ub = idx+nh-1
ub = lm - 1 do
else if (lb>ub) exit
lb = lm + 1 lm = (lb+ub)/2
end if if (key == glb_lc(lm,1)) then
end do tmp = lm
else exit
tmp = -1 else if (key<glb_lc(lm,1)) then
ub = lm - 1
else
lb = lm + 1
end if
end do
end if
end if end if
if (tmp > 0) then if (tmp > 0) then
y = glb_lc(tmp,2) y = glb_lc(tmp,2)
@ -1689,17 +1655,17 @@ contains
subroutine hash_inner_cnv1(n,x,hashmask,hashv,glb_lc,mask,nrm) subroutine hash_inner_cnv1(n,x,hashmask,hashv,glb_lc,mask,nrm)
implicit none implicit none
integer(psb_ipk_), intent(in) :: n, hashv(0:) integer(psb_ipk_), intent(in) :: n, hashv(0:)
integer(psb_lpk_), intent(inout) :: x(:)
integer(psb_lpk_), intent(in) :: glb_lc(:,:),hashmask integer(psb_lpk_), intent(in) :: glb_lc(:,:),hashmask
logical, intent(in), optional :: mask(:) logical, intent(in), optional :: mask(:)
integer(psb_ipk_), intent(in), optional :: nrm integer(psb_ipk_), intent(in), optional :: nrm
integer(psb_lpk_), intent(inout) :: x(:)
integer(psb_ipk_) :: i, nh,tmp,lb,ub,lm integer(psb_ipk_) :: i, nh,tmp,lb,ub,lm
integer(psb_lpk_) :: ih, key, idx integer(psb_lpk_) :: ih, key, idx
! !
! When a large descriptor is assembled the indices ! When a large descriptor is assembled the indices
! are kept in a (hashed) list of ordered lists. ! are kept in a (hashed) list of ordered lists.
! Thus we first hash the index, then we do a binary search on the ! Thus we first hash the index, then we do a search on the
! ordered sublist. The hashing is based on the low-order bits ! ordered sublist. The hashing is based on the low-order bits
! for a width of psb_hash_bits ! for a width of psb_hash_bits
! !
@ -1713,24 +1679,31 @@ contains
ih = iand(key,hashmask) ih = iand(key,hashmask)
idx = hashv(ih) idx = hashv(ih)
nh = hashv(ih+1) - hashv(ih) nh = hashv(ih+1) - hashv(ih)
tmp = -1
if (nh > 0) then if (nh > 0) then
tmp = -1 if (nh <= 8) then
lb = idx do lm=idx,idx+nh-1
ub = idx+nh-1 if (key == glb_lc(lm,1)) then
do tmp = lm
if (lb>ub) exit exit
lm = (lb+ub)/2 end if
if (key == glb_lc(lm,1)) then end do
tmp = lm else
exit lb = idx
else if (key<glb_lc(lm,1)) then ub = idx+nh-1
ub = lm - 1 do
else if (lb>ub) exit
lb = lm + 1 lm = (lb+ub)/2
end if if (key == glb_lc(lm,1)) then
end do tmp = lm
else exit
tmp = -1 else if (key<glb_lc(lm,1)) then
ub = lm - 1
else
lb = lm + 1
end if
end do
end if
end if end if
if (tmp > 0) then if (tmp > 0) then
x(i) = glb_lc(tmp,2) x(i) = glb_lc(tmp,2)
@ -1754,24 +1727,31 @@ contains
ih = iand(key,hashmask) ih = iand(key,hashmask)
idx = hashv(ih) idx = hashv(ih)
nh = hashv(ih+1) - hashv(ih) nh = hashv(ih+1) - hashv(ih)
tmp = -1
if (nh > 0) then if (nh > 0) then
tmp = -1 if (nh <= 8) then
lb = idx do lm=idx,idx+nh-1
ub = idx+nh-1 if (key == glb_lc(lm,1)) then
do tmp = lm
if (lb>ub) exit exit
lm = (lb+ub)/2 end if
if (key == glb_lc(lm,1)) then end do
tmp = lm else
exit lb = idx
else if (key<glb_lc(lm,1)) then ub = idx+nh-1
ub = lm - 1 do
else if (lb>ub) exit
lb = lm + 1 lm = (lb+ub)/2
end if if (key == glb_lc(lm,1)) then
end do tmp = lm
else exit
tmp = -1 else if (key<glb_lc(lm,1)) then
ub = lm - 1
else
lb = lm + 1
end if
end do
end if
end if end if
if (tmp > 0) then if (tmp > 0) then
x(i) = glb_lc(tmp,2) x(i) = glb_lc(tmp,2)
@ -1802,7 +1782,7 @@ contains
! !
! When a large descriptor is assembled the indices ! When a large descriptor is assembled the indices
! are kept in a (hashed) list of ordered lists. ! are kept in a (hashed) list of ordered lists.
! Thus we first hash the index, then we do a binary search on the ! Thus we first hash the index, then we do a search on the
! ordered sublist. The hashing is based on the low-order bits ! ordered sublist. The hashing is based on the low-order bits
! for a width of psb_hash_bits ! for a width of psb_hash_bits
! !
@ -1819,24 +1799,31 @@ contains
end if end if
idx = hashv(ih) idx = hashv(ih)
nh = hashv(ih+1) - hashv(ih) nh = hashv(ih+1) - hashv(ih)
tmp = -1
if (nh > 0) then if (nh > 0) then
tmp = -1 if (nh <= 8) then
lb = idx do lm=idx,idx+nh-1
ub = idx+nh-1 if (key == glb_lc(lm,1)) then
do tmp = lm
if (lb>ub) exit exit
lm = (lb+ub)/2 end if
if (key == glb_lc(lm,1)) then end do
tmp = lm else
exit lb = idx
else if (key<glb_lc(lm,1)) then ub = idx+nh-1
ub = lm - 1 do
else if (lb>ub) exit
lb = lm + 1 lm = (lb+ub)/2
end if if (key == glb_lc(lm,1)) then
end do tmp = lm
else exit
tmp = -1 else if (key<glb_lc(lm,1)) then
ub = lm - 1
else
lb = lm + 1
end if
end do
end if
end if end if
if (tmp > 0) then if (tmp > 0) then
y(i) = glb_lc(tmp,2) y(i) = glb_lc(tmp,2)
@ -1864,24 +1851,31 @@ contains
end if end if
idx = hashv(ih) idx = hashv(ih)
nh = hashv(ih+1) - hashv(ih) nh = hashv(ih+1) - hashv(ih)
tmp = -1
if (nh > 0) then if (nh > 0) then
tmp = -1 if (nh <= 8) then
lb = idx do lm=idx,idx+nh-1
ub = idx+nh-1 if (key == glb_lc(lm,1)) then
do tmp = lm
if (lb>ub) exit exit
lm = (lb+ub)/2 end if
if (key == glb_lc(lm,1)) then end do
tmp = lm else
exit lb = idx
else if (key<glb_lc(lm,1)) then ub = idx+nh-1
ub = lm - 1 do
else if (lb>ub) exit
lb = lm + 1 lm = (lb+ub)/2
end if if (key == glb_lc(lm,1)) then
end do tmp = lm
else exit
tmp = -1 else if (key<glb_lc(lm,1)) then
ub = lm - 1
else
lb = lm + 1
end if
end do
end if
end if end if
if (tmp > 0) then if (tmp > 0) then
y(i) = glb_lc(tmp,2) y(i) = glb_lc(tmp,2)

Write Preview
Loading…
Cancel
Save