fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-16 10:52:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
base/modules/psb_hash_map_mod.f90
 base/modules/psb_repl_map_mod.f90

Do not copy & call in-place version, take one. To be completed.
This commit is contained in:
Salvatore Filippone
2013-09-26 10:04:35 +00:00
parent 8907c096e7
commit 9fb59c39b8
2 changed files with 234 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_hash_map_mod.f90
+51
View File
@@ -73,6 +73,7 @@ module psb_hash_map_mod
procedure, pass(idxmap) :: asb => hash_asb
procedure, pass(idxmap) :: free => hash_free
procedure, pass(idxmap) :: clone => hash_clone
procedure, pass(idxmap) :: reinit => hash_reinit
procedure, nopass :: get_fmt => hash_get_fmt
procedure, nopass :: row_extendable => hash_row_extendable
@@ -1452,5 +1453,55 @@ contains
end subroutine hash_cpy
subroutine hash_reinit(idxmap,info)
use psb_penv_mod
use psb_error_mod
use psb_realloc_mod
implicit none
class(psb_hash_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, nr,nc,k, nl, ictxt, ntot
integer(psb_ipk_), allocatable :: idx(:),lidx(:)
character(len=20) :: name='hash_reinit'
logical, parameter :: debug=.false.
info = psb_success_
call psb_get_erraction(err_act)
ictxt = idxmap%get_ctxt()
nr = idxmap%get_lr()
nc = idxmap%get_lc()
ntot = idxmap%get_gr()
if (nc>nr) then
lidx = (/(k,k=1,nc)/)
idx = (/(k,k=1,nc)/)
call idxmap%l2gip(idx,info)
end if
if (info /= 0) &
& write(0,*) 'From l2gip',info
call idxmap%free()
call hash_init_vlu(idxmap,ictxt,ntot,nr,idx(1:nr),info)
if (nc>nr) then
call idxmap%g2lip_ins(idx(nr+1:nc),info,lidx=lidx(nr+1:nc))
end if
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine hash_reinit
end module psb_hash_map_mod
base/modules/psb_repl_map_mod.f90
+183 -8
View File
@@ -196,11 +196,49 @@ contains
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: is, im
integer(psb_ipk_) :: i
logical :: owned_
info = 0
is = size(idxin)
im = min(is,size(idxout))
idxout(1:im) = idxin(1:im)
call idxmap%l2gip(idxout(1:im),info,mask,owned)
if (present(mask)) then
if (size(mask) < im) then
info = -1
return
end if
end if
if (present(owned)) then
owned_ = owned
else
owned_ = .false.
end if
if (present(mask)) then
do i=1, im
if (mask(i)) then
if ((1<=idxin(i)).and.(idxin(i) <= idxmap%local_rows)) then
idxout(i) = idxin(i)
else
idxout(i) = -1
end if
end if
end do
else if (.not.present(mask)) then
do i=1, im
if ((1<=idxin(i)).and.(idxin(i) <= idxmap%local_rows)) then
idxout(i) = idxin(i)
else
idxout(i) = -1
end if
end do
end if
if (is > im) info = -3
end subroutine repl_l2gv2
@@ -331,12 +369,79 @@ contains
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: is, im
integer(psb_ipk_) :: is, im,i
logical :: owned_
info = 0
is = size(idxin)
im = min(is,size(idxout))
idxout(1:im) = idxin(1:im)
call idxmap%g2lip(idxout(1:im),info,mask,owned)
if (present(mask)) then
if (size(mask) < im) then
info = -1
return
end if
end if
if (present(owned)) then
owned_ = owned
else
owned_ = .false.
end if
if (present(mask)) then
if (idxmap%is_asb()) then
do i=1, is
if (mask(i)) then
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
idxout(i) = idxin(i)
else
idxout(i) = -1
end if
end if
end do
else if (idxmap%is_valid()) then
do i=1,is
if (mask(i)) then
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
idxout(i) = idxin(i)
else
idxout(i) = -1
end if
end if
end do
else
idxout(1:is) = -1
info = -1
end if
else if (.not.present(mask)) then
if (idxmap%is_asb()) then
do i=1, is
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
idxout(i) = idxin(i)
else
idxout(i) = -1
end if
end do
else if (idxmap%is_valid()) then
do i=1,is
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
idxout(i) = idxin(i)
else
idxout(i) = -1
end if
end do
else
idxout(1:is) = -1
info = -1
end if
end if
if (is > im) info = -3
end subroutine repl_g2lv2
@@ -480,12 +585,82 @@ contains
logical, intent(in), optional :: mask(:)
integer(psb_ipk_), intent(in), optional :: lidx(:)
integer(psb_ipk_) :: is, im
integer(psb_ipk_) :: is, im, i
info = 0
is = size(idxin)
im = min(is,size(idxout))
idxout(1:im) = idxin(1:im)
call idxmap%g2lip_ins(idxout(1:im),info,mask=mask,lidx=lidx)
if (present(mask)) then
if (size(mask) < im) then
info = -1
return
end if
end if
if (present(lidx)) then
if (size(lidx) < im) then
info = -1
return
end if
end if
if (idxmap%is_asb()) then
! State is wrong for this one !
idxout = -1
info = -1
else if (idxmap%is_valid()) then
if (present(lidx)) then
if (present(mask)) then
do i=1, is
if (mask(i)) then
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
idxout(i) = idxin(i)
else
idxout(i) = -1
end if
end if
end do
else if (.not.present(mask)) then
do i=1, is
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
idxout(i) = idxin(i)
else
idxout(i) = -1
end if
end do
end if
else if (.not.present(lidx)) then
if (present(mask)) then
do i=1, is
if (mask(i)) then
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
idxout(i) = idxin(i)
else
idxout(i) = -1
end if
end if
end do
else if (.not.present(mask)) then
do i=1, is
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
idxout(i) = idxin(i)
else
idxout(i) = -1
end if
end do
end if
end if
else
idxout = -1
info = -1
end if
if (is > im) info = -3
end subroutine repl_g2lv2_ins