fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

New get_a2av_alg() in place of conditional compilation

Browse Source
pizdaint-runs
Salvatore Filippone 5 years ago
parent 6b2fa31ae1
commit 27bf7ec666
10 changed files with 603 additions and 504 deletions
Show Stats Download Patch File Download Diff File

12
base/modules/desc/psb_desc_const_mod.f90
Unescape Escape View File

@ -104,9 +104,17 @@ module psb_desc_const_mod
integer(psb_ipk_), parameter :: psb_hash_bits = 16 integer(psb_ipk_), parameter :: psb_hash_bits = 16
integer(psb_ipk_), parameter :: psb_max_hash_bits = 22 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_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_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 ! Constants for desc_a handling
! !

35
base/modules/desc/psb_desc_mod.F90
Unescape Escape View File

@ -294,7 +294,15 @@ module psb_desc_mod
module procedure psb_l_cd_set_large_threshold module procedure psb_l_cd_set_large_threshold
end interface psb_cd_set_large_threshold end interface psb_cd_set_large_threshold
#endif #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,& private :: nullify_desc, cd_get_fmt,&
& cd_l2gs1, cd_l2gs2, cd_l2gv1, cd_l2gv2, cd_g2ls1,& & cd_l2gs1, cd_l2gs2, cd_l2gv1, cd_l2gv2, cd_g2ls1,&
& cd_g2ls2, cd_g2lv1, cd_g2lv2, cd_g2ls1_ins,& & 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_lpk_), private, save :: cd_large_threshold = psb_default_large_threshold
integer(psb_ipk_), private, save :: sp_a2av_alg = psb_sp_a2av_smpl_triad_
contains 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) function psb_cd_sizeof(desc) result(val)
implicit none implicit none
!....Parameters... !....Parameters...

58
base/tools/psb_c_glob_transpose.F90
Unescape Escape View File

@ -93,9 +93,6 @@
! persistent collectives. ! 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) subroutine psb_lc_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi 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() nzl = acoo%get_nzeros()
call acoo%ensure_size(nzl+iszr) call acoo%ensure_size(nzl+iszr)
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),&
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
& acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) case(psb_sp_a2av_smpl_v_)
if (minfo == mpi_success) & call psb_simple_a2av(valsnd,sdsz,bsdindx,&
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
& acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
if (minfo /= mpi_success) info = minfo & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
#elif defined(SP_A2AV_XI) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
call psb_simple_a2av(valsnd,sdsz,bsdindx,& & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
& acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) case(psb_sp_a2av_mpi_)
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,&
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo)
& acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) if (minfo == mpi_success) &
#elif defined(SP_A2AV_TRIAD) & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
& acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& if (minfo == mpi_success) &
& acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
#else & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
choke on me @! if (minfo /= mpi_success) info = minfo
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='alltoallv')
goto 9999 goto 9999
end if end if

207
base/tools/psb_csphalo.F90
Unescape Escape View File

