Fix METIS partition module for Intel compilers.

new-context
Salvatore Filippone 5 years ago
parent e9a8814338
commit 82d4e37043

@ -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,

Loading…
Cancel
Save