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

First round of updateds for new CONTEXT

Browse Source
new-context
Salvatore Filippone 4 years ago
parent 2697fbe73a
commit 2009ed8dbe
18 changed files with 954 additions and 3805 deletions
Show Stats Download Patch File Download Diff File

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

@ -31,28 +31,22 @@
! !
module psi_c_collective_mod module psi_c_collective_mod
use psi_penv_mod use psi_penv_mod
use psi_comm_buffers_mod
interface psb_sum interface psb_sum
module procedure psb_csums, psb_csumv, psb_csumm, & module procedure psb_csums, psb_csumv, psb_csumm
& psb_csums_ec, psb_csumv_ec, psb_csumm_ec
end interface end interface
interface psb_amx interface psb_amx
module procedure psb_camxs, psb_camxv, psb_camxm, & module procedure psb_camxs, psb_camxv, psb_camxm
& psb_camxs_ec, psb_camxv_ec, psb_camxm_ec
end interface end interface
interface psb_amn interface psb_amn
module procedure psb_camns, psb_camnv, psb_camnm, & module procedure psb_camns, psb_camnv, psb_camnm
& psb_camns_ec, psb_camnv_ec, psb_camnm_ec
end interface end interface
interface psb_bcast interface psb_bcast
module procedure psb_cbcasts, psb_cbcastv, psb_cbcastm, & module procedure psb_cbcasts, psb_cbcastv, psb_cbcastm
& psb_cbcasts_ec, psb_cbcastv_ec, psb_cbcastm_ec
end interface psb_bcast end interface psb_bcast
interface psb_scan_sum interface psb_scan_sum
@ -71,7 +65,6 @@ module psi_c_collective_mod
module procedure psb_c_e_simple_triad_a2av, psb_c_m_simple_triad_a2av module procedure psb_c_e_simple_triad_a2av, psb_c_m_simple_triad_a2av
end interface psb_simple_triad_a2av end interface psb_simple_triad_a2av
contains contains
! !!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!
@ -94,15 +87,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_spk_) :: dat_ complex(psb_spk_) :: dat_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -111,11 +103,12 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,icomm,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
if (iam == root_) dat = dat_ if (iam == root_) dat = dat_
endif endif
#endif #endif
@ -130,15 +123,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_spk_), allocatable :: dat_(:) complex(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -147,19 +139,20 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
end if end if
endif endif
#endif #endif
@ -174,12 +167,12 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_spk_), allocatable :: dat_(:,:) complex(psb_spk_), allocatable :: dat_(:,:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -191,73 +184,25 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,icomm,info)
end if end if
endif endif
#endif #endif
end subroutine psb_csumm end subroutine psb_csumm
subroutine psb_csums_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_sum(ictxt_,dat,root_)
else
call psb_sum(ictxt_,dat)
end if
end subroutine psb_csums_ec
subroutine psb_csumv_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_sum(ictxt_,dat,root_)
else
call psb_sum(ictxt_,dat)
end if
end subroutine psb_csumv_ec
subroutine psb_csumm_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(inout) :: dat(:,:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_sum(ictxt_,dat,root_)
else
call psb_sum(ictxt_,dat)
end if
end subroutine psb_csumm_ec
! !
! AMX: Maximum Absolute Value ! AMX: Maximum Absolute Value
! !
@ -270,15 +215,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_spk_) :: dat_ complex(psb_spk_) :: dat_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -287,11 +231,12 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,icomm,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
if (iam == root_) dat = dat_ if (iam == root_) dat = dat_
endif endif
#endif #endif
@ -306,15 +251,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_spk_), allocatable :: dat_(:) complex(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -323,19 +267,20 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
end if end if
endif endif
#endif #endif
@ -350,12 +295,12 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_spk_), allocatable :: dat_(:,:) complex(psb_spk_), allocatable :: dat_(:,:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -367,74 +312,25 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info)
end if end if
endif endif
#endif #endif
end subroutine psb_camxm end subroutine psb_camxm
subroutine psb_camxs_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_amx(ictxt_,dat,root_)
else
call psb_amx(ictxt_,dat)
end if
end subroutine psb_camxs_ec
subroutine psb_camxv_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_amx(ictxt_,dat,root_)
else
call psb_amx(ictxt_,dat)
end if
end subroutine psb_camxv_ec
subroutine psb_camxm_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(inout) :: dat(:,:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_amx(ictxt_,dat,root_)
else
call psb_amx(ictxt_,dat)
end if
end subroutine psb_camxm_ec
! !
! AMN: Minimum Absolute Value ! AMN: Minimum Absolute Value
! !
@ -447,15 +343,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_spk_) :: dat_ complex(psb_spk_) :: dat_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -464,11 +359,12 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,icomm,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
if (iam == root_) dat = dat_ if (iam == root_) dat = dat_
endif endif
#endif #endif
@ -483,15 +379,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_spk_), allocatable :: dat_(:) complex(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -500,19 +395,20 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
end if end if
endif endif
#endif #endif
@ -527,12 +423,12 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_spk_), allocatable :: dat_(:,:) complex(psb_spk_), allocatable :: dat_(:,:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -544,74 +440,25 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info)
end if end if
endif endif
#endif #endif
end subroutine psb_camnm end subroutine psb_camnm
subroutine psb_camns_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_amn(ictxt_,dat,root_)
else
call psb_amn(ictxt_,dat)
end if
end subroutine psb_camns_ec
subroutine psb_camnv_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_amn(ictxt_,dat,root_)
else
call psb_amn(ictxt_,dat)
end if
end subroutine psb_camnv_ec
subroutine psb_camnm_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(inout) :: dat(:,:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_amn(ictxt_,dat,root_)
else
call psb_amn(ictxt_,dat)
end if
end subroutine psb_camnm_ec
! !
! BCAST Broadcast ! BCAST Broadcast
! !
@ -624,15 +471,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -641,7 +487,8 @@ contains
else else
root_ = psb_root_ root_ = psb_root_
endif endif
call mpi_bcast(dat,1,psb_mpi_c_spk_,root_,ictxt,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_bcast(dat,1,psb_mpi_c_spk_,root_,icomm,info)
#endif #endif
end subroutine psb_cbcasts end subroutine psb_cbcasts
@ -655,14 +502,13 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -671,8 +517,8 @@ contains
else else
root_ = psb_root_ root_ = psb_root_
endif endif
icomm = psb_get_mpi_comm(ictxt)
call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,icomm,info)
#endif #endif
end subroutine psb_cbcastv end subroutine psb_cbcastv
@ -685,12 +531,12 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -702,61 +548,11 @@ contains
else else
root_ = psb_root_ root_ = psb_root_
endif endif
icomm = psb_get_mpi_comm(ictxt)
call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,icomm,info)
#endif #endif
end subroutine psb_cbcastm end subroutine psb_cbcastm
subroutine psb_cbcasts_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
call psb_bcast(ictxt_,dat)
end if
end subroutine psb_cbcasts_ec
subroutine psb_cbcastv_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
call psb_bcast(ictxt_,dat)
end if
end subroutine psb_cbcastv_ec
subroutine psb_cbcastm_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(inout) :: dat(:,:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
call psb_bcast(ictxt_,dat)
end if
end subroutine psb_cbcastm_ec
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! !
! SCAN ! SCAN
@ -771,13 +567,12 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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, icomm
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
icomm = psb_get_mpi_comm(ictxt) icomm = psb_get_mpi_comm(ictxt)
@ -795,7 +590,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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
@ -821,7 +616,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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 :: root
integer(psb_mpk_) :: root_ integer(psb_mpk_) :: root_
@ -848,7 +643,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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 :: root
integer(psb_mpk_) :: root_ integer(psb_mpk_) :: root_
@ -875,9 +670,8 @@ contains
complex(psb_spk_), intent(in) :: valsnd(:) complex(psb_spk_), intent(in) :: valsnd(:)
complex(psb_spk_), intent(out) :: valrcv(:) complex(psb_spk_), intent(out) :: valrcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -919,7 +713,7 @@ contains
complex(psb_spk_), intent(out) :: valrcv(:) complex(psb_spk_), intent(out) :: valrcv(:)
integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!Local variables !Local variables
@ -1002,7 +796,7 @@ contains
complex(psb_spk_), intent(out) :: valrcv(:) complex(psb_spk_), intent(out) :: valrcv(:)
integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!Local variables !Local variables

129
base/modules/penv/psi_c_p2p_mod.F90
Unescape Escape View File

@ -32,22 +32,18 @@
module psi_c_p2p_mod module psi_c_p2p_mod
use psi_penv_mod use psi_penv_mod
use psi_comm_buffers_mod
interface psb_snd interface psb_snd
module procedure psb_csnds, psb_csndv, psb_csndm, & module procedure psb_csnds, psb_csndv, psb_csndm
& psb_csnds_ec, psb_csndv_ec, psb_csndm_ec
end interface end interface
interface psb_rcv interface psb_rcv
module procedure psb_crcvs, psb_crcvv, psb_crcvm, & module procedure psb_crcvs, psb_crcvv, psb_crcvm
& psb_crcvs_ec, psb_crcvv_ec, psb_crcvm_ec
end interface end interface
contains contains
subroutine psb_csnds(ictxt,dat,dst) subroutine psb_csnds(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -55,7 +51,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
complex(psb_spk_), intent(in) :: dat complex(psb_spk_), intent(in) :: dat
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
complex(psb_spk_), allocatable :: dat_(:) complex(psb_spk_), allocatable :: dat_(:)
@ -70,7 +66,6 @@ contains
end subroutine psb_csnds end subroutine psb_csnds
subroutine psb_csndv(ictxt,dat,dst) subroutine psb_csndv(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -79,7 +74,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
complex(psb_spk_), intent(in) :: dat(:) complex(psb_spk_), intent(in) :: dat(:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
complex(psb_spk_), allocatable :: dat_(:) complex(psb_spk_), allocatable :: dat_(:)
@ -95,7 +90,6 @@ contains
end subroutine psb_csndv end subroutine psb_csndv
subroutine psb_csndm(ictxt,dat,dst,m) subroutine psb_csndm(ictxt,dat,dst,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -104,7 +98,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
complex(psb_spk_), intent(in) :: dat(:,:) complex(psb_spk_), intent(in) :: dat(:,:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
@ -133,7 +127,6 @@ contains
end subroutine psb_csndm end subroutine psb_csndm
subroutine psb_crcvs(ictxt,dat,src) subroutine psb_crcvs(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -141,21 +134,21 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
complex(psb_spk_), intent(out) :: dat complex(psb_spk_), intent(out) :: dat
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,1,psb_mpi_c_spk_,src,psb_complex_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_crcvs end subroutine psb_crcvs
subroutine psb_crcvv(ictxt,dat,src) subroutine psb_crcvv(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -164,22 +157,22 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
complex(psb_spk_), intent(out) :: dat(:) complex(psb_spk_), intent(out) :: dat(:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
complex(psb_spk_), allocatable :: dat_(:) complex(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
#else #else
call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_crcvv end subroutine psb_crcvv
subroutine psb_crcvm(ictxt,dat,src,m) subroutine psb_crcvm(ictxt,dat,src,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -188,14 +181,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
complex(psb_spk_), intent(out) :: dat(:,:) complex(psb_spk_), intent(out) :: dat(:,:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
complex(psb_spk_), allocatable :: dat_(:) complex(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! What should we do here?? ! What should we do here??
#else #else
@ -205,11 +198,13 @@ contains
n_ = size(dat,2) n_ = size(dat,2)
call mpi_type_vector(n_,m_,ld,psb_mpi_c_spk_,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_c_spk_,mp_rcv_type,info)
if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info)
icomm = psb_get_mpi_comm(ictxt)
if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,&
& psb_complex_tag,ictxt,status,info) & psb_complex_tag,icomm,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
else else
call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,icomm,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then
write(psb_err_unit,*) 'Error in psb_recv', info write(psb_err_unit,*) 'Error in psb_recv', info
@ -218,90 +213,4 @@ contains
#endif #endif
end subroutine psb_crcvm end subroutine psb_crcvm
subroutine psb_csnds_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(in) :: dat
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_csnds_ec
subroutine psb_csndv_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(in) :: dat(:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_csndv_ec
subroutine psb_csndm_ec(ictxt,dat,dst,m)
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(in) :: dat(:,:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_csndm_ec
subroutine psb_crcvs_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(out) :: dat
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_crcvs_ec
subroutine psb_crcvv_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(out) :: dat(:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_crcvv_ec
subroutine psb_crcvm_ec(ictxt,dat,src,m)
integer(psb_epk_), intent(in) :: ictxt
complex(psb_spk_), intent(out) :: dat(:,:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_crcvm_ec
end module psi_c_p2p_mod end module psi_c_p2p_mod

191
base/modules/penv/psi_collective_mod.F90
Unescape Escape View File

@ -40,22 +40,18 @@ module psi_collective_mod
interface psb_bcast interface psb_bcast
module procedure psb_hbcasts, psb_hbcastv,& module procedure psb_hbcasts, psb_hbcastv,&
& psb_hbcasts_ec, psb_hbcastv_ec,& & psb_lbcasts, psb_lbcastv
& psb_lbcasts, psb_lbcastv, &
& psb_lbcasts_ec, psb_lbcastv_ec
end interface psb_bcast end interface psb_bcast
#if defined(SHORT_INTEGERS) #if defined(SHORT_INTEGERS)
interface psb_sum interface psb_sum
module procedure psb_i2sums, psb_i2sumv, psb_i2summ, & module procedure psb_i2sums, psb_i2sumv, psb_i2summ
& psb_i2sums_ec, psb_i2sumv_ec, psb_i2summ_ec
end interface psb_sum end interface psb_sum
#endif #endif
contains contains
subroutine psb_hbcasts(ictxt,dat,root,length) subroutine psb_hbcasts(ictxt,dat,root,length)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -64,11 +60,11 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
character(len=*), intent(inout) :: dat character(len=*), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root,length integer(psb_mpk_), intent(in), optional :: root,length
integer(psb_mpk_) :: iam, np, root_,length_,info integer(psb_mpk_) :: iam, np, root_,length_,info, icomm
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
if (present(root)) then if (present(root)) then
@ -83,8 +79,8 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
icomm = psb_get_mpi_comm(ictxt)
call mpi_bcast(dat,length_,MPI_CHARACTER,root_,ictxt,info) call mpi_bcast(dat,length_,MPI_CHARACTER,root_,icomm,info)
#endif #endif
end subroutine psb_hbcasts end subroutine psb_hbcasts
@ -97,11 +93,12 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
character(len=*), intent(inout) :: dat(:) character(len=*), intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_), intent(in), optional :: root
integer(psb_mpk_) :: iam, np, root_,length_,info, size_ integer(psb_mpk_) :: iam, np, root_, icomm
integer(psb_mpk_) :: length_,info, size_
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
if (present(root)) then if (present(root)) then
@ -113,46 +110,12 @@ contains
size_ = size(dat) size_ = size(dat)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
icomm = psb_get_mpi_comm(ictxt)
call mpi_bcast(dat,length_*size_,MPI_CHARACTER,root_,ictxt,info) call mpi_bcast(dat,length_*size_,MPI_CHARACTER,root_,icomm,info)
#endif #endif
end subroutine psb_hbcastv end subroutine psb_hbcastv
subroutine psb_hbcasts_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
character(len=*), intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
call psb_bcast(ictxt_,dat)
end if
end subroutine psb_hbcasts_ec
subroutine psb_hbcastv_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
character(len=*), intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
call psb_bcast(ictxt_,dat)
end if
end subroutine psb_hbcastv_ec
subroutine psb_lbcasts(ictxt,dat,root) subroutine psb_lbcasts(ictxt,dat,root)
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -161,11 +124,11 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
logical, intent(inout) :: dat logical, intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_), intent(in), optional :: root
integer(psb_mpk_) :: iam, np, root_,info integer(psb_mpk_) :: iam, np, root_,info, icomm
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
if (present(root)) then if (present(root)) then
@ -175,7 +138,8 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,1,MPI_LOGICAL,root_,ictxt,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_bcast(dat,1,MPI_LOGICAL,root_,icomm,info)
#endif #endif
end subroutine psb_lbcasts end subroutine psb_lbcasts
@ -188,18 +152,19 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
logical, intent(inout) :: dat logical, intent(inout) :: dat
logical, intent(inout), optional :: rec logical, intent(inout), optional :: rec
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
icomm = psb_get_mpi_comm(ictxt)
if (present(rec)) then if (present(rec)) then
call mpi_allreduce(dat,rec,1,MPI_LOGICAL,MPI_LAND,ictxt,info) call mpi_allreduce(dat,rec,1,MPI_LOGICAL,MPI_LAND,icomm,info)
else else
call mpi_allreduce(MPI_IN_PLACE,dat,1,MPI_LOGICAL,MPI_LAND,ictxt,info) call mpi_allreduce(MPI_IN_PLACE,dat,1,MPI_LOGICAL,MPI_LAND,icomm,info)
endif endif
#endif #endif
@ -214,11 +179,11 @@ end subroutine psb_lallreduceand
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
logical, intent(inout) :: dat(:) logical, intent(inout) :: dat(:)
integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_), intent(in), optional :: root
integer(psb_mpk_) :: iam, np, root_,info integer(psb_mpk_) :: iam, np, root_,info, icomm
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
if (present(root)) then if (present(root)) then
@ -226,48 +191,13 @@ end subroutine psb_lallreduceand
else else
root_ = psb_root_ root_ = psb_root_
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),MPI_LOGICAL,root_,ictxt,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_bcast(dat,size(dat),MPI_LOGICAL,root_,icomm,info)
#endif #endif
end subroutine psb_lbcastv end subroutine psb_lbcastv
subroutine psb_lbcasts_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
logical, intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
call psb_bcast(ictxt_,dat)
end if
end subroutine psb_lbcasts_ec
subroutine psb_lbcastv_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
logical, intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
call psb_bcast(ictxt_,dat)
end if
end subroutine psb_lbcastv_ec
#if defined(SHORT_INTEGERS) #if defined(SHORT_INTEGERS)
subroutine psb_i2sums(ictxt,dat,root) subroutine psb_i2sums(ictxt,dat,root)
@ -283,7 +213,7 @@ end subroutine psb_lallreduceand
integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_), intent(in), optional :: root
integer(psb_mpk_) :: root_ integer(psb_mpk_) :: root_
integer(psb_i2pk_) :: dat_ integer(psb_i2pk_) :: dat_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -295,11 +225,12 @@ end subroutine psb_lallreduceand
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,icomm,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,root_,icomm,info)
if (iam == root_) dat = dat_ if (iam == root_) dat = dat_
endif endif
@ -320,7 +251,7 @@ end subroutine psb_lallreduceand
integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_), intent(in), optional :: root
integer(psb_mpk_) :: root_ integer(psb_mpk_) :: root_
integer(psb_i2pk_), allocatable :: dat_(:) integer(psb_i2pk_), allocatable :: dat_(:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -332,18 +263,19 @@ end subroutine psb_lallreduceand
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,ictxt,info) & psb_mpi_i2pk_,mpi_sum,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,icomm,info)
else else
call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,icomm,info)
end if end if
endif endif
#endif #endif
@ -363,7 +295,7 @@ end subroutine psb_lallreduceand
integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_), intent(in), optional :: root
integer(psb_mpk_) :: root_ integer(psb_mpk_) :: root_
integer(psb_i2pk_), allocatable :: dat_(:,:) integer(psb_i2pk_), allocatable :: dat_(:,:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
@ -375,71 +307,24 @@ end subroutine psb_lallreduceand
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,ictxt,info) & psb_mpi_i2pk_,mpi_sum,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,icomm,info)
else else
call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,icomm,info)
end if end if
endif endif
#endif #endif
end subroutine psb_i2summ end subroutine psb_i2summ
subroutine psb_i2sums_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
integer(psb_i2pk_), intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_sum(ictxt_,dat,root_)
else
call psb_sum(ictxt_,dat)
end if
end subroutine psb_i2sums_ec
subroutine psb_i2sumv_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
integer(psb_i2pk_), intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_sum(ictxt_,dat,root_)
else
call psb_sum(ictxt_,dat)
end if
end subroutine psb_i2sumv_ec
subroutine psb_i2summ_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
integer(psb_i2pk_), intent(inout) :: dat(:,:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_sum(ictxt_,dat,root_)
else
call psb_sum(ictxt_,dat)
end if
end subroutine psb_i2summ_ec
#endif #endif
end module psi_collective_mod end module psi_collective_mod

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

File diff suppressed because it is too large Load Diff

129
base/modules/penv/psi_d_p2p_mod.F90
Unescape Escape View File

@ -32,22 +32,18 @@
module psi_d_p2p_mod module psi_d_p2p_mod
use psi_penv_mod use psi_penv_mod
use psi_comm_buffers_mod
interface psb_snd interface psb_snd
module procedure psb_dsnds, psb_dsndv, psb_dsndm, & module procedure psb_dsnds, psb_dsndv, psb_dsndm
& psb_dsnds_ec, psb_dsndv_ec, psb_dsndm_ec
end interface end interface
interface psb_rcv interface psb_rcv
module procedure psb_drcvs, psb_drcvv, psb_drcvm, & module procedure psb_drcvs, psb_drcvv, psb_drcvm
& psb_drcvs_ec, psb_drcvv_ec, psb_drcvm_ec
end interface end interface
contains contains
subroutine psb_dsnds(ictxt,dat,dst) subroutine psb_dsnds(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -55,7 +51,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
real(psb_dpk_), intent(in) :: dat real(psb_dpk_), intent(in) :: dat
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
real(psb_dpk_), allocatable :: dat_(:) real(psb_dpk_), allocatable :: dat_(:)
@ -70,7 +66,6 @@ contains
end subroutine psb_dsnds end subroutine psb_dsnds
subroutine psb_dsndv(ictxt,dat,dst) subroutine psb_dsndv(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -79,7 +74,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
real(psb_dpk_), intent(in) :: dat(:) real(psb_dpk_), intent(in) :: dat(:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
real(psb_dpk_), allocatable :: dat_(:) real(psb_dpk_), allocatable :: dat_(:)
@ -95,7 +90,6 @@ contains
end subroutine psb_dsndv end subroutine psb_dsndv
subroutine psb_dsndm(ictxt,dat,dst,m) subroutine psb_dsndm(ictxt,dat,dst,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -104,7 +98,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
real(psb_dpk_), intent(in) :: dat(:,:) real(psb_dpk_), intent(in) :: dat(:,:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
@ -133,7 +127,6 @@ contains
end subroutine psb_dsndm end subroutine psb_dsndm
subroutine psb_drcvs(ictxt,dat,src) subroutine psb_drcvs(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -141,21 +134,21 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
real(psb_dpk_), intent(out) :: dat real(psb_dpk_), intent(out) :: dat
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,1,psb_mpi_r_dpk_,src,psb_double_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_drcvs end subroutine psb_drcvs
subroutine psb_drcvv(ictxt,dat,src) subroutine psb_drcvv(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -164,22 +157,22 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
real(psb_dpk_), intent(out) :: dat(:) real(psb_dpk_), intent(out) :: dat(:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
real(psb_dpk_), allocatable :: dat_(:) real(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
#else #else
call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_drcvv end subroutine psb_drcvv
subroutine psb_drcvm(ictxt,dat,src,m) subroutine psb_drcvm(ictxt,dat,src,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -188,14 +181,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
real(psb_dpk_), intent(out) :: dat(:,:) real(psb_dpk_), intent(out) :: dat(:,:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
real(psb_dpk_), allocatable :: dat_(:) real(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! What should we do here?? ! What should we do here??
#else #else
@ -205,11 +198,13 @@ contains
n_ = size(dat,2) n_ = size(dat,2)
call mpi_type_vector(n_,m_,ld,psb_mpi_r_dpk_,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_r_dpk_,mp_rcv_type,info)
if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info)
icomm = psb_get_mpi_comm(ictxt)
if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,&
& psb_double_tag,ictxt,status,info) & psb_double_tag,icomm,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
else else
call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,icomm,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then
write(psb_err_unit,*) 'Error in psb_recv', info write(psb_err_unit,*) 'Error in psb_recv', info
@ -218,90 +213,4 @@ contains
#endif #endif
end subroutine psb_drcvm end subroutine psb_drcvm
subroutine psb_dsnds_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
real(psb_dpk_), intent(in) :: dat
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_dsnds_ec
subroutine psb_dsndv_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
real(psb_dpk_), intent(in) :: dat(:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_dsndv_ec
subroutine psb_dsndm_ec(ictxt,dat,dst,m)
integer(psb_epk_), intent(in) :: ictxt
real(psb_dpk_), intent(in) :: dat(:,:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_dsndm_ec
subroutine psb_drcvs_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
real(psb_dpk_), intent(out) :: dat
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_drcvs_ec
subroutine psb_drcvv_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
real(psb_dpk_), intent(out) :: dat(:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_drcvv_ec
subroutine psb_drcvm_ec(ictxt,dat,src,m)
integer(psb_epk_), intent(in) :: ictxt
real(psb_dpk_), intent(out) :: dat(:,:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_drcvm_ec
end module psi_d_p2p_mod end module psi_d_p2p_mod

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

File diff suppressed because it is too large Load Diff

129
base/modules/penv/psi_e_p2p_mod.F90
Unescape Escape View File

@ -32,22 +32,18 @@
module psi_e_p2p_mod module psi_e_p2p_mod
use psi_penv_mod use psi_penv_mod
use psi_comm_buffers_mod
interface psb_snd interface psb_snd
module procedure psb_esnds, psb_esndv, psb_esndm, & module procedure psb_esnds, psb_esndv, psb_esndm
& psb_esnds_ec, psb_esndv_ec, psb_esndm_ec
end interface end interface
interface psb_rcv interface psb_rcv
module procedure psb_ercvs, psb_ercvv, psb_ercvm, & module procedure psb_ercvs, psb_ercvv, psb_ercvm
& psb_ercvs_ec, psb_ercvv_ec, psb_ercvm_ec
end interface end interface
contains contains
subroutine psb_esnds(ictxt,dat,dst) subroutine psb_esnds(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -55,7 +51,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_epk_), intent(in) :: dat integer(psb_epk_), intent(in) :: dat
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_epk_), allocatable :: dat_(:) integer(psb_epk_), allocatable :: dat_(:)
@ -70,7 +66,6 @@ contains
end subroutine psb_esnds end subroutine psb_esnds
subroutine psb_esndv(ictxt,dat,dst) subroutine psb_esndv(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -79,7 +74,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_epk_), intent(in) :: dat(:) integer(psb_epk_), intent(in) :: dat(:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_epk_), allocatable :: dat_(:) integer(psb_epk_), allocatable :: dat_(:)
@ -95,7 +90,6 @@ contains
end subroutine psb_esndv end subroutine psb_esndv
subroutine psb_esndm(ictxt,dat,dst,m) subroutine psb_esndm(ictxt,dat,dst,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -104,7 +98,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_epk_), intent(in) :: dat(:,:) integer(psb_epk_), intent(in) :: dat(:,:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
@ -133,7 +127,6 @@ contains
end subroutine psb_esndm end subroutine psb_esndm
subroutine psb_ercvs(ictxt,dat,src) subroutine psb_ercvs(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -141,21 +134,21 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_epk_), intent(out) :: dat integer(psb_epk_), intent(out) :: dat
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,psb_mpi_epk_,src,psb_int8_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,1,psb_mpi_epk_,src,psb_int8_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_ercvs end subroutine psb_ercvs
subroutine psb_ercvv(ictxt,dat,src) subroutine psb_ercvv(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -164,22 +157,22 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_epk_), intent(out) :: dat(:) integer(psb_epk_), intent(out) :: dat(:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_epk_), allocatable :: dat_(:) integer(psb_epk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
#else #else
call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_ercvv end subroutine psb_ercvv
subroutine psb_ercvm(ictxt,dat,src,m) subroutine psb_ercvm(ictxt,dat,src,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -188,14 +181,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_epk_), intent(out) :: dat(:,:) integer(psb_epk_), intent(out) :: dat(:,:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
integer(psb_epk_), allocatable :: dat_(:) integer(psb_epk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! What should we do here?? ! What should we do here??
#else #else
@ -205,11 +198,13 @@ contains
n_ = size(dat,2) n_ = size(dat,2)
call mpi_type_vector(n_,m_,ld,psb_mpi_epk_,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_epk_,mp_rcv_type,info)
if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info)
icomm = psb_get_mpi_comm(ictxt)
if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,&
& psb_int8_tag,ictxt,status,info) & psb_int8_tag,icomm,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
else else
call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,icomm,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then
write(psb_err_unit,*) 'Error in psb_recv', info write(psb_err_unit,*) 'Error in psb_recv', info
@ -218,90 +213,4 @@ contains
#endif #endif
end subroutine psb_ercvm end subroutine psb_ercvm
subroutine psb_esnds_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_epk_), intent(in) :: dat
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_esnds_ec
subroutine psb_esndv_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_epk_), intent(in) :: dat(:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_esndv_ec
subroutine psb_esndm_ec(ictxt,dat,dst,m)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_epk_), intent(in) :: dat(:,:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_esndm_ec
subroutine psb_ercvs_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_epk_), intent(out) :: dat
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_ercvs_ec
subroutine psb_ercvv_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_epk_), intent(out) :: dat(:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_ercvv_ec
subroutine psb_ercvm_ec(ictxt,dat,src,m)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_epk_), intent(out) :: dat(:,:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_ercvm_ec
end module psi_e_p2p_mod end module psi_e_p2p_mod

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

File diff suppressed because it is too large Load Diff

129
base/modules/penv/psi_i2_p2p_mod.F90
Unescape Escape View File

@ -32,22 +32,18 @@
module psi_i2_p2p_mod module psi_i2_p2p_mod
use psi_penv_mod use psi_penv_mod
use psi_comm_buffers_mod
interface psb_snd interface psb_snd
module procedure psb_i2snds, psb_i2sndv, psb_i2sndm, & module procedure psb_i2snds, psb_i2sndv, psb_i2sndm
& psb_i2snds_ec, psb_i2sndv_ec, psb_i2sndm_ec
end interface end interface
interface psb_rcv interface psb_rcv
module procedure psb_i2rcvs, psb_i2rcvv, psb_i2rcvm, & module procedure psb_i2rcvs, psb_i2rcvv, psb_i2rcvm
& psb_i2rcvs_ec, psb_i2rcvv_ec, psb_i2rcvm_ec
end interface end interface
contains contains
subroutine psb_i2snds(ictxt,dat,dst) subroutine psb_i2snds(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -55,7 +51,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_i2pk_), intent(in) :: dat integer(psb_i2pk_), intent(in) :: dat
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_i2pk_), allocatable :: dat_(:) integer(psb_i2pk_), allocatable :: dat_(:)
@ -70,7 +66,6 @@ contains
end subroutine psb_i2snds end subroutine psb_i2snds
subroutine psb_i2sndv(ictxt,dat,dst) subroutine psb_i2sndv(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -79,7 +74,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_i2pk_), intent(in) :: dat(:) integer(psb_i2pk_), intent(in) :: dat(:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_i2pk_), allocatable :: dat_(:) integer(psb_i2pk_), allocatable :: dat_(:)
@ -95,7 +90,6 @@ contains
end subroutine psb_i2sndv end subroutine psb_i2sndv
subroutine psb_i2sndm(ictxt,dat,dst,m) subroutine psb_i2sndm(ictxt,dat,dst,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -104,7 +98,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_i2pk_), intent(in) :: dat(:,:) integer(psb_i2pk_), intent(in) :: dat(:,:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
@ -133,7 +127,6 @@ contains
end subroutine psb_i2sndm end subroutine psb_i2sndm
subroutine psb_i2rcvs(ictxt,dat,src) subroutine psb_i2rcvs(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -141,21 +134,21 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_i2pk_), intent(out) :: dat integer(psb_i2pk_), intent(out) :: dat
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,psb_mpi_i2pk_,src,psb_int2_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,1,psb_mpi_i2pk_,src,psb_int2_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_i2rcvs end subroutine psb_i2rcvs
subroutine psb_i2rcvv(ictxt,dat,src) subroutine psb_i2rcvv(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -164,22 +157,22 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_i2pk_), intent(out) :: dat(:) integer(psb_i2pk_), intent(out) :: dat(:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_i2pk_), allocatable :: dat_(:) integer(psb_i2pk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
#else #else
call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_i2rcvv end subroutine psb_i2rcvv
subroutine psb_i2rcvm(ictxt,dat,src,m) subroutine psb_i2rcvm(ictxt,dat,src,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -188,14 +181,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_i2pk_), intent(out) :: dat(:,:) integer(psb_i2pk_), intent(out) :: dat(:,:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
integer(psb_i2pk_), allocatable :: dat_(:) integer(psb_i2pk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! What should we do here?? ! What should we do here??
#else #else
@ -205,11 +198,13 @@ contains
n_ = size(dat,2) n_ = size(dat,2)
call mpi_type_vector(n_,m_,ld,psb_mpi_i2pk_,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_i2pk_,mp_rcv_type,info)
if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info)
icomm = psb_get_mpi_comm(ictxt)
if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,&
& psb_int2_tag,ictxt,status,info) & psb_int2_tag,icomm,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
else else
call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,icomm,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then
write(psb_err_unit,*) 'Error in psb_recv', info write(psb_err_unit,*) 'Error in psb_recv', info
@ -218,90 +213,4 @@ contains
#endif #endif
end subroutine psb_i2rcvm end subroutine psb_i2rcvm
subroutine psb_i2snds_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_i2pk_), intent(in) :: dat
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_i2snds_ec
subroutine psb_i2sndv_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_i2pk_), intent(in) :: dat(:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_i2sndv_ec
subroutine psb_i2sndm_ec(ictxt,dat,dst,m)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_i2pk_), intent(in) :: dat(:,:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_i2sndm_ec
subroutine psb_i2rcvs_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_i2pk_), intent(out) :: dat
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_i2rcvs_ec
subroutine psb_i2rcvv_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_i2pk_), intent(out) :: dat(:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_i2rcvv_ec
subroutine psb_i2rcvm_ec(ictxt,dat,src,m)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_i2pk_), intent(out) :: dat(:,:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_i2rcvm_ec
end module psi_i2_p2p_mod end module psi_i2_p2p_mod

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

File diff suppressed because it is too large Load Diff

129
base/modules/penv/psi_m_p2p_mod.F90
Unescape Escape View File

@ -32,22 +32,18 @@
module psi_m_p2p_mod module psi_m_p2p_mod
use psi_penv_mod use psi_penv_mod
use psi_comm_buffers_mod
interface psb_snd interface psb_snd
module procedure psb_msnds, psb_msndv, psb_msndm, & module procedure psb_msnds, psb_msndv, psb_msndm
& psb_msnds_ec, psb_msndv_ec, psb_msndm_ec
end interface end interface
interface psb_rcv interface psb_rcv
module procedure psb_mrcvs, psb_mrcvv, psb_mrcvm, & module procedure psb_mrcvs, psb_mrcvv, psb_mrcvm
& psb_mrcvs_ec, psb_mrcvv_ec, psb_mrcvm_ec
end interface end interface
contains contains
subroutine psb_msnds(ictxt,dat,dst) subroutine psb_msnds(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -55,7 +51,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dat
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_mpk_), allocatable :: dat_(:) integer(psb_mpk_), allocatable :: dat_(:)
@ -70,7 +66,6 @@ contains
end subroutine psb_msnds end subroutine psb_msnds
subroutine psb_msndv(ictxt,dat,dst) subroutine psb_msndv(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -79,7 +74,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dat(:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_mpk_), allocatable :: dat_(:) integer(psb_mpk_), allocatable :: dat_(:)
@ -95,7 +90,6 @@ contains
end subroutine psb_msndv end subroutine psb_msndv
subroutine psb_msndm(ictxt,dat,dst,m) subroutine psb_msndm(ictxt,dat,dst,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -104,7 +98,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dat(:,:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
@ -133,7 +127,6 @@ contains
end subroutine psb_msndm end subroutine psb_msndm
subroutine psb_mrcvs(ictxt,dat,src) subroutine psb_mrcvs(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -141,21 +134,21 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(out) :: dat integer(psb_mpk_), intent(out) :: dat
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,psb_mpi_mpk_,src,psb_int4_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,1,psb_mpi_mpk_,src,psb_int4_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_mrcvs end subroutine psb_mrcvs
subroutine psb_mrcvv(ictxt,dat,src) subroutine psb_mrcvv(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -164,22 +157,22 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(out) :: dat(:) integer(psb_mpk_), intent(out) :: dat(:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_), allocatable :: dat_(:) integer(psb_mpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
#else #else
call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_mrcvv end subroutine psb_mrcvv
subroutine psb_mrcvm(ictxt,dat,src,m) subroutine psb_mrcvm(ictxt,dat,src,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -188,14 +181,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(out) :: dat(:,:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
integer(psb_mpk_), allocatable :: dat_(:) integer(psb_mpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! What should we do here?? ! What should we do here??
#else #else
@ -205,11 +198,13 @@ contains
n_ = size(dat,2) n_ = size(dat,2)
call mpi_type_vector(n_,m_,ld,psb_mpi_mpk_,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_mpk_,mp_rcv_type,info)
if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info)
icomm = psb_get_mpi_comm(ictxt)
if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,&
& psb_int4_tag,ictxt,status,info) & psb_int4_tag,icomm,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
else else
call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,icomm,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then
write(psb_err_unit,*) 'Error in psb_recv', info write(psb_err_unit,*) 'Error in psb_recv', info
@ -218,90 +213,4 @@ contains
#endif #endif
end subroutine psb_mrcvm end subroutine psb_mrcvm
subroutine psb_msnds_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: dat
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_msnds_ec
subroutine psb_msndv_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: dat(:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_msndv_ec
subroutine psb_msndm_ec(ictxt,dat,dst,m)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: dat(:,:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_msndm_ec
subroutine psb_mrcvs_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_mpk_), intent(out) :: dat
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_mrcvs_ec
subroutine psb_mrcvv_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_mpk_), intent(out) :: dat(:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_mrcvv_ec
subroutine psb_mrcvm_ec(ictxt,dat,src,m)
integer(psb_epk_), intent(in) :: ictxt
integer(psb_mpk_), intent(out) :: dat(:,:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_mrcvm_ec
end module psi_m_p2p_mod end module psi_m_p2p_mod

165
base/modules/penv/psi_p2p_mod.F90
Unescape Escape View File

@ -32,7 +32,6 @@
module psi_p2p_mod module psi_p2p_mod
use psi_penv_mod use psi_penv_mod
use psi_comm_buffers_mod
use psi_m_p2p_mod use psi_m_p2p_mod
use psi_e_p2p_mod use psi_e_p2p_mod
@ -49,13 +48,11 @@ module psi_p2p_mod
! !
interface psb_snd interface psb_snd
module procedure psb_lsnds, psb_lsndv, psb_lsndm,& module procedure psb_lsnds, psb_lsndv, psb_lsndm,&
& psb_hsnds, psb_lsnds_ec, psb_lsndv_ec, & & psb_hsnds
& psb_lsndm_ec, psb_hsnds_ec
end interface end interface
interface psb_rcv interface psb_rcv
module procedure psb_lrcvs, psb_lrcvv, psb_lrcvm,& module procedure psb_lrcvs, psb_lrcvv, psb_lrcvm,&
& psb_hrcvs, psb_lrcvs_ec, psb_lrcvv_ec, & & psb_hrcvs
& psb_lrcvm_ec, psb_hrcvs_ec
end interface end interface
@ -69,7 +66,6 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_lsnds(ictxt,dat,dst) subroutine psb_lsnds(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -77,7 +73,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
logical, intent(in) :: dat logical, intent(in) :: dat
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
logical, allocatable :: dat_(:) logical, allocatable :: dat_(:)
@ -92,7 +88,6 @@ contains
end subroutine psb_lsnds end subroutine psb_lsnds
subroutine psb_lsndv(ictxt,dat,dst) subroutine psb_lsndv(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -101,7 +96,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
logical, intent(in) :: dat(:) logical, intent(in) :: dat(:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
logical, allocatable :: dat_(:) logical, allocatable :: dat_(:)
@ -117,7 +112,6 @@ contains
end subroutine psb_lsndv end subroutine psb_lsndv
subroutine psb_lsndm(ictxt,dat,dst,m) subroutine psb_lsndm(ictxt,dat,dst,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -126,7 +120,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
logical, intent(in) :: dat(:,:) logical, intent(in) :: dat(:,:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
@ -155,7 +149,7 @@ contains
end subroutine psb_lsndm end subroutine psb_lsndm
subroutine psb_hsnds(ictxt,dat,dst) subroutine psb_hsnds(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -163,7 +157,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
character(len=*), intent(in) :: dat character(len=*), intent(in) :: dat
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
character(len=1), allocatable :: dat_(:) character(len=1), allocatable :: dat_(:)
@ -180,63 +174,6 @@ contains
#endif #endif
end subroutine psb_hsnds end subroutine psb_hsnds
subroutine psb_lsnds_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
logical, intent(in) :: dat
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_lsnds_ec
subroutine psb_lsndv_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
logical, intent(in) :: dat(:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_lsndv_ec
subroutine psb_lsndm_ec(ictxt,dat,dst,m)
integer(psb_epk_), intent(in) :: ictxt
logical, intent(in) :: dat(:,:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_lsndm_ec
subroutine psb_hsnds_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
character(len=*), intent(in) :: dat
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_hsnds_ec
! !!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!
! !
! Point-to-point RCV ! Point-to-point RCV
@ -244,7 +181,7 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_lrcvs(ictxt,dat,src) subroutine psb_lrcvs(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -252,21 +189,21 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
logical, intent(out) :: dat logical, intent(out) :: dat
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,mpi_logical,src,psb_logical_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,1,mpi_logical,src,psb_logical_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_lrcvs end subroutine psb_lrcvs
subroutine psb_lrcvv(ictxt,dat,src) subroutine psb_lrcvv(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -275,7 +212,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
logical, intent(out) :: dat(:) logical, intent(out) :: dat(:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info integer(psb_mpk_) :: info
@ -289,7 +226,6 @@ contains
end subroutine psb_lrcvv end subroutine psb_lrcvv
subroutine psb_lrcvm(ictxt,dat,src,m) subroutine psb_lrcvm(ictxt,dat,src,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -298,16 +234,17 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
logical, intent(out) :: dat(:,:) logical, intent(out) :: dat(:,:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_ipk_) :: i,j,k integer(psb_ipk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! What should we do here?? ! What should we do here??
#else #else
icomm = psb_get_mpi_comm(ictxt)
if (present(m)) then if (present(m)) then
m_ = m m_ = m
ld = size(dat,1) ld = size(dat,1)
@ -315,11 +252,11 @@ contains
call mpi_type_vector(n_,m_,ld,mpi_logical,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,mpi_logical,mp_rcv_type,info)
if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info)
if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,&
& psb_logical_tag,ictxt,status,info) & psb_logical_tag,icomm,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
else else
call mpi_recv(dat,size(dat),mpi_logical,src,& call mpi_recv(dat,size(dat),mpi_logical,src,&
& psb_logical_tag,ictxt,status,info) & psb_logical_tag,icomm,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then
write(psb_err_unit,*) 'Error in psb_recv', info write(psb_err_unit,*) 'Error in psb_recv', info
@ -330,7 +267,7 @@ contains
subroutine psb_hrcvs(ictxt,dat,src) subroutine psb_hrcvs(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -338,18 +275,19 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
character(len=*), intent(out) :: dat character(len=*), intent(out) :: dat
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
character(len=1), allocatable :: dat_(:) character(len=1), allocatable :: dat_(:)
integer(psb_mpk_) :: info, l, i integer(psb_mpk_) :: info, l, i
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
l = len(dat) l = len(dat)
icomm = psb_get_mpi_comm(ictxt)
allocate(dat_(l), stat=info) allocate(dat_(l), stat=info)
call mpi_recv(dat_,l,mpi_character,src,psb_char_tag,ictxt,status,info) call mpi_recv(dat_,l,mpi_character,src,psb_char_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
do i=1, l do i=1, l
dat(i:i) = dat_(i) dat(i:i) = dat_(i)
@ -358,61 +296,4 @@ contains
#endif #endif
end subroutine psb_hrcvs end subroutine psb_hrcvs
subroutine psb_lrcvs_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
logical, intent(out) :: dat
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_lrcvs_ec
subroutine psb_lrcvv_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
logical, intent(out) :: dat(:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_lrcvv_ec
subroutine psb_lrcvm_ec(ictxt,dat,src,m)
integer(psb_epk_), intent(in) :: ictxt
logical, intent(out) :: dat(:,:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_lrcvm_ec
subroutine psb_hrcvs_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
character(len=*), intent(out) :: dat
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_hrcvs_ec
end module psi_p2p_mod end module psi_p2p_mod

40
base/modules/penv/psi_penv_mod.F90
Unescape Escape View File

@ -144,6 +144,11 @@ module psi_penv_mod
interface psb_info interface psb_info
module procedure psb_info_mpik module procedure psb_info_mpik
end interface end interface
#if defined(IPK4) && defined(LPK8)
interface psb_info
module procedure psb_info_epk
end interface
#endif
interface psb_barrier interface psb_barrier
module procedure psb_barrier_mpik module procedure psb_barrier_mpik
@ -392,7 +397,7 @@ contains
return return
end if end if
call mpi_isend(node%int4buf,size(node%int4buf),psb_mpi_mpk_,& call mpi_isend(node%int4buf,size(node%int4buf),psb_mpi_mpk_,&
& dest,tag,icontxt,node%request,minfo) & dest,tag,icomm,node%request,minfo)
info = minfo info = minfo
call psb_insert_node(mesg_queue,node) call psb_insert_node(mesg_queue,node)
@ -852,23 +857,22 @@ contains
!!$ end if !!$ end if
!!$ end subroutine psb_abort_epk !!$ end subroutine psb_abort_epk
!!$ !!$
!!$ subroutine psb_info_epk(ictxt,iam,np) #if defined(IPK4) && defined(LPK8)
!!$ subroutine psb_info_epk(ictxt,iam,np)
!!$ integer(psb_epk_), intent(in) :: ictxt
!!$ integer(psb_epk_), intent(out) :: iam, np type(psb_ctxt_type), intent(in) :: ictxt
!!$ integer(psb_epk_), intent(out) :: iam, np
!!$ !
!!$ ! Simple caching scheme, keep track !
!!$ ! of the last CTXT encountered. ! Simple caching scheme, keep track
!!$ ! ! of the last CTXT encountered.
!!$ integer(psb_mpk_), save :: lctxt=-1, lam, lnp !
!!$ if (ictxt /= lctxt) then integer(psb_mpk_), save :: lam, lnp
!!$ lctxt = ictxt call psb_info(ictxt,lam,lnp)
!!$ call psb_info(lctxt,lam,lnp) iam = lam
!!$ end if np = lnp
!!$ iam = lam end subroutine psb_info_epk
!!$ np = lnp #endif
!!$ end subroutine psb_info_epk
subroutine psb_init_mpik(ictxt,np,basectxt,ids) subroutine psb_init_mpik(ictxt,np,basectxt,ids)
use psb_const_mod use psb_const_mod

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

File diff suppressed because it is too large Load Diff

129
base/modules/penv/psi_s_p2p_mod.F90
Unescape Escape View File

@ -32,22 +32,18 @@
module psi_s_p2p_mod module psi_s_p2p_mod
use psi_penv_mod use psi_penv_mod
use psi_comm_buffers_mod
interface psb_snd interface psb_snd
module procedure psb_ssnds, psb_ssndv, psb_ssndm, & module procedure psb_ssnds, psb_ssndv, psb_ssndm
& psb_ssnds_ec, psb_ssndv_ec, psb_ssndm_ec
end interface end interface
interface psb_rcv interface psb_rcv
module procedure psb_srcvs, psb_srcvv, psb_srcvm, & module procedure psb_srcvs, psb_srcvv, psb_srcvm
& psb_srcvs_ec, psb_srcvv_ec, psb_srcvm_ec
end interface end interface
contains contains
subroutine psb_ssnds(ictxt,dat,dst) subroutine psb_ssnds(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -55,7 +51,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
real(psb_spk_), intent(in) :: dat real(psb_spk_), intent(in) :: dat
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
real(psb_spk_), allocatable :: dat_(:) real(psb_spk_), allocatable :: dat_(:)
@ -70,7 +66,6 @@ contains
end subroutine psb_ssnds end subroutine psb_ssnds
subroutine psb_ssndv(ictxt,dat,dst) subroutine psb_ssndv(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -79,7 +74,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
real(psb_spk_), intent(in) :: dat(:) real(psb_spk_), intent(in) :: dat(:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
real(psb_spk_), allocatable :: dat_(:) real(psb_spk_), allocatable :: dat_(:)
@ -95,7 +90,6 @@ contains
end subroutine psb_ssndv end subroutine psb_ssndv
subroutine psb_ssndm(ictxt,dat,dst,m) subroutine psb_ssndm(ictxt,dat,dst,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -104,7 +98,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
real(psb_spk_), intent(in) :: dat(:,:) real(psb_spk_), intent(in) :: dat(:,:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
@ -133,7 +127,6 @@ contains
end subroutine psb_ssndm end subroutine psb_ssndm
subroutine psb_srcvs(ictxt,dat,src) subroutine psb_srcvs(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -141,21 +134,21 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
real(psb_spk_), intent(out) :: dat real(psb_spk_), intent(out) :: dat
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,1,psb_mpi_r_spk_,src,psb_real_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_srcvs end subroutine psb_srcvs
subroutine psb_srcvv(ictxt,dat,src) subroutine psb_srcvv(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -164,22 +157,22 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
real(psb_spk_), intent(out) :: dat(:) real(psb_spk_), intent(out) :: dat(:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
real(psb_spk_), allocatable :: dat_(:) real(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
#else #else
call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_srcvv end subroutine psb_srcvv
subroutine psb_srcvm(ictxt,dat,src,m) subroutine psb_srcvm(ictxt,dat,src,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -188,14 +181,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
real(psb_spk_), intent(out) :: dat(:,:) real(psb_spk_), intent(out) :: dat(:,:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
real(psb_spk_), allocatable :: dat_(:) real(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! What should we do here?? ! What should we do here??
#else #else
@ -205,11 +198,13 @@ contains
n_ = size(dat,2) n_ = size(dat,2)
call mpi_type_vector(n_,m_,ld,psb_mpi_r_spk_,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_r_spk_,mp_rcv_type,info)
if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info)
icomm = psb_get_mpi_comm(ictxt)
if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,&
& psb_real_tag,ictxt,status,info) & psb_real_tag,icomm,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
else else
call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,icomm,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then
write(psb_err_unit,*) 'Error in psb_recv', info write(psb_err_unit,*) 'Error in psb_recv', info
@ -218,90 +213,4 @@ contains
#endif #endif
end subroutine psb_srcvm end subroutine psb_srcvm
subroutine psb_ssnds_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
real(psb_spk_), intent(in) :: dat
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_ssnds_ec
subroutine psb_ssndv_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
real(psb_spk_), intent(in) :: dat(:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_ssndv_ec
subroutine psb_ssndm_ec(ictxt,dat,dst,m)
integer(psb_epk_), intent(in) :: ictxt
real(psb_spk_), intent(in) :: dat(:,:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_ssndm_ec
subroutine psb_srcvs_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
real(psb_spk_), intent(out) :: dat
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_srcvs_ec
subroutine psb_srcvv_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
real(psb_spk_), intent(out) :: dat(:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_srcvv_ec
subroutine psb_srcvm_ec(ictxt,dat,src,m)
integer(psb_epk_), intent(in) :: ictxt
real(psb_spk_), intent(out) :: dat(:,:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_srcvm_ec
end module psi_s_p2p_mod end module psi_s_p2p_mod

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

@ -31,28 +31,22 @@
! !
module psi_z_collective_mod module psi_z_collective_mod
use psi_penv_mod use psi_penv_mod
use psi_comm_buffers_mod
interface psb_sum interface psb_sum
module procedure psb_zsums, psb_zsumv, psb_zsumm, & module procedure psb_zsums, psb_zsumv, psb_zsumm
& psb_zsums_ec, psb_zsumv_ec, psb_zsumm_ec
end interface end interface
interface psb_amx interface psb_amx
module procedure psb_zamxs, psb_zamxv, psb_zamxm, & module procedure psb_zamxs, psb_zamxv, psb_zamxm
& psb_zamxs_ec, psb_zamxv_ec, psb_zamxm_ec
end interface end interface
interface psb_amn interface psb_amn
module procedure psb_zamns, psb_zamnv, psb_zamnm, & module procedure psb_zamns, psb_zamnv, psb_zamnm
& psb_zamns_ec, psb_zamnv_ec, psb_zamnm_ec
end interface end interface
interface psb_bcast interface psb_bcast
module procedure psb_zbcasts, psb_zbcastv, psb_zbcastm, & module procedure psb_zbcasts, psb_zbcastv, psb_zbcastm
& psb_zbcasts_ec, psb_zbcastv_ec, psb_zbcastm_ec
end interface psb_bcast end interface psb_bcast
interface psb_scan_sum interface psb_scan_sum
@ -71,7 +65,6 @@ module psi_z_collective_mod
module procedure psb_z_e_simple_triad_a2av, psb_z_m_simple_triad_a2av module procedure psb_z_e_simple_triad_a2av, psb_z_m_simple_triad_a2av
end interface psb_simple_triad_a2av end interface psb_simple_triad_a2av
contains contains
! !!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!
@ -94,15 +87,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_dpk_) :: dat_ complex(psb_dpk_) :: dat_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -111,11 +103,12 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
if (iam == root_) dat = dat_ if (iam == root_) dat = dat_
endif endif
#endif #endif
@ -130,15 +123,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_dpk_), allocatable :: dat_(:) complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -147,19 +139,20 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
end if end if
endif endif
#endif #endif
@ -174,12 +167,12 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_dpk_), allocatable :: dat_(:,:) complex(psb_dpk_), allocatable :: dat_(:,:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -191,73 +184,25 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,icomm,info)
end if end if
endif endif
#endif #endif
end subroutine psb_zsumm end subroutine psb_zsumm
subroutine psb_zsums_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_sum(ictxt_,dat,root_)
else
call psb_sum(ictxt_,dat)
end if
end subroutine psb_zsums_ec
subroutine psb_zsumv_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_sum(ictxt_,dat,root_)
else
call psb_sum(ictxt_,dat)
end if
end subroutine psb_zsumv_ec
subroutine psb_zsumm_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(inout) :: dat(:,:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_sum(ictxt_,dat,root_)
else
call psb_sum(ictxt_,dat)
end if
end subroutine psb_zsumm_ec
! !
! AMX: Maximum Absolute Value ! AMX: Maximum Absolute Value
! !
@ -270,15 +215,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_dpk_) :: dat_ complex(psb_dpk_) :: dat_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -287,11 +231,12 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,icomm,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
if (iam == root_) dat = dat_ if (iam == root_) dat = dat_
endif endif
#endif #endif
@ -306,15 +251,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_dpk_), allocatable :: dat_(:) complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -323,19 +267,20 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
end if end if
endif endif
#endif #endif
@ -350,12 +295,12 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_dpk_), allocatable :: dat_(:,:) complex(psb_dpk_), allocatable :: dat_(:,:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -367,74 +312,25 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info)
end if end if
endif endif
#endif #endif
end subroutine psb_zamxm end subroutine psb_zamxm
subroutine psb_zamxs_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_amx(ictxt_,dat,root_)
else
call psb_amx(ictxt_,dat)
end if
end subroutine psb_zamxs_ec
subroutine psb_zamxv_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_amx(ictxt_,dat,root_)
else
call psb_amx(ictxt_,dat)
end if
end subroutine psb_zamxv_ec
subroutine psb_zamxm_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(inout) :: dat(:,:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_amx(ictxt_,dat,root_)
else
call psb_amx(ictxt_,dat)
end if
end subroutine psb_zamxm_ec
! !
! AMN: Minimum Absolute Value ! AMN: Minimum Absolute Value
! !
@ -447,15 +343,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_dpk_) :: dat_ complex(psb_dpk_) :: dat_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -464,11 +359,12 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,icomm,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
if (iam == root_) dat = dat_ if (iam == root_) dat = dat_
endif endif
#endif #endif
@ -483,15 +379,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_dpk_), allocatable :: dat_(:) complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -500,19 +395,20 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
end if end if
endif endif
#endif #endif
@ -527,12 +423,12 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
complex(psb_dpk_), allocatable :: dat_(:,:) complex(psb_dpk_), allocatable :: dat_(:,:)
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -544,74 +440,25 @@ contains
else else
root_ = -1 root_ = -1
endif endif
icomm = psb_get_mpi_comm(ictxt)
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,icomm,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_ = dat dat_ = dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info)
end if end if
endif endif
#endif #endif
end subroutine psb_zamnm end subroutine psb_zamnm
subroutine psb_zamns_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_amn(ictxt_,dat,root_)
else
call psb_amn(ictxt_,dat)
end if
end subroutine psb_zamns_ec
subroutine psb_zamnv_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_amn(ictxt_,dat,root_)
else
call psb_amn(ictxt_,dat)
end if
end subroutine psb_zamnv_ec
subroutine psb_zamnm_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(inout) :: dat(:,:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_amn(ictxt_,dat,root_)
else
call psb_amn(ictxt_,dat)
end if
end subroutine psb_zamnm_ec
! !
! BCAST Broadcast ! BCAST Broadcast
! !
@ -624,15 +471,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -641,7 +487,8 @@ contains
else else
root_ = psb_root_ root_ = psb_root_
endif endif
call mpi_bcast(dat,1,psb_mpi_c_dpk_,root_,ictxt,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_bcast(dat,1,psb_mpi_c_dpk_,root_,icomm,info)
#endif #endif
end subroutine psb_zbcasts end subroutine psb_zbcasts
@ -655,14 +502,13 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -671,8 +517,8 @@ contains
else else
root_ = psb_root_ root_ = psb_root_
endif endif
icomm = psb_get_mpi_comm(ictxt)
call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,icomm,info)
#endif #endif
end subroutine psb_zbcastv end subroutine psb_zbcastv
@ -685,12 +531,12 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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_mpk_) :: root_ integer(psb_mpk_) :: root_
integer(psb_mpk_) :: iam, np, info integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -702,61 +548,11 @@ contains
else else
root_ = psb_root_ root_ = psb_root_
endif endif
icomm = psb_get_mpi_comm(ictxt)
call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,icomm,info)
#endif #endif
end subroutine psb_zbcastm end subroutine psb_zbcastm
subroutine psb_zbcasts_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
call psb_bcast(ictxt_,dat)
end if
end subroutine psb_zbcasts_ec
subroutine psb_zbcastv_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
call psb_bcast(ictxt_,dat)
end if
end subroutine psb_zbcastv_ec
subroutine psb_zbcastm_ec(ictxt,dat,root)
implicit none
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(inout) :: dat(:,:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
call psb_bcast(ictxt_,dat)
end if
end subroutine psb_zbcastm_ec
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! !
! SCAN ! SCAN
@ -771,13 +567,12 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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, icomm
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
icomm = psb_get_mpi_comm(ictxt) icomm = psb_get_mpi_comm(ictxt)
@ -795,7 +590,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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
@ -821,7 +616,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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 :: root
integer(psb_mpk_) :: root_ integer(psb_mpk_) :: root_
@ -848,7 +643,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
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 :: root
integer(psb_mpk_) :: root_ integer(psb_mpk_) :: root_
@ -875,9 +670,8 @@ contains
complex(psb_dpk_), intent(in) :: valsnd(:) complex(psb_dpk_), intent(in) :: valsnd(:)
complex(psb_dpk_), intent(out) :: valrcv(:) complex(psb_dpk_), intent(out) :: valrcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -919,7 +713,7 @@ contains
complex(psb_dpk_), intent(out) :: valrcv(:) complex(psb_dpk_), intent(out) :: valrcv(:)
integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!Local variables !Local variables
@ -1002,7 +796,7 @@ contains
complex(psb_dpk_), intent(out) :: valrcv(:) complex(psb_dpk_), intent(out) :: valrcv(:)
integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!Local variables !Local variables

129
base/modules/penv/psi_z_p2p_mod.F90
Unescape Escape View File

@ -32,22 +32,18 @@
module psi_z_p2p_mod module psi_z_p2p_mod
use psi_penv_mod use psi_penv_mod
use psi_comm_buffers_mod
interface psb_snd interface psb_snd
module procedure psb_zsnds, psb_zsndv, psb_zsndm, & module procedure psb_zsnds, psb_zsndv, psb_zsndm
& psb_zsnds_ec, psb_zsndv_ec, psb_zsndm_ec
end interface end interface
interface psb_rcv interface psb_rcv
module procedure psb_zrcvs, psb_zrcvv, psb_zrcvm, & module procedure psb_zrcvs, psb_zrcvv, psb_zrcvm
& psb_zrcvs_ec, psb_zrcvv_ec, psb_zrcvm_ec
end interface end interface
contains contains
subroutine psb_zsnds(ictxt,dat,dst) subroutine psb_zsnds(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -55,7 +51,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
complex(psb_dpk_), intent(in) :: dat complex(psb_dpk_), intent(in) :: dat
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
complex(psb_dpk_), allocatable :: dat_(:) complex(psb_dpk_), allocatable :: dat_(:)
@ -70,7 +66,6 @@ contains
end subroutine psb_zsnds end subroutine psb_zsnds
subroutine psb_zsndv(ictxt,dat,dst) subroutine psb_zsndv(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -79,7 +74,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
complex(psb_dpk_), intent(in) :: dat(:) complex(psb_dpk_), intent(in) :: dat(:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
complex(psb_dpk_), allocatable :: dat_(:) complex(psb_dpk_), allocatable :: dat_(:)
@ -95,7 +90,6 @@ contains
end subroutine psb_zsndv end subroutine psb_zsndv
subroutine psb_zsndm(ictxt,dat,dst,m) subroutine psb_zsndm(ictxt,dat,dst,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -104,7 +98,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
complex(psb_dpk_), intent(in) :: dat(:,:) complex(psb_dpk_), intent(in) :: dat(:,:)
integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), intent(in) :: dst
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
@ -133,7 +127,6 @@ contains
end subroutine psb_zsndm end subroutine psb_zsndm
subroutine psb_zrcvs(ictxt,dat,src) subroutine psb_zrcvs(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -141,21 +134,21 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
complex(psb_dpk_), intent(out) :: dat complex(psb_dpk_), intent(out) :: dat
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,1,psb_mpi_c_dpk_,src,psb_dcomplex_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_zrcvs end subroutine psb_zrcvs
subroutine psb_zrcvv(ictxt,dat,src) subroutine psb_zrcvv(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -164,22 +157,22 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
complex(psb_dpk_), intent(out) :: dat(:) complex(psb_dpk_), intent(out) :: dat(:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
complex(psb_dpk_), allocatable :: dat_(:) complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
#else #else
call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,icomm,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_zrcvv end subroutine psb_zrcvv
subroutine psb_zrcvm(ictxt,dat,src,m) subroutine psb_zrcvm(ictxt,dat,src,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -188,14 +181,14 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ictxt
complex(psb_dpk_), intent(out) :: dat(:,:) complex(psb_dpk_), intent(out) :: dat(:,:)
integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), intent(in) :: src
integer(psb_ipk_), intent(in), optional :: m integer(psb_ipk_), intent(in), optional :: m
complex(psb_dpk_), allocatable :: dat_(:) complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size) integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! What should we do here?? ! What should we do here??
#else #else
@ -205,11 +198,13 @@ contains
n_ = size(dat,2) n_ = size(dat,2)
call mpi_type_vector(n_,m_,ld,psb_mpi_c_dpk_,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_c_dpk_,mp_rcv_type,info)
if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info)
icomm = psb_get_mpi_comm(ictxt)
if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,&
& psb_dcomplex_tag,ictxt,status,info) & psb_dcomplex_tag,icomm,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
else else
call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) icomm = psb_get_mpi_comm(ictxt)
call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,icomm,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then
write(psb_err_unit,*) 'Error in psb_recv', info write(psb_err_unit,*) 'Error in psb_recv', info
@ -218,90 +213,4 @@ contains
#endif #endif
end subroutine psb_zrcvm end subroutine psb_zrcvm
subroutine psb_zsnds_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(in) :: dat
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_zsnds_ec
subroutine psb_zsndv_ec(ictxt,dat,dst)
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(in) :: dat(:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_zsndv_ec
subroutine psb_zsndm_ec(ictxt,dat,dst,m)
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(in) :: dat(:,:)
integer(psb_epk_), intent(in) :: dst
integer(psb_mpk_) :: iictxt, idst
iictxt = ictxt
idst = dst
call psb_snd(iictxt, dat, idst)
end subroutine psb_zsndm_ec
subroutine psb_zrcvs_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(out) :: dat
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_zrcvs_ec
subroutine psb_zrcvv_ec(ictxt,dat,src)
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(out) :: dat(:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_zrcvv_ec
subroutine psb_zrcvm_ec(ictxt,dat,src,m)
integer(psb_epk_), intent(in) :: ictxt
complex(psb_dpk_), intent(out) :: dat(:,:)
integer(psb_epk_), intent(in) :: src
integer(psb_mpk_) :: iictxt, isrc
iictxt = ictxt
isrc = src
call psb_rcv(iictxt, dat, isrc)
end subroutine psb_zrcvm_ec
end module psi_z_p2p_mod end module psi_z_p2p_mod

2
test/fileread/runs/dfs.inp
Unescape Escape View File

@ -5,7 +5,7 @@ MM File format: MM: Matrix Market HB: Harwell-Boeing.
BiCGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG BiCGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG
BJAC Preconditioner NONE DIAG BJAC BJAC Preconditioner NONE DIAG BJAC
CSR Storage format CSR COO JAD CSR Storage format CSR COO JAD
BLOCK PART: Partition method BLOCK GRAPH GRAPH PART: Partition method BLOCK GRAPH
2 ISTOPC 2 ISTOPC
00500 ITMAX 00500 ITMAX
-1 ITRACE -1 ITRACE

Write Preview
Loading…
Cancel
Save