@ -70,9 +70,6 @@
! psb_comm_ext_ use ext_index ! psb_comm_ext_ use ext_index
! psb_comm_ovrl_ DISABLED for this routine. ! 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,& Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data) & rowscale,colscale,outfmt,data)
use psb_base_mod, psb_protect_name => psb_csphalo 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 call psb_errpush(info,name,a_err=ch_err); goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & 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_,& & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
if (minfo == mpi_success) & if (minfo == mpi_success) &
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
if (minfo /= mpi_success) info = minfo if (minfo /= mpi_success) info = minfo
#elif defined(SP_A2AV_XI) case default
call psb_simple_a2av(valsnd,sdsz,bsdindx,& info = psb_err_internal_error_
& acoo%val,rvsz,brvindx,ictxt,info) call psb_errpush(info,name,a_err='wrong A2AV alg selector')
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& goto 9999
& iarcv,rvsz,brvindx,ictxt,info) end select
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 (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoallv' ch_err='alltoallv'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -421,32 +422,36 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
goto 9999 goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& case(psb_sp_a2av_smpl_v_)
& acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) call psb_simple_a2av(valsnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & acoo%ia,rvsz,brvindx,ictxt,info)
if (minfo /= mpi_success) info = minfo if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
#elif defined(SP_A2AV_XI) & acoo%ja,rvsz,brvindx,ictxt,info)
call psb_simple_a2av(valsnd,sdsz,bsdindx,& case(psb_sp_a2av_mpi_)
& acoo%val,rvsz,brvindx,ictxt,info) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,&
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo)
& acoo%ia,rvsz,brvindx,ictxt,info) if (minfo == mpi_success) &
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#elif defined(SP_A2AV_TRIAD) if (minfo == mpi_success) &
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#else if (minfo /= mpi_success) info = minfo
choke on me @! case default
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoallv' ch_err='alltoallv'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -764,32 +769,37 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
goto 9999 goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& case(psb_sp_a2av_smpl_v_)
& acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) call psb_simple_a2av(valsnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & acoo%ia,rvsz,brvindx,ictxt,info)
if (minfo /= mpi_success) info = minfo if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
#elif defined(SP_A2AV_XI) & acoo%ja,rvsz,brvindx,ictxt,info)
call psb_simple_a2av(valsnd,sdsz,bsdindx,& case(psb_sp_a2av_mpi_)
& acoo%val,rvsz,brvindx,ictxt,info)
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,&
& acoo%ia,rvsz,brvindx,ictxt,info) & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo)
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& if (minfo == mpi_success) &
& acoo%ja,rvsz,brvindx,ictxt,info) & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
#elif defined(SP_A2AV_TRIAD) & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& if (minfo == mpi_success) &
& acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
#else & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
choke on me @! if (minfo /= mpi_success) info = minfo
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='alltoallv')
goto 9999 goto 9999
end if end if
@ -1115,33 +1125,36 @@ Subroutine psb_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
goto 9999 goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& case(psb_sp_a2av_smpl_v_)
& acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) call psb_simple_a2av(valsnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & acoo%ia,rvsz,brvindx,ictxt,info)
if (minfo /= mpi_success) info = minfo if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
#elif defined(SP_A2AV_XI) & acoo%ja,rvsz,brvindx,ictxt,info)
call psb_simple_a2av(valsnd,sdsz,bsdindx,& case(psb_sp_a2av_mpi_)
& acoo%val,rvsz,brvindx,ictxt,info) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,&
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo)
& acoo%ia,rvsz,brvindx,ictxt,info) if (minfo == mpi_success) &
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#elif defined(SP_A2AV_TRIAD) if (minfo == mpi_success) &
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#else if (minfo /= mpi_success) info = minfo
choke on me @! case default
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='alltoallv')
goto 9999 goto 9999
end if end if

58
base/tools/psb_d_glob_transpose.F90
Unescape Escape View File

@ -93,9 +93,6 @@
! persistent collectives. ! 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) subroutine psb_ld_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi 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() nzl = acoo%get_nzeros()
call acoo%ensure_size(nzl+iszr) call acoo%ensure_size(nzl+iszr)
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),&
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
& acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) case(psb_sp_a2av_smpl_v_)
if (minfo == mpi_success) & call psb_simple_a2av(valsnd,sdsz,bsdindx,&
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
& acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
if (minfo /= mpi_success) info = minfo & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
#elif defined(SP_A2AV_XI) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
call psb_simple_a2av(valsnd,sdsz,bsdindx,& & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
& acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) case(psb_sp_a2av_mpi_)
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,&
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo)
& acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) if (minfo == mpi_success) &
#elif defined(SP_A2AV_TRIAD) & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
& acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& if (minfo == mpi_success) &
& acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
#else & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
choke on me @! if (minfo /= mpi_success) info = minfo
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='alltoallv')
goto 9999 goto 9999
end if end if

207
base/tools/psb_dsphalo.F90
Unescape Escape View File

