diff --git a/base/internals/Makefile b/base/internals/Makefile index cbb282a9..ccad22fc 100644 --- a/base/internals/Makefile +++ b/base/internals/Makefile @@ -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 diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index 6731b0ea..e72fc410 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -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 diff --git a/base/internals/psi_sort_dl.f90 b/base/internals/psi_sort_dl.f90 index 77357c9e..bd352142 100644 --- a/base/internals/psi_sort_dl.f90 +++ b/base/internals/psi_sort_dl.f90 @@ -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,8 +161,14 @@ 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 ! the two nodes diff --git a/base/internals/psi_srtlist.f90 b/base/internals/psi_srtlist.f90 deleted file mode 100644 index 375dc885..00000000 --- a/base/internals/psi_srtlist.f90 +++ /dev/null @@ -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= 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 - -