New usehash argument in CDALL. Still need to put in a heuristics for

gen_block with too many cores
merge-paraggr
Salvatore Filippone 6 years ago
parent d0707ae512
commit dcedab8ae0

@ -171,17 +171,17 @@ module psb_cd_tools_mod
interface psb_cdall
subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,&
& globalcheck,lidx)
& globalcheck,lidx,usehash)
import :: psb_ipk_, psb_lpk_, psb_desc_type, psb_parts
implicit None
procedure(psb_parts) :: parts
integer(psb_lpk_), intent(in) :: mg,ng, vl(:)
integer(psb_ipk_), intent(in) :: ictxt, vg(:), lidx(:),nl
integer(psb_ipk_), intent(in) :: flag
logical, intent(in) :: repl, globalcheck
logical, intent(in) :: repl, globalcheck, usehash
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc
optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx
optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx,usehash
end subroutine psb_cdall
end interface

@ -41,7 +41,7 @@
! ictxt - integer. The communication context.
! desc - type(psb_desc_type). The communication descriptor.
! info - integer. Eventually returns an error code
subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash)
use psb_base_mod
use psi_mod
use psb_repl_map_mod
@ -53,7 +53,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
integer(psb_lpk_), intent(in) :: v(:)
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc
logical, intent(in), optional :: globalcheck
logical, intent(in), optional :: globalcheck,usehash
integer(psb_ipk_), intent(in), optional :: idx(:)
!locals
@ -70,7 +70,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
integer(psb_mpk_) :: iictxt
real(psb_dpk_) :: t0, t1, t2, t3, t4, t5
logical :: do_timings=.false.
logical :: check_, islarge
logical :: check_, islarge, usehash_
character(len=20) :: name
if(psb_get_errstatus() /= 0) return
@ -100,6 +100,11 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
else
check_ = .false.
end if
if (present(usehash)) then
usehash_ = usehash
else
usehash_ = .false.
end if
n = m
@ -374,7 +379,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
if (np == 1) then
allocate(psb_repl_map :: desc%indxmap, stat=info)
else
if (islarge) then
if (islarge.or.usehash_) then
allocate(psb_hash_map :: desc%indxmap, stat=info)
else
allocate(psb_list_map :: desc%indxmap, stat=info)

@ -1,4 +1,4 @@
subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx)
subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalcheck,lidx,usehash)
use psb_desc_mod
use psb_serial_mod
use psb_const_mod
@ -11,11 +11,11 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche
integer(psb_lpk_), intent(in) :: mg,ng, vl(:)
integer(psb_ipk_), intent(in) :: ictxt, vg(:), lidx(:),nl
integer(psb_ipk_), intent(in) :: flag
logical, intent(in) :: repl, globalcheck
logical, intent(in) :: repl, globalcheck,usehash
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc
optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx
optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx, usehash
interface
subroutine psb_cdals(m, n, parts, ictxt, desc, info)
@ -33,14 +33,14 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche
integer(psb_ipk_), intent(out) :: info
Type(psb_desc_type), intent(out) :: desc
end subroutine psb_cdalv
subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx, usehash)
use psb_desc_mod
implicit None
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_lpk_), intent(in) :: v(:)
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc
logical, intent(in), optional :: globalcheck
logical, intent(in), optional :: globalcheck, usehash
integer(psb_ipk_), intent(in), optional :: idx(:)
end subroutine psb_cd_inloc
subroutine psb_cdrep(m, ictxt, desc,info)
@ -52,12 +52,14 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche
end subroutine psb_cdrep
end interface
character(len=20) :: name
integer(psb_ipk_) :: err_act, flag_, i, me, np, nlp, nnv, lr
integer(psb_lpk_) :: n_
integer(psb_ipk_), allocatable :: itmpsz(:)
integer(psb_ipk_) :: err_act, flag_, i, me, np, nnv, lr
integer(psb_lpk_) :: n_, nlp
logical :: usehash_
integer(psb_ipk_), allocatable :: itmpv(:)
integer(psb_lpk_), allocatable :: lvl(:)
integer(psb_mpk_) :: iictxt
if (psb_get_errstatus() /= 0) return
info=psb_success_
@ -134,34 +136,47 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche
call psb_cd_inloc(vl(1:nnv),ictxt,desc,info, globalcheck=globalcheck,idx=lidx)
else if (present(nl)) then
if (np == 1) then
allocate(psb_repl_map :: desc%indxmap, stat=info)
if (present(usehash)) then
usehash_ = usehash
else
allocate(psb_gen_block_map :: desc%indxmap, stat=info)
usehash_ = .false.
end if
if (info == psb_success_) then
select type(aa => desc%indxmap)
type is (psb_repl_map)
n_ = nl
call aa%repl_map_init(iictxt,n_,info)
type is (psb_gen_block_map)
call aa%gen_block_map_init(iictxt,nl,info)
class default
! This cannot happen
info = psb_err_internal_error_
goto 9999
end select
if (usehash_) then
nlp = nl
call psb_exscan_sum(ictxt,nlp)
lvl = [ (i,i=1,nl) ] + nlp
call psb_cd_inloc(lvl(1:nl),ictxt,desc,info, globalcheck=.false.)
else
if (np == 1) then
allocate(psb_repl_map :: desc%indxmap, stat=info)
else
allocate(psb_gen_block_map :: desc%indxmap, stat=info)
end if
if (info == psb_success_) then
select type(aa => desc%indxmap)
type is (psb_repl_map)
n_ = nl
call aa%repl_map_init(iictxt,n_,info)
type is (psb_gen_block_map)
call aa%gen_block_map_init(iictxt,nl,info)
class default
! This cannot happen
info = psb_err_internal_error_
goto 9999
end select
end if
end if
call psb_realloc(1,itmpsz, info)
call psb_realloc(1,itmpv, info)
if (info /= 0) then
write(0,*) 'Error reallocating itmspz'
goto 9999
end if
itmpsz(:) = -1
call psi_bld_tmpovrl(itmpsz,desc,info)
itmpv(:) = -1
call psi_bld_tmpovrl(itmpv,desc,info)
endif

Loading…
Cancel
Save