From 95dffe2f76776fc7e16bf6f4863dbbf59193e288 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 1 Nov 2019 10:34:22 +0000 Subject: [PATCH] Refactor fnd_owner into graph_fnd_owner which may call a2a_ and adjcncy_ --- base/internals/Makefile | 3 +- base/internals/psi_graph_fnd_owner.F90 | 129 ++++++++++++++++++++++ base/internals/psi_indx_map_fnd_owner.F90 | 3 +- base/modules/desc/psb_indx_map_mod.f90 | 11 ++ 4 files changed, 144 insertions(+), 2 deletions(-) create mode 100644 base/internals/psi_graph_fnd_owner.F90 diff --git a/base/internals/Makefile b/base/internals/Makefile index 5cc48a34..ea3f438b 100644 --- a/base/internals/Makefile +++ b/base/internals/Makefile @@ -6,7 +6,8 @@ FOBJS = psi_compute_size.o psi_crea_bnd_elem.o psi_crea_index.o \ psi_indx_map_fnd_owner.o \ psi_desc_impl.o psi_hash_impl.o psi_list_search.o psi_srtlist.o -MPFOBJS = psi_desc_index.o psi_extrct_dl.o psi_fnd_owner.o psi_a2a_fnd_owner.o psi_adjcncy_fnd_owner.o +MPFOBJS = psi_desc_index.o psi_extrct_dl.o psi_fnd_owner.o psi_a2a_fnd_owner.o \ + psi_graph_fnd_owner.o psi_adjcncy_fnd_owner.o LIBDIR=.. INCDIR=.. diff --git a/base/internals/psi_graph_fnd_owner.F90 b/base/internals/psi_graph_fnd_owner.F90 new file mode 100644 index 00000000..ce3fb837 --- /dev/null +++ b/base/internals/psi_graph_fnd_owner.F90 @@ -0,0 +1,129 @@ +! +! 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. +! +! +! +! File: psi_fnd_owner.f90 +! +! Subroutine: psi_fnd_owner +! Figure out who owns global indices. +! +! Arguments: +! nv - integer Number of indices required on the calling +! process +! idx(:) - integer Required indices on the calling process. +! Note: the indices should be unique! +! iprc(:) - integer(psb_ipk_), allocatable Output: process identifiers for the corresponding +! indices +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. return code. +! +subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) + use psb_serial_mod + use psb_const_mod + use psb_error_mod + use psb_penv_mod + use psb_realloc_mod + use psb_indx_map_mod, psb_protect_name => psi_graph_fnd_owner +#ifdef MPI_MOD + use mpi +#endif + + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_lpk_), intent(in) :: idx(:) + integer(psb_ipk_), allocatable, intent(out) :: iprc(:) + class(psb_indx_map), intent(in) :: idxmap + integer(psb_ipk_), intent(out) :: info + + + integer(psb_lpk_), allocatable :: answers(:,:), idxsrch(:,:), hproc(:) + integer(psb_ipk_), allocatable :: helem(:), hhidx(:) + integer(psb_mpk_), allocatable :: hsz(:),hidx(:), & + & sdsz(:),sdidx(:), rvsz(:), rvidx(:) + integer(psb_mpk_) :: icomm, minfo, iictxt + integer(psb_ipk_) :: i,n_row,n_col,err_act,hsize,ip,isz,j, k,& + & last_ih, last_j, nv + integer(psb_lpk_) :: mglob, ih + integer(psb_ipk_) :: ictxt,np,me, nresp + logical, parameter :: gettime=.false. + real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx + character(len=20) :: name + + info = psb_success_ + name = 'psb_indx_map_fnd_owner' + call psb_erractionsave(err_act) + + ictxt = idxmap%get_ctxt() + icomm = idxmap%get_mpic() + mglob = idxmap%get_gr() + n_row = idxmap%get_lr() + n_col = idxmap%get_lc() + iictxt = ictxt + + call psb_info(ictxt, me, np) + + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.(idxmap%is_valid())) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='invalid idxmap') + goto 9999 + end if + + if (gettime) then + t0 = psb_wtime() + end if + + nv = size(idx) + call psb_realloc(nv,iprc,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_realloc') + goto 9999 + end if + + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=idxmap%get_fmt()) + goto 9999 + + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +end subroutine psi_graph_fnd_owner diff --git a/base/internals/psi_indx_map_fnd_owner.F90 b/base/internals/psi_indx_map_fnd_owner.F90 index e15b086c..0e6e5f15 100644 --- a/base/internals/psi_indx_map_fnd_owner.F90 +++ b/base/internals/psi_indx_map_fnd_owner.F90 @@ -140,11 +140,12 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info) else - call psi_adjcncy_fnd_owner(idx,iprc,idxmap,info) + call psi_graph_fnd_owner(idx,iprc,idxmap,info) end if end if + if (gettime) then call psb_barrier(ictxt) t1 = psb_wtime() diff --git a/base/modules/desc/psb_indx_map_mod.f90 b/base/modules/desc/psb_indx_map_mod.f90 index 0a2098f9..e197d145 100644 --- a/base/modules/desc/psb_indx_map_mod.f90 +++ b/base/modules/desc/psb_indx_map_mod.f90 @@ -299,6 +299,17 @@ module psb_indx_map_mod end subroutine psi_adjcncy_fnd_owner end interface + interface + subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) + import :: psb_indx_map, psb_ipk_, psb_lpk_ + implicit none + integer(psb_lpk_), intent(in) :: idx(:) + integer(psb_ipk_), allocatable, intent(out) :: iprc(:) + class(psb_indx_map), intent(in) :: idxmap + integer(psb_ipk_), intent(out) :: info + end subroutine psi_graph_fnd_owner + end interface + contains