From 39f865f0947fe7930099f963697a83c53cea4e89 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Fri, 28 Mar 2025 12:40:19 +0100 Subject: [PATCH] Additional performance fixes in HASH_MAP --- base/modules/desc/psb_hash_map_mod.F90 | 209 ++++++++++++++++++------- 1 file changed, 149 insertions(+), 60 deletions(-) diff --git a/base/modules/desc/psb_hash_map_mod.F90 b/base/modules/desc/psb_hash_map_mod.F90 index 8f41333a..e99c5421 100644 --- a/base/modules/desc/psb_hash_map_mod.F90 +++ b/base/modules/desc/psb_hash_map_mod.F90 @@ -1000,100 +1000,189 @@ 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 + if (mask(i).and.(idx(i)<0)) then + ncol = idxmap%get_lc() + nxt = lidx(i) + if (nxt <= nrow) 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 + 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(ncol,nxt) + call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& + & pad=-1_psb_lpk_) + if (info /= psb_success_) then + 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/)) + isLoopValid = .false. + end if + idxmap%loc_to_glob(nxt) = ip + call idxmap%set_lc(ncol) 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 + info = psb_success_ + else + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='SearchInsKeyVal',i_err=(/info/)) + isLoopValid = .false. end if idx(i) = lip info = psb_success_ - else - idx(i) = -1 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 - 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 (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(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 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='psb_ensure_size',i_err=(/info/)) + &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='SearchInsKeyVal',i_err=(/info/)) + & 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)