@ -70,9 +70,6 @@
! psb_comm_ext_ use ext_index ! psb_comm_ext_ use ext_index
! psb_comm_ovrl_ DISABLED for this routine. ! 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,& Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data) & rowscale,colscale,outfmt,data)
use psb_base_mod, psb_protect_name => psb_dsphalo 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 call psb_errpush(info,name,a_err=ch_err); goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & 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_,& & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
if (minfo == mpi_success) & if (minfo == mpi_success) &
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
if (minfo /= mpi_success) info = minfo if (minfo /= mpi_success) info = minfo
#elif defined(SP_A2AV_XI) case default
call psb_simple_a2av(valsnd,sdsz,bsdindx,& info = psb_err_internal_error_
& acoo%val,rvsz,brvindx,ictxt,info) call psb_errpush(info,name,a_err='wrong A2AV alg selector')
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& goto 9999
& iarcv,rvsz,brvindx,ictxt,info) end select
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 (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoallv' ch_err='alltoallv'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -421,32 +422,36 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
goto 9999 goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& case(psb_sp_a2av_smpl_v_)
& acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) call psb_simple_a2av(valsnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & acoo%ia,rvsz,brvindx,ictxt,info)
if (minfo /= mpi_success) info = minfo if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
#elif defined(SP_A2AV_XI) & acoo%ja,rvsz,brvindx,ictxt,info)
call psb_simple_a2av(valsnd,sdsz,bsdindx,& case(psb_sp_a2av_mpi_)
& acoo%val,rvsz,brvindx,ictxt,info) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,&
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo)
& acoo%ia,rvsz,brvindx,ictxt,info) if (minfo == mpi_success) &
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#elif defined(SP_A2AV_TRIAD) if (minfo == mpi_success) &
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#else if (minfo /= mpi_success) info = minfo
choke on me @! case default
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoallv' ch_err='alltoallv'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -764,32 +769,37 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
goto 9999 goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& case(psb_sp_a2av_smpl_v_)
& acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) call psb_simple_a2av(valsnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & acoo%ia,rvsz,brvindx,ictxt,info)
if (minfo /= mpi_success) info = minfo if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
#elif defined(SP_A2AV_XI) & acoo%ja,rvsz,brvindx,ictxt,info)
call psb_simple_a2av(valsnd,sdsz,bsdindx,& case(psb_sp_a2av_mpi_)
& acoo%val,rvsz,brvindx,ictxt,info)
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,&
& acoo%ia,rvsz,brvindx,ictxt,info) & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo)
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& if (minfo == mpi_success) &
& acoo%ja,rvsz,brvindx,ictxt,info) & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
#elif defined(SP_A2AV_TRIAD) & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& if (minfo == mpi_success) &
& acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
#else & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
choke on me @! if (minfo /= mpi_success) info = minfo
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='alltoallv')
goto 9999 goto 9999
end if end if
@ -1115,33 +1125,36 @@ Subroutine psb_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
goto 9999 goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& case(psb_sp_a2av_smpl_v_)
& acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) call psb_simple_a2av(valsnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & acoo%ia,rvsz,brvindx,ictxt,info)
if (minfo /= mpi_success) info = minfo if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
#elif defined(SP_A2AV_XI) & acoo%ja,rvsz,brvindx,ictxt,info)
call psb_simple_a2av(valsnd,sdsz,bsdindx,& case(psb_sp_a2av_mpi_)
& acoo%val,rvsz,brvindx,ictxt,info) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,&
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo)
& acoo%ia,rvsz,brvindx,ictxt,info) if (minfo == mpi_success) &
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#elif defined(SP_A2AV_TRIAD) if (minfo == mpi_success) &
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#else if (minfo /= mpi_success) info = minfo
choke on me @! case default
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='alltoallv')
goto 9999 goto 9999
end if end if

58
base/tools/psb_s_glob_transpose.F90
Unescape Escape View File

@ -93,9 +93,6 @@
! persistent collectives. ! 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) subroutine psb_ls_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi 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() nzl = acoo%get_nzeros()
call acoo%ensure_size(nzl+iszr) call acoo%ensure_size(nzl+iszr)
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),&
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
& acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) case(psb_sp_a2av_smpl_v_)
if (minfo == mpi_success) & call psb_simple_a2av(valsnd,sdsz,bsdindx,&
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
& acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
if (minfo /= mpi_success) info = minfo & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
#elif defined(SP_A2AV_XI) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
call psb_simple_a2av(valsnd,sdsz,bsdindx,& & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
& acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) case(psb_sp_a2av_mpi_)
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,&
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo)
& acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) if (minfo == mpi_success) &
#elif defined(SP_A2AV_TRIAD) & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
& acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& if (minfo == mpi_success) &
& acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
#else & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
choke on me @! if (minfo /= mpi_success) info = minfo
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='alltoallv')
goto 9999 goto 9999
end if end if

207
base/tools/psb_ssphalo.F90
Unescape Escape View File

