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

Variant of dependency list sorting, prepare for experimentation.

Browse Source
unify_aggr_bld
Salvatore Filippone 5 years ago
parent c2621c6b28
commit 7147e6a076
4 changed files with 13 additions and 210 deletions
Show Stats Download Patch File Download Diff File

4
base/internals/Makefile
Unescape Escape View File

@ -4,9 +4,9 @@ FOBJS = psi_compute_size.o psi_crea_bnd_elem.o psi_crea_index.o \
psi_crea_ovr_elem.o psi_bld_tmpovrl.o \
psi_bld_tmphalo.o psi_sort_dl.o \
psi_indx_map_fnd_owner.o \
psi_desc_impl.o psi_hash_impl.o psi_srtlist.o \
psi_desc_impl.o psi_hash_impl.o \
psi_bld_glb_dep_list.o psi_xtr_loc_dl.o
#psi_list_search.o psi_dl_check.o
#psi_list_search.o psi_dl_check.o psi_srtlist.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 psi_symm_dep_list.o

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

@ -212,8 +212,8 @@ contains
val = .not.(((dlmax>(26*4)).or.((dlavg>=(26*2)).and.(np>=128))))
val = (dlmax<16)
!val = .true.
val = .false.
val = .true.
!val = .false.
end function choose_sorting
end subroutine psi_i_crea_index

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

@ -118,7 +118,7 @@ subroutine psi_i_csr_sort_dl_np(me,np,dl_ptr,c_dep_list,l_dep_list,info)
integer(psb_ipk_) :: i, j, nedges, ip1, ip2, nch, ip, iedge,&
& i1, ix, ist, iswap(2)
logical :: internal_error
logical, parameter :: sort_dg=.false.
nedges = size(c_dep_list)
@ -161,7 +161,13 @@ subroutine psi_i_csr_sort_dl_np(me,np,dl_ptr,c_dep_list,l_dep_list,info)
do i = ist, nedges
dgp(i) = (dg(edges(1,i)) + dg(edges(2,i)))
end do
call psb_msort(dgp(ist:nedges),ix=idx(ist:nedges),dir=psb_sort_down_)
if (sort_dg) then
call psb_msort(dgp(ist:nedges),ix=idx(ist:nedges),dir=psb_sort_down_)
else
do i=ist,nedges
idx(i) = i-ist+1
end do
end if
! 5. Scan the list of edges; if neither node of the
! edge has been marked yet, take out the edge and mark

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

