fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-07 07:04:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fix METIS interface for Intel compiler.

Browse Source
This commit is contained in:
Salvatore Filippone
2020-05-10 17:47:24 +02:00
parent 82d4e37043
commit b41e57f7c0
3 changed files with 116 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files
util/Makefile
+1 -1
View File
@@ -18,7 +18,7 @@ IMPLOBJS= psb_s_hbio_impl.o psb_d_hbio_impl.o \
psb_s_mat_dist_impl.o psb_d_mat_dist_impl.o \
psb_c_mat_dist_impl.o psb_z_mat_dist_impl.o \
psb_s_renum_impl.o psb_d_renum_impl.o \
psb_c_renum_impl.o psb_z_renum_impl.o
psb_c_renum_impl.o psb_z_renum_impl.o psi_build_mtpart.o
MODOBJS=psb_util_mod.o $(BASEOBJS)
COBJS=metis_int.o psb_amd_order.o
util/psb_metispart_mod.F90
+20 -102
View File
@@ -56,7 +56,7 @@
module psb_metispart_mod
use psb_base_mod, only : psb_sspmat_type, psb_cspmat_type,&
& psb_dspmat_type, psb_zspmat_type, psb_err_unit, &
& psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, &
& psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_spk_,&
& psb_s_csr_sparse_mat, psb_d_csr_sparse_mat, &
& psb_c_csr_sparse_mat, psb_z_csr_sparse_mat
public part_graph, build_mtpart, distr_mtpart,&
@@ -69,10 +69,22 @@ module psb_metispart_mod
& z_mat_build_mtpart, c_mat_build_mtpart
end interface
interface
subroutine psi_build_mtpart(n,ja,irp,nparts,vect, weights)
import :: psb_ipk_, psb_spk_
implicit none
integer(psb_ipk_), intent(in) :: n, nparts
integer(psb_ipk_), intent(in) :: ja(:), irp(:)
integer(psb_ipk_), allocatable, intent(inout) :: vect(:)
real(psb_spk_),optional, intent(in) :: weights(:)
end subroutine psi_build_mtpart
end interface
contains
subroutine part_graph(global_indx,n,np,pv,nv)
implicit none
implicit none
integer(psb_lpk_), intent(in) :: global_indx, n
integer(psb_ipk_), intent(in) :: np
integer(psb_ipk_), intent(out) :: nv
@@ -176,9 +188,9 @@ contains
end if
end if
if (allocated(wgh_)) then
call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,wgh_)
call psi_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,graph_vect,wgh_)
else
call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts)
call psi_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,graph_vect)
end if
end subroutine d_csr_build_mtpart
@@ -215,9 +227,9 @@ contains
end if
end if
if (allocated(wgh_)) then
call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,wgh_)
call psi_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,graph_vect,wgh_)
else
call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts)
call psi_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,graph_vect)
end if
end subroutine z_csr_build_mtpart
@@ -264,7 +276,7 @@ contains
real(psb_spk_), optional :: weights(:)
call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,weights)
call psi_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,graph_vect,weights)
end subroutine c_csr_build_mtpart
@@ -276,104 +288,10 @@ contains
real(psb_spk_), optional :: weights(:)
call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,weights)
call psi_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,graph_vect,weights)
end subroutine s_csr_build_mtpart
subroutine inner_build_mtpart(n,ja,irp,nparts,weights)
use psb_base_mod
use iso_c_binding
implicit none
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
integer(psb_ipk_) :: iopt(10),idummy(2),jdummy(2), info
integer(psb_ipk_) :: nl,nptl
integer(psb_ipk_), allocatable :: irpl(:),jal(:),gvl(:)
real(psb_spk_),allocatable :: wgh_(:)
#if defined(HAVE_METIS) && defined(IPK4)
interface
! subroutine METIS_PartGraphKway(n,ixadj,iadj,ivwg,iajw,&
! & wgflag,numflag,nparts,weights,iopt,nedc,part) bind(c)
! use iso_c_binding
! integer(c_int) :: n,wgflag,numflag,nparts,nedc
! integer(c_int) :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
! real(c_float) :: weights(*)
! !integer(psb_ipk_) :: n,wgflag,numflag,nparts,nedc
! !integer(psb_ipk_) :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
! end subroutine METIS_PartGraphKway
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
#else
write(psb_err_unit,*) 'Warning: METIS was not configured at PSBLAS compile time !'
#endif
return
end subroutine inner_build_mtpart
!
! WARNING: called IRET otherwise Intel compiler complains,
! methinks it's a compiler bug, will need to report.
util/psi_build_mtpart.F90
+95
View File
@@ -0,0 +1,95 @@
subroutine psi_build_mtpart(n,ja,irp,nparts,graph_vect,weights)
use psb_base_mod
use iso_c_binding
implicit none
integer(psb_ipk_), intent(in) :: n, nparts
integer(psb_ipk_), intent(in) :: ja(:), irp(:)
integer(psb_ipk_), allocatable, intent(inout) :: graph_vect(:)
real(psb_spk_),optional, intent(in) :: weights(:)
! local variables
integer(psb_ipk_) :: i,numflag, nedc,wgflag
integer(psb_ipk_) :: iopt(10),idummy(2),jdummy(2), info
integer(psb_ipk_) :: nl,nptl
integer(psb_ipk_), allocatable :: irpl(:),jal(:),gvl(:)
real(psb_spk_),allocatable :: wgh_(:)
#if defined(HAVE_METIS) && defined(IPK4)
interface
! subroutine METIS_PartGraphKway(n,ixadj,iadj,ivwg,iajw,&
! & wgflag,numflag,nparts,weights,iopt,nedc,part) bind(c)
! use iso_c_binding
! integer(c_int) :: n,wgflag,numflag,nparts,nedc
! integer(c_int) :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
! real(c_float) :: weights(*)
! !integer(psb_ipk_) :: n,wgflag,numflag,nparts,nedc
! !integer(psb_ipk_) :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
! end subroutine METIS_PartGraphKway
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
#else
write(psb_err_unit,*) 'Warning: METIS was not configured at PSBLAS compile time !'
#endif
return
end subroutine psi_build_mtpart