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

First step reworking G2LV2_INS

Browse Source
fix-hash
sfilippone 1 year ago
parent 3a70583ac5
commit 89c6d8d108
1 changed files with 329 additions and 23 deletions
Show Stats Download Patch File Download Diff File

352
base/modules/desc/psb_hash_map_mod.F90
Unescape Escape View File

@ -376,7 +376,6 @@ contains
else if (idxmap%is_valid()) then
if (.false.) then
! $ o m p parallel do default(none) schedule(dynamic) &
! $ o m p shared(mask,is,idx,mglob,idxmap,nrm,ncol,nrow,owned_) &
! $ o m p private(i,ip,lip,tlip,info)
@ -406,28 +405,28 @@ contains
end if
enddo
! $ o m p end parallel do
else
call hash_inner_cnv(is,idx,idxmap%hashvmask,idxmap%hashv,&
& idxmap%glb_lc,nrm=nrm,mask=mask)
do i = 1, is
lip = idx(i)
if (lip < 0) then
call psb_hash_searchkey(ip,tlip,idxmap%hash,info)
lip = tlip
info = 0
if (owned_) then
if (lip<=nrow) then
idx(i) = lip
else
idx(i) = -1
endif
else
idx(i) = lip
endif
end if
enddo
end if
!!$ call hash_inner_cnv(is,idx,idxmap%hashvmask,idxmap%hashv,&
!!$ & idxmap%glb_lc,nrm=nrm,mask=mask)
!!$
!!$ do i = 1, is
!!$ lip = idx(i)
!!$ if (lip < 0) then
!!$ call psb_hash_searchkey(ip,tlip,idxmap%hash,info)
!!$ lip = tlip
!!$ info = 0
!!$ if (owned_) then
!!$ if (lip<=nrow) then
!!$ idx(i) = lip
!!$ else
!!$ idx(i) = -1
!!$ endif
!!$ else
!!$ idx(i) = lip
!!$ endif
!!$ end if
!!$ enddo
!!$
else
write(0,*) 'Hash status: invalid ',idxmap%get_state()
idx(1:is) = -1
@ -715,6 +714,7 @@ contains
is = size(idx)
!write(0,*)me, name, ':', present(lidx),present(mask),idxmap%is_bld()
if (present(mask)) then
if (size(mask) < size(idx)) then
@ -1111,7 +1111,7 @@ contains
nxt = ncol + 1
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
& idxmap%glb_lc,ncol)
!if (i==1) write(0,*) me,' v1 icnv:',i,lip
!if (i<=4) write(0,*) me,' v1 icnv:',i,idx(i),ip,lip
if (lip > 0) then
idx(i) = lip
info = psb_success_
@ -1264,6 +1264,7 @@ contains
end subroutine hash_g2lv1_ins
! ################## END THESIS #########################
#if 0
subroutine hash_g2lv2_ins(idxin,idxout,idxmap,info,mask,lidx)
implicit none
class(psb_hash_map), intent(inout) :: idxmap
@ -1289,7 +1290,312 @@ contains
end if
end subroutine hash_g2lv2_ins
#else
subroutine hash_g2lv2_ins(idxin,idxout,idxmap,info,mask,lidx)
use psb_timers_mod
implicit none
class(psb_hash_map), intent(inout) :: idxmap
integer(psb_lpk_), intent(in) :: idxin(:)
integer(psb_ipk_), intent(out) :: idxout(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
integer(psb_ipk_), intent(in), optional :: lidx(:)
integer(psb_lpk_), allocatable :: tidx(:)
integer(psb_ipk_) :: is, im
integer(psb_ipk_) :: i, lip, nrow, ncol
integer(psb_lpk_) :: mglob, ip, nxt, tlip
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np, ith, err_act
character(len=20) :: name,ch_err
logical, volatile :: isLoopValid
logical, parameter :: do_timings=.false.
info = psb_success_
name = 'hash_g2lv2_ins'
call psb_erractionsave(err_act)
ctxt = idxmap%get_ctxt()
call psb_info(ctxt, me, np)
is = size(idxin)
is = min(is,size(idxout))
mglob = idxmap%get_gr()
nrow = idxmap%get_lr()
!write(0,*)me, name, ':', present(lidx),present(mask),idxmap%is_bld()
#if 0
!write(0,*) 'g2lv2_ins before realloc ',psb_errstatus_fatal()
call psb_realloc(is,tidx,info)
!write(0,*) 'g2lv2_ins after realloc ',psb_errstatus_fatal()
tidx(1:is) = idxin(1:is)
call idxmap%g2lip_ins(tidx(1:is),info,mask=mask,lidx=lidx)
idxout(1:is) = tidx(1:is)
!write(0,*) me,' g2lv2ins: in:',idxin(1:4),' out:',idxout(1:4)
#else
isLoopValid = .true.
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 = idxin(i)
if ((ip < 1 ).or.(ip>mglob) ) then
idxout(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
idxout(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
idxout(i) = lip
info = psb_success_
else
idxout(i) = -1
end if
enddo
else if (.not.present(mask)) then
do i = 1, is
ncol = idxmap%get_lc()
ip = idxin(i)
if ((ip < 1 ).or.(ip>mglob)) then
idxout(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
idxout(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
idxout(i) = lip
info = psb_success_
enddo
end if
else if (.not.present(lidx)) then
if (present(mask)) then
#if 0
!write(0,*) me,name, ' loop is:',is
do i = 1, is
if (mask(i)) then
ip = idxin(i)
if ((ip < 1 ).or.(ip>mglob)) then
idxout(i) = -1
cycle
endif
ncol = idxmap%get_lc()
nxt = ncol + 1
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
& idxmap%glb_lc,ncol)
!if (i<=4) write(0,*) me,' v1 icnv:',i,idxin(i),ip,lip
if (lip > 0) then
idxout(i) = lip
info = psb_success_
else
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
!if (i==1) write(0,*) me,' v1 srchins:',i,lip
if (info >=0) then
if (nxt == lip) then
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
info = psb_success_
else
call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='SearchInsKeyVal',i_err=(/info/))
isLoopValid = .false.
end if
idxout(i) = lip
info = psb_success_
end if
else
idxout(i) = -1
end if
enddo
!write(0,*) me,' g2lv2ins: in:',idxin(1:4),' out:',idxout(1:4)
#else
ncol = idxmap%get_lc()
call hash_inner_cnv(is,idxin,idxout,idxmap%hashvmask,idxmap%hashv,&
& idxmap%glb_lc,nrm=ncol, mask=mask)
! write(0,*) me,' v2 after hash_inner_cnv ',idx(1:is)
do i = 1, is
if (mask(i).and.(idxout(i)<0)) then
ncol = idxmap%get_lc()
nxt = ncol + 1
ip = idxin(i)
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
!if (i==1) write(0,*) me,' v2 isrchins:',i,lip
if (info >=0) then
if (nxt == lip) then
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
info = psb_success_
else
call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='SearchInsKeyVal',i_err=(/info/))
isLoopValid = .false.
end if
idxout(i) = lip
info = psb_success_
else if (.not.mask(i)) then
idxout(i) = -1
end if
enddo
! write(0,*) me,' v2 after cleanup ',idx(1:is)
#endif
else if (.not.present(mask)) then
do i = 1, is
ncol = idxmap%get_lc()
ip = idxin(i)
if ((ip < 1 ).or.(ip>mglob)) then
idxout(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
idxout(i) = lip
info = psb_success_
else
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
if (info >=0) then
if (nxt == lip) then
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
idxout(i) = lip
info = psb_success_
end if
enddo
end if
end if
else
! Wrong state
idxout(:) = -1
info = -1
end if
if (.not. isLoopValid) goto 9999
#endif
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ctxt,err_act)
return
end subroutine hash_g2lv2_ins
#endif
!
! init from VL, with checks on input.
!

Write Preview
Loading…
Cancel
Save