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

Complete non-blocking collectives.

Browse Source
split_sum
Salvatore Filippone 4 years ago
parent 336f7bf132
commit 1fe2c71163
7 changed files with 5184 additions and 1496 deletions
Show Stats Download Patch File Download Diff File

672
base/modules/penv/psi_c_collective_mod.F90
Unescape Escape View File

@ -94,7 +94,6 @@ contains
integer(psb_ipk_), intent(in), optional :: mode integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_spk_) :: dat_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
@ -126,16 +125,20 @@ contains
end if end if
if (collective_sync) then if (collective_sync) then
if (root_ == -1) 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 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 endif
else else
if (collective_start) then if (collective_start) then
if (root_ == -1) 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 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 end if
else if (collective_end) then else if (collective_end) then
call mpi_wait(request,status,info) call mpi_wait(request,status,info)
@ -191,27 +194,30 @@ contains
if (collective_sync) then if (collective_sync) then
if (root_ == -1) then if (root_ == -1) then
if (iinfo == psb_success_) & 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 else
if (iam == root_) then 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 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
end if end if
else else
if (collective_start) then if (collective_start) then
if (root_ == -1) then if (root_ == -1) then
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_spk_,mpi_sum,& & call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& icomm,request,info) & psb_mpi_c_spk_,mpi_sum,icomm,request,info)
else else
if (iam == root_) then if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,& call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& icomm,request,info) & psb_mpi_c_spk_,mpi_sum,root_,icomm,request,info)
else else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,& call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& icomm,request,info) & psb_mpi_c_spk_,mpi_sum,root_,icomm,request,info)
end if end if
end if end if
else if (collective_end) then else if (collective_end) then
@ -270,27 +276,30 @@ contains
if (collective_sync) then if (collective_sync) then
if (root_ == -1) then if (root_ == -1) then
if (iinfo == psb_success_) & 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 else
if (iam == root_) then 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 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
end if end if
else else
if (collective_start) then if (collective_start) then
if (root_ == -1) then if (root_ == -1) then
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_spk_,mpi_sum,& & call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& icomm,request,info) & psb_mpi_c_spk_,mpi_sum,icomm,request,info)
else else
if (iam == root_) then if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,& call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& icomm,request,info) & psb_mpi_c_spk_,mpi_sum,root_, icomm,request,info)
else else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,& call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& icomm,request,info) & psb_mpi_c_spk_,mpi_sum,root_,icomm,request,info)
end if end if
end if end if
else if (collective_end) then else if (collective_end) then
@ -304,7 +313,7 @@ contains
! AMX: Maximum Absolute Value ! AMX: Maximum Absolute Value
! !
subroutine psb_camxs(ctxt,dat,root) subroutine psb_camxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -315,10 +324,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat complex(psb_spk_), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
complex(psb_spk_) :: dat_ integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -329,17 +342,46 @@ contains
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then if (present(mode)) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,icomm,info) collective_sync = .false.
dat = dat_ 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 else
call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info) collective_sync = .true.
if (iam == root_) dat = dat_ collective_start = .false.
endif 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 #endif
end subroutine psb_camxs end subroutine psb_camxs
subroutine psb_camxv(ctxt,dat,root) subroutine psb_camxv(ctxt,dat,root,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -351,10 +393,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:) complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
complex(psb_spk_), allocatable :: dat_(:) integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -365,25 +411,52 @@ contains
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then if (present(mode)) then
call psb_realloc(size(dat),dat_,iinfo) collective_sync = .false.
dat_ = dat collective_start = iand(mode,psb_collective_start_) /= 0
if (iinfo == psb_success_) & collective_end = iand(mode,psb_collective_end_) /= 0
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,icomm,info) if (.not.present(request)) then
else collective_sync = .true.
if (iam == root_) then collective_start = .false.
call psb_realloc(size(dat),dat_,iinfo) collective_end = .false.
dat_ = dat end if
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info) 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 else
call psb_realloc(1,dat_,iinfo) if (iam == root_) then
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info) 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 if
#endif #endif
end subroutine psb_camxv end subroutine psb_camxv
subroutine psb_camxm(ctxt,dat,root) subroutine psb_camxm(ctxt,dat,root,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -395,10 +468,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:,:) complex(psb_spk_), intent(inout) :: dat(:,:)
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
complex(psb_spk_), allocatable :: dat_(:,:) integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -410,29 +487,54 @@ contains
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then if (present(mode)) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) collective_sync = .false.
dat_ = dat collective_start = iand(mode,psb_collective_start_) /= 0
if (iinfo == psb_success_)& collective_end = iand(mode,psb_collective_end_) /= 0
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,icomm,info) if (.not.present(request)) then
else collective_sync = .true.
if (iam == root_) then collective_start = .false.
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) collective_end = .false.
dat_ = dat end if
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info) 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 else
call psb_realloc(1,1,dat_,iinfo) if (iam == root_) then
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info) 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 if
#endif #endif
end subroutine psb_camxm end subroutine psb_camxm
! !
! AMN: Minimum Absolute Value ! AMN: Minimum Absolute Value
! !
subroutine psb_camns(ctxt,dat,root,mode,request)
subroutine psb_camns(ctxt,dat,root)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -443,10 +545,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat complex(psb_spk_), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
complex(psb_spk_) :: dat_ integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -457,17 +563,46 @@ contains
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then if (present(mode)) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,icomm,info) collective_sync = .false.
dat = dat_ 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 else
call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info) collective_sync = .true.
if (iam == root_) dat = dat_ collective_start = .false.
endif 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 #endif
end subroutine psb_camns end subroutine psb_camns
subroutine psb_camnv(ctxt,dat,root) subroutine psb_camnv(ctxt,dat,root,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -479,10 +614,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:) complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
complex(psb_spk_), allocatable :: dat_(:) integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -493,25 +632,52 @@ contains
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then if (present(mode)) then
call psb_realloc(size(dat),dat_,iinfo) collective_sync = .false.
dat_ = dat collective_start = iand(mode,psb_collective_start_) /= 0
if (iinfo == psb_success_) & collective_end = iand(mode,psb_collective_end_) /= 0
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,icomm,info) if (.not.present(request)) then
else collective_sync = .true.
if (iam == root_) then collective_start = .false.
call psb_realloc(size(dat),dat_,iinfo) collective_end = .false.
dat_ = dat end if
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info) 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 else
call psb_realloc(1,dat_,iinfo) if (iam == root_) then
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info) 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 if
#endif #endif
end subroutine psb_camnv end subroutine psb_camnv
subroutine psb_camnm(ctxt,dat,root) subroutine psb_camnm(ctxt,dat,root,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -523,10 +689,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:,:) complex(psb_spk_), intent(inout) :: dat(:,:)
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
complex(psb_spk_), allocatable :: dat_(:,:) integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -538,29 +708,55 @@ contains
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then if (present(mode)) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) collective_sync = .false.
dat_ = dat collective_start = iand(mode,psb_collective_start_) /= 0
if (iinfo == psb_success_)& collective_end = iand(mode,psb_collective_end_) /= 0
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,icomm,info) if (.not.present(request)) then
else collective_sync = .true.
if (iam == root_) then collective_start = .false.
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) collective_end = .false.
dat_ = dat end if
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info) 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 else
call psb_realloc(1,1,dat_,iinfo) if (iam == root_) then
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info) 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 if
#endif #endif
end subroutine psb_camnm end subroutine psb_camnm
! !
! BCAST Broadcast ! BCAST Broadcast
! !
subroutine psb_cbcasts(ctxt,dat,root,mode,request)
subroutine psb_cbcasts(ctxt,dat,root)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -571,10 +767,15 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat complex(psb_spk_), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -585,12 +786,33 @@ contains
root_ = psb_root_ root_ = psb_root_
endif endif
icomm = psb_get_mpi_comm(ctxt) 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 #endif
end subroutine psb_cbcasts end subroutine psb_cbcasts
subroutine psb_cbcastv(ctxt,dat,root) subroutine psb_cbcastv(ctxt,dat,root,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -602,9 +824,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:) complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root 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_) :: 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 integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -615,11 +842,34 @@ contains
root_ = psb_root_ root_ = psb_root_
endif endif
icomm = psb_get_mpi_comm(ctxt) 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 #endif
end subroutine psb_cbcastv end subroutine psb_cbcastv
subroutine psb_cbcastm(ctxt,dat,root) subroutine psb_cbcastm(ctxt,dat,root,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -631,10 +881,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:,:) complex(psb_spk_), intent(inout) :: dat(:,:)
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -646,7 +900,30 @@ contains
root_ = psb_root_ root_ = psb_root_
endif endif
icomm = psb_get_mpi_comm(ctxt) 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 #endif
end subroutine psb_cbcastm 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 #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -665,21 +942,48 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt 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_), intent(inout) :: dat
complex(psb_spk_) :: dat_ complex(psb_spk_) :: dat_
integer(psb_ipk_) :: iam, np, info 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) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
call mpi_scan(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,icomm,minfo) if (present(mode)) then
dat = dat_ 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 #endif
end subroutine psb_cscan_sums end subroutine psb_cscan_sums
subroutine psb_cexscan_sums(ctxt,dat,mode,request)
subroutine psb_cexscan_sums(ctxt,dat)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -689,22 +993,50 @@ contains
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat complex(psb_spk_), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
complex(psb_spk_) :: dat_ complex(psb_spk_) :: dat_
integer(psb_ipk_) :: iam, np, info 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) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
call mpi_exscan(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,icomm,minfo) if (present(mode)) then
dat = dat_ 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 #else
dat = czero dat = czero
#endif #endif
end subroutine psb_cexscan_sums end subroutine psb_cexscan_sums
subroutine psb_cscan_sumv(ctxt,dat,root) subroutine psb_cscan_sumv(ctxt,dat,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -715,23 +1047,46 @@ contains
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:) complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_) :: root_ integer(psb_mpk_), intent(inout), optional :: request
complex(psb_spk_), allocatable :: dat_(:)
integer(psb_ipk_) :: iam, np, info 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) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
call psb_realloc(size(dat),dat_,info) if (present(mode)) then
dat_ = dat collective_sync = .false.
if (info == psb_success_) & collective_start = iand(mode,psb_collective_start_) /= 0
& call mpi_scan(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,icomm,minfo) 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 #endif
end subroutine psb_cscan_sumv end subroutine psb_cscan_sumv
subroutine psb_cexscan_sumv(ctxt,dat,root) subroutine psb_cexscan_sumv(ctxt,dat,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -742,19 +1097,44 @@ contains
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_spk_), intent(inout) :: dat(:) complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_) :: root_ integer(psb_mpk_), intent(inout), optional :: request
complex(psb_spk_), allocatable :: dat_(:) complex(psb_spk_), allocatable :: dat_(:)
integer(psb_ipk_) :: iam, np, info 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) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
call psb_realloc(size(dat),dat_,info) if (present(mode)) then
dat_ = dat collective_sync = .false.
if (info == psb_success_) & collective_start = iand(mode,psb_collective_start_) /= 0
& call mpi_exscan(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,icomm,minfo) 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 #else
dat = czero dat = czero
#endif #endif

