From 7064777e2ee176b44b52d72cf555288ad05f838f Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 31 Mar 2022 18:05:36 +0200 Subject: [PATCH] Fix collective implementation bugs --- base/modules/penv/psi_c_collective_mod.F90 | 118 +++---------- base/modules/penv/psi_d_collective_mod.F90 | 186 +++++--------------- base/modules/penv/psi_e_collective_mod.F90 | 172 +++++------------- base/modules/penv/psi_i2_collective_mod.F90 | 172 +++++------------- base/modules/penv/psi_m_collective_mod.F90 | 172 +++++------------- base/modules/penv/psi_s_collective_mod.F90 | 186 +++++--------------- base/modules/penv/psi_z_collective_mod.F90 | 118 +++---------- 7 files changed, 269 insertions(+), 855 deletions(-) diff --git a/base/modules/penv/psi_c_collective_mod.F90 b/base/modules/penv/psi_c_collective_mod.F90 index b887023c..118cdc00 100644 --- a/base/modules/penv/psi_c_collective_mod.F90 +++ b/base/modules/penv/psi_c_collective_mod.F90 @@ -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) diff --git a/base/modules/penv/psi_d_collective_mod.F90 b/base/modules/penv/psi_d_collective_mod.F90 index 8e225c04..225aa3c6 100644 --- a/base/modules/penv/psi_d_collective_mod.F90 +++ b/base/modules/penv/psi_d_collective_mod.F90 @@ -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) diff --git a/base/modules/penv/psi_e_collective_mod.F90 b/base/modules/penv/psi_e_collective_mod.F90 index 3dd1d9dc..4e3f9637 100644 --- a/base/modules/penv/psi_e_collective_mod.F90 +++ b/base/modules/penv/psi_e_collective_mod.F90 @@ -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) diff --git a/base/modules/penv/psi_i2_collective_mod.F90 b/base/modules/penv/psi_i2_collective_mod.F90 index 1c7558b2..022fcbdf 100644 --- a/base/modules/penv/psi_i2_collective_mod.F90 +++ b/base/modules/penv/psi_i2_collective_mod.F90 @@ -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) diff --git a/base/modules/penv/psi_m_collective_mod.F90 b/base/modules/penv/psi_m_collective_mod.F90 index fd0102ab..c63c148a 100644 --- a/base/modules/penv/psi_m_collective_mod.F90 +++ b/base/modules/penv/psi_m_collective_mod.F90 @@ -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) diff --git a/base/modules/penv/psi_s_collective_mod.F90 b/base/modules/penv/psi_s_collective_mod.F90 index ce91cb6c..e29a3a49 100644 --- a/base/modules/penv/psi_s_collective_mod.F90 +++ b/base/modules/penv/psi_s_collective_mod.F90 @@ -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) diff --git a/base/modules/penv/psi_z_collective_mod.F90 b/base/modules/penv/psi_z_collective_mod.F90 index 03953e13..bf288edb 100644 --- a/base/modules/penv/psi_z_collective_mod.F90 +++ b/base/modules/penv/psi_z_collective_mod.F90 @@ -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)