From 27bf7ec666dec3168119b3d94afee09d33c9cb95 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 18 Feb 2020 10:44:49 +0000 Subject: [PATCH] New get_a2av_alg() in place of conditional compilation --- base/modules/desc/psb_desc_const_mod.f90 | 12 +- base/modules/desc/psb_desc_mod.F90 | 35 +++- base/tools/psb_c_glob_transpose.F90 | 58 ++++--- base/tools/psb_csphalo.F90 | 207 ++++++++++++----------- base/tools/psb_d_glob_transpose.F90 | 58 ++++--- base/tools/psb_dsphalo.F90 | 207 ++++++++++++----------- base/tools/psb_s_glob_transpose.F90 | 58 ++++--- base/tools/psb_ssphalo.F90 | 207 ++++++++++++----------- base/tools/psb_z_glob_transpose.F90 | 58 ++++--- base/tools/psb_zsphalo.F90 | 207 ++++++++++++----------- 10 files changed, 603 insertions(+), 504 deletions(-) diff --git a/base/modules/desc/psb_desc_const_mod.f90 b/base/modules/desc/psb_desc_const_mod.f90 index 8c3937e0..aa2ea2fe 100644 --- a/base/modules/desc/psb_desc_const_mod.f90 +++ b/base/modules/desc/psb_desc_const_mod.f90 @@ -104,9 +104,17 @@ module psb_desc_const_mod integer(psb_ipk_), parameter :: psb_hash_bits = 16 integer(psb_ipk_), parameter :: psb_max_hash_bits = 22 integer(psb_ipk_), parameter :: psb_hash_size = 2**psb_hash_bits, psb_hash_mask=psb_hash_size-1 - integer(psb_ipk_), parameter :: psb_default_large_threshold=1*1024*1024 integer(psb_ipk_), parameter :: psb_hpnt_nentries_ = 7 - + integer(psb_ipk_), parameter :: psb_default_large_threshold=1*1024*1024 + ! + ! Choice of algorithm for sparse matrix A2AV + ! + integer(psb_ipk_), parameter :: psb_sp_a2av_smpl_triad_ = 1 + integer(psb_ipk_), parameter :: psb_sp_a2av_smpl_v_ = 2 + integer(psb_ipk_), parameter :: psb_sp_a2av_mpi_ = 3 + integer(psb_ipk_), parameter :: psb_sp_a2av_alg_min_ = psb_sp_a2av_smpl_triad_ + integer(psb_ipk_), parameter :: psb_sp_a2av_alg_max_ = psb_sp_a2av_mpi_ + ! ! Constants for desc_a handling ! diff --git a/base/modules/desc/psb_desc_mod.F90 b/base/modules/desc/psb_desc_mod.F90 index 03ddc7c4..43ae5852 100644 --- a/base/modules/desc/psb_desc_mod.F90 +++ b/base/modules/desc/psb_desc_mod.F90 @@ -294,7 +294,15 @@ module psb_desc_mod module procedure psb_l_cd_set_large_threshold end interface psb_cd_set_large_threshold #endif - + + interface psb_set_sp_a2av_alg + module procedure psb_m_set_sp_a2av_alg, psb_e_set_sp_a2av_alg + end interface psb_set_sp_a2av_alg + + interface psb_get_sp_a2av_alg + module procedure psb_m_get_sp_a2av_alg + end interface psb_get_sp_a2av_alg + private :: nullify_desc, cd_get_fmt,& & cd_l2gs1, cd_l2gs2, cd_l2gv1, cd_l2gv2, cd_g2ls1,& & cd_g2ls2, cd_g2lv1, cd_g2lv2, cd_g2ls1_ins,& @@ -302,10 +310,33 @@ module psb_desc_mod integer(psb_lpk_), private, save :: cd_large_threshold = psb_default_large_threshold - + integer(psb_ipk_), private, save :: sp_a2av_alg = psb_sp_a2av_smpl_triad_ contains + function psb_m_get_sp_a2av_alg() result(val) + implicit none + integer(psb_mpk_) :: val + val = sp_a2av_alg + end function psb_m_get_sp_a2av_alg + + subroutine psb_m_set_sp_a2av_alg(val) + implicit none + integer(psb_mpk_), intent(in) :: val + + if ((psb_sp_a2av_alg_min_ <= val).and.(val<=psb_sp_a2av_alg_max_)) & + & sp_a2av_alg = val + end subroutine psb_m_set_sp_a2av_alg + + subroutine psb_e_set_sp_a2av_alg(val) + implicit none + integer(psb_epk_), intent(in) :: val + + if ((psb_sp_a2av_alg_min_ <= val).and.(val<=psb_sp_a2av_alg_max_)) & + & sp_a2av_alg = val + end subroutine psb_e_set_sp_a2av_alg + + function psb_cd_sizeof(desc) result(val) implicit none !....Parameters... diff --git a/base/tools/psb_c_glob_transpose.F90 b/base/tools/psb_c_glob_transpose.F90 index 179149d8..f3851ee3 100644 --- a/base/tools/psb_c_glob_transpose.F90 +++ b/base/tools/psb_c_glob_transpose.F90 @@ -93,9 +93,6 @@ ! persistent collectives. ! ! -#undef SP_A2AV_MPI -#undef SP_A2AV_XI -#define SP_A2AV_TRIAD subroutine psb_lc_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) #ifdef MPI_MOD use mpi @@ -287,33 +284,38 @@ subroutine psb_lc_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) nzl = acoo%get_nzeros() call acoo%ensure_size(nzl+iszr) -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if diff --git a/base/tools/psb_csphalo.F90 b/base/tools/psb_csphalo.F90 index d6b7b565..24ebb4f6 100644 --- a/base/tools/psb_csphalo.F90 +++ b/base/tools/psb_csphalo.F90 @@ -70,9 +70,6 @@ ! psb_comm_ext_ use ext_index ! psb_comm_ovrl_ DISABLED for this routine. ! -#undef SP_A2AV_MPI -#undef SP_A2AV_XI -#define SP_A2AV_TRIAD Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) use psb_base_mod, psb_protect_name => psb_csphalo @@ -329,32 +326,36 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_errpush(info,name,a_err=ch_err); goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) - if (minfo == mpi_success) & + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & iarcv,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) + if (minfo == mpi_success) & & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& & iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & iarcv,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & jarcv,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -421,32 +422,36 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -764,32 +769,37 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if @@ -1115,33 +1125,36 @@ Subroutine psb_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if diff --git a/base/tools/psb_d_glob_transpose.F90 b/base/tools/psb_d_glob_transpose.F90 index 6b582cfb..697e7ad2 100644 --- a/base/tools/psb_d_glob_transpose.F90 +++ b/base/tools/psb_d_glob_transpose.F90 @@ -93,9 +93,6 @@ ! persistent collectives. ! ! -#undef SP_A2AV_MPI -#undef SP_A2AV_XI -#define SP_A2AV_TRIAD subroutine psb_ld_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) #ifdef MPI_MOD use mpi @@ -287,33 +284,38 @@ subroutine psb_ld_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) nzl = acoo%get_nzeros() call acoo%ensure_size(nzl+iszr) -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index 171a03dd..51c4c9ef 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -70,9 +70,6 @@ ! psb_comm_ext_ use ext_index ! psb_comm_ovrl_ DISABLED for this routine. ! -#undef SP_A2AV_MPI -#undef SP_A2AV_XI -#define SP_A2AV_TRIAD Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) use psb_base_mod, psb_protect_name => psb_dsphalo @@ -329,32 +326,36 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_errpush(info,name,a_err=ch_err); goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) - if (minfo == mpi_success) & + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & iarcv,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) + if (minfo == mpi_success) & & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& & iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & iarcv,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & jarcv,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -421,32 +422,36 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -764,32 +769,37 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if @@ -1115,33 +1125,36 @@ Subroutine psb_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if diff --git a/base/tools/psb_s_glob_transpose.F90 b/base/tools/psb_s_glob_transpose.F90 index eaeae083..9b6fd434 100644 --- a/base/tools/psb_s_glob_transpose.F90 +++ b/base/tools/psb_s_glob_transpose.F90 @@ -93,9 +93,6 @@ ! persistent collectives. ! ! -#undef SP_A2AV_MPI -#undef SP_A2AV_XI -#define SP_A2AV_TRIAD subroutine psb_ls_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) #ifdef MPI_MOD use mpi @@ -287,33 +284,38 @@ subroutine psb_ls_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) nzl = acoo%get_nzeros() call acoo%ensure_size(nzl+iszr) -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if diff --git a/base/tools/psb_ssphalo.F90 b/base/tools/psb_ssphalo.F90 index eedad8ee..a7c914c0 100644 --- a/base/tools/psb_ssphalo.F90 +++ b/base/tools/psb_ssphalo.F90 @@ -70,9 +70,6 @@ ! psb_comm_ext_ use ext_index ! psb_comm_ovrl_ DISABLED for this routine. ! -#undef SP_A2AV_MPI -#undef SP_A2AV_XI -#define SP_A2AV_TRIAD Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) use psb_base_mod, psb_protect_name => psb_ssphalo @@ -329,32 +326,36 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_errpush(info,name,a_err=ch_err); goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) - if (minfo == mpi_success) & + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & iarcv,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) + if (minfo == mpi_success) & & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& & iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & iarcv,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & jarcv,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -421,32 +422,36 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -764,32 +769,37 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if @@ -1115,33 +1125,36 @@ Subroutine psb_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if diff --git a/base/tools/psb_z_glob_transpose.F90 b/base/tools/psb_z_glob_transpose.F90 index b8ff2e03..1d087bd3 100644 --- a/base/tools/psb_z_glob_transpose.F90 +++ b/base/tools/psb_z_glob_transpose.F90 @@ -93,9 +93,6 @@ ! persistent collectives. ! ! -#undef SP_A2AV_MPI -#undef SP_A2AV_XI -#define SP_A2AV_TRIAD subroutine psb_lz_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) #ifdef MPI_MOD use mpi @@ -287,33 +284,38 @@ subroutine psb_lz_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) nzl = acoo%get_nzeros() call acoo%ensure_size(nzl+iszr) -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index 925ccc3c..434680c4 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -70,9 +70,6 @@ ! psb_comm_ext_ use ext_index ! psb_comm_ovrl_ DISABLED for this routine. ! -#undef SP_A2AV_MPI -#undef SP_A2AV_XI -#define SP_A2AV_TRIAD Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) use psb_base_mod, psb_protect_name => psb_zsphalo @@ -329,32 +326,36 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_errpush(info,name,a_err=ch_err); goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) - if (minfo == mpi_success) & + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & iarcv,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) + if (minfo == mpi_success) & & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& & iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & iarcv,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & jarcv,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -421,32 +422,36 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -764,32 +769,37 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if @@ -1115,33 +1125,36 @@ Subroutine psb_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_TRIAD) - call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) -#else - choke on me @! -#endif + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if