Refactor fnd_owner into graph_fnd_owner which may call a2a_ and adjcncy_

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=..

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

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()

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