Initial handling of USEHASH in cd_inloc & friends

psblas-3.6-maint
Salvatore Filippone 6 years ago
parent 1092dede54
commit 4555b22f97

@ -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

@ -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

@ -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)

@ -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
@ -10,11 +10,11 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche
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
interface
subroutine psb_cdals(m, n, parts, ictxt, desc, info)
@ -31,13 +31,13 @@ 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, 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)
@ -49,7 +49,8 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche
end interface
character(len=20) :: name
integer(psb_ipk_) :: err_act, n_, flag_, i, me, np, nlp, nnv, lr
integer(psb_ipk_), allocatable :: itmpsz(:)
logical :: usehash_
integer(psb_ipk_), allocatable :: itmpv(:), lvl(:)
integer(psb_mpik_) :: iictxt
@ -130,7 +131,19 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche
else if (present(nl)) then
if (present(usehash)) then
usehash_ = usehash
else
usehash_ = .false.
end if
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
@ -148,14 +161,15 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche
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