Change interface to fnd_owner

base/internals/psi_indx_map_fnd_owner.F90

@@ -51,7 +51,7 @@
 !  2. Check if TEMPVG(:) is allocated, and use it; or
 !  3. Call the general method PSI_GRAPH_FND_OWNER. 
 ! 
-subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info)
+subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info,adj)
   use psb_serial_mod
   use psb_const_mod
   use psb_error_mod
@@ -70,11 +70,11 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info)
   integer(psb_ipk_), allocatable, intent(out) ::  iprc(:)
   class(psb_indx_map), intent(inout) :: idxmap
   integer(psb_ipk_), intent(out)     :: info
-
+  integer(psb_ipk_), optional, allocatable, intent(out) ::  adj(:)
 
   integer(psb_ipk_), allocatable :: hhidx(:), ladj(:) 
   integer(psb_mpk_) :: icomm, minfo
-  integer(psb_ipk_) :: i, err_act, hsize
+  integer(psb_ipk_) :: i, err_act, hsize, nadj
   integer(psb_lpk_) :: nv
   integer(psb_lpk_) :: mglob
   type(psb_ctxt_type) :: ctxt
@@ -131,7 +131,6 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info)
         iprc(i) = -1 
       end if
     end do
-
   else if (allocated(idxmap%tempvg)) then 
 !!$    write(0,*) me,trim(name),' indxmap%tempvg shortcut'
     ! Use temporary vector 
@@ -202,7 +201,11 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info)
     end if
     
   end if
-  
+  if (present(adj)) then
+    adj = iprc
+    call psb_msort_unique(adj,nadj)
+    call psb_realloc(nadj,adj,info)
+  end if
   if (gettime) then 
     call psb_barrier(ctxt)
     t1 = psb_wtime()

base/modules/desc/psb_gen_block_map_mod.F90

@@ -1050,15 +1050,16 @@ contains
 
   end subroutine block_lg2lv2_ins
 
-  subroutine block_fnd_owner(idx,iprc,idxmap,info)
+  subroutine block_fnd_owner(idx,iprc,idxmap,info,adj)
     use psb_penv_mod
     implicit none 
     integer(psb_lpk_), intent(in)           :: idx(:)
     integer(psb_ipk_), allocatable, intent(out) ::  iprc(:)
     class(psb_gen_block_map), intent(inout) :: idxmap
     integer(psb_ipk_), intent(out)          :: info
+    integer(psb_ipk_), optional, allocatable, intent(out) ::  adj(:)
     type(psb_ctxt_type) :: ctxt
-    integer(psb_ipk_) :: iam, np, nv, ip, i
+    integer(psb_ipk_) :: iam, np, nv, ip, i, nadj
     integer(psb_lpk_) :: tidx
     
     ctxt = idxmap%get_ctxt()
@@ -1073,7 +1074,11 @@ contains
       ip = gen_block_search(tidx-1,np+1,idxmap%vnl)
       iprc(i) = ip - 1
     end do
-
+    if (present(adj)) then 
+      adj = iprc
+      call psb_msort_unique(adj,nadj)
+      call psb_realloc(nadj,adj,info)
+    end if
   end subroutine block_fnd_owner
 
 

base/modules/desc/psb_glist_map_mod.f90

@@ -150,16 +150,20 @@ contains
    
   end subroutine glist_initvg
 
-  subroutine glist_fnd_owner(idx,iprc,idxmap,info)
+  subroutine glist_fnd_owner(idx,iprc,idxmap,info,adj)
     use psb_penv_mod
     use psb_sort_mod
+    use psb_realloc_mod
     implicit none 
     integer(psb_lpk_), intent(in)       :: idx(:)
     integer(psb_ipk_), allocatable, intent(out) ::  iprc(:)
     class(psb_glist_map), intent(inout) :: idxmap
     integer(psb_ipk_), intent(out)      :: info
+    integer(psb_ipk_), optional, allocatable, intent(out) ::  adj(:)
+    
     type(psb_ctxt_type) :: ctxt
     integer(psb_mpk_)   :: iam, np
+    integer(psb_ipk_)   :: nadj
     integer(psb_lpk_)   :: nv, i, ngp
     
     ctxt = idxmap%get_ctxt()
@@ -180,6 +184,12 @@ contains
       end if
     end do
 
+    if (present(adj)) then 
+      adj = iprc
+      call psb_msort_unique(adj,nadj)
+      call psb_realloc(nadj,adj,info)
+    end if
+
   end subroutine glist_fnd_owner
 
   function glist_get_fmt() result(res)

base/modules/desc/psb_indx_map_mod.f90

@@ -268,13 +268,14 @@ module psb_indx_map_mod
   !!
 
   interface 
-    subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info)
+    subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info,adj)
       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(inout) :: idxmap
       integer(psb_ipk_), intent(out)     :: info
+      integer(psb_ipk_), optional, allocatable, intent(out) ::  adj(:)
     end subroutine psi_indx_map_fnd_owner
   end interface
 

base/modules/desc/psb_repl_map_mod.f90

@@ -696,13 +696,14 @@ contains
   end subroutine repl_g2lv2_ins
 
 
-  subroutine repl_fnd_owner(idx,iprc,idxmap,info)
+  subroutine repl_fnd_owner(idx,iprc,idxmap,info,adj)
     use psb_penv_mod
     implicit none 
     integer(psb_lpk_), intent(in)      :: idx(:)
     integer(psb_ipk_), allocatable, intent(out) ::  iprc(:)
     class(psb_repl_map), intent(inout) :: idxmap
     integer(psb_ipk_), intent(out)     :: info
+    integer(psb_ipk_), optional, allocatable, intent(out) ::  adj(:)
     integer(psb_ipk_)   :: nv
     type(psb_ctxt_type) :: ctxt
     integer(psb_mpk_)   :: iam, np
@@ -717,6 +718,9 @@ contains
       return
     end if
     iprc(1:nv) = iam 
+    if (present(adj)) then 
+      adj = (/ iam /) 
+    end if
 
   end subroutine repl_fnd_owner