You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
psblas3/util/psb_metispart_mod.F90

220 lines
6.9 KiB
Fortran

!!$
!!$ Parallel Sparse BLAS version 2.2
!!$ (C) Copyright 2006/2007/2008
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ 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.
!!$
!!$
!
! Purpose:
! Provide a set of subroutines to define a data distribution based on
! a graph partitioning routine from METIS. May serve as the basis
! for interfacing other graph partitioning tools.
!
! Subroutines:
!
! BUILD_MTPART(A,NPARTS): This subroutine will be called by the root
! process to build define the data distribuition mapping.
! Input parameters:
! TYPE(D_SPMAT) :: A The input matrix. The coefficients are
! ignored; only the structure is used.
! INTEGER :: NPARTS How many parts we are requiring to the
! partition utility
!
! DISTR_MTPART(RROOT,CROOT,ICTXT): This subroutine will be called by
! all processes to distribute the information computed by the root
! process, to be used subsequently.
!
!
! PART_GRAPH : The subroutine to be passed to PSBLAS sparse library;
! uses information prepared by the previous two subroutines.
!
module psb_metispart_mod
public part_graph, build_mtpart, distr_mtpart,&
& getv_mtpart, free_part
private
integer, allocatable, save :: graph_vect(:)
interface build_mtpart
module procedure build_mtpart, d_mat_build_mtpart
end interface
contains
subroutine part_graph(global_indx,n,np,pv,nv)
integer, intent(in) :: global_indx, n, np
integer, intent(out) :: nv
integer, intent(out) :: pv(*)
IF (.not.allocated(graph_vect)) then
write(0,*) 'Fatal error in PART_GRAPH: vector GRAPH_VECT ',&
& 'not initialized'
return
endif
if ((global_indx<1).or.(global_indx > size(graph_vect))) then
write(0,*) 'Fatal error in PART_GRAPH: index GLOBAL_INDX ',&
& 'outside GRAPH_VECT bounds',global_indx,size(graph_vect)
return
endif
nv = 1
pv(nv) = graph_vect(global_indx)
return
end subroutine part_graph
subroutine distr_mtpart(root, ictxt)
use psb_base_mod
integer :: root, ictxt
integer :: n, me, np
call psb_info(ictxt,me,np)
if (.not.((root>=0).and.(root<np))) then
write(0,*) 'Fatal error in DISTR_MTPART: invalid ROOT ',&
& 'coordinates '
call psb_abort(ictxt)
return
endif
if (me == root) then
if (.not.allocated(graph_vect)) then
write(0,*) 'Fatal error in DISTR_MTPART: vector GRAPH_VECT ',&
& 'not initialized'
call psb_abort(ictxt)
return
endif
n = size(graph_vect)
call psb_bcast(ictxt,n,root=root)
else
call psb_bcast(ictxt,n,root=root)
allocate(graph_vect(n),stat=info)
if (info /= 0) then
write(0,*) 'Fatal error in DISTR_MTPART: memory allocation ',&
& ' failure.'
return
endif
endif
call psb_bcast(ictxt,graph_vect(1:n),root=root)
return
end subroutine distr_mtpart
subroutine getv_mtpart(ivg)
integer, allocatable, intent(out) :: ivg(:)
if (allocated(graph_vect)) then
allocate(ivg(size(graph_vect)))
ivg(:) = graph_vect(:)
end if
end subroutine getv_mtpart
subroutine d_mat_build_mtpart(a,nparts)
use psb_base_mod
type(psb_d_sparse_mat), intent(in) :: a
integer :: nparts
select type (aa=>a%a)
type is (psb_d_csr_sparse_mat)
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts)
class default
write(0,*) 'Sorry, right now we only take CSR input!'
call psb_abort(ictxt)
end select
end subroutine d_mat_build_mtpart
subroutine build_mtpart(n,fida,ia1,ia2,nparts)
use psb_base_mod
integer :: nparts
integer :: ia1(:), ia2(:)
integer :: n, i,numflag,nedc,wgflag
character(len=5) :: fida
integer, parameter :: nb=512
real(psb_dpk_), parameter :: seed=12345.d0
integer :: iopt(10),idummy(2),jdummy(2)
#if defined(HAVE_METIS)
interface
subroutine METIS_PartGraphRecursive(n,ixadj,iadj,ivwg,iajw,&
& wgflag,numflag,nparts,iopt,nedc,part)
integer :: n,wgflag,numflag,nparts,nedc
integer :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
end subroutine METIS_PartGraphRecursive
end interface
allocate(graph_vect(n),stat=info)
if (info /= 0) then
write(0,*) 'Fatal error in BUILD_MTPART: memory allocation ',&
& ' failure.'
return
endif
if (nparts > 1) then
if (psb_toupper(fida) == 'CSR') then
iopt(1) = 0
numflag = 1
wgflag = 0
call METIS_PartGraphRecursive(n,ia2,ia1,idummy,jdummy,&
& wgflag,numflag,nparts,iopt,nedc,graph_vect)
do i=1, n
graph_vect(i) = graph_vect(i) - 1
enddo
else
write(0,*) 'Fatal error in BUILD_MTPART: matrix format ',&
& ' failure. ', FIDA
return
endif
else
do i=1, n
graph_vect(i) = 0
enddo
endif
#else
write(0,*) 'Warning: METIS was not configured at PSBLAS compile time !'
#endif
return
end subroutine build_mtpart
subroutine free_part(info)
integer :: info
deallocate(graph_vect,stat=info)
return
end subroutine free_part
end module psb_metispart_mod