fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

First draft of psi_graph_fnd_owner. Need to revise choice of algorithmic thresholds.

Browse Source
fnd_owner
Salvatore Filippone 5 years ago
parent 95dffe2f76
commit 6c31765b3f
11 changed files with 177 additions and 65 deletions
Show Stats Download Patch File Download Diff File

6
base/internals/psi_a2a_fnd_owner.F90
Unescape Escape View File

@ -60,10 +60,10 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info)
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_), intent(in) :: idx(:)
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_ipk_), intent(out) :: info
integer(psb_lpk_), allocatable :: answers(:,:), idxsrch(:,:), hproc(:)
@ -80,7 +80,7 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info)
character(len=20) :: name
info = psb_success_
name = 'psb_indx_map_fnd_owner'
name = 'psi_a2a_fnd_owner'
call psb_erractionsave(err_act)
ictxt = idxmap%get_ctxt()

16
base/internals/psi_adjcncy_fnd_owner.F90
Unescape Escape View File

@ -45,7 +45,7 @@
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code.
!
subroutine psi_adjcncy_fnd_owner(idx,iprc,idxmap,info)
subroutine psi_adjcncy_fnd_owner(idx,iprc,ladj,idxmap,info)
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@ -60,10 +60,11 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,idxmap,info)
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
integer(psb_ipk_), intent(in) :: ladj(:)
class(psb_indx_map), intent(in) :: idxmap
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), allocatable :: answers(:,:), idxsrch(:,:), hproc(:)
@ -80,7 +81,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,idxmap,info)
character(len=20) :: name
info = psb_success_
name = 'psb_indx_map_fnd_owner'
name = 'psi_adjcncy_fnd_owner'
call psb_erractionsave(err_act)
ictxt = idxmap%get_ctxt()
@ -113,11 +114,10 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,idxmap,info)
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_realloc')
goto 9999
end if
!write(0,*) me,name,' Going through ',nv,size(ladj)
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=idxmap%get_fmt())
goto 9999
call psi_a2a_fnd_owner(idx,iprc,idxmap,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return

8
base/internals/psi_fnd_owner.F90
Unescape Escape View File

@ -62,11 +62,11 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: nv
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), intent(in) :: nv
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), allocatable :: hsz(:),hidx(:),helem(:),hproc(:),&

145
base/internals/psi_graph_fnd_owner.F90
Unescape Escape View File

