fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 04:42:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Additional performance fixes in HASH_MAP

Browse Source
This commit is contained in:
sfilippone
2025-03-28 12:40:19 +01:00
parent b2cdfc8a1b
commit 39f865f094
1 changed files with 159 additions and 70 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/desc/psb_hash_map_mod.F90
+159 -70
View File
@@ -1000,86 +1000,130 @@ contains
if (idxmap%is_bld()) then
if (present(lidx)) then
if (present(mask)) then
!!$ if (present(mask)) then
!!$ do i = 1, is
!!$ ncol = idxmap%get_lc()
!!$ if (mask(i)) then
!!$ ip = idx(i)
!!$ if ((ip < 1 ).or.(ip>mglob) ) then
!!$ idx(i) = -1
!!$ cycle
!!$ endif
!!$ call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
!!$ & idxmap%hashv,idxmap%glb_lc,ncol)
!!$ if (lip < 0) then
!!$ nxt = lidx(i)
!!$ if (nxt <= nrow) then
!!$ idx(i) = -1
!!$ cycle
!!$ endif
!!$ call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
!!$ lip = tlip
!!$ if (info >=0) then
!!$ if (nxt == tlip) then
!!$ ncol = max(ncol,nxt)
!!$ call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
!!$ & pad=-1_psb_lpk_)
!!$ if (info /= psb_success_) then
!!$ !write(0,*) 'Error spot'
!!$ write(0,*)'Problem 5:',info,lip,size(idxmap%loc_to_glob)
!!$ info = lip
!!$ call psb_errpush(psb_err_from_subroutine_ai_,name,&
!!$ &a_err='psb_ensure_size',i_err=(/info/))
!!$ isLoopValid = .false.
!!$ end if
!!$ idxmap%loc_to_glob(nxt) = ip
!!$ call idxmap%set_lc(ncol)
!!$ endif
!!$ info = psb_success_
!!$ else
!!$ call psb_errpush(psb_err_from_subroutine_ai_,name,&
!!$ & a_err='SearchInsKeyVal',i_err=(/info/))
!!$ isLoopValid = .false.
!!$ end if
!!$ end if
!!$ idx(i) = lip
!!$ info = psb_success_
!!$ end if
!!$ enddo
!!$
!!$ 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
!!$ call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
!!$ & idxmap%glb_lc,ncol)
!!$ if (lip < 0) then
!!$ nxt = lidx(i)
!!$ if (nxt <= nrow) then
!!$ idx(i) = -1
!!$ cycle
!!$ endif
!!$ call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
!!$ lip = tlip
!!$
!!$ if (info >=0) then
!!$ if (nxt == lip) then
!!$ ncol = max(nxt,ncol)
!!$ call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
!!$ & pad=-1_psb_lpk_)
!!$ if (info /= psb_success_) then
!!$ !write(0,*) 'Error spot'
!!$ write(0,*)'Problem 6:',info,lip,size(idxmap%loc_to_glob)
!!$ info = lip
!!$ call psb_errpush(psb_err_from_subroutine_ai_,name,&
!!$ &a_err='psb_ensure_size',i_err=(/info/))
!!$ isLoopValid = .false.
!!$ end if
!!$ idxmap%loc_to_glob(nxt) = ip
!!$ call idxmap%set_lc(ncol)
!!$ endif
!!$ info = psb_success_
!!$ else
!!$ call psb_errpush(psb_err_from_subroutine_ai_,name,&
!!$ & a_err='SearchInsKeyVal',i_err=(/info/))
!!$ isLoopValid = .false.
!!$ end if
!!$ end if
!!$ idx(i) = lip
!!$ info = psb_success_
!!$ enddo
!!$
!!$ end if
if (present(mask)) then
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
ncol = idxmap%get_lc()
if (mask(i)) then
ip = idx(i)
if ((ip < 1 ).or.(ip>mglob) ) then
idx(i) = -1
cycle
endif
call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) then
nxt = lidx(i)
if (nxt <= nrow) then
idx(i) = -1
cycle
endif
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
if (info >=0) then
if (nxt == tlip) then
ncol = max(ncol,nxt)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_)
if (info /= psb_success_) then
!write(0,*) 'Error spot'
write(0,*)'Problem 5:',info,lip,size(idxmap%loc_to_glob)
info = lip
call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false.
end if
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol)
endif
info = psb_success_
else
call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='SearchInsKeyVal',i_err=(/info/))
isLoopValid = .false.
end if
end if
idx(i) = lip
info = psb_success_
else
idx(i) = -1
end if
enddo
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
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
& idxmap%glb_lc,ncol)
if (lip < 0) then
nxt = lidx(i)
if (mask(i).and.(idx(i)<0)) then
ncol = idxmap%get_lc()
nxt = lidx(i)
if (nxt <= nrow) then
idx(i) = -1
cycle
endif
ip = idx(i)
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
if (info >=0) then
if (nxt == lip) then
ncol = max(nxt,ncol)
ncol = max(ncol,nxt)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_)
if (info /= psb_success_) then
!write(0,*) 'Error spot'
write(0,*)'Problem 6:',info,lip,size(idxmap%loc_to_glob)
write(0,*)'Problem 7:',info,lip,size(idxmap%loc_to_glob)
info = lip
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.
end if
idxmap%loc_to_glob(nxt) = ip
@@ -1091,9 +1135,54 @@ contains
& a_err='SearchInsKeyVal',i_err=(/info/))
isLoopValid = .false.
end if
idx(i) = lip
info = psb_success_
end if
enddo
call psb_toc(ins_phase2)
else if (.not.present(mask)) then
ncol = idxmap%get_lc()
call hash_inner_cnv(is,idx,idxmap%hashvmask,idxmap%hashv,&
& idxmap%glb_lc,nrm=ncol)
do i = 1, is
if (idx(i)<0) then
ncol = idxmap%get_lc()
nxt = lidx(i)
if (nxt <= nrow) then
idx(i) = -1
cycle
endif
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
if (info >=0) then
if (nxt == lip) then
ncol = max(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_
end if
idx(i) = lip
info = psb_success_
enddo
end if
@@ -1114,7 +1203,7 @@ contains
ip = idx(i)
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
if (info >=0) then
if (nxt == lip) then
ncol = nxt
@@ -1154,7 +1243,7 @@ contains
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
end if
if (info >=0) then
if (nxt == lip) then
ncol = nxt
@@ -1167,7 +1256,7 @@ contains
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)