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

Fix sorting of dep_list: store in CSR-like, handle self-loops

Browse Source
pizdaint-runs
Salvatore Filippone 5 years ago
parent 781f0ef083
commit 62a67a0d0e
4 changed files with 42 additions and 20 deletions
Show Stats Download Patch File Download Diff File

9
base/internals/psi_crea_index.f90
Unescape Escape View File

@ -191,11 +191,16 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info)
if (do_timings) call psb_tic(idx_phase2) if (do_timings) call psb_tic(idx_phase2)
call psi_bld_glb_dep_list(ictxt,& call psi_bld_glb_dep_list(ictxt,&
& loc_dl,length_dl,c_dep_list,dl_ptr,info) & loc_dl,length_dl,c_dep_list,dl_ptr,info)
if (info /= 0) then
write(0,*) me,trim(name),' From bld_glb_list ',info
end if
!!$ call psi_dl_check(dep_list,dl_lda,np,length_dl) !!$ call psi_dl_check(dep_list,dl_lda,np,length_dl)
!!$ !!$
!!$ ! ....now i can sort dependency lists. !!$ ! ....now i can sort dependency lists.
call psi_sort_dl(dl_ptr,c_dep_list,length_dl,np,info) call psi_sort_dl(dl_ptr,c_dep_list,length_dl,np,info)
if (info /= 0) then
write(0,*) me,trim(name),' From sort_dl ',info
end if
ldl = length_dl(me) ldl = length_dl(me)
loc_dl = c_dep_list(dl_ptr(me):dl_ptr(me)+ldl-1) loc_dl = c_dep_list(dl_ptr(me):dl_ptr(me)+ldl-1)
@ -253,7 +258,7 @@ contains
logical :: val logical :: val
val = .not.(((dlmax>(26*4)).or.((dlavg>=(26*2)).and.(np>=128)))) val = .not.(((dlmax>(26*4)).or.((dlavg>=(26*2)).and.(np>=128))))
val = .true. !val = .true.
end function choose_sorting end function choose_sorting
end subroutine psi_i_crea_index end subroutine psi_i_crea_index

36
base/internals/psi_sort_dl.f90
Unescape Escape View File

@ -136,7 +136,7 @@ end subroutine psi_i_sort_dl
! node in the dependency list for the current one * ! node in the dependency list for the current one *
! * ! *
!********************************************************************** !**********************************************************************
subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,np,info) subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ictxt,info)
use psi_mod, psb_protect_name => psi_i_csr_sort_dl use psi_mod, psb_protect_name => psi_i_csr_sort_dl
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
@ -144,14 +144,18 @@ subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,np,info)
implicit none implicit none
integer(psb_ipk_), intent(inout) :: c_dep_list(:), dl_ptr(0:), l_dep_list(0:) integer(psb_ipk_), intent(inout) :: c_dep_list(:), dl_ptr(0:), l_dep_list(0:)
integer(psb_ipk_), intent(in) :: np integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer(psb_ipk_), allocatable :: dg(:), dgp(:),& integer(psb_ipk_), allocatable :: dg(:), dgp(:),&
& idx(:), upd(:), edges(:,:), ich(:) & idx(:), upd(:), edges(:,:), ich(:)
integer(psb_ipk_) :: i, j, nedges, ip1, ip2, nch, ip, iedge,& integer(psb_ipk_) :: i, j, nedges, ip1, ip2, nch, ip, iedge,&
& i1, ix, ist, iswap(2) & i1, ix, ist, iswap(2)
logical :: internal_error
integer(psb_ipk_) :: me, np
info = 0
call psb_info(ictxt,me,np)
nedges = size(c_dep_list) nedges = size(c_dep_list)
allocate(dg(0:np-1),dgp(nedges),edges(2,nedges),upd(0:np-1),& allocate(dg(0:np-1),dgp(nedges),edges(2,nedges),upd(0:np-1),&
@ -173,7 +177,7 @@ subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,np,info)
do i = 0, np-1 do i = 0, np-1
do j = dl_ptr(i),dl_ptr(i+1) - 1 do j = dl_ptr(i),dl_ptr(i+1) - 1
ip = c_dep_list(j) ip = c_dep_list(j)
if (i<ip) then if (i<=ip) then
nedges = nedges + 1 nedges = nedges + 1
edges(1,nedges) = i edges(1,nedges) = i
edges(2,nedges) = ip edges(2,nedges) = ip
@ -237,21 +241,28 @@ subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,np,info)
iswap(1:2) = edges(1:2,ist) iswap(1:2) = edges(1:2,ist)
edges(1:2,ist) = edges(1:2,ich(i)) edges(1:2,ist) = edges(1:2,ich(i))
edges(1:2,ich(i)) = iswap(1:2) edges(1:2,ich(i)) = iswap(1:2)
ist = ist + 1 ist = ist + 1
end do end do
do i=0, np-1 do i=0, np-1
dg(i) = dg(i) + upd(i) dg(i) = dg(i) + upd(i)
end do end do
end do end do
internal_error = .false.
do i=0, np-1 do i=0, np-1
if (dg(i) /= 0) then if (dg(i) /= 0) then
write(psb_err_unit,*)& internal_error = .true.
& 'SRTLIST Error on exit:',i,dg(i) if (me == 0) write(psb_err_unit,*)&
& 'csr_SRTLIST Error on exit:',i,dg(i)
end if end if
dg(i) = 0 dg(i) = 0
end do end do
if (internal_error .and. (me==0)) then
write(0,*) 'Error on srt_list. Input:'
do i = 0, np-1
write(0,*) 'Proc: ',i,' list: '
write(0,*) c_dep_list(dl_ptr(i):dl_ptr(i+1) - 1)
end do
end if
! !
! 10. Scan the edge sequence; ! 10. Scan the edge sequence;
! for each edge, take each one of its ! for each edge, take each one of its
@ -268,11 +279,16 @@ subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,np,info)
ix = dl_ptr(i) ix = dl_ptr(i)
c_dep_list(ix+dg(i)) = edges(1,j) c_dep_list(ix+dg(i)) = edges(1,j)
dg(i) = dg(i)+1 dg(i) = dg(i)+1
!
! If there are any self loops, adjust for error condition
! check
!
if (edges(1,j) == edges(2,j)) dg(i) = dg(i) -1
end do end do
do i=0, np-1 do i=0, np-1
if (dg(i) /= l_dep_list(i)) then if (dg(i) /= l_dep_list(i)) then
write(psb_err_unit,*) & if (me == 0) write(psb_err_unit,*) &
& 'SRTLIST Mismatch on output',i,dg(i),l_dep_list(i) & 'SRTLIST Mismatch on output',i,dg(i),l_dep_list(i)
end if end if
end do end do