@ -60,27 +60,27 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info)
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_), intent(in) :: idx(:)
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
class(psb_indx_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), allocatable :: answers(:,:), idxsrch(:,:), hproc(:)
integer(psb_ipk_), allocatable :: helem(:), hhidx(:)
integer(psb_lpk_), allocatable :: answers(:,:), idxsrch(:,:), hproc(:), tidx(:)
integer(psb_ipk_), allocatable :: helem(:), hhidx(:), tprc(:), tsmpl(:), ladj(:)
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
& last_ih, last_j, nv, n_answers, n_rest, n_samples, locr_max, nrest_max, nadj, maxspace
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
real(psb_dpk_) :: t0, t1, t2, t3, t4
character(len=20) :: name
info = psb_success_
name = 'psb_indx_map_fnd_owner'
name = 'psi_graph_fnd_owner'
call psb_erractionsave(err_act)
ictxt = idxmap%get_ctxt()
@ -88,7 +88,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info)
mglob = idxmap%get_gr()
n_row = idxmap%get_lr()
n_col = idxmap%get_lc()
iictxt = ictxt
iictxt = ictxt
call psb_info(ictxt, me, np)
@ -103,22 +103,90 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info)
goto 9999
end if
if (gettime) then
t0 = psb_wtime()
end if
locr_max = n_row
call psb_max(ictxt,locr_max)
!
! Choice of maxspace should be adjusted to account for a default
! "sensible" size and/or a user-specified value
maxspace = 2*locr_max
nv = size(idx)
call psb_realloc(nv,iprc,info)
if (info == psb_success_) call psb_realloc(nv,tidx,info)
if (info == psb_success_) call psb_realloc(nv,tprc,info)
if (info == psb_success_) call psb_realloc(nv,tsmpl,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
iprc(:) = -1
n_answers = 0
if (.true.) then
!
! Start from the adjacncy list
!
! Skip for the time being
n_rest = nv - n_answers
nrest_max = n_rest
call psb_max(ictxt,nrest_max)
fnd_owner_loop: do while (nrest_max>0)
!
! The basic idea of this loop is to alternate between
! searching through all processes and searching
! in the neighbourood.
!
! 1. Select a sample to be sent to all processes; sample
! size is such that the total size is <= maxspace
!
if (me == 0) write(0,*) 'Looping in graph_fnd_owner: ', nrest_max
n_samples = min(n_rest,max(1,(maxspace+np-1)/np))
!
! Choose a sample, should it be done in this simplistic way?
!
call psi_get_sample(idx,tidx,tsmpl,n_samples,k)
n_samples = min(k,n_samples)
!
! 2. Do a search on all processes; this is supposed to find
! the owning process for all inputs;
!
call psi_a2a_fnd_owner(tidx(1:n_samples),tprc,idxmap,info)
call psi_cpy_out(iprc,tprc,tsmpl,n_samples,k)
if (k /= n_samples) then
write(0,*) me,'Warning: indices not found by a2a_fnd_owner ',k,n_samples
end if
n_answers = n_answers + k
n_rest = nv - n_answers
!
! 3. Extract the resulting adjacency list and add it to the
! indxmap;
!
ladj = tprc(1:n_samples)
call psb_msort_unique(ladj,nadj)
!
! NOTE: should symmetrize the list...
!
call idxmap%xtnd_p_adjcncy(ladj(1:nadj))
!
! 4. Extract a sample and do a neighbourhood search so that the total
! size is <= maxspace
! (will not be exact since nadj varies with process)
!
n_samples = min(n_rest,max(1,(maxspace+max(1,nadj)-1))/(max(1,nadj)))
call psi_get_sample(idx,tidx,tsmpl,n_samples,k)
n_samples = min(k,n_samples)
call psi_adjcncy_fnd_owner(tidx(1:n_samples),tprc,ladj(1:nadj),idxmap,info)
call psi_cpy_out(iprc,tprc,tsmpl,n_samples,k)
n_answers = n_answers + k
n_rest = nv - n_answers
nrest_max = n_rest
call psb_max(ictxt,nrest_max)
end do fnd_owner_loop
else
call psi_a2a_fnd_owner(idx,iprc,idxmap,info)
end if
call psb_erractionrestore(err_act)
return
@ -126,4 +194,47 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info)
return
contains
subroutine psi_get_sample(idx,tidx,tsmpl,ns_in,ns_out)
implicit none
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), intent(in) :: ns_in
integer(psb_lpk_), intent(out) :: tidx(:)
integer(psb_ipk_), intent(out) :: tsmpl(:), ns_out
!
integer(psb_ipk_) :: j, nv
nv = size(idx)
!
! Choose a sample, should it be done in this simplistic way?
!
ns_out = 0
do j=1, nv
if (iprc(j) == -1) then
ns_out = ns_out + 1
tsmpl(ns_out) = j
tidx(ns_out) = idx(j)
end if
if (ns_out >= ns_in) exit
end do
end subroutine psi_get_sample
subroutine psi_cpy_out(iprc,tprc,tsmpl,ns_in,ns_out)
implicit none
integer(psb_ipk_), intent(out) :: iprc(:)
integer(psb_ipk_), intent(in) :: ns_in
integer(psb_ipk_), intent(in) :: tprc(:), tsmpl(:)
integer(psb_ipk_), intent(out) :: ns_out
integer(psb_ipk_) :: j
ns_out = 0
do j=1, ns_in
if (tprc(j) /= -1) then
ns_out = ns_out + 1
iprc(tsmpl(j)) = tprc(j)
end if
end do
end subroutine psi_cpy_out
end subroutine psi_graph_fnd_owner

10
base/internals/psi_indx_map_fnd_owner.F90
Unescape Escape View File

