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

Fix collective implementation bugs

Browse Source
This commit is contained in:
Salvatore Filippone
2022-03-31 18:05:36 +02:00
parent a5c3956cb0
commit 7064777e2e
7 changed files with 269 additions and 855 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/penv/psi_c_collective_mod.F90
+29 -89
View File
@@ -97,7 +97,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -165,7 +164,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -193,32 +191,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -246,7 +232,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -275,32 +260,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_, icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_, icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -330,7 +303,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -399,7 +371,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -427,17 +398,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camx_op,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
psb_mpi_c_spk_,mpi_camx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -474,7 +439,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -503,19 +467,13 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
endif
else
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
@@ -551,7 +509,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -620,7 +577,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -648,17 +604,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -695,7 +645,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -724,17 +673,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -773,7 +716,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -830,7 +772,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -887,7 +828,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1025,7 +965,7 @@ contains
& psb_mpi_c_spk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_exscan(MPI_IN_PLACE,dat,1,&
call mpi_iexscan(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,minfo)
@@ -1077,7 +1017,7 @@ contains
& psb_mpi_c_spk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_scan(MPI_IN_PLACE,dat,size(dat),&
call mpi_iscan(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)
base/modules/penv/psi_d_collective_mod.F90
+44 -142
View File
@@ -109,7 +109,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -175,7 +174,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -204,17 +202,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_max,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_max,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_max,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_max,root_,icomm,info)
endif
else
if (collective_start) then
@@ -251,7 +243,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -281,17 +272,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_max,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_max,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_max,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_max,root_,icomm,info)
endif
else
if (collective_start) then
@@ -330,7 +315,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -397,7 +381,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -425,17 +408,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_min,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_min,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_min,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_min,root_,icomm,info)
endif
else
if (collective_start) then
@@ -472,7 +449,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -501,17 +477,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_min,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_min,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_min,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_min,root_,icomm,info)
end if
else
if (collective_start) then
@@ -552,7 +522,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -621,7 +590,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -649,17 +617,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_r_dpk_,&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_r_dpk_,&
& mpi_dnrm2_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_r_dpk_,&
& mpi_dnrm2_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_r_dpk_,&
& mpi_dnrm2_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_r_dpk_,&
& mpi_dnrm2_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -700,7 +662,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -768,7 +729,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -796,32 +756,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,root_,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -849,7 +797,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -878,32 +825,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,root_, icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,root_, icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -933,7 +868,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1002,7 +936,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1030,17 +963,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damx_op,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
psb_mpi_r_dpk_,mpi_damx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damx_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -1077,7 +1004,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1106,19 +1032,13 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damx_op,root_,icomm,info)
endif
else
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
@@ -1154,7 +1074,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1223,7 +1142,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1251,17 +1169,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -1298,7 +1210,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1327,17 +1238,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_damn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -1376,7 +1281,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -1433,7 +1337,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1490,7 +1393,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1628,7 +1530,7 @@ contains
& psb_mpi_r_dpk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_exscan(MPI_IN_PLACE,dat,1,&
call mpi_iexscan(MPI_IN_PLACE,dat,1,&
& psb_mpi_r_dpk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,minfo)
@@ -1680,7 +1582,7 @@ contains
& psb_mpi_r_dpk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_scan(MPI_IN_PLACE,dat,size(dat),&
call mpi_iscan(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)
base/modules/penv/psi_e_collective_mod.F90
+41 -131
View File
@@ -106,7 +106,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -172,7 +171,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -201,17 +199,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_max,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_max,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_max,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_max,root_,icomm,info)
endif
else
if (collective_start) then
@@ -248,7 +240,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -278,17 +269,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_max,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_max,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_max,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_max,root_,icomm,info)
endif
else
if (collective_start) then
@@ -327,7 +312,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -394,7 +378,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -422,17 +405,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_min,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_min,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_min,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_min,root_,icomm,info)
endif
else
if (collective_start) then
@@ -469,7 +446,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -498,17 +474,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_min,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_min,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_min,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_min,root_,icomm,info)
end if
else
if (collective_start) then
@@ -549,7 +519,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -617,7 +586,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -645,32 +613,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,root_,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -698,7 +654,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -727,32 +682,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,root_, icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,root_, icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -782,7 +725,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -851,7 +793,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -879,17 +820,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamx_op,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
psb_mpi_epk_,mpi_eamx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamx_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -926,7 +861,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -955,19 +889,13 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamx_op,root_,icomm,info)
endif
else
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
@@ -1003,7 +931,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1072,7 +999,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1100,17 +1026,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -1147,7 +1067,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1176,17 +1095,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_eamn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -1225,7 +1138,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -1282,7 +1194,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1339,7 +1250,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1477,7 +1387,7 @@ contains
& psb_mpi_epk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_exscan(MPI_IN_PLACE,dat,1,&
call mpi_iexscan(MPI_IN_PLACE,dat,1,&
& psb_mpi_epk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,minfo)
@@ -1529,7 +1439,7 @@ contains
& psb_mpi_epk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_scan(MPI_IN_PLACE,dat,size(dat),&
call mpi_iscan(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)
base/modules/penv/psi_i2_collective_mod.F90
+41 -131
View File
@@ -106,7 +106,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -172,7 +171,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -201,17 +199,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_max,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_max,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_max,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_max,root_,icomm,info)
endif
else
if (collective_start) then
@@ -248,7 +240,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -278,17 +269,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_max,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_max,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_max,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_max,root_,icomm,info)
endif
else
if (collective_start) then
@@ -327,7 +312,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -394,7 +378,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -422,17 +405,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_min,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_min,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_min,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_min,root_,icomm,info)
endif
else
if (collective_start) then
@@ -469,7 +446,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -498,17 +474,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_min,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_min,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_min,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_min,root_,icomm,info)
end if
else
if (collective_start) then
@@ -549,7 +519,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -617,7 +586,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -645,32 +613,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,root_,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -698,7 +654,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -727,32 +682,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,root_, icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,root_, icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -782,7 +725,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -851,7 +793,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -879,17 +820,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amx_op,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
psb_mpi_i2pk_,mpi_i2amx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amx_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -926,7 +861,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -955,19 +889,13 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amx_op,root_,icomm,info)
endif
else
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
@@ -1003,7 +931,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1072,7 +999,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1100,17 +1026,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -1147,7 +1067,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1176,17 +1095,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_i2amn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -1225,7 +1138,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -1282,7 +1194,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1339,7 +1250,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1477,7 +1387,7 @@ contains
& psb_mpi_i2pk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_exscan(MPI_IN_PLACE,dat,1,&
call mpi_iexscan(MPI_IN_PLACE,dat,1,&
& psb_mpi_i2pk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,minfo)
@@ -1529,7 +1439,7 @@ contains
& psb_mpi_i2pk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_scan(MPI_IN_PLACE,dat,size(dat),&
call mpi_iscan(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)
base/modules/penv/psi_m_collective_mod.F90
+41 -131
View File
@@ -106,7 +106,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -172,7 +171,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -201,17 +199,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_max,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_max,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_max,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_max,root_,icomm,info)
endif
else
if (collective_start) then
@@ -248,7 +240,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -278,17 +269,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_max,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_max,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_max,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_max,root_,icomm,info)
endif
else
if (collective_start) then
@@ -327,7 +312,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -394,7 +378,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -422,17 +405,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_min,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_min,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_min,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_min,root_,icomm,info)
endif
else
if (collective_start) then
@@ -469,7 +446,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -498,17 +474,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_min,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_min,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_min,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_min,root_,icomm,info)
end if
else
if (collective_start) then
@@ -549,7 +519,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -617,7 +586,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -645,32 +613,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,root_,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -698,7 +654,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -727,32 +682,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,root_, icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,root_, icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -782,7 +725,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -851,7 +793,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -879,17 +820,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamx_op,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
psb_mpi_mpk_,mpi_mamx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamx_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -926,7 +861,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -955,19 +889,13 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamx_op,root_,icomm,info)
endif
else
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
@@ -1003,7 +931,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1072,7 +999,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1100,17 +1026,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -1147,7 +1067,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1176,17 +1095,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_mamn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -1225,7 +1138,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -1282,7 +1194,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1339,7 +1250,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1477,7 +1387,7 @@ contains
& psb_mpi_mpk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_exscan(MPI_IN_PLACE,dat,1,&
call mpi_iexscan(MPI_IN_PLACE,dat,1,&
& psb_mpi_mpk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,minfo)
@@ -1529,7 +1439,7 @@ contains
& psb_mpi_mpk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_scan(MPI_IN_PLACE,dat,size(dat),&
call mpi_iscan(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)
base/modules/penv/psi_s_collective_mod.F90
+44 -142
View File
@@ -109,7 +109,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -175,7 +174,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -204,17 +202,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_max,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_max,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_max,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_max,root_,icomm,info)
endif
else
if (collective_start) then
@@ -251,7 +243,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -281,17 +272,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_max,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_max,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_max,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_max,root_,icomm,info)
endif
else
if (collective_start) then
@@ -330,7 +315,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -397,7 +381,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -425,17 +408,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_min,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_min,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_min,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_min,root_,icomm,info)
endif
else
if (collective_start) then
@@ -472,7 +449,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -501,17 +477,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_min,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_min,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_min,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_min,root_,icomm,info)
end if
else
if (collective_start) then
@@ -552,7 +522,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -621,7 +590,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -649,17 +617,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_r_spk_,&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_r_spk_,&
& mpi_snrm2_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_r_spk_,&
& mpi_snrm2_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_r_spk_,&
& mpi_snrm2_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_r_spk_,&
& mpi_snrm2_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -700,7 +662,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -768,7 +729,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -796,32 +756,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,root_,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -849,7 +797,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -878,32 +825,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,root_, icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,root_, icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -933,7 +868,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1002,7 +936,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1030,17 +963,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samx_op,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
psb_mpi_r_spk_,mpi_samx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samx_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -1077,7 +1004,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1106,19 +1032,13 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samx_op,root_,icomm,info)
endif
else
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
@@ -1154,7 +1074,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1223,7 +1142,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1251,17 +1169,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -1298,7 +1210,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1327,17 +1238,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_samn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -1376,7 +1281,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -1433,7 +1337,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1490,7 +1393,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1628,7 +1530,7 @@ contains
& psb_mpi_r_spk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_exscan(MPI_IN_PLACE,dat,1,&
call mpi_iexscan(MPI_IN_PLACE,dat,1,&
& psb_mpi_r_spk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,minfo)
@@ -1680,7 +1582,7 @@ contains
& psb_mpi_r_spk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_scan(MPI_IN_PLACE,dat,size(dat),&
call mpi_iscan(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_r_spk_,mpi_sum,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)
base/modules/penv/psi_z_collective_mod.F90
+29 -89
View File
@@ -97,7 +97,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -165,7 +164,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -193,32 +191,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -246,7 +232,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -275,32 +260,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,icomm,request,info)
else
if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_, icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,request,info)
end if
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_, icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -330,7 +303,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -399,7 +371,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -427,17 +398,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamx_op,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
psb_mpi_c_dpk_,mpi_zamx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -474,7 +439,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -503,19 +467,13 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamx_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
endif
else
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
@@ -551,7 +509,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -620,7 +577,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -648,17 +604,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -695,7 +645,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -724,17 +673,11 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
if (iinfo == psb_success_)&
& call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
call mpi_allreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamn_op,icomm,info)
else
if (iam == root_) then
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
end if
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
endif
else
if (collective_start) then
@@ -773,7 +716,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
@@ -830,7 +772,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -887,7 +828,6 @@ contains
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -1025,7 +965,7 @@ contains
& psb_mpi_c_dpk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_exscan(MPI_IN_PLACE,dat,1,&
call mpi_iexscan(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,minfo)
@@ -1077,7 +1017,7 @@ contains
& psb_mpi_c_dpk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_scan(MPI_IN_PLACE,dat,size(dat),&
call mpi_iscan(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)