From bb4e80f647b1ad51f391313c193e6a5952faacfd Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 10 Feb 2023 17:57:56 +0100 Subject: [PATCH] Bit of cleanup in psb_hash_map_mod --- base/modules/desc/psb_hash_map_mod.F90 | 523 ++++++++----------------- 1 file changed, 172 insertions(+), 351 deletions(-) diff --git a/base/modules/desc/psb_hash_map_mod.F90 b/base/modules/desc/psb_hash_map_mod.F90 index efb3ed10..e5ab6385 100644 --- a/base/modules/desc/psb_hash_map_mod.F90 +++ b/base/modules/desc/psb_hash_map_mod.F90 @@ -690,164 +690,20 @@ contains nrow = idxmap%get_lr() if (idxmap%is_bld()) then - + call OMP_init_lock(ins_lck) isLoopValid = .true. ncol = idxmap%get_lc() - + if (present(lidx)) then if (present(mask)) then - if (use_openmp) then - !$OMP PARALLEL DO default(none) schedule(STATIC) & - !$OMP shared(name,is,mask,lidx,idx,mglob,idxmap,ncol,nrow,ins_lck,laddsz) & - !$OMP private(i,ip,lip,tlip,nxt,info) & - !$OMP reduction(.AND.:isLoopValid) - do i = 1, is - - if (mask(i)) then - ip = idx(i) - - if ((ip < 1 ).or.(ip>mglob)) then - idx(i) = -1 - cycle - endif - - ! 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,& - & idxmap%hashv,idxmap%glb_lc,ncol) - - if (lip < 0) then - tlip = lip - nxt = lidx(i) - - if (nxt <= nrow) then - idx(i) = -1 - cycle - endif - - ! We check again if the index is already in 'idxmap', this - ! time inside a critical region (we assume that the index - ! is often already existing). - call OMP_set_lock(ins_lck) - call hash_inner_cnv(ip,lip,idxmap%hashvmask,& - & idxmap%hashv,idxmap%glb_lc,ncol) - ! Index not found - if (lip < 0) then - ! Locking system to handle concurrent hashmap read/write. - call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,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 OMP_unset_lock(ins_lck) - - call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& - & pad=-1_psb_lpk_,addsz=laddsz) - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_ai_,name,& - &a_err='psb_ensure_size',i_err=(/info/)) - - isLoopValid = .false. - cycle - end if - - idxmap%loc_to_glob(nxt) = ip - else - call OMP_unset_lock(ins_lck) - end if - - info = psb_success_ - - else - call OMP_unset_lock(ins_lck) - - call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='SearchInsKeyVal',i_err=(/info/)) - - isLoopValid = .false. - cycle - end if - else - call OMP_unset_lock(ins_lck) - end if - end if - - idx(i) = lip - info = psb_success_ - else - idx(i) = -1 - end if - end do - !$OMP END PARALLEL DO - - call idxmap%set_lc(ncol) - - if (.not. isLoopValid) then - goto 9999 - end if - - else - 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 - tlip = lip - nxt = lidx(i) - if (nxt <= nrow) then - idx(i) = -1 - cycle - endif - call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) - 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_,addsz=laddsz) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_ai_,name,& - &a_err='psb_ensure_size',i_err=(/info/)) - goto 9999 - 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/)) - goto 9999 - end if - end if - idx(i) = lip - info = psb_success_ - else - idx(i) = -1 - end if - enddo - end if - - else if (.not.present(mask)) then + !$OMP PARALLEL DO default(none) schedule(STATIC) & + !$OMP shared(name,is,mask,lidx,idx,mglob,idxmap,ncol,nrow,ins_lck,laddsz) & + !$OMP private(i,ip,lip,tlip,nxt,info) & + !$OMP reduction(.AND.:isLoopValid) + do i = 1, is - if (use_openmp) then - !$OMP PARALLEL DO default(none) schedule(STATIC) & - !$OMP shared(name,is,idx,lidx,mglob,idxmap,ncol,nrow,ins_lck,laddsz) & - !$OMP private(i,ip,lip,tlip,nxt,info) & - !$OMP reduction(.AND.:isLoopValid) - do i = 1, is + if (mask(i)) then ip = idx(i) if ((ip < 1 ).or.(ip>mglob)) then @@ -855,14 +711,15 @@ contains cycle endif - ! In OMP logic the index research limit is turned off. It is - ! a correct way to fit the subroutine? + ! 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,& & idxmap%hashv,idxmap%glb_lc,ncol) if (lip < 0) then tlip = lip - nxt = lidx(i) + nxt = lidx(i) if (nxt <= nrow) then idx(i) = -1 @@ -872,14 +729,13 @@ contains ! We check again if the index is already in 'idxmap', this ! time inside a critical region (we assume that the index ! is often already existing). - call OMP_set_lock(ins_lck) + call OMP_set_lock(ins_lck) call hash_inner_cnv(ip,lip,idxmap%hashvmask,& & idxmap%hashv,idxmap%glb_lc,ncol) - + ! Index not found if (lip < 0) then - ! Locking system to handle concurrent write/access. Under checking! + ! Locking system to handle concurrent hashmap read/write. call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) - call OMP_unset_lock(ins_lck) if (info >= 0) then ! 'nxt' is not equal to 'tlip' when the key is already inside @@ -890,7 +746,6 @@ contains ncol = MAX(ncol,nxt) call OMP_unset_lock(ins_lck) - ! Under checking! call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& & pad=-1_psb_lpk_,addsz=laddsz) @@ -904,10 +759,11 @@ contains idxmap%loc_to_glob(nxt) = ip else - call OMP_unset_lock(ins_lck) + call OMP_unset_lock(ins_lck) end if info = psb_success_ + else call OMP_unset_lock(ins_lck) @@ -924,108 +780,58 @@ contains idx(i) = lip info = psb_success_ - end do - !$OMP END PARALLEL DO - - call idxmap%set_lc(ncol) - - if (.not. isLoopValid) then - goto 9999 + else + idx(i) = -1 end if + end do + !$OMP END PARALLEL DO - else - 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 + call idxmap%set_lc(ncol) - 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_,addsz=laddsz) - if (info /= psb_success_) then - info=1 - call psb_errpush(psb_err_from_subroutine_ai_,name,& - &a_err='psb_ensure_size',i_err=(/info/)) - goto 9999 - 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/)) - goto 9999 - end if - end if - idx(i) = lip - info = psb_success_ - enddo + if (.not. isLoopValid) then + goto 9999 end if - end if - else if (.not.present(lidx)) then - if (present(mask)) then - if (use_openmp) then - !$OMP PARALLEL DO default(none) schedule(STATIC) & - !$OMP shared(name,is,idx,mask,mglob,idxmap,ncol,nrow,ins_lck,laddsz) & - !$OMP private(i,ip,lip,tlip,nxt,info) & - !$OMP reduction(.AND.:isLoopValid) - do i = 1, is - - ncol = idxmap%get_lc() - info = 0 - if (mask(i)) then - ip = idx(i) - - if ((ip < 1 ).or.(ip>mglob)) then - idx(i) = -1 - cycle - endif + else if (.not.present(mask)) then - nxt = ncol + 1 - ! 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,& - & idxmap%hashv,idxmap%glb_lc,ncol) + !$OMP PARALLEL DO default(none) schedule(STATIC) & + !$OMP shared(name,is,idx,lidx,mglob,idxmap,ncol,nrow,ins_lck,laddsz) & + !$OMP private(i,ip,lip,tlip,nxt,info) & + !$OMP reduction(.AND.:isLoopValid) + do i = 1, is + ip = idx(i) - if (lip < 0) then + if ((ip < 1 ).or.(ip>mglob)) then + idx(i) = -1 + cycle + endif - ! We check again if the index is already in 'idxmap', this - ! time inside a critical region (we assume that the index - ! is often already existing). - call OMP_set_lock(ins_lck) - call hash_inner_cnv(ip,lip,idxmap%hashvmask,& - & idxmap%hashv,idxmap%glb_lc,ncol) - - ! Index not found - if (lip < 0) then - ! Locking system to handle concurrent hashmap write/access. - call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) - lip = tlip - else - call OMP_unset_lock(ins_lck) - end if + ! In OMP logic the index research limit is turned off. It is + ! a correct way to fit the subroutine? + call hash_inner_cnv(ip,lip,idxmap%hashvmask,& + & idxmap%hashv,idxmap%glb_lc,ncol) - idx(i) = lip - info = psb_success_ - end if + if (lip < 0) then + tlip = lip + nxt = lidx(i) + + if (nxt <= nrow) then + idx(i) = -1 + cycle + endif + + ! We check again if the index is already in 'idxmap', this + ! time inside a critical region (we assume that the index + ! is often already existing). + call OMP_set_lock(ins_lck) + call hash_inner_cnv(ip,lip,idxmap%hashvmask,& + & idxmap%hashv,idxmap%glb_lc,ncol) + + if (lip < 0) then + ! Locking system to handle concurrent write/access. Under checking! + call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) + call OMP_unset_lock(ins_lck) if (info >= 0) then ! 'nxt' is not equal to 'tlip' when the key is already inside @@ -1036,6 +842,7 @@ contains ncol = MAX(ncol,nxt) call OMP_unset_lock(ins_lck) + ! Under checking! call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& & pad=-1_psb_lpk_,addsz=laddsz) @@ -1062,71 +869,36 @@ contains isLoopValid = .false. cycle end if - else - idx(i) = -1 + call OMP_unset_lock(ins_lck) end if - end do - !$OMP END PARALLEL DO - - call idxmap%set_lc(ncol) - - if (.not. isLoopValid) then - goto 9999 end if - else - 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 - 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 + idx(i) = lip + info = psb_success_ + end do + !$OMP END PARALLEL DO - if (info >=0) then - if (nxt == lip) then - ncol = nxt - call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& - & pad=-1_psb_lpk_,addsz=laddsz) - if (info /= psb_success_) then - info=1 - call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_ensure_size',i_err=(/info/)) - goto 9999 - 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/)) - goto 9999 - end if - idx(i) = lip - info = psb_success_ - else - idx(i) = -1 - end if - enddo + call idxmap%set_lc(ncol) + + if (.not. isLoopValid) then + goto 9999 end if - else if (.not.present(mask)) then - if (use_openmp) then - !$OMP PARALLEL DO default(none) schedule(STATIC) & - !$OMP shared(name,is,idx,mglob,idxmap,ncol,nrow,ins_lck,laddsz) & - !$OMP private(i,ip,lip,tlip,nxt,info) & - !$OMP reduction(.AND.:isLoopValid) - do i = 1, is + end if + + else if (.not.present(lidx)) then + + if (present(mask)) then + !$OMP PARALLEL DO default(none) schedule(STATIC) & + !$OMP shared(name,is,idx,mask,mglob,idxmap,ncol,nrow,ins_lck,laddsz) & + !$OMP private(i,ip,lip,tlip,nxt,info) & + !$OMP reduction(.AND.:isLoopValid) + do i = 1, is + + ncol = idxmap%get_lc() + info = 0 + if (mask(i)) then ip = idx(i) if ((ip < 1 ).or.(ip>mglob)) then @@ -1134,6 +906,7 @@ contains cycle endif + nxt = ncol + 1 ! 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. @@ -1167,6 +940,7 @@ contains ! the hash map. In that case 'tlip' is the value corresponding ! to the existing mapping. if (nxt == tlip) then + ncol = MAX(ncol,nxt) call OMP_unset_lock(ins_lck) @@ -1187,7 +961,6 @@ contains end if info = psb_success_ - else call OMP_unset_lock(ins_lck) @@ -1197,57 +970,105 @@ contains isLoopValid = .false. cycle end if - end do - !$OMP END PARALLEL DO - call idxmap%set_lc(ncol) - - if (.not. isLoopValid) then - goto 9999 + else + idx(i) = -1 end if + end do + !$OMP END PARALLEL DO - else - 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) + call idxmap%set_lc(ncol) + + if (.not. isLoopValid) then + goto 9999 + end if + + else if (.not.present(mask)) then + !$OMP PARALLEL DO default(none) schedule(STATIC) & + !$OMP shared(name,is,idx,mglob,idxmap,ncol,nrow,ins_lck,laddsz) & + !$OMP private(i,ip,lip,tlip,nxt,info) & + !$OMP reduction(.AND.:isLoopValid) + do i = 1, is + + ip = idx(i) + + if ((ip < 1 ).or.(ip>mglob)) then + idx(i) = -1 + cycle + endif + + ! 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,& + & idxmap%hashv,idxmap%glb_lc,ncol) + + if (lip < 0) then + + ! We check again if the index is already in 'idxmap', this + ! time inside a critical region (we assume that the index + ! is often already existing). + call OMP_set_lock(ins_lck) + call hash_inner_cnv(ip,lip,idxmap%hashvmask,& + & idxmap%hashv,idxmap%glb_lc,ncol) + + ! Index not found if (lip < 0) then + ! Locking system to handle concurrent hashmap write/access. call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) lip = tlip + else + call OMP_unset_lock(ins_lck) 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_,addsz=laddsz) - if (info /= psb_success_) then - info=1 - 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/)) - goto 9999 - end if - idxmap%loc_to_glob(nxt) = ip - call idxmap%set_lc(ncol) - endif - info = psb_success_ + idx(i) = lip + info = psb_success_ + end if + + 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 OMP_unset_lock(ins_lck) + + call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& + & pad=-1_psb_lpk_,addsz=laddsz) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + &a_err='psb_ensure_size',i_err=(/info/)) + + isLoopValid = .false. + cycle + end if + + idxmap%loc_to_glob(nxt) = ip else - ch_err='SearchInsKeyVal' - call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err=ch_err,i_err=(/info,izero,izero,izero,izero/)) - goto 9999 + call OMP_unset_lock(ins_lck) end if - idx(i) = lip + info = psb_success_ - enddo + + else + call OMP_unset_lock(ins_lck) + + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='SearchInsKeyVal',i_err=(/info/)) + + isLoopValid = .false. + cycle + end if + end do + !$OMP END PARALLEL DO + + call idxmap%set_lc(ncol) + + if (.not. isLoopValid) then + goto 9999 end if + end if end if