From b41e57f7c0c846faa6b164cd330d045b3d95aec9 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 10 May 2020 17:47:24 +0200 Subject: [PATCH] Fix METIS interface for Intel compiler. --- util/Makefile | 2 +- util/psb_metispart_mod.F90 | 122 ++++++------------------------------- util/psi_build_mtpart.F90 | 95 +++++++++++++++++++++++++++++ 3 files changed, 116 insertions(+), 103 deletions(-) create mode 100644 util/psi_build_mtpart.F90 diff --git a/util/Makefile b/util/Makefile index 1359a762..0f572e9c 100644 --- a/util/Makefile +++ b/util/Makefile @@ -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 diff --git a/util/psb_metispart_mod.F90 b/util/psb_metispart_mod.F90 index 7657a91a..425d8106 100644 --- a/util/psb_metispart_mod.F90 +++ b/util/psb_metispart_mod.F90 @@ -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. diff --git a/util/psi_build_mtpart.F90 b/util/psi_build_mtpart.F90 new file mode 100644 index 00000000..b8974185 --- /dev/null +++ b/util/psi_build_mtpart.F90 @@ -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