diff --git a/base/internals/psi_indx_map_fnd_owner.F90 b/base/internals/psi_indx_map_fnd_owner.F90 index 31c4d51f..dc9ab7f1 100644 --- a/base/internals/psi_indx_map_fnd_owner.F90 +++ b/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() diff --git a/base/modules/desc/psb_gen_block_map_mod.F90 b/base/modules/desc/psb_gen_block_map_mod.F90 index 8daa038f..68871cb1 100644 --- a/base/modules/desc/psb_gen_block_map_mod.F90 +++ b/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 diff --git a/base/modules/desc/psb_glist_map_mod.f90 b/base/modules/desc/psb_glist_map_mod.f90 index c8ac8f99..5f260d7e 100644 --- a/base/modules/desc/psb_glist_map_mod.f90 +++ b/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) diff --git a/base/modules/desc/psb_indx_map_mod.f90 b/base/modules/desc/psb_indx_map_mod.f90 index 5c8785ac..046a7f1f 100644 --- a/base/modules/desc/psb_indx_map_mod.f90 +++ b/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 diff --git a/base/modules/desc/psb_repl_map_mod.f90 b/base/modules/desc/psb_repl_map_mod.f90 index e0d352e2..f360f6c3 100644 --- a/base/modules/desc/psb_repl_map_mod.f90 +++ b/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