3
base/internals/psi_srtlist.f90
Unescape Escape View File

@ -114,7 +114,7 @@ subroutine srtlist(dep_list,dl_lda,ldl,np,dg,dgp,upd, edges,idx,ich,info)
do i=1, np do i=1, np
do j=1, dg(i) do j=1, dg(i)
ip = dep_list(j,i) + 1 ip = dep_list(j,i) + 1
if (ip.gt.i) then if (ip >= i) then
iedge = iedge + 1 iedge = iedge + 1
edges(1,iedge) = i edges(1,iedge) = i
edges(2,iedge) = ip edges(2,iedge) = ip
@ -187,6 +187,7 @@ subroutine srtlist(dep_list,dl_lda,ldl,np,dg,dgp,upd, edges,idx,ich,info)
i = edges(2,j) i = edges(2,j)
dg(i) = dg(i)+1 dg(i) = dg(i)+1
dep_list(dg(i),i) = edges(1,j)-1 dep_list(dg(i),i) = edges(1,j)-1
if (edges(1,j) == edges(2,j)) dg(i) = dg(i) -1
enddo enddo
do i=1, np do i=1, np
if (dg(i).ne.ldl(i)) then if (dg(i).ne.ldl(i)) then

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

@ -111,13 +111,13 @@ module psi_i_mod
integer(psb_ipk_) :: np integer(psb_ipk_) :: np
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
end subroutine psi_i_sort_dl end subroutine psi_i_sort_dl
subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,np,info) subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ictxt,info)
import import
implicit none implicit none
integer(psb_ipk_), intent(in) :: c_dep_list(:), dl_ptr(0:) integer(psb_ipk_), intent(in) :: c_dep_list(:), dl_ptr(0:)
integer(psb_ipk_), intent(inout) :: l_dep_list(0:) integer(psb_ipk_), intent(inout) :: l_dep_list(0:)
integer(psb_ipk_), intent(in) :: np integer(psb_ipk_) :: ictxt
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: info
end subroutine psi_i_csr_sort_dl end subroutine psi_i_csr_sort_dl
end interface end interface
@ -145,13 +145,13 @@ module psi_i_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_i_bld_glb_dep_list end subroutine psi_i_bld_glb_dep_list
subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,info)
import import
integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:)
integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:), dl_ptr(:) integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:), dl_ptr(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_i_bld_glb_csr_dep_list end subroutine psi_i_bld_glb_csr_dep_list
end interface psi_bld_glb_dep_list end interface
interface psi_extract_loc_dl interface psi_extract_loc_dl
subroutine psi_i_xtr_loc_dl(ictxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) subroutine psi_i_xtr_loc_dl(ictxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info)

Write Preview
Loading…
Cancel
Save