From 4555b22f970c602c657f82ce004a6c029a9d3917 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 2 Aug 2019 09:33:57 +0100 Subject: [PATCH] Initial handling of USEHASH in cd_inloc & friends --- base/modules/psi_reduce_mod.F90 | 63 +++++++++++++++ base/modules/tools/psb_cd_tools_mod.f90 | 6 +- base/tools/psb_cd_inloc.f90 | 13 ++- base/tools/psb_cdall.f90 | 102 ++++++++++++++---------- 4 files changed, 133 insertions(+), 51 deletions(-) diff --git a/base/modules/psi_reduce_mod.F90 b/base/modules/psi_reduce_mod.F90 index 597d8f8e..8322df55 100644 --- a/base/modules/psi_reduce_mod.F90 +++ b/base/modules/psi_reduce_mod.F90 @@ -182,6 +182,14 @@ module psi_reduce_mod end interface #endif + interface psb_scan_sum + module procedure psb_iscan_sums + end interface psb_scan_sum + + interface psb_exscan_sum + module procedure psb_iexscan_sums + end interface psb_exscan_sum + contains @@ -5586,4 +5594,59 @@ contains end subroutine psb_d_nrm2v_ic #endif + + + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! SCAN + ! + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine psb_iscan_sums(ictxt,dat) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(inout) :: dat + integer(psb_ipk_) :: dat_ + integer(psb_mpik_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + call mpi_scan(dat,dat_,1,psb_mpi_ipk_integer,mpi_sum,ictxt,info) + dat = dat_ +#endif + end subroutine psb_iscan_sums + + + subroutine psb_iexscan_sums(ictxt,dat) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(inout) :: dat + integer(psb_ipk_) :: dat_ + integer(psb_mpik_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + call mpi_scan(dat,dat_,1,psb_mpi_ipk_integer,mpi_sum,ictxt,info) + dat = dat_ +#else + dat = 0 +#endif + end subroutine psb_iexscan_sums + end module psi_reduce_mod diff --git a/base/modules/tools/psb_cd_tools_mod.f90 b/base/modules/tools/psb_cd_tools_mod.f90 index e2fee54a..317a40c0 100644 --- a/base/modules/tools/psb_cd_tools_mod.f90 +++ b/base/modules/tools/psb_cd_tools_mod.f90 @@ -169,16 +169,16 @@ 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_desc_type, psb_parts implicit None procedure(psb_parts) :: parts integer(psb_ipk_), intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl,lidx(:) 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 6ea184d1..de80f527 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 @@ -52,7 +52,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) integer(psb_ipk_), intent(in) :: ictxt, 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 @@ -65,7 +65,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) & nov(:), ov_idx(:,:), ix(:) integer(psb_ipk_) :: debug_level, debug_unit integer(psb_mpik_) :: iictxt - logical :: check_, islarge + logical :: check_, islarge, usehash_ character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -92,6 +92,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 @@ -351,7 +356,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 46aa9d44..bebf51bb 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 @@ -7,49 +7,50 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche use psb_cd_tools_mod, psb_protect_name => psb_cdall use psi_mod implicit None - procedure(psb_parts) :: parts - integer(psb_ipk_), intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl,lidx(:) - integer(psb_ipk_), intent(in) :: flag - logical, intent(in) :: repl, globalcheck - integer(psb_ipk_), intent(out) :: info + procedure(psb_parts) :: parts + integer(psb_ipk_), intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl,lidx(:) + integer(psb_ipk_), intent(in) :: flag + 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) use psb_desc_mod - procedure(psb_parts) :: parts - integer(psb_ipk_), intent(in) :: m,n,ictxt - Type(psb_desc_type), intent(out) :: desc - integer(psb_ipk_), intent(out) :: info + procedure(psb_parts) :: parts + integer(psb_ipk_), intent(in) :: m,n,ictxt + Type(psb_desc_type), intent(out) :: desc + integer(psb_ipk_), intent(out) :: info end subroutine psb_cdals subroutine psb_cdalv(v, ictxt, desc, info, flag) use psb_desc_mod - integer(psb_ipk_), intent(in) :: ictxt, v(:) - integer(psb_ipk_), intent(in), optional :: flag - integer(psb_ipk_), intent(out) :: info - Type(psb_desc_type), intent(out) :: desc + integer(psb_ipk_), intent(in) :: ictxt, v(:) + integer(psb_ipk_), intent(in), optional :: flag + 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, v(:) - integer(psb_ipk_), intent(out) :: info - type(psb_desc_type), intent(out) :: desc - logical, intent(in), optional :: globalcheck - integer(psb_ipk_), intent(in), optional :: idx(:) + integer(psb_ipk_), intent(in) :: ictxt, v(:) + integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(out) :: desc + 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) use psb_desc_mod - integer(psb_ipk_), intent(in) :: m,ictxt + integer(psb_ipk_), intent(in) :: m,ictxt Type(psb_desc_type), intent(out) :: desc - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_cdrep end interface - character(len=20) :: name - integer(psb_ipk_) :: err_act, n_, flag_, i, me, np, nlp, nnv, lr - integer(psb_ipk_), allocatable :: itmpsz(:) + character(len=20) :: name + integer(psb_ipk_) :: err_act, n_, flag_, i, me, np, nlp, nnv, lr + logical :: usehash_ + integer(psb_ipk_), allocatable :: itmpv(:), lvl(:) integer(psb_mpik_) :: iictxt @@ -130,32 +131,45 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche 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) - call aa%repl_map_init(iictxt,nl,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) + call aa%repl_map_init(iictxt,nl,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