From dcedab8ae0462cc3f66db3b3630d4ed29ae3778b Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 1 Aug 2019 14:56:48 +0100 Subject: [PATCH] New usehash argument in CDALL. Still need to put in a heuristics for gen_block with too many cores --- base/modules/tools/psb_cd_tools_mod.f90 | 6 +- base/tools/psb_cd_inloc.f90 | 13 +++-- base/tools/psb_cdall.f90 | 75 +++++++++++++++---------- 3 files changed, 57 insertions(+), 37 deletions(-) diff --git a/base/modules/tools/psb_cd_tools_mod.f90 b/base/modules/tools/psb_cd_tools_mod.f90 index 531072ca..9f871b90 100644 --- a/base/modules/tools/psb_cd_tools_mod.f90 +++ b/base/modules/tools/psb_cd_tools_mod.f90 @@ -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 diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index 6f9fb2a3..1cb2c913 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -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) diff --git a/base/tools/psb_cdall.f90 b/base/tools/psb_cdall.f90 index d79f1f21..0f0ec813 100644 --- a/base/tools/psb_cdall.f90 +++ b/base/tools/psb_cdall.f90 @@ -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