diff --git a/base/modules/Makefile b/base/modules/Makefile index 01b6615c4..a522efd96 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -8,13 +8,21 @@ BASIC_MODS= psb_const_mod.o psb_error_mod.o psb_realloc_mod.o \ basics/psb_c_realloc_mod.o \ basics/psb_z_realloc_mod.o -COMMINT=psi_comm_buffers_mod.o psi_penv_mod.o psi_bcast_mod.o psi_reduce_mod.o\ +COMMINT=psi_comm_buffers_mod.o psi_penv_mod.o psi_bcast_mod.o \ psi_p2p_mod.o basics/psi_m_p2p_mod.o \ basics/psi_e_p2p_mod.o \ basics/psi_s_p2p_mod.o \ basics/psi_d_p2p_mod.o \ basics/psi_c_p2p_mod.o \ - basics/psi_z_p2p_mod.o + basics/psi_z_p2p_mod.o \ + psi_reduce_mod.o \ + basics/psi_e_reduce_mod.o \ + basics/psi_m_reduce_mod.o \ + basics/psi_s_reduce_mod.o \ + basics/psi_d_reduce_mod.o \ + basics/psi_c_reduce_mod.o \ + basics/psi_z_reduce_mod.o + UTIL_MODS = aux/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_mod.o\ desc/psb_gen_block_map_mod.o desc/psb_list_map_mod.o desc/psb_repl_map_mod.o\ desc/psb_glist_map_mod.o desc/psb_hash_map_mod.o \ @@ -89,9 +97,17 @@ psi_p2p_mod.o: basics/psi_m_p2p_mod.o \ basics/psi_d_p2p_mod.o \ basics/psi_c_p2p_mod.o \ basics/psi_z_p2p_mod.o +psi_reduce_mod.o: basics/psi_e_reduce_mod.o \ + basics/psi_m_reduce_mod.o \ + basics/psi_s_reduce_mod.o \ + basics/psi_d_reduce_mod.o \ + basics/psi_c_reduce_mod.o \ + basics/psi_z_reduce_mod.o basics/psi_m_p2p_mod.o basics/psi_e_p2p_mod.o basics/psi_s_p2p_mod.o \ - basics/psi_d_p2p_mod.o basics/psi_c_p2p_mod.o basics/psi_z_p2p_mod.o: psi_penv_mod.o +basics/psi_d_p2p_mod.o basics/psi_c_p2p_mod.o basics/psi_z_p2p_mod.o\ +basics/psi_e_reduce_mod.o basics/psi_m_reduce_mod.o basics/psi_s_reduce_mod.o \ +basics/psi_d_reduce_mod.o basics/psi_c_reduce_mod.o basics/psi_z_reduce_mod.o: psi_penv_mod.o aux/psb_string_mod.o desc/psb_desc_const_mod.o psi_comm_buffers_mod.o: psb_const_mod.o aux/psb_hash_mod.o: psb_realloc_mod.o psb_const_mod.o diff --git a/base/modules/basics/psi_c_reduce_mod.F90 b/base/modules/basics/psi_c_reduce_mod.F90 new file mode 100644 index 000000000..d3da30f59 --- /dev/null +++ b/base/modules/basics/psi_c_reduce_mod.F90 @@ -0,0 +1,592 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +module psi_c_reduce_mod + use psi_penv_mod + + + interface psb_sum + module procedure psb_csums, psb_csumv, psb_csumm, & + & psb_csums_ec, psb_csumv_ec, psb_csumm_ec + end interface + + interface psb_amx + module procedure psb_camxs, psb_camxv, psb_camxm, & + & psb_camxs_ec, psb_camxv_ec, psb_camxm_ec + end interface + + interface psb_amn + module procedure psb_camns, psb_camnv, psb_camnm, & + & psb_camns_ec, psb_camnv_ec, psb_camnm_ec + end interface + + + +contains + + ! !!!!!!!!!!!!!!!!!!!!!! + ! + ! Reduction operations + ! + ! !!!!!!!!!!!!!!!!!!!!!! + + + + ! + ! SUM + ! + + subroutine psb_csums(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_spk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_csums + + subroutine psb_csumv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_csumv + + subroutine psb_csumm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_spk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + 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 + ! + + subroutine psb_camxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_spk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_camxs + + subroutine psb_camxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_camxv + + subroutine psb_camxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_spk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) + end if + endif +#endif + 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 + ! + + subroutine psb_camns(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_spk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_camns + + subroutine psb_camnv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_camnv + + subroutine psb_camnm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_spk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) + end if + endif +#endif + 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 + +end module psi_c_reduce_mod diff --git a/base/modules/basics/psi_d_reduce_mod.F90 b/base/modules/basics/psi_d_reduce_mod.F90 new file mode 100644 index 000000000..597798238 --- /dev/null +++ b/base/modules/basics/psi_d_reduce_mod.F90 @@ -0,0 +1,1083 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +module psi_d_reduce_mod + use psi_penv_mod + + interface psb_max + module procedure psb_dmaxs, psb_dmaxv, psb_dmaxm, & + & psb_dmaxs_ec, psb_dmaxv_ec, psb_dmaxm_ec + end interface + + interface psb_min + module procedure psb_dmins, psb_dminv, psb_dminm, & + & psb_dmins_ec, psb_dminv_ec, psb_dminm_ec + end interface psb_min + + interface psb_nrm2 + module procedure psb_d_nrm2s, psb_d_nrm2v, & + & psb_d_nrm2s_ec, psb_d_nrm2v_ec + end interface psb_nrm2 + + interface psb_sum + module procedure psb_dsums, psb_dsumv, psb_dsumm, & + & psb_dsums_ec, psb_dsumv_ec, psb_dsumm_ec + end interface + + interface psb_amx + module procedure psb_damxs, psb_damxv, psb_damxm, & + & psb_damxs_ec, psb_damxv_ec, psb_damxm_ec + end interface + + interface psb_amn + module procedure psb_damns, psb_damnv, psb_damnm, & + & psb_damns_ec, psb_damnv_ec, psb_damnm_ec + end interface + + + +contains + + ! !!!!!!!!!!!!!!!!!!!!!! + ! + ! Reduction operations + ! + ! !!!!!!!!!!!!!!!!!!!!!! + + + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! MAX + ! + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine psb_dmaxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_dmaxs + + subroutine psb_dmaxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_dmaxv + + subroutine psb_dmaxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_dmaxm + + + subroutine psb_dmaxs_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_dmaxs_ec + + subroutine psb_dmaxv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_dmaxv_ec + + subroutine psb_dmaxm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_dmaxm_ec + + + ! + ! MIN: Minimum Value + ! + + + subroutine psb_dmins(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_dmins + + subroutine psb_dminv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_dminv + + subroutine psb_dminm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_dminm + + + subroutine psb_dmins_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_dmins_ec + + subroutine psb_dminv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_dminv_ec + + subroutine psb_dminm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_dminm_ec + + + + ! !!!!!!!!!!!! + ! + ! Norm 2, only for reals + ! + ! !!!!!!!!!!!! + subroutine psb_d_nrm2s(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_d_nrm2s + + subroutine psb_d_nrm2v(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& + & mpi_dnrm2_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& + & mpi_dnrm2_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,& + & mpi_dnrm2_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_d_nrm2v + + subroutine psb_d_nrm2s_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_nrm2(ictxt_,dat,root_) + else + call psb_nrm2(ictxt_,dat) + end if + end subroutine psb_d_nrm2s_ec + + subroutine psb_d_nrm2v_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_nrm2(ictxt_,dat,root_) + else + call psb_nrm2(ictxt_,dat) + end if + end subroutine psb_d_nrm2v_ec + + + ! + ! SUM + ! + + subroutine psb_dsums(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_dsums + + subroutine psb_dsumv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_dsumv + + subroutine psb_dsumm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_dsumm + + subroutine psb_dsums_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_dsums_ec + + subroutine psb_dsumv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_dsumv_ec + + subroutine psb_dsumm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_dsumm_ec + + + ! + ! AMX: Maximum Absolute Value + ! + + subroutine psb_damxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_damxs + + subroutine psb_damxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_damxv + + subroutine psb_damxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_damxm + + + subroutine psb_damxs_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_damxs_ec + + subroutine psb_damxv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_damxv_ec + + subroutine psb_damxm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_damxm_ec + + + ! + ! AMN: Minimum Absolute Value + ! + + subroutine psb_damns(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_damns + + subroutine psb_damnv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_damnv + + subroutine psb_damnm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_dpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_damnm + + + subroutine psb_damns_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_damns_ec + + subroutine psb_damnv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_damnv_ec + + subroutine psb_damnm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_damnm_ec + +end module psi_d_reduce_mod diff --git a/base/modules/basics/psi_e_reduce_mod.F90 b/base/modules/basics/psi_e_reduce_mod.F90 new file mode 100644 index 000000000..0f34ddc34 --- /dev/null +++ b/base/modules/basics/psi_e_reduce_mod.F90 @@ -0,0 +1,960 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +module psi_e_reduce_mod + use psi_penv_mod + + interface psb_max + module procedure psb_emaxs, psb_emaxv, psb_emaxm, & + & psb_emaxs_ec, psb_emaxv_ec, psb_emaxm_ec + end interface + + interface psb_min + module procedure psb_emins, psb_eminv, psb_eminm, & + & psb_emins_ec, psb_eminv_ec, psb_eminm_ec + end interface psb_min + + + interface psb_sum + module procedure psb_esums, psb_esumv, psb_esumm, & + & psb_esums_ec, psb_esumv_ec, psb_esumm_ec + end interface + + interface psb_amx + module procedure psb_eamxs, psb_eamxv, psb_eamxm, & + & psb_eamxs_ec, psb_eamxv_ec, psb_eamxm_ec + end interface + + interface psb_amn + module procedure psb_eamns, psb_eamnv, psb_eamnm, & + & psb_eamns_ec, psb_eamnv_ec, psb_eamnm_ec + end interface + + + +contains + + ! !!!!!!!!!!!!!!!!!!!!!! + ! + ! Reduction operations + ! + ! !!!!!!!!!!!!!!!!!!!!!! + + + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! MAX + ! + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine psb_emaxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_max,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_max,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_emaxs + + subroutine psb_emaxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_max,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_max,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_max,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_emaxv + + subroutine psb_emaxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_max,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_max,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_max,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_emaxm + + + subroutine psb_emaxs_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_emaxs_ec + + subroutine psb_emaxv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_emaxv_ec + + subroutine psb_emaxm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_emaxm_ec + + + ! + ! MIN: Minimum Value + ! + + + subroutine psb_emins(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_min,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_min,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_emins + + subroutine psb_eminv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_min,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_min,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_min,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_eminv + + subroutine psb_eminm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_min,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_min,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_min,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_eminm + + + subroutine psb_emins_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_emins_ec + + subroutine psb_eminv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_eminv_ec + + subroutine psb_eminm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_eminm_ec + + + + + ! + ! SUM + ! + + subroutine psb_esums(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_sum,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_sum,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_esums + + subroutine psb_esumv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_esumv + + subroutine psb_esumm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_esumm + + subroutine psb_esums_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_esums_ec + + subroutine psb_esumv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_esumv_ec + + subroutine psb_esumm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_esumm_ec + + + ! + ! AMX: Maximum Absolute Value + ! + + subroutine psb_eamxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_eamx_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_eamx_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_eamxs + + subroutine psb_eamxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamx_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_eamx_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_eamxv + + subroutine psb_eamxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamx_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_eamx_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_eamxm + + + subroutine psb_eamxs_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_eamxs_ec + + subroutine psb_eamxv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_eamxv_ec + + subroutine psb_eamxm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_eamxm_ec + + + ! + ! AMN: Minimum Absolute Value + ! + + subroutine psb_eamns(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_eamn_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_eamn_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_eamns + + subroutine psb_eamnv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamn_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_eamn_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_eamnv + + subroutine psb_eamnm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_epk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamn_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_eamn_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_eamnm + + + subroutine psb_eamns_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_eamns_ec + + subroutine psb_eamnv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_eamnv_ec + + subroutine psb_eamnm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), 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_eamnm_ec + +end module psi_e_reduce_mod diff --git a/base/modules/basics/psi_m_reduce_mod.F90 b/base/modules/basics/psi_m_reduce_mod.F90 new file mode 100644 index 000000000..c827c767f --- /dev/null +++ b/base/modules/basics/psi_m_reduce_mod.F90 @@ -0,0 +1,960 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +module psi_m_reduce_mod + use psi_penv_mod + + interface psb_max + module procedure psb_mmaxs, psb_mmaxv, psb_mmaxm, & + & psb_mmaxs_ec, psb_mmaxv_ec, psb_mmaxm_ec + end interface + + interface psb_min + module procedure psb_mmins, psb_mminv, psb_mminm, & + & psb_mmins_ec, psb_mminv_ec, psb_mminm_ec + end interface psb_min + + + interface psb_sum + module procedure psb_msums, psb_msumv, psb_msumm, & + & psb_msums_ec, psb_msumv_ec, psb_msumm_ec + end interface + + interface psb_amx + module procedure psb_mamxs, psb_mamxv, psb_mamxm, & + & psb_mamxs_ec, psb_mamxv_ec, psb_mamxm_ec + end interface + + interface psb_amn + module procedure psb_mamns, psb_mamnv, psb_mamnm, & + & psb_mamns_ec, psb_mamnv_ec, psb_mamnm_ec + end interface + + + +contains + + ! !!!!!!!!!!!!!!!!!!!!!! + ! + ! Reduction operations + ! + ! !!!!!!!!!!!!!!!!!!!!!! + + + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! MAX + ! + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine psb_mmaxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_max,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_max,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_mmaxs + + subroutine psb_mmaxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_mmaxv + + subroutine psb_mmaxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_mmaxm + + + subroutine psb_mmaxs_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_mmaxs_ec + + subroutine psb_mmaxv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_mmaxv_ec + + subroutine psb_mmaxm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_mmaxm_ec + + + ! + ! MIN: Minimum Value + ! + + + subroutine psb_mmins(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_min,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_min,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_mmins + + subroutine psb_mminv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_mminv + + subroutine psb_mminm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_mminm + + + subroutine psb_mmins_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_mmins_ec + + subroutine psb_mminv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_mminv_ec + + subroutine psb_mminm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_mminm_ec + + + + + ! + ! SUM + ! + + subroutine psb_msums(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_sum,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_sum,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_msums + + subroutine psb_msumv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_msumv + + subroutine psb_msumm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_msumm + + subroutine psb_msums_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_msums_ec + + subroutine psb_msumv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_msumv_ec + + subroutine psb_msumm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_msumm_ec + + + ! + ! AMX: Maximum Absolute Value + ! + + subroutine psb_mamxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamx_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamx_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_mamxs + + subroutine psb_mamxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamx_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_mamx_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_mamxv + + subroutine psb_mamxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamx_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_mamx_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_mamxm + + + subroutine psb_mamxs_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_mamxs_ec + + subroutine psb_mamxv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_mamxv_ec + + subroutine psb_mamxm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_mamxm_ec + + + ! + ! AMN: Minimum Absolute Value + ! + + subroutine psb_mamns(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamn_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamn_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_mamns + + subroutine psb_mamnv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamn_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_mamn_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_mamnv + + subroutine psb_mamnm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamn_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_mamn_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_mamnm + + + subroutine psb_mamns_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_mamns_ec + + subroutine psb_mamnv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_mamnv_ec + + subroutine psb_mamnm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), 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_mamnm_ec + +end module psi_m_reduce_mod diff --git a/base/modules/basics/psi_s_reduce_mod.F90 b/base/modules/basics/psi_s_reduce_mod.F90 new file mode 100644 index 000000000..d584dd3a0 --- /dev/null +++ b/base/modules/basics/psi_s_reduce_mod.F90 @@ -0,0 +1,1083 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +module psi_s_reduce_mod + use psi_penv_mod + + interface psb_max + module procedure psb_smaxs, psb_smaxv, psb_smaxm, & + & psb_smaxs_ec, psb_smaxv_ec, psb_smaxm_ec + end interface + + interface psb_min + module procedure psb_smins, psb_sminv, psb_sminm, & + & psb_smins_ec, psb_sminv_ec, psb_sminm_ec + end interface psb_min + + interface psb_nrm2 + module procedure psb_s_nrm2s, psb_s_nrm2v, & + & psb_s_nrm2s_ec, psb_s_nrm2v_ec + end interface psb_nrm2 + + interface psb_sum + module procedure psb_ssums, psb_ssumv, psb_ssumm, & + & psb_ssums_ec, psb_ssumv_ec, psb_ssumm_ec + end interface + + interface psb_amx + module procedure psb_samxs, psb_samxv, psb_samxm, & + & psb_samxs_ec, psb_samxv_ec, psb_samxm_ec + end interface + + interface psb_amn + module procedure psb_samns, psb_samnv, psb_samnm, & + & psb_samns_ec, psb_samnv_ec, psb_samnm_ec + end interface + + + +contains + + ! !!!!!!!!!!!!!!!!!!!!!! + ! + ! Reduction operations + ! + ! !!!!!!!!!!!!!!!!!!!!!! + + + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! MAX + ! + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine psb_smaxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_smaxs + + subroutine psb_smaxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_smaxv + + subroutine psb_smaxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_smaxm + + + subroutine psb_smaxs_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_smaxs_ec + + subroutine psb_smaxv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_smaxv_ec + + subroutine psb_smaxm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_smaxm_ec + + + ! + ! MIN: Minimum Value + ! + + + subroutine psb_smins(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_smins + + subroutine psb_sminv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_sminv + + subroutine psb_sminm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_sminm + + + subroutine psb_smins_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_smins_ec + + subroutine psb_sminv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_sminv_ec + + subroutine psb_sminm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_sminm_ec + + + + ! !!!!!!!!!!!! + ! + ! Norm 2, only for reals + ! + ! !!!!!!!!!!!! + subroutine psb_s_nrm2s(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_s_nrm2s + + subroutine psb_s_nrm2v(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,& + & mpi_snrm2_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,& + & mpi_snrm2_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,& + & mpi_snrm2_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_s_nrm2v + + subroutine psb_s_nrm2s_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_nrm2(ictxt_,dat,root_) + else + call psb_nrm2(ictxt_,dat) + end if + end subroutine psb_s_nrm2s_ec + + subroutine psb_s_nrm2v_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_nrm2(ictxt_,dat,root_) + else + call psb_nrm2(ictxt_,dat) + end if + end subroutine psb_s_nrm2v_ec + + + ! + ! SUM + ! + + subroutine psb_ssums(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_ssums + + subroutine psb_ssumv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_ssumv + + subroutine psb_ssumm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_ssumm + + subroutine psb_ssums_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_ssums_ec + + subroutine psb_ssumv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_ssumv_ec + + subroutine psb_ssumm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_ssumm_ec + + + ! + ! AMX: Maximum Absolute Value + ! + + subroutine psb_samxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_samxs + + subroutine psb_samxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_samxv + + subroutine psb_samxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_samxm + + + subroutine psb_samxs_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_samxs_ec + + subroutine psb_samxv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_samxv_ec + + subroutine psb_samxm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_samxm_ec + + + ! + ! AMN: Minimum Absolute Value + ! + + subroutine psb_samns(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_samns + + subroutine psb_samnv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_samnv + + subroutine psb_samnm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + real(psb_spk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_samnm + + + subroutine psb_samns_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_samns_ec + + subroutine psb_samnv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_samnv_ec + + subroutine psb_samnm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + real(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_samnm_ec + +end module psi_s_reduce_mod diff --git a/base/modules/basics/psi_z_reduce_mod.F90 b/base/modules/basics/psi_z_reduce_mod.F90 new file mode 100644 index 000000000..abcae8568 --- /dev/null +++ b/base/modules/basics/psi_z_reduce_mod.F90 @@ -0,0 +1,592 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +module psi_z_reduce_mod + use psi_penv_mod + + + interface psb_sum + module procedure psb_zsums, psb_zsumv, psb_zsumm, & + & psb_zsums_ec, psb_zsumv_ec, psb_zsumm_ec + end interface + + interface psb_amx + module procedure psb_zamxs, psb_zamxv, psb_zamxm, & + & psb_zamxs_ec, psb_zamxv_ec, psb_zamxm_ec + end interface + + interface psb_amn + module procedure psb_zamns, psb_zamnv, psb_zamnm, & + & psb_zamns_ec, psb_zamnv_ec, psb_zamnm_ec + end interface + + + +contains + + ! !!!!!!!!!!!!!!!!!!!!!! + ! + ! Reduction operations + ! + ! !!!!!!!!!!!!!!!!!!!!!! + + + + ! + ! SUM + ! + + subroutine psb_zsums(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_dpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_zsums + + subroutine psb_zsumv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_zsumv + + subroutine psb_zsumm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_dpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + 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 + ! + + subroutine psb_zamxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_dpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_zamxs + + subroutine psb_zamxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_zamxv + + subroutine psb_zamxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_dpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) + end if + endif +#endif + 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 + ! + + subroutine psb_zamns(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_dpk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_zamns + + subroutine psb_zamnv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_zamnv + + subroutine psb_zamnm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + complex(psb_dpk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) + end if + endif +#endif + 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 + +end module psi_z_reduce_mod diff --git a/base/modules/psi_p2p_mod.F90 b/base/modules/psi_p2p_mod.F90 index ca5a9fbc6..392344740 100644 --- a/base/modules/psi_p2p_mod.F90 +++ b/base/modules/psi_p2p_mod.F90 @@ -43,7 +43,7 @@ module psi_p2p_mod ! - ! Add interfaces for + ! Add here interfaces for ! LOGICAL scalar/vector/matrix ! CHARACTER scalar (use H prefix as in old style Hollerith) ! diff --git a/base/modules/psi_penv_mod.F90 b/base/modules/psi_penv_mod.F90 index b042a1a77..aab452ff4 100644 --- a/base/modules/psi_penv_mod.F90 +++ b/base/modules/psi_penv_mod.F90 @@ -53,29 +53,26 @@ module psi_penv_mod module procedure psb_barrier_mpik end interface -#if defined(LONG_INTEGERS) interface psb_init - module procedure psb_init_ipk + module procedure psb_init_epk end interface interface psb_exit - module procedure psb_exit_ipk + module procedure psb_exit_epk end interface interface psb_abort - module procedure psb_abort_ipk + module procedure psb_abort_epk end interface interface psb_info - module procedure psb_info_ipk + module procedure psb_info_epk end interface interface psb_barrier - module procedure psb_barrier_ipk + module procedure psb_barrier_epk end interface -#endif - interface psb_wtime module procedure psb_wtime end interface @@ -87,8 +84,8 @@ module psi_penv_mod #else integer(psb_mpk_), save :: mpi_iamx_op, mpi_iamn_op - integer(psb_mpk_), save :: mpi_i4amx_op, mpi_i4amn_op - integer(psb_mpk_), save :: mpi_i8amx_op, mpi_i8amn_op + integer(psb_mpk_), save :: mpi_mamx_op, mpi_mamn_op + integer(psb_mpk_), save :: mpi_eamx_op, mpi_eamn_op integer(psb_mpk_), save :: mpi_samx_op, mpi_samn_op integer(psb_mpk_), save :: mpi_damx_op, mpi_damn_op integer(psb_mpk_), save :: mpi_camx_op, mpi_camn_op @@ -101,8 +98,8 @@ module psi_penv_mod private :: psi_get_sizes, psi_register_mpi_extras private :: psi_iamx_op, psi_iamn_op - private :: psi_i4amx_op, psi_i4amn_op - private :: psi_i8amx_op, psi_i8amn_op + private :: psi_mamx_op, psi_mamn_op + private :: psi_eamx_op, psi_eamn_op private :: psi_samx_op, psi_samn_op private :: psi_damx_op, psi_damn_op private :: psi_camx_op, psi_camn_op @@ -121,6 +118,7 @@ contains use psb_const_mod real(psb_dpk_) :: dv(2) real(psb_spk_) :: sv(2) + integer(psb_i2pk_):: i2v(2) integer(psb_mpk_) :: mv(2) integer(psb_ipk_) :: iv(2) integer(psb_lpk_) :: lv(2) @@ -128,6 +126,7 @@ contains call psi_c_diffadd(sv(1),sv(2),psb_sizeof_sp) call psi_c_diffadd(dv(1),dv(2),psb_sizeof_dp) + call psi_c_diffadd(i2v(1),i2v(2),psb_sizeof_i2p) call psi_c_diffadd(mv(1),mv(2),psb_sizeof_mp) call psi_c_diffadd(iv(1),iv(2),psb_sizeof_ip) call psi_c_diffadd(lv(1),lv(2),psb_sizeof_lp) @@ -148,6 +147,7 @@ contains info = 0 #if 0 if (info == 0) call mpi_type_create_f90_integer(psb_ipk_, psb_mpi_ipk_ ,info) + if (info == 0) call mpi_type_create_f90_integer(psb_lpk_, psb_mpi_lpk_ ,info) if (info == 0) call mpi_type_create_f90_integer(psb_mpk_, psb_mpi_mpk_ ,info) if (info == 0) call mpi_type_create_f90_integer(psb_epk_, psb_mpi_lpk_ ,info) if (info == 0) call mpi_type_create_f90_real(psb_spk_p_,psb_spk_r_, psb_mpi_r_spk_,info) @@ -156,10 +156,10 @@ contains if (info == 0) call mpi_type_create_f90_complex(psb_dpk_p_,psb_dpk_r_, psb_mpi_c_dpk_,info) #else #if defined(INT_I4_L4) - psb_mpi_ipk_ = mpi_integer - psb_mpi_lpk_ = mpi_integer + psb_mpi_ipk_ = mpi_integer4 + psb_mpi_lpk_ = mpi_integer4 #elif defined(INT_I4_L8) - psb_mpi_ipk_ = mpi_integer + psb_mpi_ipk_ = mpi_integer4 psb_mpi_lpk_ = mpi_integer8 #elif defined(INT_I8_L8) psb_mpi_ipk_ = mpi_integer8 @@ -171,8 +171,9 @@ contains psb_mpi_ipk_ = -1 psb_mpi_lpk_ = -1 #endif - psb_mpi_mpk_ = mpi_integer - psb_mpi_epk_ = mpi_integer8 + psb_mpi_i2pk_ = mpi_integer2 + psb_mpi_mpk_ = mpi_integer4 + psb_mpi_epk_ = mpi_integer8 psb_mpi_r_spk_ = mpi_real psb_mpi_r_dpk_ = mpi_double_precision psb_mpi_c_spk_ = mpi_complex @@ -181,12 +182,10 @@ contains #if defined(SERIAL_MPI) #else - if (info == 0) call mpi_op_create(psi_iamx_op,.true.,mpi_iamx_op,info) - if (info == 0) call mpi_op_create(psi_iamn_op,.true.,mpi_iamn_op,info) - if (info == 0) call mpi_op_create(psi_i4amx_op,.true.,mpi_i4amx_op,info) - if (info == 0) call mpi_op_create(psi_i4amn_op,.true.,mpi_i4amn_op,info) - if (info == 0) call mpi_op_create(psi_i8amx_op,.true.,mpi_i8amx_op,info) - if (info == 0) call mpi_op_create(psi_i8amn_op,.true.,mpi_i8amn_op,info) + if (info == 0) call mpi_op_create(psi_mamx_op,.true.,mpi_mamx_op,info) + if (info == 0) call mpi_op_create(psi_mamn_op,.true.,mpi_mamn_op,info) + if (info == 0) call mpi_op_create(psi_eamx_op,.true.,mpi_eamx_op,info) + if (info == 0) call mpi_op_create(psi_eamn_op,.true.,mpi_eamn_op,info) if (info == 0) call mpi_op_create(psi_samx_op,.true.,mpi_samx_op,info) if (info == 0) call mpi_op_create(psi_samn_op,.true.,mpi_samn_op,info) if (info == 0) call mpi_op_create(psi_damx_op,.true.,mpi_damx_op,info) @@ -201,10 +200,9 @@ contains end subroutine psi_register_mpi_extras -#if defined(LONG_INTEGERS) - subroutine psb_init_ipk(ictxt,np,basectxt,ids) - integer(psb_ipk_), intent(out) :: ictxt - integer(psb_ipk_), intent(in), optional :: np, basectxt, ids(:) + subroutine psb_init_epk(ictxt,np,basectxt,ids) + integer(psb_epk_), intent(out) :: ictxt + integer(psb_epk_), intent(in), optional :: np, basectxt, ids(:) integer(psb_mpk_) :: iictxt integer(psb_mpk_) :: inp, ibasectxt @@ -230,28 +228,28 @@ contains call psb_init(iictxt,ids=ids_) end if ictxt = iictxt - end subroutine psb_init_ipk + end subroutine psb_init_epk - subroutine psb_exit_ipk(ictxt,close) - integer(psb_ipk_), intent(inout) :: ictxt + subroutine psb_exit_epk(ictxt,close) + integer(psb_epk_), intent(inout) :: ictxt logical, intent(in), optional :: close integer(psb_mpk_) :: iictxt iictxt = ictxt call psb_exit(iictxt, close) - end subroutine psb_exit_ipk + end subroutine psb_exit_epk - subroutine psb_barrier_ipk(ictxt) - integer(psb_ipk_), intent(in) :: ictxt + subroutine psb_barrier_epk(ictxt) + integer(psb_epk_), intent(in) :: ictxt integer(psb_mpk_) :: iictxt iictxt = ictxt call psb_barrier(iictxt) - end subroutine psb_barrier_ipk + end subroutine psb_barrier_epk - subroutine psb_abort_ipk(ictxt,errc) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(in), optional :: errc + subroutine psb_abort_epk(ictxt,errc) + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), intent(in), optional :: errc integer(psb_mpk_) :: iictxt, ierrc iictxt = ictxt @@ -261,12 +259,12 @@ contains else call psb_abort(iictxt) end if - end subroutine psb_abort_ipk + end subroutine psb_abort_epk - subroutine psb_info_ipk(ictxt,iam,np) + subroutine psb_info_epk(ictxt,iam,np) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: iam, np + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), intent(out) :: iam, np ! ! Simple caching scheme, keep track @@ -279,11 +277,8 @@ contains end if iam = lam np = lnp - end subroutine psb_info_ipk + end subroutine psb_info_epk - -#endif - subroutine psb_init_mpik(ictxt,np,basectxt,ids) use psi_comm_buffers_mod use psb_const_mod @@ -585,26 +580,7 @@ contains ! Note: len & type are always default integer. ! ! !!!!!!!!!!!!!!!!!!!!!! - subroutine psi_iamx_op(inv, outv,len,type) - integer(psb_ipk_) :: inv(*),outv(*) - integer(psb_mpk_) :: len,type - integer(psb_mpk_) :: i - - do i=1, len - if (abs(inv(i)) > abs(outv(i))) outv(i) = inv(i) - end do - end subroutine psi_iamx_op - - subroutine psi_iamn_op(inv, outv,len,type) - integer(psb_ipk_) :: inv(*),outv(*) - integer(psb_mpk_) :: len,type - integer(psb_mpk_) :: i - do i=1, len - if (abs(inv(i)) < abs(outv(i))) outv(i) = inv(i) - end do - end subroutine psi_iamn_op - - subroutine psi_i4amx_op(inv, outv,len,type) + subroutine psi_mamx_op(inv, outv,len,type) integer(psb_mpk_) :: inv(*),outv(*) integer(psb_mpk_) :: len,type integer(psb_mpk_) :: i @@ -612,9 +588,9 @@ contains do i=1, len if (abs(inv(i)) > abs(outv(i))) outv(i) = inv(i) end do - end subroutine psi_i4amx_op + end subroutine psi_mamx_op - subroutine psi_i4amn_op(inv, outv,len,type) + subroutine psi_mamn_op(inv, outv,len,type) integer(psb_mpk_) :: inv(*),outv(*) integer(psb_mpk_) :: len,type integer(psb_mpk_) :: i @@ -622,9 +598,9 @@ contains do i=1, len if (abs(inv(i)) < abs(outv(i))) outv(i) = inv(i) end do - end subroutine psi_i4amn_op + end subroutine psi_mamn_op - subroutine psi_i8amx_op(inv, outv,len,type) + subroutine psi_eamx_op(inv, outv,len,type) integer(psb_epk_) :: inv(*),outv(*) integer(psb_mpk_) :: len,type integer(psb_mpk_) :: i @@ -632,9 +608,9 @@ contains do i=1, len if (abs(inv(i)) > abs(outv(i))) outv(i) = inv(i) end do - end subroutine psi_i8amx_op + end subroutine psi_eamx_op - subroutine psi_i8amn_op(inv, outv,len,type) + subroutine psi_eamn_op(inv, outv,len,type) integer(psb_epk_) :: inv(*),outv(*) integer(psb_mpk_) :: len,type integer(psb_mpk_) :: i @@ -642,7 +618,7 @@ contains do i=1, len if (abs(inv(i)) < abs(outv(i))) outv(i) = inv(i) end do - end subroutine psi_i8amn_op + end subroutine psi_eamn_op subroutine psi_samx_op(vin,vinout,len,itype) integer(psb_mpk_), intent(in) :: len, itype diff --git a/base/modules/psi_reduce_mod.F90 b/base/modules/psi_reduce_mod.F90 index 1bda35909..b244cf96b 100644 --- a/base/modules/psi_reduce_mod.F90 +++ b/base/modules/psi_reduce_mod.F90 @@ -31,174 +31,23 @@ ! module psi_reduce_mod use psi_penv_mod - interface psb_max - module procedure psb_imaxs, psb_imaxv, psb_imaxm,& - & psb_smaxs, psb_smaxv, psb_smaxm,& - & psb_dmaxs, psb_dmaxv, psb_dmaxm - end interface -#if defined(LONG_INTEGERS) - interface psb_max - module procedure psb_i4maxs, psb_i4maxv, psb_i4maxm - end interface -#endif -#if !defined(LONG_INTEGERS) - interface psb_max - module procedure psb_i8maxs, psb_i8maxv, psb_i8maxm - end interface -#endif - - interface psb_min - module procedure psb_imins, psb_iminv, psb_iminm,& - & psb_smins, psb_sminv, psb_sminm,& - & psb_dmins, psb_dminv, psb_dminm - end interface -#if !defined(LONG_INTEGERS) - interface psb_min - module procedure psb_i8mins, psb_i8minv, psb_i8minm - end interface -#endif -#if defined(LONG_INTEGERS) - interface psb_min - module procedure psb_i4mins, psb_i4minv, psb_i4minm - end interface -#endif - - - interface psb_amx - module procedure psb_iamxs, psb_iamxv, psb_iamxm,& - & psb_samxs, psb_samxv, psb_samxm,& - & psb_camxs, psb_camxv, psb_camxm,& - & psb_damxs, psb_damxv, psb_damxm,& - & psb_zamxs, psb_zamxv, psb_zamxm - end interface -#if !defined(LONG_INTEGERS) - interface psb_amx - module procedure psb_i8amxs, psb_i8amxv, psb_i8amxm - end interface -#endif -#if defined(LONG_INTEGERS) - interface psb_amx - module procedure psb_i4amxs, psb_i4amxv, psb_i4amxm - end interface -#endif - - interface psb_amn - module procedure psb_iamns, psb_iamnv, psb_iamnm,& - & psb_samns, psb_samnv, psb_samnm,& - & psb_camns, psb_camnv, psb_camnm,& - & psb_damns, psb_damnv, psb_damnm,& - & psb_zamns, psb_zamnv, psb_zamnm - end interface -#if defined(LONG_INTEGERS) - interface psb_amn - module procedure psb_i4amns, psb_i4amnv, psb_i4amnm - end interface -#endif -#if !defined(LONG_INTEGERS) - interface psb_amn - module procedure psb_i8amns, psb_i8amnv, psb_i8amnm - end interface -#endif - - - interface psb_sum - module procedure psb_isums, psb_isumv, psb_isumm,& - & psb_ssums, psb_ssumv, psb_ssumm,& - & psb_csums, psb_csumv, psb_csumm,& - & psb_dsums, psb_dsumv, psb_dsumm,& - & psb_zsums, psb_zsumv, psb_zsumm - end interface -#if defined(SHORT_INTEGERS) - interface psb_sum - module procedure psb_i2sums, psb_i2sumv, psb_i2summ - end interface psb_sum -#endif -#if defined(LONG_INTEGERS) - interface psb_sum - module procedure psb_i4sums, psb_i4sumv, psb_i4summ - end interface -#endif -#if !defined(LONG_INTEGERS) - interface psb_sum - module procedure psb_i8sums, psb_i8sumv, psb_i8summ - end interface -#endif - - - interface psb_nrm2 - module procedure psb_s_nrm2s, psb_s_nrm2v,& - & psb_d_nrm2s, psb_d_nrm2v - end interface - - - -#if defined(LONG_INTEGERS) - interface psb_max - module procedure psb_imaxs_ic, psb_imaxv_ic, psb_imaxm_ic,& - & psb_smaxs_ic, psb_smaxv_ic, psb_smaxm_ic,& - & psb_dmaxs_ic, psb_dmaxv_ic, psb_dmaxm_ic - end interface - - interface psb_min - module procedure psb_imins_ic, psb_iminv_ic, psb_iminm_ic,& - & psb_smins_ic, psb_sminv_ic, psb_sminm_ic,& - & psb_dmins_ic, psb_dminv_ic, psb_dminm_ic - end interface - - - interface psb_amx - module procedure psb_iamxs_ic, psb_iamxv_ic, psb_iamxm_ic,& - & psb_samxs_ic, psb_samxv_ic, psb_samxm_ic,& - & psb_camxs_ic, psb_camxv_ic, psb_camxm_ic,& - & psb_damxs_ic, psb_damxv_ic, psb_damxm_ic,& - & psb_zamxs_ic, psb_zamxv_ic, psb_zamxm_ic - end interface - - interface psb_amn - module procedure psb_iamns_ic, psb_iamnv_ic, psb_iamnm_ic,& - & psb_samns_ic, psb_samnv_ic, psb_samnm_ic,& - & psb_camns_ic, psb_camnv_ic, psb_camnm_ic,& - & psb_damns_ic, psb_damnv_ic, psb_damnm_ic,& - & psb_zamns_ic, psb_zamnv_ic, psb_zamnm_ic - end interface + use psi_m_reduce_mod + use psi_e_reduce_mod + use psi_s_reduce_mod + use psi_d_reduce_mod + use psi_c_reduce_mod + use psi_z_reduce_mod - - interface psb_sum - module procedure psb_isums_ic, psb_isumv_ic, psb_isumm_ic,& - & psb_ssums_ic, psb_ssumv_ic, psb_ssumm_ic,& - & psb_csums_ic, psb_csumv_ic, psb_csumm_ic,& - & psb_dsums_ic, psb_dsumv_ic, psb_dsumm_ic,& - & psb_zsums_ic, psb_zsumv_ic, psb_zsumm_ic - end interface #if defined(SHORT_INTEGERS) interface psb_sum - module procedure psb_i2sums_ic, psb_i2sumv_ic, psb_i2summ_ic + module procedure psb_i2sums, psb_i2sumv, psb_i2summ, & + & psb_i2sums_ec, psb_i2sumv_ec, psb_i2summ_ec end interface psb_sum -#endif - - interface psb_nrm2 - module procedure psb_s_nrm2s_ic, psb_s_nrm2v_ic,& - & psb_d_nrm2s_ic, psb_d_nrm2v_ic - end interface -#endif - - -contains - - ! !!!!!!!!!!!!!!!!!!!!!! - ! - ! Reduction operations - ! - ! !!!!!!!!!!!!!!!!!!!!!! +contains + + subroutine psb_i2sums(ictxt,dat,root) - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! MAX - ! - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine psb_imaxs(ictxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -207,15 +56,15 @@ contains include 'mpif.h' #endif integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat + integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root - integer(psb_ipk_) :: dat_ integer(psb_mpk_) :: root_ + integer(psb_i2pk_) :: dat_ integer(psb_mpk_) :: iam, np, info integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) if (present(root)) then @@ -224,60 +73,17 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_,mpi_max,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_ipk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) if (iam == root_) dat = dat_ endif -#endif - end subroutine psb_imaxs - - subroutine psb_imaxv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_ipk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_,mpi_max,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_max,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_max,root_,ictxt,info) - end if - endif #endif - end subroutine psb_imaxv + end subroutine psb_i2sums - subroutine psb_imaxm(ictxt,dat,root) + subroutine psb_i2sumv(ictxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -287,93 +93,13 @@ contains include 'mpif.h' #endif integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:,:) + integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_ipk_), allocatable :: dat_(:,:) + integer(psb_i2pk_), allocatable :: dat_(:) integer(psb_mpk_) :: iam, np, info integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_,mpi_max,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_max,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_max,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_imaxm - -#if defined(LONG_INTEGERS) - subroutine psb_i4maxs(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_mpk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_max,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_max,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_i4maxs - - subroutine psb_i4maxv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_mpk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -387,21 +113,20 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_,mpi_max,ictxt,info) + & psb_mpi_i2pk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) end if endif #endif - end subroutine psb_i4maxv + end subroutine psb_i2sumv - subroutine psb_i4maxm(ictxt,dat,root) + subroutine psb_i2summ(ictxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -411,12 +136,12 @@ contains include 'mpif.h' #endif integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:,:) + integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_), allocatable :: dat_(:,:) + integer(psb_i2pk_), allocatable :: dat_(:,:) integer(psb_mpk_) :: iam, np, info - integer(psb_mpk_) :: iinfo + integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -431,5159 +156,67 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_,mpi_max,ictxt,info) + & psb_mpi_i2pk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) end if endif #endif - end subroutine psb_i4maxm - -#endif - + end subroutine psb_i2summ -#if !defined(LONG_INTEGERS) - subroutine psb_i8maxs(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif + subroutine psb_i2sums_ec(ictxt,dat,root) implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + 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 - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_,mpi_max,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_lpk_,mpi_max,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_i8maxs + call psb_sum(ictxt_,dat) + end if + end subroutine psb_i2sums_ec - subroutine psb_i8maxv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif + subroutine psb_i2sumv_ec(ictxt,dat,root) implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) + 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 - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_,mpi_max,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_max,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_max,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i8maxv + call psb_sum(ictxt_,dat) + end if + end subroutine psb_i2sumv_ec - subroutine psb_i8maxm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif + subroutine psb_i2summ_ec(ictxt,dat,root) implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + 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 - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_,mpi_max,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_max,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_max,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i8maxm + call psb_sum(ictxt_,dat) + end if + end subroutine psb_i2summ_ec #endif - - subroutine psb_smaxs(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_smaxs - - subroutine psb_smaxv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_smaxv - - subroutine psb_smaxm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_smaxm - - subroutine psb_dmaxs(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_dmaxs - - subroutine psb_dmaxv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& - & mpi_max,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_dmaxv - - subroutine psb_dmaxm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_dmaxm - - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! MIN - ! - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine psb_imins(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_ipk_) :: dat_ - integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_,mpi_min,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_ipk_,mpi_min,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_imins - - subroutine psb_iminv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_ipk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_,mpi_min,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_min,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_min,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_iminv - - subroutine psb_iminm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_ipk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_,mpi_min,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_min,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_min,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_iminm - -#if defined(LONG_INTEGERS) - subroutine psb_i4mins(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_mpk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_min,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_min,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_i4mins - - subroutine psb_i4minv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_mpk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_,mpi_min,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i4minv - - subroutine psb_i4minm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_mpk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_,mpi_min,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i4minm - -#endif - - -#if !defined(LONG_INTEGERS) - subroutine psb_i8mins(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_,mpi_min,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_lpk_,mpi_min,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_i8mins - - subroutine psb_i8minv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_,mpi_min,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_min,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_min,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i8minv - - subroutine psb_i8minm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_,mpi_min,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_min,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_min,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i8minm - -#endif - - - - subroutine psb_smins(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_smins - - subroutine psb_sminv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_sminv - - subroutine psb_sminm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_sminm - - subroutine psb_dmins(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_dmins - - subroutine psb_dminv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& - & mpi_min,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_dminv - - subroutine psb_dminm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_dminm - - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! AMX: maximum absolute value - ! - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - subroutine psb_iamxs(ictxt,dat,root) - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_ipk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_,mpi_iamx_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_ipk_,mpi_iamx_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif - -#endif - end subroutine psb_iamxs - - subroutine psb_iamxv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_ipk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_,mpi_iamx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_iamx_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_iamx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_iamxv - - subroutine psb_iamxm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_ipk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_,mpi_iamx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_iamx_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_iamx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_iamxm - - -#if defined(LONG_INTEGERS) - subroutine psb_i4amxs(ictxt,dat,root) - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_mpk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_i4amx_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_i4amx_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif - -#endif - end subroutine psb_i4amxs - - subroutine psb_i4amxv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_mpk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_,mpi_i4amx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_i4amx_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_i4amx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i4amxv - - subroutine psb_i4amxm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_mpk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_,mpi_i4amx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_i4amx_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_i4amx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i4amxm - -#endif - -#if !defined(LONG_INTEGERS) - subroutine psb_i8amxs(ictxt,dat,root) - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_,mpi_i8amx_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_lpk_,mpi_i8amx_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif - -#endif - end subroutine psb_i8amxs - - subroutine psb_i8amxv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_,mpi_i8amx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_i8amx_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_i8amx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i8amxv - - subroutine psb_i8amxm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_,mpi_i8amx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_i8amx_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_i8amx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i8amxm - -#endif - - - - subroutine psb_samxs(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_samxs - - subroutine psb_samxv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_samxv - - subroutine psb_samxm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_samxm - - subroutine psb_damxs(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_damxs - - subroutine psb_damxv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& - & mpi_damx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_damxv - - subroutine psb_damxm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_damxm - - - subroutine psb_camxs(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_camxs - - subroutine psb_camxv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_camxv - - subroutine psb_camxm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_camxm - - subroutine psb_zamxs(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_zamxs - - subroutine psb_zamxv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,& - & mpi_zamx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_zamxv - - subroutine psb_zamxm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_zamxm - - - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! AMN: minimum absolute value - ! - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine psb_iamns(ictxt,dat,root) - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_ipk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_,mpi_iamn_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_ipk_,mpi_iamn_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif - -#endif - end subroutine psb_iamns - - subroutine psb_iamnv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_ipk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_,mpi_iamn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_iamn_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_iamn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_iamnv - - subroutine psb_iamnm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_ipk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_,mpi_iamn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_iamn_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_iamn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_iamnm - - -#if defined(LONG_INTEGERS) - subroutine psb_i4amns(ictxt,dat,root) - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_mpk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_i4amn_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_i4amn_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif - -#endif - end subroutine psb_i4amns - - subroutine psb_i4amnv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_mpk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_,mpi_i4amn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_i4amn_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_i4amn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i4amnv - - subroutine psb_i4amnm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_mpk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_,mpi_i4amn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_i4amn_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_i4amn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i4amnm - -#endif - -#if !defined(LONG_INTEGERS) - subroutine psb_i8amns(ictxt,dat,root) - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_,mpi_i8amn_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_lpk_,mpi_i8amn_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif - -#endif - end subroutine psb_i8amns - - subroutine psb_i8amnv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_,mpi_i8amn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_i8amn_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_i8amn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i8amnv - - subroutine psb_i8amnm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_,mpi_i8amn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_i8amn_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_i8amn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i8amnm - -#endif - - - - subroutine psb_samns(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_samns - - subroutine psb_samnv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_samnv - - subroutine psb_samnm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_samnm - - subroutine psb_damns(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_damns - - subroutine psb_damnv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& - & mpi_damn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_damnv - - subroutine psb_damnm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_damnm - - - subroutine psb_camns(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_camns - - subroutine psb_camnv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_camnv - - subroutine psb_camnm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_camnm - - subroutine psb_zamns(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_zamns - - subroutine psb_zamnv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,& - & mpi_zamn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_zamnv - - subroutine psb_zamnm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_zamnm - - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! SUM - ! - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine psb_isums(ictxt,dat,root) - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_ipk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_,mpi_sum,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_ipk_,mpi_sum,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif - -#endif - end subroutine psb_isums - - subroutine psb_isumv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_ipk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_isumv - - subroutine psb_isumm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_ipk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_isumm - - -#if defined(SHORT_INTEGERS) - subroutine psb_i2sums(ictxt,dat,root) - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(2), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(2) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_2,mpi_sum,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_2,mpi_sum,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif - -#endif - end subroutine psb_i2sums - - subroutine psb_i2sumv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(2), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(2), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_2,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_2,mpi_sum,root_,ictxt,info) - else - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_2,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i2sumv - - subroutine psb_i2summ(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(2), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(2), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_2,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_2,mpi_sum,root_,ictxt,info) - else - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_2,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i2summ - -#endif - - -#if defined(LONG_INTEGERS) - subroutine psb_i4sums(ictxt,dat,root) - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_sum,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_sum,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif - -#endif - end subroutine psb_i4sums - - subroutine psb_i4sumv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,info) - dat_=dat - if (info == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,info) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,dat_,info) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i4sumv - - subroutine psb_i4summ(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_mpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,info) - dat_=dat - if (info == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,info) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,info) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i4summ - -#endif - -#if !defined(LONG_INTEGERS) - subroutine psb_i8sums(ictxt,dat,root) - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_,mpi_sum,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_lpk_,mpi_sum,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif - -#endif - end subroutine psb_i8sums - - subroutine psb_i8sumv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i8sumv - - subroutine psb_i8summ(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - integer(psb_epk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_i8summ - -#endif - - - - subroutine psb_ssums(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_ssums - - subroutine psb_ssumv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_ssumv - - subroutine psb_ssumm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_ssumm - - subroutine psb_dsums(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_dsums - - subroutine psb_dsumv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& - & mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_dsumv - - subroutine psb_dsumm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_dsumm - - - subroutine psb_csums(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_csums - - subroutine psb_csumv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_csumv - - subroutine psb_csumm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_csumm - - subroutine psb_zsums(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_zsums - - subroutine psb_zsumv(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,& - & mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_zsumv - - subroutine psb_zsumm(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - complex(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - -#if !defined(SERIAL_MPI) - - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) - else - call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_zsumm - - ! !!!!!!!!!!!! - ! - ! Norm 2 - ! - ! !!!!!!!!!!!! - subroutine psb_s_nrm2s(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_s_nrm2s - - subroutine psb_d_nrm2s(ictxt,dat,root) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,ictxt,info) - dat = dat_ - else - call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,root_,ictxt,info) - if (iam == root_) dat = dat_ - endif -#endif - end subroutine psb_d_nrm2s - - subroutine psb_s_nrm2v(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,& - & mpi_snrm2_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,& - & mpi_snrm2_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,& - & mpi_snrm2_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_s_nrm2v - - subroutine psb_d_nrm2v(ictxt,dat,root) - use psb_realloc_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: root_ - real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo - - -#if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - - if (present(root)) then - root_ = root - else - root_ = -1 - endif - if (root_ == -1) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& - & mpi_dnrm2_op,ictxt,info) - else - if (iam == root_) then - call psb_realloc(size(dat),dat_,iinfo) - dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& - & mpi_dnrm2_op,root_,ictxt,info) - else - call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,& - & mpi_dnrm2_op,root_,ictxt,info) - end if - endif -#endif - end subroutine psb_d_nrm2v - -#if defined(LONG_INTEGERS) - - subroutine psb_imaxs_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - - end subroutine psb_imaxs_ic - - subroutine psb_imaxv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_imaxv_ic - - subroutine psb_imaxm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_imaxm_ic - - - subroutine psb_smaxs_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_smaxs_ic - - subroutine psb_smaxv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_smaxv_ic - - subroutine psb_smaxm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_smaxm_ic - - subroutine psb_dmaxs_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_dmaxs_ic - - subroutine psb_dmaxv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_dmaxv_ic - - subroutine psb_dmaxm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_dmaxm_ic - - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! MIN - ! - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine psb_imins_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_imins_ic - - subroutine psb_iminv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_iminv_ic - - subroutine psb_iminm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_iminm_ic - - - subroutine psb_smins_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_smins_ic - - subroutine psb_sminv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_sminv_ic - - subroutine psb_sminm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_sminm_ic - - subroutine psb_dmins_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_dmins_ic - - subroutine psb_dminv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_dminv_ic - - subroutine psb_dminm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_dminm_ic - - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! AMX: maximum absolute value - ! - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - subroutine psb_iamxs_ic(ictxt,dat,root) - - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat - integer(psb_ipk_), 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_iamxs_ic - - subroutine psb_iamxv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_iamxv_ic - - subroutine psb_iamxm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_iamxm_ic - - - - subroutine psb_samxs_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_ipk_), 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_samxs_ic - - subroutine psb_samxv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_samxv_ic - - subroutine psb_samxm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_samxm_ic - - subroutine psb_damxs_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_ipk_), 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_damxs_ic - - subroutine psb_damxv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_damxv_ic - - subroutine psb_damxm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_damxm_ic - - - subroutine psb_camxs_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat - integer(psb_ipk_), 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_ic - - subroutine psb_camxv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_ic - - subroutine psb_camxm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_ic - - subroutine psb_zamxs_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat - integer(psb_ipk_), 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_ic - - subroutine psb_zamxv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_ic - - subroutine psb_zamxm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_ic - - - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! AMN: minimum absolute value - ! - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine psb_iamns_ic(ictxt,dat,root) - - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat - integer(psb_ipk_), 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_iamns_ic - - subroutine psb_iamnv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_iamnv_ic - - subroutine psb_iamnm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_iamnm_ic - - - - - subroutine psb_samns_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_ipk_), 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_samns_ic - - subroutine psb_samnv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_samnv_ic - - subroutine psb_samnm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_samnm_ic - - subroutine psb_damns_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_ipk_), 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_damns_ic - - subroutine psb_damnv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_damnv_ic - - subroutine psb_damnm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_damnm_ic - - - subroutine psb_camns_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat - integer(psb_ipk_), 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_ic - - subroutine psb_camnv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_ic - - subroutine psb_camnm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_ic - - subroutine psb_zamns_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat - integer(psb_ipk_), 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_ic - - subroutine psb_zamnv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_ic - - subroutine psb_zamnm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_ic - - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! SUM - ! - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine psb_isums_ic(ictxt,dat,root) - - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat - integer(psb_ipk_), 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_isums_ic - - subroutine psb_isumv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_isumv_ic - - subroutine psb_isumm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_isumm_ic - -#if defined(SHORT_INTEGERS) - subroutine psb_i2sums_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(2), intent(inout) :: dat - integer(psb_ipk_), 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_ic - - subroutine psb_i2sumv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(2), intent(inout) :: dat(:) - integer(psb_ipk_), 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_ic - - subroutine psb_i2summ_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(2), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_ic - -#endif - - - - - subroutine psb_ssums_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_ipk_), 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_ssums_ic - - subroutine psb_ssumv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_ssumv_ic - - subroutine psb_ssumm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_ssumm_ic - - subroutine psb_dsums_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_ipk_), 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_dsums_ic - - subroutine psb_dsumv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_dsumv_ic - - subroutine psb_dsumm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_dsumm_ic - - - subroutine psb_csums_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat - integer(psb_ipk_), 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_ic - - subroutine psb_csumv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_ic - - subroutine psb_csumm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_ic - - subroutine psb_zsums_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat - integer(psb_ipk_), 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_ic - - subroutine psb_zsumv_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_ipk_), 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_ic - - subroutine psb_zsumm_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), 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_ic - - ! !!!!!!!!!!!! - ! - ! Norm 2 - ! - ! !!!!!!!!!!!! - subroutine psb_s_nrm2s_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_nrm2(ictxt_,dat,root_) - else - call psb_nrm2(ictxt_,dat) - end if - end subroutine psb_s_nrm2s_ic - - subroutine psb_d_nrm2s_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_nrm2(ictxt_,dat,root_) - else - call psb_nrm2(ictxt_,dat) - end if - end subroutine psb_d_nrm2s_ic - - subroutine psb_s_nrm2v_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_nrm2(ictxt_,dat,root_) - else - call psb_nrm2(ictxt_,dat) - end if - end subroutine psb_s_nrm2v_ic - - subroutine psb_d_nrm2v_ic(ictxt,dat,root) - implicit none - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_nrm2(ictxt_,dat,root_) - else - call psb_nrm2(ictxt_,dat) - end if - end subroutine psb_d_nrm2v_ic - -#endif end module psi_reduce_mod