1147
base/modules/penv/psi_d_collective_mod.F90
View File

File diff suppressed because it is too large Load Diff

1014
base/modules/penv/psi_e_collective_mod.F90
View File

File diff suppressed because it is too large Load Diff

1014
base/modules/penv/psi_i2_collective_mod.F90
View File

File diff suppressed because it is too large Load Diff

1014
base/modules/penv/psi_m_collective_mod.F90
View File

File diff suppressed because it is too large Load Diff

1147
base/modules/penv/psi_s_collective_mod.F90
View File

File diff suppressed because it is too large Load Diff

672
base/modules/penv/psi_z_collective_mod.F90
Unescape Escape View File

@ -94,7 +94,6 @@ contains
integer(psb_ipk_), intent(in), optional :: mode integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_dpk_) :: dat_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
@ -126,16 +125,20 @@ contains
end if end if
if (collective_sync) then if (collective_sync) then
if (root_ == -1) 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 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 endif
else else
if (collective_start) then if (collective_start) then
if (root_ == -1) 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 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 end if
else if (collective_end) then else if (collective_end) then
call mpi_wait(request,status,info) call mpi_wait(request,status,info)
@ -191,27 +194,30 @@ contains
if (collective_sync) then if (collective_sync) then
if (root_ == -1) then if (root_ == -1) then
if (iinfo == psb_success_) & 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 else
if (iam == root_) then 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 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
end if end if
else else
if (collective_start) then if (collective_start) then
if (root_ == -1) then if (root_ == -1) then
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,& & call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& icomm,request,info) & psb_mpi_c_dpk_,mpi_sum,icomm,request,info)
else else
if (iam == root_) then if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,& call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& icomm,request,info) & psb_mpi_c_dpk_,mpi_sum,root_,icomm,request,info)
else else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,& call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& icomm,request,info) & psb_mpi_c_dpk_,mpi_sum,root_,icomm,request,info)
end if end if
end if end if
else if (collective_end) then else if (collective_end) then
@ -270,27 +276,30 @@ contains
if (collective_sync) then if (collective_sync) then
if (root_ == -1) then if (root_ == -1) then
if (iinfo == psb_success_) & 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 else
if (iam == root_) then 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 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
end if end if
else else
if (collective_start) then if (collective_start) then
if (root_ == -1) then if (root_ == -1) then
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,& & call mpi_iallreduce(MPI_IN_PLACE,dat,size(dat),&
& icomm,request,info) & psb_mpi_c_dpk_,mpi_sum,icomm,request,info)
else else
if (iam == root_) then if (iam == root_) then
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,& call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& icomm,request,info) & psb_mpi_c_dpk_,mpi_sum,root_, icomm,request,info)
else else
call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,& call mpi_ireduce(MPI_IN_PLACE,dat,size(dat),&
& icomm,request,info) & psb_mpi_c_dpk_,mpi_sum,root_,icomm,request,info)
end if end if
end if end if
else if (collective_end) then else if (collective_end) then
@ -304,7 +313,7 @@ contains
! AMX: Maximum Absolute Value ! AMX: Maximum Absolute Value
! !
subroutine psb_zamxs(ctxt,dat,root) subroutine psb_zamxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -315,10 +324,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
complex(psb_dpk_) :: dat_ integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -329,17 +342,46 @@ contains
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then if (present(mode)) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,icomm,info) collective_sync = .false.
dat = dat_ 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 else
call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info) collective_sync = .true.
if (iam == root_) dat = dat_ collective_start = .false.
endif 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 #endif
end subroutine psb_zamxs end subroutine psb_zamxs
subroutine psb_zamxv(ctxt,dat,root) subroutine psb_zamxv(ctxt,dat,root,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -351,10 +393,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:) complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
complex(psb_dpk_), allocatable :: dat_(:) integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -365,25 +411,52 @@ contains
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then if (present(mode)) then
call psb_realloc(size(dat),dat_,iinfo) collective_sync = .false.
dat_ = dat collective_start = iand(mode,psb_collective_start_) /= 0
if (iinfo == psb_success_) & collective_end = iand(mode,psb_collective_end_) /= 0
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,icomm,info) if (.not.present(request)) then
else collective_sync = .true.
if (iam == root_) then collective_start = .false.
call psb_realloc(size(dat),dat_,iinfo) collective_end = .false.
dat_ = dat end if
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info) 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 else
call psb_realloc(1,dat_,iinfo) if (iam == root_) then
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info) 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 if
#endif #endif
end subroutine psb_zamxv end subroutine psb_zamxv
subroutine psb_zamxm(ctxt,dat,root) subroutine psb_zamxm(ctxt,dat,root,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -395,10 +468,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:,:) complex(psb_dpk_), intent(inout) :: dat(:,:)
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
complex(psb_dpk_), allocatable :: dat_(:,:) integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -410,29 +487,54 @@ contains
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then if (present(mode)) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) collective_sync = .false.
dat_ = dat collective_start = iand(mode,psb_collective_start_) /= 0
if (iinfo == psb_success_)& collective_end = iand(mode,psb_collective_end_) /= 0
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,icomm,info) if (.not.present(request)) then
else collective_sync = .true.
if (iam == root_) then collective_start = .false.
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) collective_end = .false.
dat_ = dat end if
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info) 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 else
call psb_realloc(1,1,dat_,iinfo) if (iam == root_) then
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info) 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 if
#endif #endif
end subroutine psb_zamxm end subroutine psb_zamxm
! !
! AMN: Minimum Absolute Value ! AMN: Minimum Absolute Value
! !
subroutine psb_zamns(ctxt,dat,root,mode,request)
subroutine psb_zamns(ctxt,dat,root)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -443,10 +545,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
complex(psb_dpk_) :: dat_ integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -457,17 +563,46 @@ contains
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then if (present(mode)) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,icomm,info) collective_sync = .false.
dat = dat_ 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 else
call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info) collective_sync = .true.
if (iam == root_) dat = dat_ collective_start = .false.
endif 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 #endif
end subroutine psb_zamns end subroutine psb_zamns
subroutine psb_zamnv(ctxt,dat,root) subroutine psb_zamnv(ctxt,dat,root,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -479,10 +614,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:) complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
complex(psb_dpk_), allocatable :: dat_(:) integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -493,25 +632,52 @@ contains
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then if (present(mode)) then
call psb_realloc(size(dat),dat_,iinfo) collective_sync = .false.
dat_ = dat collective_start = iand(mode,psb_collective_start_) /= 0
if (iinfo == psb_success_) & collective_end = iand(mode,psb_collective_end_) /= 0
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,icomm,info) if (.not.present(request)) then
else collective_sync = .true.
if (iam == root_) then collective_start = .false.
call psb_realloc(size(dat),dat_,iinfo) collective_end = .false.
dat_ = dat end if
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info) 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 else
call psb_realloc(1,dat_,iinfo) if (iam == root_) then
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info) 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 if
#endif #endif
end subroutine psb_zamnv end subroutine psb_zamnv
subroutine psb_zamnm(ctxt,dat,root) subroutine psb_zamnm(ctxt,dat,root,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -523,10 +689,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:,:) complex(psb_dpk_), intent(inout) :: dat(:,:)
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
complex(psb_dpk_), allocatable :: dat_(:,:) integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -538,29 +708,55 @@ contains
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
if (root_ == -1) then if (present(mode)) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) collective_sync = .false.
dat_ = dat collective_start = iand(mode,psb_collective_start_) /= 0
if (iinfo == psb_success_)& collective_end = iand(mode,psb_collective_end_) /= 0
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,icomm,info) if (.not.present(request)) then
else collective_sync = .true.
if (iam == root_) then collective_start = .false.
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) collective_end = .false.
dat_ = dat end if
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info) 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 else
call psb_realloc(1,1,dat_,iinfo) if (iam == root_) then
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info) 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 if
#endif #endif
end subroutine psb_zamnm end subroutine psb_zamnm
! !
! BCAST Broadcast ! BCAST Broadcast
! !
subroutine psb_zbcasts(ctxt,dat,root,mode,request)
subroutine psb_zbcasts(ctxt,dat,root)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -571,10 +767,15 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -585,12 +786,33 @@ contains
root_ = psb_root_ root_ = psb_root_
endif endif
icomm = psb_get_mpi_comm(ctxt) 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 #endif
end subroutine psb_zbcasts end subroutine psb_zbcasts
subroutine psb_zbcastv(ctxt,dat,root) subroutine psb_zbcastv(ctxt,dat,root,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -602,9 +824,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:) complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root 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_) :: 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 integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -615,11 +842,34 @@ contains
root_ = psb_root_ root_ = psb_root_
endif endif
icomm = psb_get_mpi_comm(ctxt) 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 #endif
end subroutine psb_zbcastv end subroutine psb_zbcastv
subroutine psb_zbcastm(ctxt,dat,root) subroutine psb_zbcastm(ctxt,dat,root,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -631,10 +881,14 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:,:) complex(psb_dpk_), intent(inout) :: dat(:,:)
integer(psb_mpk_), intent(in), optional :: root 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_) :: root_
integer(psb_mpk_) :: iam, np, info
integer(psb_mpk_) :: iam, np, info, icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -646,7 +900,30 @@ contains
root_ = psb_root_ root_ = psb_root_
endif endif
icomm = psb_get_mpi_comm(ctxt) 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 #endif
end subroutine psb_zbcastm 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 #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -665,21 +942,48 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt 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_), intent(inout) :: dat
complex(psb_dpk_) :: dat_ complex(psb_dpk_) :: dat_
integer(psb_ipk_) :: iam, np, info 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) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
call mpi_scan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,minfo) if (present(mode)) then
dat = dat_ 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 #endif
end subroutine psb_zscan_sums end subroutine psb_zscan_sums
subroutine psb_zexscan_sums(ctxt,dat,mode,request)
subroutine psb_zexscan_sums(ctxt,dat)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -689,22 +993,50 @@ contains
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
complex(psb_dpk_) :: dat_ complex(psb_dpk_) :: dat_
integer(psb_ipk_) :: iam, np, info 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) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
call mpi_exscan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,minfo) if (present(mode)) then
dat = dat_ 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 #else
dat = zzero dat = zzero
#endif #endif
end subroutine psb_zexscan_sums end subroutine psb_zexscan_sums
subroutine psb_zscan_sumv(ctxt,dat,root) subroutine psb_zscan_sumv(ctxt,dat,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -715,23 +1047,46 @@ contains
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:) complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_) :: root_ integer(psb_mpk_), intent(inout), optional :: request
complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_ipk_) :: iam, np, info 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) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
call psb_realloc(size(dat),dat_,info) if (present(mode)) then
dat_ = dat collective_sync = .false.
if (info == psb_success_) & collective_start = iand(mode,psb_collective_start_) /= 0
& call mpi_scan(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,icomm,minfo) 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 #endif
end subroutine psb_zscan_sumv end subroutine psb_zscan_sumv
subroutine psb_zexscan_sumv(ctxt,dat,root) subroutine psb_zexscan_sumv(ctxt,dat,mode,request)
use psb_realloc_mod use psb_realloc_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -742,19 +1097,44 @@ contains
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
complex(psb_dpk_), intent(inout) :: dat(:) complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_) :: root_ integer(psb_mpk_), intent(inout), optional :: request
complex(psb_dpk_), allocatable :: dat_(:) complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_ipk_) :: iam, np, info 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) #if !defined(SERIAL_MPI)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt) icomm = psb_get_mpi_comm(ctxt)
call psb_realloc(size(dat),dat_,info) if (present(mode)) then
dat_ = dat collective_sync = .false.
if (info == psb_success_) & collective_start = iand(mode,psb_collective_start_) /= 0
& call mpi_exscan(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,icomm,minfo) 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 #else
dat = zzero dat = zzero
#endif #endif

Write Preview
Loading…
Cancel
Save