mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-17 03:12:15 +00:00
Fix METIS partition module for Intel compilers.
This commit is contained in:
+39
-50
@@ -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
|
||||
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
|
||||
write(psb_err_unit,*) 'Fatal error in BUILD_MTPART: matrix format ',&
|
||||
& ' failure. ', FIDA
|
||||
return
|
||||
endif
|
||||
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,
|
||||
|
||||
Reference in New Issue
Block a user