From 49d37911caa43599512a6a57974da83be5dd0ec9 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 10 Feb 2023 17:14:47 +0100 Subject: [PATCH] Work on psb_hash_map_mod --- ..._hash_map_mod.f90 => psb_hash_map_mod.F90} | 512 +++++++++--------- 1 file changed, 257 insertions(+), 255 deletions(-) rename base/modules/desc/{psb_hash_map_mod.f90 => psb_hash_map_mod.F90} (97%) diff --git a/base/modules/desc/psb_hash_map_mod.f90 b/base/modules/desc/psb_hash_map_mod.F90 similarity index 97% rename from base/modules/desc/psb_hash_map_mod.f90 rename to base/modules/desc/psb_hash_map_mod.F90 index 528450ae..efb3ed10 100644 --- a/base/modules/desc/psb_hash_map_mod.f90 +++ b/base/modules/desc/psb_hash_map_mod.F90 @@ -636,7 +636,9 @@ contains use psb_realloc_mod use psb_sort_mod use psb_penv_mod - !$ use omp_lib +#ifdef OPENMP + use omp_lib +#endif implicit none @@ -655,230 +657,12 @@ contains logical :: use_openmp = .false. logical, volatile :: isLoopValid - !$ integer(kind = OMP_lock_kind) :: ins_lck - - !$ use_openmp = .true. - - if (.true.) then - info = psb_success_ - name = 'hash_g2l_ins' - call psb_erractionsave(err_act) - - ctxt = idxmap%get_ctxt() - call psb_info(ctxt, me, np) - - is = size(idx) - - if (present(mask)) then - if (size(mask) < size(idx)) then - info = -1 - return - end if - end if - if (present(lidx)) then - if (size(lidx) < size(idx)) then - info = -1 - return - end if - end if - - - mglob = idxmap%get_gr() - nrow = idxmap%get_lr() - if (idxmap%is_bld()) then - - if (present(lidx)) 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 - 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 - - 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_,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 - - end if - - else if (.not.present(lidx)) 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 - 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_,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 - - 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_,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_ - 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 - end if - idx(i) = lip - info = psb_success_ - enddo - - - end if - end if - else - ! Wrong state - idx = -1 - info = -1 - end if - else +#ifdef OPENMP + integer(kind = OMP_lock_kind) :: ins_lck +#endif + if (use_openmp) then +#ifdef OPENMP info = psb_success_ name = 'hash_g2l_ins' call psb_erractionsave(err_act) @@ -905,13 +689,12 @@ contains mglob = idxmap%get_gr() nrow = idxmap%get_lr() - if (idxmap%is_bld()) then - if (use_openmp) then - !$ call OMP_init_lock(ins_lck) - isLoopValid = .true. - ncol = idxmap%get_lc() - end if - + 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 @@ -947,7 +730,7 @@ 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 @@ -962,7 +745,7 @@ contains if (nxt == tlip) then ncol = MAX(ncol,nxt) - !$ call OMP_unset_lock(ins_lck) + call OMP_unset_lock(ins_lck) call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& & pad=-1_psb_lpk_,addsz=laddsz) @@ -977,13 +760,13 @@ 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) + call OMP_unset_lock(ins_lck) call psb_errpush(psb_err_from_subroutine_ai_,name,& & a_err='SearchInsKeyVal',i_err=(/info/)) @@ -992,7 +775,7 @@ contains cycle end if else - !$ call OMP_unset_lock(ins_lck) + call OMP_unset_lock(ins_lck) end if end if @@ -1056,7 +839,9 @@ contains end if enddo end if + else if (.not.present(mask)) then + if (use_openmp) then !$OMP PARALLEL DO default(none) schedule(STATIC) & !$OMP shared(name,is,idx,lidx,mglob,idxmap,ncol,nrow,ins_lck,laddsz) & @@ -1087,14 +872,14 @@ 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) 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) + call OMP_unset_lock(ins_lck) if (info >= 0) then ! 'nxt' is not equal to 'tlip' when the key is already inside @@ -1103,7 +888,7 @@ contains if (nxt == tlip) then ncol = MAX(ncol,nxt) - !$ call OMP_unset_lock(ins_lck) + call OMP_unset_lock(ins_lck) ! Under checking! call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& @@ -1119,12 +904,12 @@ 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) + call OMP_unset_lock(ins_lck) call psb_errpush(psb_err_from_subroutine_ai_,name,& & a_err='SearchInsKeyVal',i_err=(/info/)) @@ -1133,7 +918,7 @@ contains cycle end if else - !$ call OMP_unset_lock(ins_lck) + call OMP_unset_lock(ins_lck) end if end if @@ -1225,7 +1010,7 @@ 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) @@ -1235,7 +1020,7 @@ contains call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) lip = tlip else - !$ call OMP_unset_lock(ins_lck) + call OMP_unset_lock(ins_lck) end if idx(i) = lip @@ -1249,7 +1034,7 @@ contains if (nxt == tlip) then ncol = MAX(ncol,nxt) - !$ call OMP_unset_lock(ins_lck) + call OMP_unset_lock(ins_lck) call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& & pad=-1_psb_lpk_,addsz=laddsz) @@ -1264,12 +1049,12 @@ 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) + call OMP_unset_lock(ins_lck) call psb_errpush(psb_err_from_subroutine_ai_,name,& & a_err='SearchInsKeyVal',i_err=(/info/)) @@ -1360,7 +1145,7 @@ 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) @@ -1370,7 +1155,7 @@ contains call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) lip = tlip else - !$ call OMP_unset_lock(ins_lck) + call OMP_unset_lock(ins_lck) end if idx(i) = lip @@ -1383,7 +1168,7 @@ contains ! to the existing mapping. if (nxt == tlip) then ncol = MAX(ncol,nxt) - !$ call OMP_unset_lock(ins_lck) + call OMP_unset_lock(ins_lck) call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& & pad=-1_psb_lpk_,addsz=laddsz) @@ -1392,19 +1177,19 @@ contains call psb_errpush(psb_err_from_subroutine_ai_,name,& &a_err='psb_ensure_size',i_err=(/info/)) - !$ isLoopValid = .false. + isLoopValid = .false. cycle end if 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) + call OMP_unset_lock(ins_lck) call psb_errpush(psb_err_from_subroutine_ai_,name,& & a_err='SearchInsKeyVal',i_err=(/info/)) @@ -1466,10 +1251,227 @@ contains end if end if - if (use_openmp) then - !$ call OMP_destroy_lock(ins_lck) + call OMP_destroy_lock(ins_lck) + + else + ! Wrong state + idx = -1 + info = -1 + end if +#endif + else if (.not.use_openmp) then + info = psb_success_ + name = 'hash_g2l_ins' + call psb_erractionsave(err_act) + + ctxt = idxmap%get_ctxt() + call psb_info(ctxt, me, np) + + is = size(idx) + + if (present(mask)) then + if (size(mask) < size(idx)) then + info = -1 + return end if + end if + if (present(lidx)) then + if (size(lidx) < size(idx)) then + info = -1 + return + end if + end if + + + mglob = idxmap%get_gr() + nrow = idxmap%get_lr() + if (idxmap%is_bld()) then + + if (present(lidx)) 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 + 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 + + 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_,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 + + end if + + else if (.not.present(lidx)) 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 + 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_,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 + + 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_,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_ + 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 + end if + idx(i) = lip + info = psb_success_ + enddo + + + end if + end if else ! Wrong state idx = -1