@ -60,10 +60,10 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info)
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_), intent(in) :: idx(:)
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
class(psb_indx_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), allocatable :: hhidx(:)
@ -134,8 +134,8 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info)
else
if (.true.) then
if (.false.) then
call psi_a2a_fnd_owner(idx,iprc,idxmap,info)
else

6
base/modules/desc/psb_desc_mod.F90
Unescape Escape View File

@ -1746,10 +1746,10 @@ contains
subroutine cd_fnd_owner(idx,iprc,desc,info)
use psb_error_mod
implicit none
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
class(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='cd_fnd_owner'
logical, parameter :: debug=.false.

6
base/modules/desc/psb_gen_block_map_mod.F90
Unescape Escape View File

@ -1934,10 +1934,10 @@ contains
subroutine block_fnd_owner(idx,iprc,idxmap,info)
use psb_penv_mod
implicit none
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
class(psb_gen_block_map), intent(in) :: idxmap
integer(psb_ipk_), intent(out) :: info
class(psb_gen_block_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: ictxt, iam, np, nv, ip, i
integer(psb_lpk_) :: tidx

6
base/modules/desc/psb_glist_map_mod.f90
Unescape Escape View File

@ -154,10 +154,10 @@ contains
use psb_penv_mod
use psb_sort_mod
implicit none
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
class(psb_glist_map), intent(in) :: idxmap
integer(psb_ipk_), intent(out) :: info
class(psb_glist_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: ictxt, iam, np
integer(psb_lpk_) :: nv, i, ngp

25
base/modules/desc/psb_indx_map_mod.f90
Unescape Escape View File

@ -270,10 +270,10 @@ module psb_indx_map_mod
subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info)
import :: psb_indx_map, psb_ipk_, psb_lpk_
implicit none
integer(psb_lpk_), intent(in) :: idx(:)
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
class(psb_indx_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(out) :: info
end subroutine psi_indx_map_fnd_owner
end interface
@ -281,21 +281,22 @@ module psb_indx_map_mod
subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info)
import :: psb_indx_map, psb_ipk_, psb_lpk_
implicit none
integer(psb_lpk_), intent(in) :: idx(:)
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
class(psb_indx_map), intent(in) :: idxmap
integer(psb_ipk_), intent(out) :: info
end subroutine psi_a2a_fnd_owner
end interface
interface
subroutine psi_adjcncy_fnd_owner(idx,iprc,idxmap,info)
subroutine psi_adjcncy_fnd_owner(idx,iprc,ladj,idxmap,info)
import :: psb_indx_map, psb_ipk_, psb_lpk_
implicit none
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
integer(psb_ipk_), intent(in) :: ladj(:)
class(psb_indx_map), intent(in) :: idxmap
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psi_adjcncy_fnd_owner
end interface
@ -303,10 +304,10 @@ module psb_indx_map_mod
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_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
class(psb_indx_map), intent(in) :: idxmap
integer(psb_ipk_), intent(out) :: info
class(psb_indx_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(out) :: info
end subroutine psi_graph_fnd_owner
end interface

6
base/modules/desc/psb_repl_map_mod.f90
Unescape Escape View File

@ -699,10 +699,10 @@ contains
subroutine repl_fnd_owner(idx,iprc,idxmap,info)
use psb_penv_mod
implicit none
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
class(psb_repl_map), intent(in) :: idxmap
integer(psb_ipk_), intent(out) :: info
class(psb_repl_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: nv
integer(psb_mpk_) :: ictxt, iam, np

8
base/modules/psi_i_mod.F90
Unescape Escape View File

@ -131,11 +131,11 @@ module psi_i_mod
subroutine psi_i_fnd_owner(nv,idx,iprc,desc,info)
import
implicit none
integer(psb_ipk_), intent(in) :: nv
integer(psb_ipk_), intent(in) :: idx(:)
integer(psb_ipk_), intent(in) :: nv
integer(psb_ipk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i_fnd_owner
end interface psi_fnd_owner

Write Preview
Loading…
Cancel
Save