@ -1,203 +0,0 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006, 2010, 2015, 2017
! Salvatore Filippone
! Alfredo Buttari CNRS-IRIT, Toulouse
!
! 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.
!
!
!**********************************************************************
! *
! The communication step among processors at each *
! matrix-vector product is a variable all-to-all *
! collective communication that we reimplement *
! in terms of point-to-point communications. *
! The data in input is a list of dependencies: *
! for each node a list of all the nodes it has to *
! communicate with. The lists are guaranteed to be *
! symmetric, i.e. for each pair (I,J) there is a *
! pair (J,I). The idea is to organize the ordering *
! so that at each communication step as many *
! processors as possible are communicating at the *
! same time, i.e. a step is defined by the fact *
! that all edges (I,J) in it have no common node. *
! *
! Formulation of the problem is: *
! Given an undirected graph (forest): *
! Find the shortest series of steps to cancel all *
! graph edges, where at each step all edges belonging *
! to a matching in the graph are canceled. *
! *
! An obvious lower bound to the optimum number of steps *
! is the largest degree of any node in the graph. *
! *
! The algorithm proceeds as follows: *
! 1. Build a list of all edges, e.g. copy the *
! dependencies lists keeping only (I,J) with I<J *
! 2. Compute an auxiliary vector with the degree of *
! each node of the graph. *
! 3. While there are edges in the graph do: *
! 4. Weight the edges with the sum of the degrees *
! of their nodes and sort them into descending order *
! 5. Scan the list of edges; if neither node of the *
! edge has been marked yet, cancel the edge and mark *
! the two nodes *
! 6. If no edge was chosen but the graph is nonempty *
! raise an error condition *
! 7. Queue the edges in the matchin to the output *
! sequence; *
! 8. Decrease by 1 the degree of all marked nodes, *
! then clear all marks *
! 9. Cycle to 3. *
! 10. For each node: scan the edge sequence; if an *
! edge has the node as an endpoint, queue the other *
! node in the dependency list for the current one *
! *
!**********************************************************************
subroutine srtlist(dep_list,dl_lda,ldl,np,dg,dgp,upd, edges,idx,ich,info)
use psb_serial_mod
implicit none
integer(psb_ipk_) :: np, dl_lda, info
integer(psb_ipk_) :: dep_list(dl_lda,*), ldl(*),dg(*), dgp(*),&
& idx(*), upd(*),edges(2,*),ich(*)
integer(psb_ipk_) :: i,j, nedges,ip1,ip2,nch,ip,iedge,&
& i1,ix,ist,iswap(2)
integer(psb_ipk_) :: no_comm
parameter (no_comm=-1)
if (np .lt. 0) then
info = 1
return
endif
!
! dg contains number of communications
!
do i=1, np
dg(i)=ldl(i)
enddo
nedges = 0
do i=1, np
do j=1, dg(i)
ip = dep_list(j,i) + 1
if (ip.gt.i) nedges = nedges + 1
enddo
enddo
iedge = 0
do i=1, np
do j=1, dg(i)
ip = dep_list(j,i) + 1
if (ip >= i) then
iedge = iedge + 1
edges(1,iedge) = i
edges(2,iedge) = ip
endif
enddo
enddo
ist = 1
do while (ist.le.nedges)
do i=1, np
upd(i) = 0
enddo
do i=ist, nedges
dgp(i) = -(dg(edges(1,i))+dg(edges(2,i)))
enddo
call psb_msort(dgp(ist:nedges),ix=idx(ist:nedges))
i1 = ist
nch = 0
do i = ist, nedges
ix = idx(i)+ist-1
ip1 = edges(1,ix)
ip2 = edges(2,ix)
if ((upd(ip1).eq.0).and.(upd(ip2).eq.0)) then
upd(ip1) = -1
upd(ip2) = -1
nch = nch + 1
ich(nch) = ix
endif
enddo
if (nch.eq.0) then
write(psb_err_unit,*)&
& 'srtlist ?????? impossible error !!!!!?????',&
& nedges,ist
do i=ist, nedges
ix = idx(i)+ist-1
write(psb_err_unit,*)&
& 'SRTLIST: Edge:',ix,edges(1,ix),&
& edges(2,ix),dgp(ix)
enddo
info = psb_err_input_value_invalid_i_
return
endif
call psb_msort(ich(1:nch))
do i=1, nch
iswap(1) = edges(1,ist)
iswap(2) = edges(2,ist)
edges(1,ist) = edges(1,ich(i))
edges(2,ist) = edges(2,ich(i))
edges(1,ich(i)) = iswap(1)
edges(2,ich(i)) = iswap(2)
ist = ist + 1
enddo
do i=1, np
dg(i) = dg(i) + upd(i)
enddo
enddo
do i=1, np
if (dg(i).ne.0) then
write(psb_err_unit,*)&
& 'SRTLIST Error on exit:',i,dg(i)
endif
dg(i) = 0
enddo
do j=1,nedges
i = edges(1,j)
dg(i) = dg(i)+1
dep_list(dg(i),i) = edges(2,j)-1
i = edges(2,j)
dg(i) = dg(i)+1
dep_list(dg(i),i) = edges(1,j)-1
if (edges(1,j) == edges(2,j)) dg(i) = dg(i) -1
enddo
do i=1, np
if (dg(i).ne.ldl(i)) then
write(psb_err_unit,*) &
& 'SRTLIST Mismatch on output',i,dg(i),ldl(i)
endif
enddo
return
end subroutine srtlist
Write Preview
Loading…
Cancel
Save