@ -70,9 +70,6 @@
! psb_comm_ext_ use ext_index ! psb_comm_ext_ use ext_index
! psb_comm_ovrl_ DISABLED for this routine. ! 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,& Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data) & rowscale,colscale,outfmt,data)
use psb_base_mod, psb_protect_name => psb_ssphalo 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 call psb_errpush(info,name,a_err=ch_err); goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & 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_,& & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
if (minfo == mpi_success) & if (minfo == mpi_success) &
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
if (minfo /= mpi_success) info = minfo if (minfo /= mpi_success) info = minfo
#elif defined(SP_A2AV_XI) case default
call psb_simple_a2av(valsnd,sdsz,bsdindx,& info = psb_err_internal_error_
& acoo%val,rvsz,brvindx,ictxt,info) call psb_errpush(info,name,a_err='wrong A2AV alg selector')
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& goto 9999
& iarcv,rvsz,brvindx,ictxt,info) end select
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 (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoallv' ch_err='alltoallv'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -421,32 +422,36 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
goto 9999 goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& case(psb_sp_a2av_smpl_v_)
& acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) call psb_simple_a2av(valsnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & acoo%ia,rvsz,brvindx,ictxt,info)
if (minfo /= mpi_success) info = minfo if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
#elif defined(SP_A2AV_XI) & acoo%ja,rvsz,brvindx,ictxt,info)
call psb_simple_a2av(valsnd,sdsz,bsdindx,& case(psb_sp_a2av_mpi_)
& acoo%val,rvsz,brvindx,ictxt,info) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,&
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo)
& acoo%ia,rvsz,brvindx,ictxt,info) if (minfo == mpi_success) &
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#elif defined(SP_A2AV_TRIAD) if (minfo == mpi_success) &
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#else if (minfo /= mpi_success) info = minfo
choke on me @! case default
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoallv' ch_err='alltoallv'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -764,32 +769,37 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
goto 9999 goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& case(psb_sp_a2av_smpl_v_)
& acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) call psb_simple_a2av(valsnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & acoo%ia,rvsz,brvindx,ictxt,info)
if (minfo /= mpi_success) info = minfo if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
#elif defined(SP_A2AV_XI) & acoo%ja,rvsz,brvindx,ictxt,info)
call psb_simple_a2av(valsnd,sdsz,bsdindx,& case(psb_sp_a2av_mpi_)
& acoo%val,rvsz,brvindx,ictxt,info)
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,&
& acoo%ia,rvsz,brvindx,ictxt,info) & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo)
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& if (minfo == mpi_success) &
& acoo%ja,rvsz,brvindx,ictxt,info) & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
#elif defined(SP_A2AV_TRIAD) & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& if (minfo == mpi_success) &
& acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
#else & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
choke on me @! if (minfo /= mpi_success) info = minfo
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='alltoallv')
goto 9999 goto 9999
end if end if
@ -1115,33 +1125,36 @@ Subroutine psb_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
goto 9999 goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& case(psb_sp_a2av_smpl_v_)
& acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) call psb_simple_a2av(valsnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & acoo%ia,rvsz,brvindx,ictxt,info)
if (minfo /= mpi_success) info = minfo if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
#elif defined(SP_A2AV_XI) & acoo%ja,rvsz,brvindx,ictxt,info)
call psb_simple_a2av(valsnd,sdsz,bsdindx,& case(psb_sp_a2av_mpi_)
& acoo%val,rvsz,brvindx,ictxt,info) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,&
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo)
& acoo%ia,rvsz,brvindx,ictxt,info) if (minfo == mpi_success) &
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#elif defined(SP_A2AV_TRIAD) if (minfo == mpi_success) &
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#else if (minfo /= mpi_success) info = minfo
choke on me @! case default
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='alltoallv')
goto 9999 goto 9999
end if end if

58
base/tools/psb_z_glob_transpose.F90
Unescape Escape View File

@ -93,9 +93,6 @@
! persistent collectives. ! 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) subroutine psb_lz_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi 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() nzl = acoo%get_nzeros()
call acoo%ensure_size(nzl+iszr) call acoo%ensure_size(nzl+iszr)
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),&
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
& acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) case(psb_sp_a2av_smpl_v_)
if (minfo == mpi_success) & call psb_simple_a2av(valsnd,sdsz,bsdindx,&
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
& acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
if (minfo /= mpi_success) info = minfo & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
#elif defined(SP_A2AV_XI) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
call psb_simple_a2av(valsnd,sdsz,bsdindx,& & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info)
& acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) case(psb_sp_a2av_mpi_)
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,&
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo)
& acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) if (minfo == mpi_success) &
#elif defined(SP_A2AV_TRIAD) & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
& acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& if (minfo == mpi_success) &
& acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
#else & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
choke on me @! if (minfo /= mpi_success) info = minfo
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='alltoallv')
goto 9999 goto 9999
end if end if

