fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 21:02:26 +00:00
Code Issues Packages Projects Releases Wiki Activity

Changes for --enable-serial

Browse Source
This commit is contained in:
sfilippone
2025-03-08 20:28:14 +01:00
parent 39b5886b63
commit e42dfbe4f7
18 changed files with 533 additions and 463 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/comm/psb_cspgather.F90
+25 -22
View File
@@ -48,6 +48,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -62,7 +63,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_c_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_c_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_ipk_) :: nrg, ncg, nzg, nzl
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k
@@ -156,27 +157,27 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
enddo
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_c_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_spk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(locia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((locia),ndx,psb_mpi_lpk_,&
& glbia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(locja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((locja),ndx,psb_mpi_lpk_,&
& glbja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_spk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_c_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_spk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(locia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((locia),ndx,psb_mpi_lpk_,&
& glbia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(locja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((locja),ndx,psb_mpi_lpk_,&
& glbja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
@@ -231,6 +232,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -245,7 +247,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_lc_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_lc_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
@@ -337,27 +339,27 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
enddo
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_c_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_spk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_spk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_c_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_spk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
end if
@@ -369,7 +371,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
call loc_coo%free()
!
! Is the code below safe? For very large cases
! the indices in glob_coo will overflow. But then,
! the indices in glob_coo will overflow. But then),
! for very large cases it does not make sense to
! gather the matrix on a single procecss anyway...
!
@@ -403,6 +405,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -417,7 +420,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_lc_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_lc_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
@@ -507,27 +510,27 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_c_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_spk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_spk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_c_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_spk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
end if
base/comm/psb_dspgather.F90
+25 -22
View File
@@ -48,6 +48,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -62,7 +63,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_d_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_d_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_ipk_) :: nrg, ncg, nzg, nzl
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k
@@ -156,27 +157,27 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
enddo
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_r_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_dpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(locia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((locia),ndx,psb_mpi_lpk_,&
& glbia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(locja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((locja),ndx,psb_mpi_lpk_,&
& glbja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_r_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_dpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(locia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((locia),ndx,psb_mpi_lpk_,&
& glbia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(locja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((locja),ndx,psb_mpi_lpk_,&
& glbja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
@@ -231,6 +232,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -245,7 +247,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_ld_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_ld_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
@@ -337,27 +339,27 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
enddo
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_r_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_dpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_r_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_dpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
end if
@@ -369,7 +371,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
call loc_coo%free()
!
! Is the code below safe? For very large cases
! the indices in glob_coo will overflow. But then,
! the indices in glob_coo will overflow. But then),
! for very large cases it does not make sense to
! gather the matrix on a single procecss anyway...
!
@@ -403,6 +405,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -417,7 +420,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_ld_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_ld_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
@@ -507,27 +510,27 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_r_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_dpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_r_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_dpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
end if
base/comm/psb_ispgather.F90
+25 -22
View File
@@ -48,6 +48,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -62,7 +63,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_i_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_i_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_ipk_) :: nrg, ncg, nzg, nzl
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k
@@ -156,27 +157,27 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
enddo
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_ipk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_ipk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(locia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((locia),ndx,psb_mpi_lpk_,&
& glbia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(locja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((locja),ndx,psb_mpi_lpk_,&
& glbja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_ipk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_ipk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_ipk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(locia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((locia),ndx,psb_mpi_lpk_,&
& glbia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(locja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((locja),ndx,psb_mpi_lpk_,&
& glbja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
@@ -231,6 +232,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -245,7 +247,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_@LX@_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_@LX@_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
@@ -337,27 +339,27 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
enddo
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_ipk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_ipk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_ipk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_ipk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_ipk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
end if
@@ -369,7 +371,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
call loc_coo%free()
!
! Is the code below safe? For very large cases
! the indices in glob_coo will overflow. But then,
! the indices in glob_coo will overflow. But then),
! for very large cases it does not make sense to
! gather the matrix on a single procecss anyway...
!
@@ -403,6 +405,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -417,7 +420,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_@LX@_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_@LX@_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
@@ -507,27 +510,27 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_ipk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_ipk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_ipk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_ipk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_ipk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
end if
base/comm/psb_lspgather.F90
+25 -22
View File
@@ -48,6 +48,7 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -62,7 +63,7 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_l_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_l_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_ipk_) :: nrg, ncg, nzg, nzl
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k
@@ -156,27 +157,27 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
enddo
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_lpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(locia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((locia),ndx,psb_mpi_lpk_,&
& glbia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(locja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((locja),ndx,psb_mpi_lpk_,&
& glbja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_lpk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_lpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(locia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((locia),ndx,psb_mpi_lpk_,&
& glbia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(locja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((locja),ndx,psb_mpi_lpk_,&
& glbja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
@@ -231,6 +232,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -245,7 +247,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_@LX@_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_@LX@_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
@@ -337,27 +339,27 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
enddo
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_lpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_lpk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_lpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
end if
@@ -369,7 +371,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
call loc_coo%free()
!
! Is the code below safe? For very large cases
! the indices in glob_coo will overflow. But then,
! the indices in glob_coo will overflow. But then),
! for very large cases it does not make sense to
! gather the matrix on a single procecss anyway...
!
@@ -403,6 +405,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -417,7 +420,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_@LX@_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_@LX@_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
@@ -507,27 +510,27 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_lpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_lpk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_lpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
end if
base/comm/psb_sspgather.F90
+25 -22
View File
@@ -48,6 +48,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -62,7 +63,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_s_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_s_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_ipk_) :: nrg, ncg, nzg, nzl
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k
@@ -156,27 +157,27 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
enddo
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_r_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_spk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(locia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((locia),ndx,psb_mpi_lpk_,&
& glbia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(locja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((locja),ndx,psb_mpi_lpk_,&
& glbja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_spk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_r_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_spk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(locia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((locia),ndx,psb_mpi_lpk_,&
& glbia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(locja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((locja),ndx,psb_mpi_lpk_,&
& glbja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
@@ -231,6 +232,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -245,7 +247,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_ls_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_ls_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
@@ -337,27 +339,27 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
enddo
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_r_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_spk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_spk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_r_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_spk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
end if
@@ -369,7 +371,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
call loc_coo%free()
!
! Is the code below safe? For very large cases
! the indices in glob_coo will overflow. But then,
! the indices in glob_coo will overflow. But then),
! for very large cases it does not make sense to
! gather the matrix on a single procecss anyway...
!
@@ -403,6 +405,7 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -417,7 +420,7 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_ls_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_ls_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
@@ -507,27 +510,27 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_r_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_spk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_spk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_r_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_spk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
end if
base/comm/psb_zspgather.F90
+25 -22
View File
@@ -48,6 +48,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -62,7 +63,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_z_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_z_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_ipk_) :: nrg, ncg, nzg, nzl
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k
@@ -156,27 +157,27 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
enddo
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_c_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_dpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(locia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((locia),ndx,psb_mpi_lpk_,&
& glbia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(locja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((locja),ndx,psb_mpi_lpk_,&
& glbja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_c_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_dpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(locia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((locia),ndx,psb_mpi_lpk_,&
& glbia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(locja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((locja),ndx,psb_mpi_lpk_,&
& glbja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
@@ -231,6 +232,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -245,7 +247,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_lz_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_lz_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
@@ -337,27 +339,27 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
enddo
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_c_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_dpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_c_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_dpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
end if
@@ -369,7 +371,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
call loc_coo%free()
!
! Is the code below safe? For very large cases
! the indices in glob_coo will overflow. But then,
! the indices in glob_coo will overflow. But then),
! for very large cases it does not make sense to
! gather the matrix on a single procecss anyway...
!
@@ -403,6 +405,7 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
use mpi
#endif
@@ -417,7 +420,7 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_lz_coo_sparse_mat) :: loc_coo, glob_coo
type(psb_lz_coo_sparse_mat), target :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
@@ -507,27 +510,27 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
ndx = nzbr(me+1)
if (root_ == -1) then
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,&
call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_c_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_dpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,&
call mpi_gatherv((loc_coo%val),ndx,psb_mpi_c_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_dpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,root_,icomm,minfo)
end if
base/modules/Makefile
+2
View File
@@ -116,6 +116,7 @@ UTIL_MODS = desc/psb_desc_const_mod.o desc/psb_indx_map_mod.o\
MODULES=$(BASIC_MODS) $(SERIAL_MODS) $(UTIL_MODS)
OBJS = error.o psb_base_mod.o $(EXTRA_COBJS) cutil.o
MODDIR=../../modules
INCDIR=../../include
LIBDIR=../
CINCLUDES=-I.
FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG). $(FIFLAG).
@@ -123,6 +124,7 @@ FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG). $(FIFLAG).
objs: $(MODULES) $(OBJS) $(MPFOBJS)
/bin/cp -p $(CPUPDFLAG) *$(.mod) $(MODDIR)
/bin/cp -p $(CPUPDFLAG) *.h $(INCDIR)
lib: objs $(LIBDIR)/$(LIBNAME)
base/modules/fakempi.c
+109 -178
View File
@@ -3,105 +3,6 @@
#include <string.h>
#include "psb_internals.h"
#ifdef LowerUnderscore
#define mpi_wtime mpi_wtime_
#define mpi_send mpi_send_
#define mpi_isend mpi_isend_
#define mpi_irecv mpi_irecv_
#define mpi_wait mpi_wait_
#define mpi_alltoall mpi_alltoall_
#define mpi_alltoallv mpi_alltoallv_
#define mpi_gather mpi_gather_
#define mpi_gatherv mpi_gatherv_
#define mpi_allgather mpi_allgather_
#define mpi_allgatherv mpi_allgatherv_
#define mpi_scatterv mpi_scatterv_
#define mpi_scatter mpi_scatter_
#endif
#ifdef LowerDoubleUnderscore
#define mpi_wtime mpi_wtime__
#define mpi_send mpi_send__
#define mpi_isend mpi_isend__
#define mpi_irecv mpi_irecv__
#define mpi_wait mpi_wait__
#define mpi_alltoall mpi_alltoall__
#define mpi_alltoallv mpi_alltoallv__
#define mpi_gather mpi_gather__
#define mpi_gatherv mpi_gatherv__
#define mpi_allgather mpi_allgather__
#define mpi_allgatherv mpi_allgatherv__
#define mpi_scatterv mpi_scatterv__
#define mpi_scatter mpi_scatter__
#endif
#ifdef LowerCase
#define mpi_wtime mpi_wtime
#define mpi_send mpi_send
#define mpi_isend mpi_isend
#define mpi_irecv mpi_irecv
#define mpi_wait mpi_wait
#define mpi_alltoall mpi_alltoall
#define mpi_alltoallv mpi_alltoallv
#define mpi_gather mpi_gather
#define mpi_gatherv mpi_gatherv
#define mpi_allgather mpi_allgather
#define mpi_allgatherv mpi_allgatherv
#define mpi_scatterv mpi_scatterv
#define mpi_scatter mpi_scatter
#endif
#ifdef UpperUnderscore
#define mpi_wtime MPI_WTIME_
#define mpi_send MPI_SEND_
#define mpi_isend MPI_ISEND_
#define mpi_irecv MPI_IRECV_
#define mpi_wait MPI_WAIT_
#define mpi_alltoall MPI_ALLTOALL_
#define mpi_alltoallv MPI_ALLTOALLV_
#define mpi_gather MPI_GATHER_
#define mpi_gatherv MPI_GATHERV_
#define mpi_allgather MPI_ALLGATHER_
#define mpi_allgatherv MPI_ALLGATHERV_
#define mpi_scatterv MPI_SCATTERV_
#define mpi_scatter MPI_SCATTER_
#endif
#ifdef UpperDoubleUnderscore
#define mpi_wtime MPI_WTIME__
#define mpi_send MPI_SEND__
#define mpi_isend MPI_ISEND__
#define mpi_irecv MPI_IRECV__
#define mpi_wait MPI_WAIT__
#define mpi_alltoall MPI_ALLTOALL__
#define mpi_alltoallv MPI_ALLTOALLV__
#define mpi_gather MPI_GATHER__
#define mpi_gatherv MPI_GATHERV__
#define mpi_allgather MPI_ALLGATHER__
#define mpi_allgatherv MPI_ALLGATHERV__
#define mpi_scatterv MPI_SCATTERV__
#define mpi_scatter MPI_SCATTER__
#endif
#ifdef UpperCase
#define mpi_wtime MPI_WTIME
#define mpi_send MPI_SEND
#define mpi_isend MPI_ISEND
#define mpi_irecv MPI_IRECV
#define mpi_wait MPI_WAIT
#define mpi_alltoall MPI_ALLTOALL
#define mpi_alltoallv MPI_ALLTOALLV
#define mpi_gather MPI_GATHER
#define mpi_gatherv MPI_GATHERV
#define mpi_allgather MPI_ALLGATHER
#define mpi_allgatherv MPI_ALLGATHERV
#define mpi_scatterv MPI_SCATTERV
#define mpi_scatter MPI_SCATTER
#endif
#define mpi_integer 1
#define mpi_integer8 2
#define mpi_real 3
#define mpi_double 4
#define mpi_complex 5
#define mpi_double_complex 6
double mpi_wtime()
{
struct timeval tt;
@@ -150,22 +51,28 @@ void mpi_alltoall(void* sdb, int* sdc, int* sdt,
{
int i,j,k;
if (*sdt == mpi_integer) {
memcpy(rvb,sdb, (*sdc)*sizeof(int));
if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) {
memcpy(rvb,sdb, (*sdc)*sizeof(int32_t));
}
if (*sdt == mpi_integer8) {
memcpy(rvb,sdb, (*sdc)*sizeof(long long));
if (*sdt == MPI_CHARACTER) {
memcpy(rvb,sdb, (*sdc)*sizeof(char));
}
if (*sdt == mpi_real) {
if (*sdt == MPI_INTEGER8) {
memcpy(rvb,sdb, (*sdc)*sizeof(int64_t));
}
if (*sdt == MPI_INTEGER2) {
memcpy(rvb,sdb, (*sdc)*sizeof(int16_t));
}
if (*sdt == MPI_REAL) {
memcpy(rvb,sdb, (*sdc)*sizeof(float));
}
if (*sdt == mpi_double) {
if (*sdt == MPI_DOUBLE) {
memcpy(rvb,sdb, (*sdc)*sizeof(double));
}
if (*sdt == mpi_complex) {
if (*sdt == MPI_COMPLEX) {
memcpy(rvb,sdb, (*sdc)*2*sizeof(float));
}
if (*sdt == mpi_double_complex) {
if (*sdt == MPI_DOUBLE_COMPLEX) {
memcpy(rvb,sdb, (*sdc)*2*sizeof(double));
}
*ierr = 0;
@@ -177,27 +84,31 @@ void mpi_alltoallv(void* sdb, int* sdc, int* sdspl, int* sdt,
int i,j,k;
if (*sdt == mpi_integer) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int)),
(void *)((char *)sdb+sdspl[0]*sizeof(int)),(*sdc)*sizeof(int));
if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int32_t)),
(void *)((char *)sdb+sdspl[0]*sizeof(int32_t)),(*sdc)*sizeof(int32_t));
}
if (*sdt == mpi_integer8) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(long long)),
(void *)((char *)sdb+sdspl[0]*sizeof(long long)),(*sdc)*sizeof(long long));
if (*sdt == MPI_CHARACTER) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(char)),
(void *)((char *)sdb+sdspl[0]*sizeof(char)),(*sdc)*sizeof(char));
}
if (*sdt == mpi_real) {
if (*sdt == MPI_INTEGER8) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int64_t)),
(void *)((char *)sdb+sdspl[0]*sizeof(int64_t)),(*sdc)*sizeof(int64_t));
}
if (*sdt == MPI_REAL) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(float)),
(void *)((char *)sdb+sdspl[0]*sizeof(float)),(*sdc)*sizeof(float));
}
if (*sdt == mpi_double) {
if (*sdt == MPI_DOUBLE) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(double)),
(void *)((char *)sdb+sdspl[0]*sizeof(double)),(*sdc)*sizeof(double));
}
if (*sdt == mpi_complex) {
if (*sdt == MPI_COMPLEX) {
memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(float)),
(void *)((char *)sdb+sdspl[0]*2*sizeof(float)),(*sdc)*2*sizeof(float));
}
if (*sdt == mpi_double_complex) {
if (*sdt == MPI_DOUBLE_COMPLEX) {
memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(double)),
(void *)((char *)sdb+sdspl[0]*2*sizeof(double)),(*sdc)*2*sizeof(double));
}
@@ -210,22 +121,25 @@ void mpi_gather(void* sdb, int* sdc, int* sdt,
{
int i,j,k;
if (*sdt == mpi_integer) {
memcpy(rvb,sdb, (*sdc)*sizeof(int));
if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) {
memcpy(rvb,sdb, (*sdc)*sizeof(int32_t));
}
if (*sdt == mpi_integer8) {
memcpy(rvb,sdb, (*sdc)*sizeof(long long));
if (*sdt == MPI_INTEGER8) {
memcpy(rvb,sdb, (*sdc)*sizeof(int64_t));
}
if (*sdt == mpi_real) {
if (*sdt == MPI_CHARACTER) {
memcpy(rvb,sdb, (*sdc)*sizeof(char));
}
if (*sdt == MPI_REAL) {
memcpy(rvb,sdb, (*sdc)*sizeof(float));
}
if (*sdt == mpi_double) {
if (*sdt == MPI_DOUBLE) {
memcpy(rvb,sdb, (*sdc)*sizeof(double));
}
if (*sdt == mpi_complex) {
if (*sdt == MPI_COMPLEX) {
memcpy(rvb,sdb, (*sdc)*2*sizeof(float));
}
if (*sdt == mpi_double_complex) {
if (*sdt == MPI_DOUBLE_COMPLEX) {
memcpy(rvb,sdb, (*sdc)*2*sizeof(double));
}
*ierr = 0;
@@ -238,27 +152,31 @@ void mpi_gatherv(void* sdb, int* sdc, int* sdt,
{
int i,j,k;
if (*sdt == mpi_integer) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int)),
(void *)((char *)sdb),(*sdc)*sizeof(int));
if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int32_t)),
(void *)((char *)sdb),(*sdc)*sizeof(int32_t));
}
if (*sdt == mpi_integer8) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(long long)),
(void *)((char *)sdb),(*sdc)*sizeof(long long));
if (*sdt == MPI_INTEGER8) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int64_t)),
(void *)((char *)sdb),(*sdc)*sizeof(int64_t));
}
if (*sdt == mpi_real) {
if (*sdt == MPI_CHARACTER) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(char)),
(void *)((char *)sdb),(*sdc)*sizeof(char));
}
if (*sdt == MPI_REAL) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(float)),
(void *)((char *)sdb),(*sdc)*sizeof(float));
}
if (*sdt == mpi_double) {
if (*sdt == MPI_DOUBLE) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(double)),
(void *)((char *)sdb),(*sdc)*sizeof(double));
}
if (*sdt == mpi_complex) {
if (*sdt == MPI_COMPLEX) {
memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(float)),
(void *)((char *)sdb),(*sdc)*2*sizeof(float));
}
if (*sdt == mpi_double_complex) {
if (*sdt == MPI_DOUBLE_COMPLEX) {
memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(double)),
(void *)((char *)sdb),(*sdc)*2*sizeof(double));
}
@@ -273,56 +191,63 @@ void mpi_scatter(void* sdb, int* sdc, int* sdt,
{
int i,j,k;
if (*sdt == mpi_integer) {
memcpy(rvb,sdb, (*sdc)*sizeof(int));
if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) {
memcpy(rvb,sdb, (*sdc)*sizeof(int32_t));
}
if (*sdt == mpi_integer8) {
memcpy(rvb,sdb, (*sdc)*sizeof(long long));
if (*sdt == MPI_CHARACTER) {
memcpy(rvb,sdb, (*sdc)*sizeof(char));
}
if (*sdt == mpi_real) {
if (*sdt == MPI_INTEGER8) {
memcpy(rvb,sdb, (*sdc)*sizeof(int64_t));
}
if (*sdt == MPI_REAL) {
memcpy(rvb,sdb, (*sdc)*sizeof(float));
}
if (*sdt == mpi_double) {
if (*sdt == MPI_DOUBLE) {
memcpy(rvb,sdb, (*sdc)*sizeof(double));
}
if (*sdt == mpi_complex) {
if (*sdt == MPI_COMPLEX) {
memcpy(rvb,sdb, (*sdc)*2*sizeof(float));
}
if (*sdt == mpi_double_complex) {
if (*sdt == MPI_DOUBLE_COMPLEX) {
memcpy(rvb,sdb, (*sdc)*2*sizeof(double));
}
*ierr = 0;
}
void mpi_scatterv(void* sdb, int* sdc, int* sdt,
void* rvb, int* rvc, int* rdspl,
void mpi_scatterv(void* sdb, int* sdc, int* sdspl, int* sdt,
void* rvb, int* rvc,
int* rvt, int* comm, int *root, int* ierr)
{
int i,j,k;
if (*sdt == mpi_integer) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int)),
(void *)((char *)sdb),(*sdc)*sizeof(int));
if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) {
memcpy((void *)((char *)rvb+sdspl[0]*sizeof(int32_t)),
(void *)((char *)sdb),(*sdc)*sizeof(int32_t));
}
if (*sdt == mpi_integer8) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(long long)),
(void *)((char *)sdb),(*sdc)*sizeof(long long));
if (*sdt == MPI_CHARACTER) {
memcpy((void *)((char *)rvb+sdspl[0]*sizeof(char)),
(void *)((char *)sdb),(*sdc)*sizeof(char));
}
if (*sdt == mpi_real) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(float)),
if (*sdt == MPI_INTEGER8) {
memcpy((void *)((char *)rvb+sdspl[0]*sizeof(int64_t)),
(void *)((char *)sdb),(*sdc)*sizeof(int64_t));
}
if (*sdt == MPI_REAL) {
memcpy((void *)((char *)rvb+sdspl[0]*sizeof(float)),
(void *)((char *)sdb),(*sdc)*sizeof(float));
}
if (*sdt == mpi_double) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(double)),
if (*sdt == MPI_DOUBLE) {
memcpy((void *)((char *)rvb+sdspl[0]*sizeof(double)),
(void *)((char *)sdb),(*sdc)*sizeof(double));
}
if (*sdt == mpi_complex) {
memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(float)),
if (*sdt == MPI_COMPLEX) {
memcpy((void *)((char *)rvb+sdspl[0]*2*sizeof(float)),
(void *)((char *)sdb),(*sdc)*2*sizeof(float));
}
if (*sdt == mpi_double_complex) {
memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(double)),
if (*sdt == MPI_DOUBLE_COMPLEX) {
memcpy((void *)((char *)rvb+sdspl[0]*2*sizeof(double)),
(void *)((char *)sdb),(*sdc)*2*sizeof(double));
}
@@ -336,22 +261,25 @@ void mpi_allgather(void* sdb, int* sdc, int* sdt,
{
int i,j,k;
if (*sdt == mpi_integer) {
memcpy(rvb,sdb, (*sdc)*sizeof(int));
if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) {
memcpy(rvb,sdb, (*sdc)*sizeof(int32_t));
}
if (*sdt == mpi_integer8) {
memcpy(rvb,sdb, (*sdc)*sizeof(long long));
if (*sdt == MPI_CHARACTER) {
memcpy(rvb,sdb, (*sdc)*sizeof(char));
}
if (*sdt == mpi_real) {
if (*sdt == MPI_INTEGER8) {
memcpy(rvb,sdb, (*sdc)*sizeof(int64_t));
}
if (*sdt == MPI_REAL) {
memcpy(rvb,sdb, (*sdc)*sizeof(float));
}
if (*sdt == mpi_double) {
if (*sdt == MPI_DOUBLE) {
memcpy(rvb,sdb, (*sdc)*sizeof(double));
}
if (*sdt == mpi_complex) {
if (*sdt == MPI_COMPLEX) {
memcpy(rvb,sdb, (*sdc)*2*sizeof(float));
}
if (*sdt == mpi_double_complex) {
if (*sdt == MPI_DOUBLE_COMPLEX) {
memcpy(rvb,sdb, (*sdc)*2*sizeof(double));
}
*ierr = 0;
@@ -363,31 +291,34 @@ void mpi_allgatherv(void* sdb, int* sdc, int* sdt,
{
int i,j,k;
if (*sdt == mpi_integer) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int)),
(void *)((char *)sdb),(*sdc)*sizeof(int));
if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int32_t)),
(void *)((char *)sdb),(*sdc)*sizeof(int32_t));
}
if (*sdt == mpi_integer8) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(long long)),
(void *)((char *)sdb),(*sdc)*sizeof(long long));
if (*sdt == MPI_CHARACTER) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(char)),
(void *)((char *)sdb),(*sdc)*sizeof(char));
}
if (*sdt == mpi_real) {
if (*sdt == MPI_INTEGER8) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int64_t)),
(void *)((char *)sdb),(*sdc)*sizeof(int64_t));
}
if (*sdt == MPI_REAL) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(float)),
(void *)((char *)sdb),(*sdc)*sizeof(float));
}
if (*sdt == mpi_double) {
if (*sdt == MPI_DOUBLE) {
memcpy((void *)((char *)rvb+rdspl[0]*sizeof(double)),
(void *)((char *)sdb),(*sdc)*sizeof(double));
}
if (*sdt == mpi_complex) {
if (*sdt == MPI_COMPLEX) {
memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(float)),
(void *)((char *)sdb),(*sdc)*2*sizeof(float));
}
if (*sdt == mpi_double_complex) {
if (*sdt == MPI_DOUBLE_COMPLEX) {
memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(double)),
(void *)((char *)sdb),(*sdc)*2*sizeof(double));
}
*ierr = 0;
}
base/modules/penv/psi_c_collective_mod.F90
+21 -20
View File
@@ -32,6 +32,7 @@
module psi_c_collective_mod
use psi_penv_mod
use psb_desc_const_mod
use iso_c_binding
interface psb_gather
@@ -1463,10 +1464,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
complex(psb_spk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
complex(psb_spk_), intent(out) :: valrcv(:)
integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:)
complex(psb_spk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
complex(psb_spk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -1493,14 +1494,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_complex_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_c_spk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -1513,14 +1514,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_complex_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_c_spk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@@ -1546,10 +1547,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
complex(psb_spk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
complex(psb_spk_), intent(out) :: valrcv(:)
integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:)
complex(psb_spk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
complex(psb_spk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -1576,14 +1577,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_complex_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_c_spk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -1596,14 +1597,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_complex_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_c_spk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
base/modules/penv/psi_d_collective_mod.F90
+21 -20
View File
@@ -32,6 +32,7 @@
module psi_d_collective_mod
use psi_penv_mod
use psb_desc_const_mod
use iso_c_binding
interface psb_max
module procedure psb_dmaxs, psb_dmaxv, psb_dmaxm
@@ -2103,10 +2104,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
real(psb_dpk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
real(psb_dpk_), intent(out) :: valrcv(:)
integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:)
real(psb_dpk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
real(psb_dpk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -2133,14 +2134,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_double_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -2153,14 +2154,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_double_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@@ -2186,10 +2187,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
real(psb_dpk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
real(psb_dpk_), intent(out) :: valrcv(:)
integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:)
real(psb_dpk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
real(psb_dpk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -2216,14 +2217,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_double_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -2236,14 +2237,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_double_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
base/modules/penv/psi_e_collective_mod.F90
+21 -20
View File
@@ -32,6 +32,7 @@
module psi_e_collective_mod
use psi_penv_mod
use psb_desc_const_mod
use iso_c_binding
interface psb_max
module procedure psb_emaxs, psb_emaxv, psb_emaxm
@@ -1941,10 +1942,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_epk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
integer(psb_epk_), intent(out) :: valrcv(:)
integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:)
integer(psb_epk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
integer(psb_epk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -1971,14 +1972,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_int8_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -1991,14 +1992,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_int8_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@@ -2024,10 +2025,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_epk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
integer(psb_epk_), intent(out) :: valrcv(:)
integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:)
integer(psb_epk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
integer(psb_epk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -2054,14 +2055,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_int8_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -2074,14 +2075,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_int8_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
base/modules/penv/psi_i2_collective_mod.F90
+21 -20
View File
@@ -32,6 +32,7 @@
module psi_i2_collective_mod
use psi_penv_mod
use psb_desc_const_mod
use iso_c_binding
interface psb_max
module procedure psb_i2maxs, psb_i2maxv, psb_i2maxm
@@ -1941,10 +1942,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_i2pk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
integer(psb_i2pk_), intent(out) :: valrcv(:)
integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:)
integer(psb_i2pk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
integer(psb_i2pk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -1971,14 +1972,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_int2_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_i2pk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -1991,14 +1992,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_int2_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_i2pk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@@ -2024,10 +2025,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_i2pk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
integer(psb_i2pk_), intent(out) :: valrcv(:)
integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:)
integer(psb_i2pk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
integer(psb_i2pk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -2054,14 +2055,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_int2_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_i2pk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -2074,14 +2075,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_int2_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_i2pk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
base/modules/penv/psi_m_collective_mod.F90
+21 -20
View File
@@ -32,6 +32,7 @@
module psi_m_collective_mod
use psi_penv_mod
use psb_desc_const_mod
use iso_c_binding
interface psb_max
module procedure psb_mmaxs, psb_mmaxv, psb_mmaxm
@@ -1941,10 +1942,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
integer(psb_mpk_), intent(out) :: valrcv(:)
integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
integer(psb_mpk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -1971,14 +1972,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_int4_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -1991,14 +1992,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_int4_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@@ -2024,10 +2025,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
integer(psb_mpk_), intent(out) :: valrcv(:)
integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
integer(psb_mpk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -2054,14 +2055,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_int4_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -2074,14 +2075,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_int4_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
base/modules/penv/psi_penv_mod.F90
+122 -10
View File
@@ -33,6 +33,7 @@
! Provide a fake mpi module just to keep the compiler(s) happy.
module mpi
use psb_const_mod
use iso_c_binding
integer(psb_mpk_), parameter :: mpi_success = 0
integer(psb_mpk_), parameter :: mpi_request_null = 0
integer(psb_mpk_), parameter :: mpi_status_size = 1
@@ -49,13 +50,124 @@ module mpi
integer(psb_mpk_), parameter :: mpi_comm_null = -1
integer(psb_mpk_), parameter :: mpi_comm_world = 1
real(psb_dpk_), external :: mpi_wtime
!real(psb_dpk_), external :: mpi_wtime
interface
function mpi_wtime() result(res) bind(c,name='mpi_wtime')
import
end function mpi_wtime
end interface
interface
subroutine mpi_wait(request, status,ierr) bind(c,name='mpi_wait')
import
type(*), dimension(..) :: request
integer(psb_mpk_) :: status(*)
integer(psb_mpk_) :: ierr
end subroutine mpi_wait
end interface
interface
subroutine mpi_send(buf,count,datatype,dest,tag,comm,ierr) &
& bind(c,name='mpi_send')
import
type(*), dimension(..) :: buf
integer(psb_mpk_) :: count, datatype, dest, tag, comm, ierr
end subroutine mpi_send
end interface
interface
subroutine mpi_irecv(buf,count,datatype,src,tag,comm,request,ierr) &
& bind(c,name='mpi_irecv')
import
type(*), dimension(..) :: buf
integer(psb_mpk_) :: count, datatype, src, tag, comm, request, ierr
end subroutine mpi_irecv
end interface
interface
subroutine mpi_alltoall(sdb,sdc,sdt,rvb,rvc,rvt,comm,ierr) &
& bind(c,name='mpi_alltoall')
import
type(*), dimension(..) :: sdb, rvb
integer(psb_mpk_) :: sdc,sdt,rvc,rvt, comm, ierr
end subroutine mpi_alltoall
end interface
interface
subroutine mpi_alltoallv(sdb,sdc,sdspl,sdt,rvb,rvc,rdspl,rvt,comm,ierr) &
& bind(c,name='mpi_alltoallv')
import
type(*), dimension(..) :: sdb, rvb
integer(psb_mpk_) :: sdspl(*), rdspl(*), sdc(*), rvc(*)
integer(psb_mpk_) :: sdt,rvt, comm, ierr
end subroutine mpi_alltoallv
end interface
interface
subroutine mpi_gather(sdb,sdc,sdt,rvb,rvc,rvt,root,comm,ierr) &
& bind(c,name='mpi_gather')
import
type(*), dimension(..) :: sdb, rvb
integer(psb_mpk_) :: sdc,sdt,rvc,rvt, root, comm, ierr
end subroutine mpi_gather
end interface
interface
subroutine mpi_gatherv(sdb,sdc,sdt,rvb,rvc,rdspl,rvt,root,comm,ierr) &
& bind(c,name='mpi_gatherv')
import
type(*), dimension(..) :: sdb, rvb
integer(psb_mpk_) :: rdspl(*), rvc(*)
integer(psb_mpk_) :: sdt,sdc,rvt, root, comm, ierr
end subroutine mpi_gatherv
end interface
interface
subroutine mpi_scatter(sdb,sdc,sdt,rvb,rvc,rvt,root,comm,ierr) &
& bind(c,name='mpi_scatter')
import
type(*), dimension(..) :: sdb, rvb
integer(psb_mpk_) :: sdc,sdt,rvc,rvt, root, comm, ierr
end subroutine mpi_scatter
end interface
interface
subroutine mpi_scatterv(sdb,sdc,sdspl,sdt,rvb,rvc,rvt,root,comm,ierr) &
& bind(c,name='mpi_scatterv')
import
type(*), dimension(..) :: sdb, rvb
integer(psb_mpk_) :: sdspl(*), sdc(*)
integer(psb_mpk_) :: sdt,rvc,rvt, root, comm, ierr
end subroutine mpi_scatterv
end interface
interface
subroutine mpi_allgather(sdb,sdc,sdt,rvb,rvc,rvt,comm,ierr) &
& bind(c,name='mpi_allgather')
import
type(*), dimension(..) :: sdb, rvb
integer(psb_mpk_) :: sdc,sdt,rvc,rvt, comm, ierr
end subroutine mpi_allgather
end interface
interface
subroutine mpi_allgatherv(sdb,sdc,sdt,rvb,rvc,rdspl,rvt,comm,ierr) &
& bind(c,name='mpi_allgatherv')
import
type(*), dimension(..) :: sdb, rvb
integer(psb_mpk_) :: rdspl(*),rvc(*)
integer(psb_mpk_) :: sdc,sdt,rvt, comm, ierr
end subroutine mpi_allgatherv
end interface
end module mpi
#endif
module psi_penv_mod
use psb_const_mod
use iso_c_binding
integer(psb_mpk_), parameter:: psb_int_tag = 543987
integer(psb_mpk_), parameter:: psb_real_tag = psb_int_tag + 1
@@ -381,7 +493,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%int4buf,size(node%int4buf),psb_mpi_mpk_,&
call mpi_isend(c_loc(node%int4buf),size(node%int4buf),psb_mpi_mpk_,&
& dest,tag,icomm,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
@@ -420,7 +532,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%int8buf,size(node%int8buf),psb_mpi_epk_,&
call mpi_isend(c_loc(node%int8buf),size(node%int8buf),psb_mpi_epk_,&
& dest,tag,icomm,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
@@ -457,7 +569,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%int2buf,size(node%int2buf),psb_mpi_i2pk_,&
call mpi_isend(c_loc(node%int2buf),size(node%int2buf),psb_mpi_i2pk_,&
& dest,tag,icomm,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
@@ -494,7 +606,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%realbuf,size(node%realbuf),psb_mpi_r_spk_,&
call mpi_isend(c_loc(node%realbuf),size(node%realbuf),psb_mpi_r_spk_,&
& dest,tag,icomm,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
@@ -531,7 +643,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%doublebuf,size(node%doublebuf),psb_mpi_r_dpk_,&
call mpi_isend(c_loc(node%doublebuf),size(node%doublebuf),psb_mpi_r_dpk_,&
& dest,tag,icomm,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
@@ -568,7 +680,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%complexbuf,size(node%complexbuf),psb_mpi_c_spk_,&
call mpi_isend(c_loc(node%complexbuf),size(node%complexbuf),psb_mpi_c_spk_,&
& dest,tag,icomm,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
@@ -605,7 +717,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%dcomplbuf,size(node%dcomplbuf),psb_mpi_c_dpk_,&
call mpi_isend(c_loc(node%dcomplbuf),size(node%dcomplbuf),psb_mpi_c_dpk_,&
& dest,tag,icomm,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
@@ -643,7 +755,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%logbuf,size(node%logbuf),mpi_logical,&
call mpi_isend(c_loc(node%logbuf),size(node%logbuf),mpi_logical,&
& dest,tag,icomm,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
@@ -681,7 +793,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%charbuf,size(node%charbuf),mpi_character,&
call mpi_isend(c_loc(node%charbuf),size(node%charbuf),mpi_character,&
& dest,tag,icomm,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
base/modules/penv/psi_s_collective_mod.F90
+21 -20
View File
@@ -32,6 +32,7 @@
module psi_s_collective_mod
use psi_penv_mod
use psb_desc_const_mod
use iso_c_binding
interface psb_max
module procedure psb_smaxs, psb_smaxv, psb_smaxm
@@ -2103,10 +2104,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
real(psb_spk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
real(psb_spk_), intent(out) :: valrcv(:)
integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:)
real(psb_spk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
real(psb_spk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -2133,14 +2134,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_real_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_r_spk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -2153,14 +2154,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_real_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_r_spk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@@ -2186,10 +2187,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
real(psb_spk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
real(psb_spk_), intent(out) :: valrcv(:)
integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:)
real(psb_spk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
real(psb_spk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -2216,14 +2217,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_real_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_r_spk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -2236,14 +2237,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_real_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_r_spk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
base/modules/penv/psi_z_collective_mod.F90
+21 -20
View File
@@ -32,6 +32,7 @@
module psi_z_collective_mod
use psi_penv_mod
use psb_desc_const_mod
use iso_c_binding
interface psb_gather
@@ -1463,10 +1464,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
complex(psb_dpk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
complex(psb_dpk_), intent(out) :: valrcv(:)
integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:)
complex(psb_dpk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
complex(psb_dpk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -1493,14 +1494,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_dcomplex_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_c_dpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -1513,14 +1514,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_dcomplex_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_c_dpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@@ -1546,10 +1547,10 @@ contains
#ifdef MPI_H
include 'mpif.h'
#endif
complex(psb_dpk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
complex(psb_dpk_), intent(out) :: valrcv(:)
integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:)
complex(psb_dpk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
complex(psb_dpk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
@@ -1576,14 +1577,14 @@ contains
prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = brvindx(ip+1)
p2ptag = psb_dcomplex_tag
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
call mpi_irecv((valrcv(idx+1:idx+sz)),sz,&
& psb_mpi_c_dpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@@ -1596,14 +1597,14 @@ contains
if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip)
idx = bsdindx(ip+1)
p2ptag = psb_dcomplex_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
call mpi_send((valsnd(idx+1:idx+sz)),sz,&
& psb_mpi_c_dpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send(jasnd(idx+1:idx+sz),sz,&
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
base/modules/psb_internals.h
+2 -2
View File
@@ -37,8 +37,8 @@ void mpi_gatherv(void* sdb, int* sdc, int* sdt,
int* rvt, int* comm, int *root, int* ierr);
void mpi_scatter(void* sdb, int* sdc, int* sdt,
void* rvb, int* rvc, int* rvt, int *root, int* comm, int* ierr);
void mpi_scatterv(void* sdb, int* sdc, int* sdt,
void* rvb, int* rvc, int* rdspl,
void mpi_scatterv(void* sdb, int* sdc, int* sdspl, int* sdt,
void* rvb, int* rvc,
int* rvt, int* comm, int *root, int* ierr);
void mpi_allgather(void* sdb, int* sdc, int* sdt,
void* rvb, int* rvc, int* rvt, int* comm, int* ierr);
util/Makefile
+1 -1
View File
@@ -27,7 +27,7 @@ OBJS=$(COBJS) $(MODOBJS) $(IMPLOBJS)
LOCAL_MODS=$(MODOBJS:.o=$(.mod))
LIBNAME=$(UTILLIBNAME)
FINCLUDES=$(FMFLAG). $(FMFLAG)$(MODDIR)
CINCLUDES=-I. -I$(INCDIR)
objs: $(OBJS)
/bin/cp -p $(CPUPDFLAG) *$(.mod) $(MODDIR)