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/tools/psb_cdall.f90 b/base/tools/psb_cdall.f90 index 557fea2c..bebf51bb 100644 --- a/base/tools/psb_cdall.f90 +++ b/base/tools/psb_cdall.f90 @@ -50,7 +50,7 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec character(len=20) :: name integer(psb_ipk_) :: err_act, n_, flag_, i, me, np, nlp, nnv, lr logical :: usehash_ - integer(psb_ipk_), allocatable :: itmpsz(:) + integer(psb_ipk_), allocatable :: itmpv(:), lvl(:) integer(psb_mpik_) :: iictxt @@ -136,35 +136,40 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec else usehash_ = .false. end if - if (usehash_) then - write(0,*) 'Fix usehash_ implementationt ' - end if - if (np == 1) then - allocate(psb_repl_map :: desc%indxmap, stat=info) + 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 - 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 + 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