207
base/tools/psb_zsphalo.F90
Unescape Escape View File

@ -70,9 +70,6 @@
! psb_comm_ext_ use ext_index ! psb_comm_ext_ use ext_index
! psb_comm_ovrl_ DISABLED for this routine. ! 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,& Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data) & rowscale,colscale,outfmt,data)
use psb_base_mod, psb_protect_name => psb_zsphalo 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 call psb_errpush(info,name,a_err=ch_err); goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & 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_,& & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
if (minfo == mpi_success) & if (minfo == mpi_success) &
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
if (minfo /= mpi_success) info = minfo if (minfo /= mpi_success) info = minfo
#elif defined(SP_A2AV_XI) case default
call psb_simple_a2av(valsnd,sdsz,bsdindx,& info = psb_err_internal_error_
& acoo%val,rvsz,brvindx,ictxt,info) call psb_errpush(info,name,a_err='wrong A2AV alg selector')
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& goto 9999
& iarcv,rvsz,brvindx,ictxt,info) end select
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 (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoallv' ch_err='alltoallv'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -421,32 +422,36 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
goto 9999 goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& case(psb_sp_a2av_smpl_v_)
& acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) call psb_simple_a2av(valsnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & acoo%ia,rvsz,brvindx,ictxt,info)
if (minfo /= mpi_success) info = minfo if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
#elif defined(SP_A2AV_XI) & acoo%ja,rvsz,brvindx,ictxt,info)
call psb_simple_a2av(valsnd,sdsz,bsdindx,& case(psb_sp_a2av_mpi_)
& acoo%val,rvsz,brvindx,ictxt,info) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,&
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo)
& acoo%ia,rvsz,brvindx,ictxt,info) if (minfo == mpi_success) &
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#elif defined(SP_A2AV_TRIAD) if (minfo == mpi_success) &
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#else if (minfo /= mpi_success) info = minfo
choke on me @! case default
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoallv' ch_err='alltoallv'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -764,32 +769,37 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
goto 9999 goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& case(psb_sp_a2av_smpl_v_)
& acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) call psb_simple_a2av(valsnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & acoo%ia,rvsz,brvindx,ictxt,info)
if (minfo /= mpi_success) info = minfo if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
#elif defined(SP_A2AV_XI) & acoo%ja,rvsz,brvindx,ictxt,info)
call psb_simple_a2av(valsnd,sdsz,bsdindx,& case(psb_sp_a2av_mpi_)
& acoo%val,rvsz,brvindx,ictxt,info)
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,&
& acoo%ia,rvsz,brvindx,ictxt,info) & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo)
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& if (minfo == mpi_success) &
& acoo%ja,rvsz,brvindx,ictxt,info) & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
#elif defined(SP_A2AV_TRIAD) & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& if (minfo == mpi_success) &
& acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
#else & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
choke on me @! if (minfo /= mpi_success) info = minfo
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='alltoallv')
goto 9999 goto 9999
end if end if
@ -1115,33 +1125,36 @@ Subroutine psb_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
goto 9999 goto 9999
end if end if
#if defined(SP_A2AV_MPI) select case(psb_get_sp_a2av_alg())
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& case(psb_sp_a2av_smpl_triad_)
& acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& case(psb_sp_a2av_smpl_v_)
& acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) call psb_simple_a2av(valsnd,sdsz,bsdindx,&
if (minfo == mpi_success) & & acoo%val,rvsz,brvindx,ictxt,info)
& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) & acoo%ia,rvsz,brvindx,ictxt,info)
if (minfo /= mpi_success) info = minfo if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
#elif defined(SP_A2AV_XI) & acoo%ja,rvsz,brvindx,ictxt,info)
call psb_simple_a2av(valsnd,sdsz,bsdindx,& case(psb_sp_a2av_mpi_)
& acoo%val,rvsz,brvindx,ictxt,info) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,&
if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo)
& acoo%ia,rvsz,brvindx,ictxt,info) if (minfo == mpi_success) &
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#elif defined(SP_A2AV_TRIAD) if (minfo == mpi_success) &
call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,&
& acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
#else if (minfo /= mpi_success) info = minfo
choke on me @! case default
#endif 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='alltoallv')
goto 9999 goto 9999
end if end if

Write Preview
Loading…
Cancel
Save