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

Fix collective implementation bugs

Browse Source
maint-3.7.1
Salvatore Filippone 3 years ago
parent a5c3956cb0
commit 7064777e2e
7 changed files with 269 additions and 855 deletions
Show Stats Download Patch File Download Diff File

118
base/modules/penv/psi_c_collective_mod.F90
Unescape Escape 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)

186
base/modules/penv/psi_d_collective_mod.F90
Unescape Escape 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)

172
base/modules/penv/psi_e_collective_mod.F90
Unescape Escape 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)

172
base/modules/penv/psi_i2_collective_mod.F90
Unescape Escape 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)

172
base/modules/penv/psi_m_collective_mod.F90
Unescape Escape 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)

186
base/modules/penv/psi_s_collective_mod.F90
Unescape Escape 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)

118
base/modules/penv/psi_z_collective_mod.F90
Unescape Escape 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)

Write Preview
Loading…
Cancel
Save