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

Temporarily revert hash_map_mod waiting for a proper fix

Browse Source
omp-threadsafe
Salvatore Filippone 2 years ago
parent beefe9aa1a
commit 784cc65e51
1 changed files with 547 additions and 324 deletions
Show Stats Download Patch File Download Diff File

225
base/modules/desc/psb_hash_map_mod.f90
Unescape Escape View File

@ -659,6 +659,226 @@ contains
!$ 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
info = psb_success_
name = 'hash_g2l_ins'
call psb_erractionsave(err_act)
@ -983,6 +1203,8 @@ contains
!$OMP reduction(.AND.:isLoopValid)
do i = 1, is
ncol = idxmap%get_lc()
info = 0
if (mask(i)) then
ip = idx(i)
@ -991,6 +1213,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.
@ -1252,7 +1475,7 @@ contains
idx = -1
info = -1
end if
end if
call psb_erractionrestore(err_act)
return

Write Preview
Loading…
Cancel
Save