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

Complete non-blocking collectives.

Browse Source
This commit is contained in:
Salvatore Filippone
2022-03-28 14:04:40 +02:00
parent 336f7bf132
commit 1fe2c71163
7 changed files with 5250 additions and 1562 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/penv/psi_c_collective_mod.F90
+530 -150
View File
@@ -94,7 +94,6 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_spk_) :: dat_
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
@@ -126,16 +125,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
call mpi_allreduce(MPI_IN_PLACE,dat,1,psb_mpi_c_spk_,mpi_sum,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_sum,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,1,psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
call mpi_reduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,1,psb_mpi_c_spk_,mpi_sum,icomm,request,info)
call mpi_iallreduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_sum,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,1,psb_mpi_c_spk_,mpi_sum,root_,icomm,request,info)
call mpi_ireduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -191,27 +194,30 @@ contains
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)
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)
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
end if
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_spk_,mpi_sum,&
& icomm,request,info)
& 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)
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)
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,request,info)
end if
end if
else if (collective_end) then
@@ -270,27 +276,30 @@ contains
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)
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)
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
end if
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_spk_,mpi_sum,&
& icomm,request,info)
& 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)
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)
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,root_,icomm,request,info)
end if
end if
else if (collective_end) then
@@ -304,7 +313,7 @@ contains
! AMX: Maximum Absolute Value
!
subroutine psb_camxs(ctxt,dat,root)
subroutine psb_camxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
use mpi
#endif
@@ -315,10 +324,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_spk_) :: dat_
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
@@ -329,17 +342,46 @@ contains
root_ = -1
endif
icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,icomm,info)
dat = dat_
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
if (iam == root_) dat = dat_
endif
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
if (root_ == -1) then
call mpi_allreduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_camx_op,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_camx_op,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_camx_op,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_camxs
subroutine psb_camxv(ctxt,dat,root)
subroutine psb_camxv(ctxt,dat,root,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -351,10 +393,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
@@ -365,25 +411,52 @@ contains
root_ = -1
endif
icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then
call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat
if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,icomm,info)
else
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
else
call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
endif
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
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)
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
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camx_op,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camx_op,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_camxv
subroutine psb_camxm(ctxt,dat,root)
subroutine psb_camxm(ctxt,dat,root,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -395,10 +468,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:,:)
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_spk_), allocatable :: dat_(:,:)
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -410,29 +487,54 @@ contains
root_ = -1
endif
icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat
if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,icomm,info)
else
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
else
call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
endif
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
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)
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
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camx_op,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camx_op,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_camxm
!
! AMN: Minimum Absolute Value
!
subroutine psb_camns(ctxt,dat,root)
subroutine psb_camns(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
use mpi
#endif
@@ -443,10 +545,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_spk_) :: dat_
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
@@ -457,17 +563,46 @@ contains
root_ = -1
endif
icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,icomm,info)
dat = dat_
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
if (iam == root_) dat = dat_
endif
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
if (root_ == -1) then
call mpi_allreduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_camn_op,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_camn_op,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_camn_op,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_camns
subroutine psb_camnv(ctxt,dat,root)
subroutine psb_camnv(ctxt,dat,root,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -479,10 +614,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
@@ -493,25 +632,52 @@ contains
root_ = -1
endif
icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then
call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat
if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,icomm,info)
else
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
else
call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
endif
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
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_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
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camn_op,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camn_op,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_camnv
subroutine psb_camnm(ctxt,dat,root)
subroutine psb_camnm(ctxt,dat,root,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -523,10 +689,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:,:)
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_spk_), allocatable :: dat_(:,:)
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -538,29 +708,55 @@ contains
root_ = -1
endif
icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat
if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,icomm,info)
else
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
else
call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
endif
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
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_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
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camn_op,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_camn_op,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_camnm
!
! BCAST Broadcast
!
subroutine psb_cbcasts(ctxt,dat,root)
!
subroutine psb_cbcasts(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
use mpi
#endif
@@ -571,10 +767,15 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
@@ -585,12 +786,33 @@ contains
root_ = psb_root_
endif
icomm = psb_get_mpi_comm(ctxt)
call mpi_bcast(dat,1,psb_mpi_c_spk_,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_bcast(dat,1,psb_mpi_c_spk_,root_,icomm,info)
else
if (collective_start) then
call mpi_ibcast(dat,1,psb_mpi_c_spk_,root_,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_cbcasts
subroutine psb_cbcastv(ctxt,dat,root)
subroutine psb_cbcastv(ctxt,dat,root,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -602,9 +824,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
@@ -615,11 +842,34 @@ contains
root_ = psb_root_
endif
icomm = psb_get_mpi_comm(ctxt)
call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,icomm,info)
else
if (collective_start) then
call mpi_ibcast(dat,size(dat),psb_mpi_c_spk_,root_,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_cbcastv
subroutine psb_cbcastm(ctxt,dat,root)
subroutine psb_cbcastm(ctxt,dat,root,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -631,10 +881,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:,:)
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -646,7 +900,30 @@ contains
root_ = psb_root_
endif
icomm = psb_get_mpi_comm(ctxt)
call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,icomm,info)
else
if (collective_start) then
call mpi_ibcast(dat,size(dat),psb_mpi_c_spk_,root_,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_cbcastm
@@ -656,7 +933,7 @@ contains
!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_cscan_sums(ctxt,dat)
subroutine psb_cscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
use mpi
#endif
@@ -665,21 +942,48 @@ contains
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
complex(psb_spk_), intent(inout) :: dat
complex(psb_spk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo, icomm
integer(psb_mpk_) :: minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
call mpi_scan(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,icomm,minfo)
dat = dat_
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_scan(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_iscan(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)
end if
end if
#endif
end subroutine psb_cscan_sums
subroutine psb_cexscan_sums(ctxt,dat)
subroutine psb_cexscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
use mpi
#endif
@@ -689,22 +993,50 @@ contains
#endif
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
complex(psb_spk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: icomm, minfo
integer(psb_mpk_) :: minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
call mpi_exscan(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,icomm,minfo)
dat = dat_
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_exscan(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_spk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_exscan(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)
end if
end if
#else
dat = czero
#endif
end subroutine psb_cexscan_sums
subroutine psb_cscan_sumv(ctxt,dat,root)
subroutine psb_cscan_sumv(ctxt,dat,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -715,23 +1047,46 @@ contains
#endif
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_ipk_), intent(in), optional :: root
integer(psb_mpk_) :: root_
complex(psb_spk_), allocatable :: dat_(:)
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo, icomm
integer(psb_mpk_) :: minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
call psb_realloc(size(dat),dat_,info)
dat_ = dat
if (info == psb_success_) &
& call mpi_scan(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,icomm,minfo)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_scan(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_scan(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)
end if
end if
#endif
end subroutine psb_cscan_sumv
subroutine psb_cexscan_sumv(ctxt,dat,root)
subroutine psb_cexscan_sumv(ctxt,dat,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -742,19 +1097,44 @@ contains
#endif
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_ipk_), intent(in), optional :: root
integer(psb_mpk_) :: root_
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
complex(psb_spk_), allocatable :: dat_(:)
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo, icomm
integer(psb_mpk_) :: minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
call psb_realloc(size(dat),dat_,info)
dat_ = dat
if (info == psb_success_) &
& call mpi_exscan(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,icomm,minfo)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_exscan(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_iexscan(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)
end if
end if
#else
dat = czero
#endif
base/modules/penv/psi_d_collective_mod.F90
+892 -271
View File
File diff suppressed because it is too large Load Diff
base/modules/penv/psi_e_collective_mod.F90
+802 -240
View File
File diff suppressed because it is too large Load Diff
base/modules/penv/psi_i2_collective_mod.F90
+802 -240
View File
File diff suppressed because it is too large Load Diff
base/modules/penv/psi_m_collective_mod.F90
+802 -240
View File
File diff suppressed because it is too large Load Diff
base/modules/penv/psi_s_collective_mod.F90
+892 -271
View File
File diff suppressed because it is too large Load Diff
base/modules/penv/psi_z_collective_mod.F90
+530 -150
View File
@@ -94,7 +94,6 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_dpk_) :: dat_
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
@@ -126,16 +125,20 @@ contains
end if
if (collective_sync) then
if (root_ == -1) then
call mpi_allreduce(MPI_IN_PLACE,dat,1,psb_mpi_c_dpk_,mpi_sum,icomm,info)
call mpi_allreduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_sum,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,1,psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
call mpi_reduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,1,psb_mpi_c_dpk_,mpi_sum,icomm,request,info)
call mpi_iallreduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_sum,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,1,psb_mpi_c_dpk_,mpi_sum,root_,icomm,request,info)
call mpi_ireduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
@@ -191,27 +194,30 @@ contains
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)
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)
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
end if
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,&
& icomm,request,info)
& 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)
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)
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,request,info)
end if
end if
else if (collective_end) then
@@ -270,27 +276,30 @@ contains
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)
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)
call mpi_reduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
end if
end if
else
if (collective_start) then
if (root_ == -1) then
if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,&
& icomm,request,info)
& 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)
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)
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,root_,icomm,request,info)
end if
end if
else if (collective_end) then
@@ -304,7 +313,7 @@ contains
! AMX: Maximum Absolute Value
!
subroutine psb_zamxs(ctxt,dat,root)
subroutine psb_zamxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
use mpi
#endif
@@ -315,10 +324,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_dpk_) :: dat_
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
@@ -329,17 +342,46 @@ contains
root_ = -1
endif
icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,icomm,info)
dat = dat_
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
if (iam == root_) dat = dat_
endif
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
if (root_ == -1) then
call mpi_allreduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_zamx_op,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_zamx_op,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_zamxs
subroutine psb_zamxv(ctxt,dat,root)
subroutine psb_zamxv(ctxt,dat,root,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -351,10 +393,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
@@ -365,25 +411,52 @@ contains
root_ = -1
endif
icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then
call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat
if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,icomm,info)
else
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
else
call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
endif
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
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)
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
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamx_op,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_zamxv
subroutine psb_zamxm(ctxt,dat,root)
subroutine psb_zamxm(ctxt,dat,root,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -395,10 +468,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:,:)
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_dpk_), allocatable :: dat_(:,:)
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -410,29 +487,54 @@ contains
root_ = -1
endif
icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat
if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,icomm,info)
else
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
else
call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
endif
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
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)
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
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamx_op,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_zamxm
!
! AMN: Minimum Absolute Value
!
subroutine psb_zamns(ctxt,dat,root)
subroutine psb_zamns(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
use mpi
#endif
@@ -443,10 +545,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_dpk_) :: dat_
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
@@ -457,17 +563,46 @@ contains
root_ = -1
endif
icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,icomm,info)
dat = dat_
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
if (iam == root_) dat = dat_
endif
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
if (root_ == -1) then
call mpi_allreduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_zamn_op,icomm,info)
else
call mpi_reduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_zamn_op,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_zamns
subroutine psb_zamnv(ctxt,dat,root)
subroutine psb_zamnv(ctxt,dat,root,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -479,10 +614,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
@@ -493,25 +632,52 @@ contains
root_ = -1
endif
icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then
call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat
if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,icomm,info)
else
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
else
call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
endif
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
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_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
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamn_op,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_zamnv
subroutine psb_zamnm(ctxt,dat,root)
subroutine psb_zamnm(ctxt,dat,root,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -523,10 +689,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:,:)
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
complex(psb_dpk_), allocatable :: dat_(:,:)
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -538,29 +708,55 @@ contains
root_ = -1
endif
icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat
if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,icomm,info)
else
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
else
call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
endif
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
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_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
endif
else
if (collective_start) then
if (root_ == -1) then
call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamn_op,icomm,request,info)
else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,request,info)
end if
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_zamnm
!
! BCAST Broadcast
!
subroutine psb_zbcasts(ctxt,dat,root)
!
subroutine psb_zbcasts(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
use mpi
#endif
@@ -571,10 +767,15 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
@@ -585,12 +786,33 @@ contains
root_ = psb_root_
endif
icomm = psb_get_mpi_comm(ctxt)
call mpi_bcast(dat,1,psb_mpi_c_dpk_,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_bcast(dat,1,psb_mpi_c_dpk_,root_,icomm,info)
else
if (collective_start) then
call mpi_ibcast(dat,1,psb_mpi_c_dpk_,root_,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_zbcasts
subroutine psb_zbcastv(ctxt,dat,root)
subroutine psb_zbcastv(ctxt,dat,root,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -602,9 +824,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
@@ -615,11 +842,34 @@ contains
root_ = psb_root_
endif
icomm = psb_get_mpi_comm(ctxt)
call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,icomm,info)
else
if (collective_start) then
call mpi_ibcast(dat,size(dat),psb_mpi_c_dpk_,root_,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_zbcastv
subroutine psb_zbcastm(ctxt,dat,root)
subroutine psb_zbcastm(ctxt,dat,root,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -631,10 +881,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:,:)
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
@@ -646,7 +900,30 @@ contains
root_ = psb_root_
endif
icomm = psb_get_mpi_comm(ctxt)
call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,icomm,info)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,icomm,info)
else
if (collective_start) then
call mpi_ibcast(dat,size(dat),psb_mpi_c_dpk_,root_,icomm,request,info)
else if (collective_end) then
call mpi_wait(request,status,info)
end if
end if
#endif
end subroutine psb_zbcastm
@@ -656,7 +933,7 @@ contains
!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_zscan_sums(ctxt,dat)
subroutine psb_zscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
use mpi
#endif
@@ -665,21 +942,48 @@ contains
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
complex(psb_dpk_), intent(inout) :: dat
complex(psb_dpk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo, icomm
integer(psb_mpk_) :: minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
call mpi_scan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,minfo)
dat = dat_
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_scan(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_iscan(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)
end if
end if
#endif
end subroutine psb_zscan_sums
subroutine psb_zexscan_sums(ctxt,dat)
subroutine psb_zexscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
use mpi
#endif
@@ -689,22 +993,50 @@ contains
#endif
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
complex(psb_dpk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: icomm, minfo
integer(psb_mpk_) :: minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
call mpi_exscan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,minfo)
dat = dat_
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_exscan(MPI_IN_PLACE,dat,1,&
& psb_mpi_c_dpk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_exscan(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)
end if
end if
#else
dat = zzero
#endif
end subroutine psb_zexscan_sums
subroutine psb_zscan_sumv(ctxt,dat,root)
subroutine psb_zscan_sumv(ctxt,dat,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -715,23 +1047,46 @@ contains
#endif
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_ipk_), intent(in), optional :: root
integer(psb_mpk_) :: root_
complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo, icomm
integer(psb_mpk_) :: minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
call psb_realloc(size(dat),dat_,info)
dat_ = dat
if (info == psb_success_) &
& call mpi_scan(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,icomm,minfo)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_scan(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_scan(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)
end if
end if
#endif
end subroutine psb_zscan_sumv
subroutine psb_zexscan_sumv(ctxt,dat,root)
subroutine psb_zexscan_sumv(ctxt,dat,mode,request)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
@@ -742,19 +1097,44 @@ contains
#endif
type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_ipk_), intent(in), optional :: root
integer(psb_mpk_) :: root_
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo, icomm
integer(psb_mpk_) :: minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
call psb_realloc(size(dat),dat_,info)
dat_ = dat
if (info == psb_success_) &
& call mpi_exscan(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,icomm,minfo)
if (present(mode)) then
collective_sync = .false.
collective_start = iand(mode,psb_collective_start_) /= 0
collective_end = iand(mode,psb_collective_end_) /= 0
if (.not.present(request)) then
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
else
collective_sync = .true.
collective_start = .false.
collective_end = .false.
end if
if (collective_sync) then
call mpi_exscan(MPI_IN_PLACE,dat,size(dat),&
& psb_mpi_c_dpk_,mpi_sum,icomm,minfo)
else
if (collective_start) then
call mpi_iexscan(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)
end if
end if
#else
dat = zzero
#endif