|
|
|
@ -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)
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
call psb_realloc(1,dat_,iinfo)
|
|
|
|
|
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
|
|
|
|
|
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
|
|
|
|
|
endif
|
|
|
|
|
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)
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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 (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
|
|
|
|
|
endif
|
|
|
|
|
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)
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
call psb_realloc(1,dat_,iinfo)
|
|
|
|
|
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
|
|
|
|
|
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
|
|
|
|
|
endif
|
|
|
|
|
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)
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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 (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
|
|
|
|
|
endif
|
|
|
|
|
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
|
|
|
|
|