|
|
|
@ -65,12 +65,8 @@ module psb_metispart_mod
|
|
|
|
|
integer(psb_ipk_), allocatable, save :: graph_vect(:)
|
|
|
|
|
|
|
|
|
|
interface build_mtpart
|
|
|
|
|
module procedure build_mtpart,&
|
|
|
|
|
& d_mat_build_mtpart, s_mat_build_mtpart,&
|
|
|
|
|
& z_mat_build_mtpart, c_mat_build_mtpart, &
|
|
|
|
|
& d_csr_build_mtpart, s_csr_build_mtpart,&
|
|
|
|
|
& z_csr_build_mtpart, c_csr_build_mtpart
|
|
|
|
|
|
|
|
|
|
module procedure d_mat_build_mtpart, s_mat_build_mtpart,&
|
|
|
|
|
& z_mat_build_mtpart, c_mat_build_mtpart
|
|
|
|
|
end interface
|
|
|
|
|
|
|
|
|
|
contains
|
|
|
|
@ -180,9 +176,9 @@ contains
|
|
|
|
|
end if
|
|
|
|
|
end if
|
|
|
|
|
if (allocated(wgh_)) then
|
|
|
|
|
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_)
|
|
|
|
|
call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,wgh_)
|
|
|
|
|
else
|
|
|
|
|
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts)
|
|
|
|
|
call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts)
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
end subroutine d_csr_build_mtpart
|
|
|
|
@ -219,9 +215,9 @@ contains
|
|
|
|
|
end if
|
|
|
|
|
end if
|
|
|
|
|
if (allocated(wgh_)) then
|
|
|
|
|
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_)
|
|
|
|
|
call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,wgh_)
|
|
|
|
|
else
|
|
|
|
|
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts)
|
|
|
|
|
call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts)
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
end subroutine z_csr_build_mtpart
|
|
|
|
@ -268,7 +264,7 @@ contains
|
|
|
|
|
real(psb_spk_), optional :: weights(:)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,weights)
|
|
|
|
|
call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,weights)
|
|
|
|
|
|
|
|
|
|
end subroutine c_csr_build_mtpart
|
|
|
|
|
|
|
|
|
@ -280,21 +276,20 @@ contains
|
|
|
|
|
real(psb_spk_), optional :: weights(:)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,weights)
|
|
|
|
|
call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,weights)
|
|
|
|
|
|
|
|
|
|
end subroutine s_csr_build_mtpart
|
|
|
|
|
|
|
|
|
|
subroutine build_mtpart(n,fida,ja,irp,nparts,weights)
|
|
|
|
|
subroutine inner_build_mtpart(n,ja,irp,nparts,weights)
|
|
|
|
|
use psb_base_mod
|
|
|
|
|
use iso_c_binding
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_ipk_) :: nparts
|
|
|
|
|
integer(psb_ipk_) :: ja(:), irp(:)
|
|
|
|
|
integer(psb_ipk_), intent(in) :: nparts
|
|
|
|
|
integer(psb_ipk_), intent(in) :: ja(:), irp(:)
|
|
|
|
|
real(psb_spk_),optional, intent(in) :: weights(:)
|
|
|
|
|
! local variables
|
|
|
|
|
integer(psb_ipk_) :: n, i,numflag,nedc,wgflag
|
|
|
|
|
character(len=5) :: fida
|
|
|
|
|
integer(psb_ipk_), parameter :: nb=512
|
|
|
|
|
real(psb_dpk_), parameter :: seed=12345.d0
|
|
|
|
|
integer(psb_ipk_) :: iopt(10),idummy(2),jdummy(2), info
|
|
|
|
|
real(psb_spk_),optional :: weights(:)
|
|
|
|
|
integer(psb_ipk_) :: nl,nptl
|
|
|
|
|
integer(psb_ipk_), allocatable :: irpl(:),jal(:),gvl(:)
|
|
|
|
|
real(psb_spk_),allocatable :: wgh_(:)
|
|
|
|
@ -332,46 +327,40 @@ contains
|
|
|
|
|
return
|
|
|
|
|
endif
|
|
|
|
|
if (nparts > 1) then
|
|
|
|
|
if (psb_toupper(fida) == 'CSR') then
|
|
|
|
|
iopt(1) = 0
|
|
|
|
|
numflag = 1
|
|
|
|
|
wgflag = 0
|
|
|
|
|
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
|
|
|
|
|
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)
|
|
|
|
|
! 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_
|
|
|
|
|
!!$ 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
|
|
|
|
|
end if
|
|
|
|
|
else
|
|
|
|
|
write(psb_err_unit,*) 'Fatal error in BUILD_MTPART: matrix format ',&
|
|
|
|
|
& ' failure. ', FIDA
|
|
|
|
|
return
|
|
|
|
|
!!$ 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
|
|
|
|
@ -383,7 +372,7 @@ contains
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
end subroutine build_mtpart
|
|
|
|
|
end subroutine inner_build_mtpart
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! WARNING: called IRET otherwise Intel compiler complains,
|
|
|
|
|