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.
152 lines
4.4 KiB
Fortran
152 lines
4.4 KiB
Fortran
subroutine psi_l_build_mtpart(n,ja,irp,nparts,graph_vect,weights)
|
|
use psb_base_mod
|
|
use iso_c_binding
|
|
implicit none
|
|
integer(psb_lpk_), intent(in) :: n, nparts
|
|
integer(psb_lpk_), intent(in) :: ja(:), irp(:)
|
|
integer(psb_lpk_), allocatable, intent(inout) :: graph_vect(:)
|
|
real(psb_spk_),optional, intent(in) :: weights(:)
|
|
! local variables
|
|
integer(psb_lpk_) :: i,numflag, nedc,wgflag
|
|
integer(psb_lpk_) :: iopt(10),idummy(2),jdummy(2)
|
|
integer(psb_ipk_) :: info
|
|
integer(psb_lpk_) :: nl,nptl
|
|
integer(psb_lpk_), allocatable :: irpl(:),jal(:),gvl(:)
|
|
real(psb_spk_),allocatable :: wgh_(:)
|
|
|
|
#if defined(HAVE_METIS) && defined(LPK4) && defined(METIS_32)
|
|
interface
|
|
function METIS_PartGraphKway(n,ixadj,iadj,ivwg,iajw,&
|
|
& nparts,weights,part) bind(c,name="metis_PartGraphKway_C") result(res)
|
|
use iso_c_binding
|
|
integer(c_int) :: res
|
|
integer(c_int) :: n,nparts
|
|
integer(c_int) :: ixadj(*),iadj(*),ivwg(*),iajw(*),part(*)
|
|
real(c_float) :: weights(*)
|
|
!integer(psb_ipk_) :: n,wgflag,numflag,nparts,nedc
|
|
!integer(psb_ipk_) :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
|
|
end function METIS_PartGraphKway
|
|
end interface
|
|
|
|
call psb_realloc(n,graph_vect,info)
|
|
if (info == psb_success_) allocate(gvl(n),wgh_(nparts),stat=info)
|
|
|
|
if (info /= psb_success_) then
|
|
write(psb_err_unit,*) 'Fatal error in BUILD_MTPART: memory allocation ',&
|
|
& ' failure.'
|
|
return
|
|
endif
|
|
if (nparts > 1) then
|
|
iopt(1) = 0
|
|
numflag = 1
|
|
wgflag = 0
|
|
|
|
!!$ write(*,*) 'Before allocation',nparts
|
|
|
|
irpl=irp
|
|
jal = ja
|
|
nl = n
|
|
nptl = nparts
|
|
wgh_ = -1.0
|
|
if(present(weights)) then
|
|
if (size(weights) == nptl) then
|
|
!!$ write(*,*) 'weights present',weights
|
|
! call METIS_PartGraphKway(n,irp,ja,idummy,jdummy,&
|
|
! & wgflag,numflag,nparts,weights,iopt,nedc,graph_vect)
|
|
info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
|
|
& nptl,weights,gvl)
|
|
|
|
else
|
|
!!$ write(*,*) 'weights absent',wgh_
|
|
info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
|
|
& nptl,wgh_,gvl)
|
|
end if
|
|
else
|
|
!!$ write(*,*) 'weights absent',wgh_
|
|
info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
|
|
& nptl,wgh_,gvl)
|
|
endif
|
|
!!$ write(*,*) 'after allocation',info
|
|
|
|
do i=1, n
|
|
graph_vect(i) = gvl(i) - 1
|
|
enddo
|
|
else
|
|
do i=1, n
|
|
graph_vect(i) = 0
|
|
enddo
|
|
endif
|
|
|
|
#elif defined(HAVE_METIS) && defined(LPK8) && defined(METIS_64)
|
|
|
|
interface
|
|
function METIS_PartGraphKway(n,ixadj,iadj,ivwg,iajw,&
|
|
& nparts,weights,part) bind(c,name="metis_PartGraphKway_C") result(res)
|
|
use iso_c_binding
|
|
integer(c_long_long) :: res
|
|
integer(c_long_long) :: n,nparts
|
|
integer(c_long_long) :: ixadj(*),iadj(*),ivwg(*),iajw(*),part(*)
|
|
real(c_float) :: weights(*)
|
|
!integer(psb_ipk_) :: n,wgflag,numflag,nparts,nedc
|
|
!integer(psb_ipk_) :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
|
|
end function METIS_PartGraphKway
|
|
end interface
|
|
|
|
call psb_realloc(n,graph_vect,info)
|
|
if (info == psb_success_) allocate(gvl(n),wgh_(nparts),stat=info)
|
|
|
|
if (info /= psb_success_) then
|
|
write(psb_err_unit,*) 'Fatal error in BUILD_MTPART: memory allocation ',&
|
|
& ' failure.'
|
|
return
|
|
endif
|
|
if (nparts > 1) then
|
|
iopt(1) = 0
|
|
numflag = 1
|
|
wgflag = 0
|
|
|
|
!!$ write(*,*) 'Before allocation',nparts
|
|
|
|
irpl=irp
|
|
jal = ja
|
|
nl = n
|
|
nptl = nparts
|
|
wgh_ = -1.0
|
|
if(present(weights)) then
|
|
if (size(weights) == nptl) then
|
|
!!$ write(*,*) 'weights present',weights
|
|
! call METIS_PartGraphKway(n,irp,ja,idummy,jdummy,&
|
|
! & wgflag,numflag,nparts,weights,iopt,nedc,graph_vect)
|
|
info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
|
|
& nptl,weights,gvl)
|
|
|
|
else
|
|
!!$ write(*,*) 'weights absent',wgh_
|
|
info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
|
|
& nptl,wgh_,gvl)
|
|
end if
|
|
else
|
|
!!$ write(*,*) 'weights absent',wgh_
|
|
info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
|
|
& nptl,wgh_,gvl)
|
|
endif
|
|
!!$ write(*,*) 'after allocation',info
|
|
|
|
do i=1, n
|
|
graph_vect(i) = gvl(i) - 1
|
|
enddo
|
|
else
|
|
do i=1, n
|
|
graph_vect(i) = 0
|
|
enddo
|
|
endif
|
|
|
|
#else
|
|
|
|
write(psb_err_unit,*) 'Warning: no suitable METIS interface for LPK indices'
|
|
#endif
|
|
|
|
return
|
|
|
|
end subroutine psi_l_build_mtpart
|